Commit 36cec983 authored by Stefan Monnier's avatar Stefan Monnier

Further GV/CL cleanups.

* lisp/emacs-lisp/gv.el (gv-get): Autoload functions to find their
gv-expander.
(gv--defun-declaration): New function.
(defun-declarations-alist): Use it.
(gv-define-modify-macro, gv-pushnew!, gv-inc!, gv-dec!): Remove.
(gv-place): Autoload.
* lisp/emacs-lisp/cl.el (cl--dotimes, cl--dolist): Remember subr.el's
original definition of dotimes and dolist.
* lisp/emacs-lisp/cl-macs.el (cl-expr-access-order): Remove unused.
(cl-dolist, cl-dotimes): Use `dolist' and `dotimes'.
* lisp/emacs-lisp/cl-lib.el: Move gv handlers from cl-macs to here.
(cl-fifth, cl-sixth, cl-seventh, cl-eighth)
(cl-ninth, cl-tenth): Move gv handler to the function's definition.
* lisp/emacs-lisp/cl-extra.el (cl-subseq, cl-get, cl-getf): Move gv handler
to the function's definition.
* lisp/Makefile.in (COMPILE_FIRST): Re-order to speed it up by about 50%.
* lisp/window.el:
* lisp/files.el:
* lisp/faces.el:
* lisp/env.el: Don't use CL.
parent d35af63c
2012-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
Further GV/CL cleanups.
* emacs-lisp/gv.el (gv-get): Autoload functions to find their
gv-expander.
(gv--defun-declaration): New function.
(defun-declarations-alist): Use it.
(gv-define-modify-macro, gv-pushnew!, gv-inc!, gv-dec!): Remove.
(gv-place): Autoload.
* emacs-lisp/cl.el (cl--dotimes, cl--dolist): Remember subr.el's
original definition of dotimes and dolist.
* emacs-lisp/cl-macs.el (cl-expr-access-order): Remove unused.
(cl-dolist, cl-dotimes): Use `dolist' and `dotimes'.
* emacs-lisp/cl-lib.el: Move gv handlers from cl-macs to here.
(cl-fifth, cl-sixth, cl-seventh, cl-eighth)
(cl-ninth, cl-tenth): Move gv handler to the function's definition.
* emacs-lisp/cl-extra.el (cl-subseq, cl-get, cl-getf): Move gv handler
to the function's definition.
* Makefile.in (COMPILE_FIRST): Re-order to speed it up by about 50%.
* window.el:
* files.el:
* faces.el:
* env.el: Don't use CL.
2012-06-22 Paul Eggert <eggert@cs.ucla.edu>
Support higher-resolution time stamps (Bug#9000).
......
......@@ -92,13 +92,17 @@ BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process.
# speed up the bootstrap process. They're ordered by size, so we use
# the slowest-compiler on the smallest file and move to larger files as the
# compiler gets faster. `autoload.elc' comes last because it is not used by
# the compiler (so its compilation does not speed up subsequent compilations),
# it's only placed here so as to speed up generation of the loaddefs.el file.
COMPILE_FIRST = \
$(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/macroexp.elc \
$(lisp)/emacs-lisp/cconv.elc \
$(lisp)/emacs-lisp/cconv.elc \
$(lisp)/emacs-lisp/byte-opt.elc \
$(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/autoload.elc
# The actual Emacs command run in the targets below.
......
......@@ -523,6 +523,10 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
"Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end."
(declare (gv-setter
(lambda (new)
`(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
,new))))
(if (stringp seq) (substring seq start end)
(let (len)
(and end (< end 0) (setq end (+ end (setq len (length seq)))))
......@@ -587,7 +591,8 @@ If START or END is negative, it counts from the end."
(defun cl-get (sym tag &optional def)
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
(declare (compiler-macro cl--compiler-macro-get))
(declare (compiler-macro cl--compiler-macro-get)
(gv-setter (lambda (store) `(put ,sym ,tag ,store))))
(or (get sym tag)
(and def
;; Make sure `def' is really absent as opposed to set to nil.
......@@ -602,6 +607,15 @@ If START or END is negative, it counts from the end."
"Search PROPLIST for property PROPNAME; return its value or DEFAULT.
PROPLIST is a list of the sort returned by `symbol-plist'.
\n(fn PROPLIST PROPNAME &optional DEFAULT)"
(declare (gv-expander
(lambda (do)
(gv-letplace (getter setter) plist
(macroexp-let2 nil k tag
(macroexp-let2 nil d def
(funcall do `(cl-getf ,getter ,k ,d)
(lambda (v)
(funcall setter
`(cl--set-getf ,getter ,k ,v))))))))))
(setplist '--cl-getf-symbol-- plist)
(or (get '--cl-getf-symbol-- tag)
;; Originally we called cl-get here,
......
......@@ -378,26 +378,32 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
(defsubst cl-fifth (x)
"Return the fifth element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store))))
(nth 4 x))
(defsubst cl-sixth (x)
"Return the sixth element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store))))
(nth 5 x))
(defsubst cl-seventh (x)
"Return the seventh element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store))))
(nth 6 x))
(defsubst cl-eighth (x)
"Return the eighth element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store))))
(nth 7 x))
(defsubst cl-ninth (x)
"Return the ninth element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store))))
(nth 8 x))
(defsubst cl-tenth (x)
"Return the tenth element of the list X."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
(nth 9 x))
(defun cl-caaar (x)
......@@ -612,6 +618,108 @@ If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
;;; Generalized variables.
;; These used to be in cl-macs.el since all macros that use them (like setf)
;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
;; core Elisp, they need to either be right here or be autoloaded via
;; cl-loaddefs.el, which is more trouble than it is worth.
;; Some more Emacs-related place types.
(gv-define-simple-setter buffer-file-name set-visited-file-name t)
(gv-define-setter buffer-modified-p (flag &optional buf)
`(with-current-buffer ,buf
(set-buffer-modified-p ,flag)))
(gv-define-simple-setter buffer-name rename-buffer t)
(gv-define-setter buffer-string (store)
`(progn (erase-buffer) (insert ,store)))
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(gv-define-simple-setter current-buffer set-buffer)
(gv-define-simple-setter current-case-table set-case-table)
(gv-define-simple-setter current-column move-to-column t)
(gv-define-simple-setter current-global-map use-global-map t)
(gv-define-setter current-input-mode (store)
`(progn (apply #'set-input-mode ,store) ,store))
(gv-define-simple-setter current-local-map use-local-map t)
(gv-define-simple-setter current-window-configuration
set-window-configuration t)
(gv-define-simple-setter default-file-modes set-default-file-modes t)
(gv-define-simple-setter documentation-property put)
(gv-define-setter face-background (x f &optional s)
`(set-face-background ,f ,x ,s))
(gv-define-setter face-background-pixmap (x f &optional s)
`(set-face-background-pixmap ,f ,x ,s))
(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
(gv-define-setter face-foreground (x f &optional s)
`(set-face-foreground ,f ,x ,s))
(gv-define-setter face-underline-p (x f &optional s)
`(set-face-underline-p ,f ,x ,s))
(gv-define-simple-setter file-modes set-file-modes t)
(gv-define-simple-setter frame-height set-screen-height t)
(gv-define-simple-setter frame-parameters modify-frame-parameters t)
(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
(gv-define-simple-setter frame-width set-screen-width t)
(gv-define-simple-setter getenv setenv t)
(gv-define-simple-setter get-register set-register)
(gv-define-simple-setter global-key-binding global-set-key)
(gv-define-simple-setter local-key-binding local-set-key)
(gv-define-simple-setter mark set-mark t)
(gv-define-simple-setter mark-marker set-mark t)
(gv-define-simple-setter marker-position set-marker t)
(gv-define-setter mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cadr ,store)
(cddr ,store)))
(gv-define-simple-setter point goto-char)
(gv-define-simple-setter point-marker goto-char t)
(gv-define-setter point-max (store)
`(progn (narrow-to-region (point-min) ,store) ,store))
(gv-define-setter point-min (store)
`(progn (narrow-to-region ,store (point-max)) ,store))
(gv-define-setter read-mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cdr ,store)))
(gv-define-simple-setter screen-height set-screen-height t)
(gv-define-simple-setter screen-width set-screen-width t)
(gv-define-simple-setter selected-window select-window)
(gv-define-simple-setter selected-screen select-screen)
(gv-define-simple-setter selected-frame select-frame)
(gv-define-simple-setter standard-case-table set-standard-case-table)
(gv-define-simple-setter syntax-table set-syntax-table)
(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
(gv-define-setter window-height (store)
`(progn (enlarge-window (- ,store (window-height))) ,store))
(gv-define-setter window-width (store)
`(progn (enlarge-window (- ,store (window-width)) t) ,store))
(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
(gv-define-simple-setter x-get-selection x-own-selection t)
;; More complex setf-methods.
;; This is a hack that allows (setf (eq a 7) B) to mean either
;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
;; This is useful when you have control over the PLACE but not over
;; the VALUE, as is the case in define-minor-mode's :variable.
;; It turned out that :variable needed more flexibility anyway, so
;; this doesn't seem too useful now.
(gv-define-expander eq
(lambda (do place val)
(gv-letplace (getter setter) place
(macroexp-let2 nil val val
(funcall do `(eq ,getter ,val)
(lambda (v)
`(cond
(,v ,(funcall setter val))
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
(gv-define-expander substring
(lambda (do place from &optional to)
(gv-letplace (getter setter) place
(macroexp-let2 nil start from
(macroexp-let2 nil end to
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
(funcall setter `(cl--set-substring
,getter ,start ,end ,v)))))))))
;;; Miscellaneous.
;;;###autoload
......
......@@ -11,7 +11,7 @@
;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals
;;;;;; cl--map-keymap-recursively cl-notevery cl-notany cl-every
;;;;;; cl-some cl-mapcon cl-mapcan cl-mapl cl-maplist cl-map cl--mapcar-many
;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "edc8a08741d81c74be36b27664d3555a")
;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "25963dec757a527e3be3ba7f7abc49ee")
;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\
......@@ -265,7 +265,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
;;;;;; "e37cb1001378ce1d677b67760fb6994b")
;;;;;; "66d8d151a97f91a79ebe3d1a9d699483")
;;; Generated autoloads from cl-macs.el
(autoload 'cl-gensym "cl-macs" "\
......
......@@ -110,20 +110,6 @@
(defun cl--const-expr-val (x)
(and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
(defun cl-expr-access-order (x v)
;; This apparently tries to return nil iff the expression X evaluates
;; the variables V in the same order as they appear in V (so as to
;; be able to replace those vars with the expressions they're bound
;; to).
;; FIXME: This is very naive, it doesn't even check to see if those
;; variables appear more than once.
(if (macroexp-const-p x) v
(if (consp x)
(progn
(while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
v)
(if (eq x (car v)) (cdr v) '(t)))))
(defun cl--expr-contains (x y)
"Count number of times X refers to Y. Return nil for 0 times."
;; FIXME: This is naive, and it will cl-count Y as referred twice in
......@@ -1489,30 +1475,9 @@ An implicit nil block is established around the loop.
\(fn (VAR LIST [RESULT]) BODY...)"
(declare (debug ((symbolp form &optional form) cl-declarations body)))
(let ((temp (make-symbol "--cl-dolist-temp--")))
;; FIXME: Copy&pasted from subr.el.
`(cl-block nil
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other is slightly faster (and has cleaner semantics)
;; with lexical scoping.
,(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
(let ((,(car spec) (car ,temp)))
,@body
(setq ,temp (cdr ,temp))))
,@(if (cdr (cdr spec))
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
`(let ((,temp ,(nth 1 spec))
,(car spec))
(while ,temp
(setq ,(car spec) (car ,temp))
,@body
(setq ,temp (cdr ,temp)))
,@(if (cdr (cdr spec))
`((setq ,(car spec) nil) ,@(cddr spec))))))))
`(cl-block nil
(,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
,spec ,@body)))
;;;###autoload
(defmacro cl-dotimes (spec &rest body)
......@@ -1523,30 +1488,9 @@ nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist))
(let ((temp (make-symbol "--cl-dotimes-temp--"))
(end (nth 1 spec)))
;; FIXME: Copy&pasted from subr.el.
`(cl-block nil
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other has cleaner semantics.
,(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
(,counter 0))
(while (< ,counter ,temp)
(let ((,(car spec) ,counter))
,@body)
(setq ,counter (1+ ,counter)))
,@(if (cddr spec)
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,(car spec) ,counter)) ,@(cddr spec))))))
`(let ((,temp ,end)
(,(car spec) 0))
(while (< ,(car spec) ,temp)
,@body
(cl-incf ,(car spec)))
,@(cdr (cdr spec)))))))
`(cl-block nil
(,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
,spec ,@body)))
;;;###autoload
(defmacro cl-do-symbols (spec &rest body)
......@@ -1730,7 +1674,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body)))
(cond
((cdr bindings)
`(cl-symbol-macrolet (,(car bindings))
`(cl-symbol-macrolet (,(car bindings))
(cl-symbol-macrolet ,(cdr bindings) ,@body)))
((null bindings) (macroexp-progn body))
(t
......@@ -1740,8 +1684,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(fset 'macroexpand #'cl--sm-macroexpand)
;; FIXME: For N bindings, this will traverse `body' N times!
(macroexpand-all (cons 'progn body)
(cons (list (symbol-name (caar bindings))
(cl-cadar bindings))
(cons (list (symbol-name (caar bindings))
(cl-cadar bindings))
macroexpand-all-environment)))
(fset 'macroexpand previous-macroexpand))))))
......@@ -1864,130 +1808,6 @@ See Info node `(cl)Declarations' for details."
;;; Generalized variables.
;;; Some standard place types from Common Lisp.
(gv-define-setter cl-get (store x y &optional d) `(put ,x ,y ,store))
(gv-define-setter cl-subseq (new seq start &optional end)
`(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) ,new))
;;; Various car/cdr aliases. Note that `cadr' is handled specially.
(gv-define-setter cl-fourth (store x) `(setcar (cl-cdddr ,x) ,store))
(gv-define-setter cl-fifth (store x) `(setcar (nthcdr 4 ,x) ,store))
(gv-define-setter cl-sixth (store x) `(setcar (nthcdr 5 ,x) ,store))
(gv-define-setter cl-seventh (store x) `(setcar (nthcdr 6 ,x) ,store))
(gv-define-setter cl-eighth (store x) `(setcar (nthcdr 7 ,x) ,store))
(gv-define-setter cl-ninth (store x) `(setcar (nthcdr 8 ,x) ,store))
(gv-define-setter cl-tenth (store x) `(setcar (nthcdr 9 ,x) ,store))
;;; Some more Emacs-related place types.
(gv-define-simple-setter buffer-file-name set-visited-file-name t)
(gv-define-setter buffer-modified-p (flag &optional buf)
`(with-current-buffer ,buf
(set-buffer-modified-p ,flag)))
(gv-define-simple-setter buffer-name rename-buffer t)
(gv-define-setter buffer-string (store)
`(progn (erase-buffer) (insert ,store)))
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(gv-define-simple-setter current-buffer set-buffer)
(gv-define-simple-setter current-case-table set-case-table)
(gv-define-simple-setter current-column move-to-column t)
(gv-define-simple-setter current-global-map use-global-map t)
(gv-define-setter current-input-mode (store)
`(progn (apply #'set-input-mode ,store) ,store))
(gv-define-simple-setter current-local-map use-local-map t)
(gv-define-simple-setter current-window-configuration set-window-configuration t)
(gv-define-simple-setter default-file-modes set-default-file-modes t)
(gv-define-simple-setter documentation-property put)
(gv-define-setter face-background (x f &optional s) `(set-face-background ,f ,x ,s))
(gv-define-setter face-background-pixmap (x f &optional s)
`(set-face-background-pixmap ,f ,x ,s))
(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
(gv-define-setter face-foreground (x f &optional s) `(set-face-foreground ,f ,x ,s))
(gv-define-setter face-underline-p (x f &optional s)
`(set-face-underline-p ,f ,x ,s))
(gv-define-simple-setter file-modes set-file-modes t)
(gv-define-simple-setter frame-height set-screen-height t)
(gv-define-simple-setter frame-parameters modify-frame-parameters t)
(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
(gv-define-simple-setter frame-width set-screen-width t)
(gv-define-simple-setter getenv setenv t)
(gv-define-simple-setter get-register set-register)
(gv-define-simple-setter global-key-binding global-set-key)
(gv-define-simple-setter local-key-binding local-set-key)
(gv-define-simple-setter mark set-mark t)
(gv-define-simple-setter mark-marker set-mark t)
(gv-define-simple-setter marker-position set-marker t)
(gv-define-setter mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cadr ,store)
(cddr ,store)))
(gv-define-simple-setter point goto-char)
(gv-define-simple-setter point-marker goto-char t)
(gv-define-setter point-max (store)
`(progn (narrow-to-region (point-min) ,store) ,store))
(gv-define-setter point-min (store)
`(progn (narrow-to-region ,store (point-max)) ,store))
(gv-define-setter read-mouse-position (store scr)
`(set-mouse-position ,scr (car ,store) (cdr ,store)))
(gv-define-simple-setter screen-height set-screen-height t)
(gv-define-simple-setter screen-width set-screen-width t)
(gv-define-simple-setter selected-window select-window)
(gv-define-simple-setter selected-screen select-screen)
(gv-define-simple-setter selected-frame select-frame)
(gv-define-simple-setter standard-case-table set-standard-case-table)
(gv-define-simple-setter syntax-table set-syntax-table)
(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
(gv-define-setter window-height (store)
`(progn (enlarge-window (- ,store (window-height))) ,store))
(gv-define-setter window-width (store)
`(progn (enlarge-window (- ,store (window-width)) t) ,store))
(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
(gv-define-simple-setter x-get-selection x-own-selection t)
;;; More complex setf-methods.
;; This is a hack that allows (setf (eq a 7) B) to mean either
;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
;; This is useful when you have control over the PLACE but not over
;; the VALUE, as is the case in define-minor-mode's :variable.
;; It turned out that :variable needed more flexibility anyway, so
;; this doesn't seem too useful now.
(gv-define-expander eq
(lambda (do place val)
(gv-letplace (getter setter) place
(macroexp-let2 nil val val
(funcall do `(eq ,getter ,val)
(lambda (v)
`(cond
(,v ,(funcall setter val))
((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
(gv-define-expander nthcdr
(lambda (do n place)
(macroexp-let2 nil idx n
(gv-letplace (getter setter) place
(funcall do `(nthcdr ,idx ,getter)
(lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
(setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
(gv-define-expander cl-getf
(lambda (do place tag &optional def)
(gv-letplace (getter setter) place
(macroexp-let2 nil k tag
(macroexp-let2 nil d def
(funcall do `(cl-getf ,getter ,k ,d)
(lambda (v) (funcall setter `(cl--set-getf ,getter ,k ,v)))))))))
(gv-define-expander substring
(lambda (do place from &optional to)
(gv-letplace (getter setter) place
(macroexp-let2 nil start from
(macroexp-let2 nil end to
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
(funcall setter `(cl--set-substring
,getter ,start ,end ,v)))))))))
;;; The standard modify macros.
;; `setf' is now part of core Elisp, defined in gv.el.
......@@ -2571,8 +2391,6 @@ surrounded by (cl-block NAME ...).
;; Compile-time optimizations for some functions defined in this package.
;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
;; mainly to make sure these macros will be present.
(defun cl--compiler-macro-member (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
......
......@@ -107,6 +107,14 @@
))
(defvaralias var (intern (format "cl-%s" var))))
;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
;; them under a different name, so we can use them in our implementation
;; of `dotimes' and `dolist'.
(unless (fboundp 'cl--dotimes)
(defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'."))
(unless (fboundp 'cl--dolist)
(defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'."))
(dolist (fun '(
(get* . cl-get)
(random* . cl-random)
......@@ -501,6 +509,10 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
;; still to support old users of cl.el.
;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
;; previous state. If the getter/setter loses information, that info is
;; not recovered.
(defun cl--letf (bindings simplebinds binds body)
;; It's not quite clear what the semantics of let! should be.
;; E.g. in (let! ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
......@@ -581,7 +593,9 @@ the PLACE is not modified before executing BODY.
(declare (indent 1) (debug letf))
(cl--letf* bindings body))
(defun cl--gv-adapt (cl-gv do) ;FIXME: needed during setf expansion!
(defun cl--gv-adapt (cl-gv do)
;; This function is used by all .elc files that use define-setf-expander and
;; were compiled with Emacs>=24.2.
(let ((vars (nth 0 cl-gv))
(vals (nth 1 cl-gv))
(binds ())
......@@ -774,7 +788,5 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
,store)))
(list accessor temp))))
;; FIXME: More candidates: define-modify-macro, define-setf-expander.
(provide 'cl)
;;; cl.el ends here
......@@ -53,12 +53,6 @@
;; `gv-letplace' macro) is actually much easier and more elegant than the old
;; approach which is clunky and often leads to unreadable code.
;; FIXME: `let!' is unsatisfactory because it does not really "restore" the
;; previous state. If the getter/setter loses information, that info is
;; not recovered.
;; FIXME: Add to defun-declarations-alist.
;; Food for thought: the syntax of places does not actually conflict with the
;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase
;; pattern, and actually the `logand' gv is even closer since it should
......@@ -91,6 +85,13 @@ DO must return an Elisp expression."
(funcall do place (lambda (v) `(setq ,place ,v)))
(let* ((head (car place))
(gf (get head 'gv-expander)))
;; Autoload the head, if applicable, since that might define
;; `gv-expander'.
(when (and (null gf) (fboundp head)
(eq 'autoload (car-safe (symbol-function head))))
(with-demoted-errors
(load (nth 1 (symbol-function head)) 'noerror 'nomsg)
(setq gf (get head 'gv-expander))))
(if gf (apply gf do (cdr place))
(let ((me (macroexpand place ;FIXME: expand one step at a time!
;; (append macroexpand-all-environment
......@@ -139,23 +140,30 @@ arguments as NAME. DO is a function as defined in `gv-get'."
;; cleanly without affecting the running Emacs.
`(eval-and-compile (put ',name 'gv-expander ,handler)))
;; (eval-and-compile
;; (defun gv--defun-declaration (name args handler)
;; (pcase handler
;; (`(lambda (,do) . ,body)
;; `(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
;; ;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
;; ;; FIXME: If `setter' is a lambda, give it a name rather
;; ;; than duplicate it at each setf use.
;; (`(setter ,setter) `(gv-define-simple-setter ,name ,setter))
;; (`(setter (,arg) . ,body)
;; `(gv-define-setter ,name (,arg ,@args) ,@body))
;; ;; FIXME: Should we prefer gv-define-simple-setter in this case?
;; ;;((pred symbolp) `(gv-define-expander ,name #',handler))
;; (_ (message "Unknown gv-expander declaration %S" handler) nil)))
;; (push `(gv-expander ,#'gv--defun-declaration) defun-declarations-alist)
;; )
;;;###autoload
(defun gv--defun-declaration (symbol name args handler &optional fix)
`(progn
;; No need to autoload this part, since gv-get will auto-load the
;; function's definition before checking the `gv-expander' property.
:autoload-end
,(pcase (cons symbol handler)
(`(gv-expander . (lambda (,do) . ,body))
`(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
(`(gv-expander . ,(pred symbolp))
`(gv-define-expander ,name #',handler))
(`(gv-setter . (lambda (,store) . ,body))
`(gv-define-setter ,name (,store ,@args) ,@body))
(`(gv-setter . ,(pred symbolp))