aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-05-17 17:39:36 -0400
committerStefan Monnier2012-05-17 17:39:36 -0400
commitb1198e177ffc930aaf60c66f1a0b3d54db8ba3b1 (patch)
tree599b4de0e84145db075434702d90f13fa06a2f6a
parent4735906a0363f9a5a77f939afe9bfec07765845e (diff)
downloademacs-b1198e177ffc930aaf60c66f1a0b3d54db8ba3b1.tar.gz
emacs-b1198e177ffc930aaf60c66f1a0b3d54db8ba3b1.zip
* lisp/emacs-lisp/cl.el: Add edebug specs from cl-specs.el.
* lisp/emacs-lisp/cl-macs.el: Idem. * lisp/emacs-lisp/cl-specs.el: Remove.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el320
-rw-r--r--lisp/emacs-lisp/cl-specs.el471
-rw-r--r--lisp/emacs-lisp/cl.el8
5 files changed, 333 insertions, 474 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3981911d99b..cdb8217ed2c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
12012-05-17 Stefan Monnier <monnier@iro.umontreal.ca> 12012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * emacs-lisp/cl.el: Add edebug specs from cl-specs.el.
4 * emacs-lisp/cl-macs.el: Idem.
5 * emacs-lisp/cl-specs.el: Remove.
6
72012-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
8
3 Minor renaming of internal CL functions and variables. 9 Minor renaming of internal CL functions and variables.
4 * emacs-lisp/cl-seq.el (cl--adjoin): Rename from cl-adjoin. 10 * emacs-lisp/cl-seq.el (cl--adjoin): Rename from cl-adjoin.
5 (cl--position): Rename from cl-position. 11 (cl--position): Rename from cl-position.
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index a00b4550b31..d16b98630c8 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -286,7 +286,7 @@ This also does some trivial optimizations to make the form prettier.
286;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist 286;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
287;;;;;; do* do loop return-from return block etypecase typecase ecase 287;;;;;; do* do loop return-from return block etypecase typecase ecase
288;;;;;; case load-time-value eval-when destructuring-bind function* 288;;;;;; case load-time-value eval-when destructuring-bind function*
289;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "69ccd3344cea28acc44dd28eca07292f") 289;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "ed94b3ba46080516e6ada69bdf617be5")
290;;; Generated autoloads from cl-macs.el 290;;; Generated autoloads from cl-macs.el
291 291
292(autoload 'gensym "cl-macs" "\ 292(autoload 'gensym "cl-macs" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6ca5e6294d6..9fd53d78d92 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -191,6 +191,28 @@ The name is made by appending a number to PREFIX, default \"G\"."
191 191
192;;; Program structure. 192;;; Program structure.
193 193
194(def-edebug-spec cl-declarations
195 (&rest ("declare" &rest sexp)))
196
197(def-edebug-spec cl-declarations-or-string
198 (&or stringp cl-declarations))
199
200(def-edebug-spec cl-lambda-list
201 (([&rest arg]
202 [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
203 [&optional ["&rest" arg]]
204 [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
205 &optional "&allow-other-keys"]]
206 [&optional ["&aux" &rest
207 &or (symbolp &optional def-form) symbolp]]
208 )))
209
210(def-edebug-spec cl-&optional-arg
211 (&or (arg &optional def-form arg) arg))
212
213(def-edebug-spec cl-&key-arg
214 (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
215
194;;;###autoload 216;;;###autoload
195(defmacro defun* (name args &rest body) 217(defmacro defun* (name args &rest body)
196 "Define NAME as a function. 218 "Define NAME as a function.
@@ -198,10 +220,55 @@ Like normal `defun', except ARGLIST allows full Common Lisp conventions,
198and BODY is implicitly surrounded by (block NAME ...). 220and BODY is implicitly surrounded by (block NAME ...).
199 221
200\(fn NAME ARGLIST [DOCSTRING] BODY...)" 222\(fn NAME ARGLIST [DOCSTRING] BODY...)"
223 (declare (debug
224 ;; Same as defun but use cl-lambda-list.
225 (&define [&or name ("setf" :name setf name)]
226 cl-lambda-list
227 cl-declarations-or-string
228 [&optional ("interactive" interactive)]
229 def-body)))
201 (let* ((res (cl-transform-lambda (cons args body) name)) 230 (let* ((res (cl-transform-lambda (cons args body) name))
202 (form (list* 'defun name (cdr res)))) 231 (form (list* 'defun name (cdr res))))
203 (if (car res) (list 'progn (car res) form) form))) 232 (if (car res) (list 'progn (car res) form) form)))
204 233
234;; The lambda list for macros is different from that of normal lambdas.
235;; Note that &environment is only allowed as first or last items in the
236;; top level list.
237
238(def-edebug-spec cl-macro-list
239 (([&optional "&environment" arg]
240 [&rest cl-macro-arg]
241 [&optional ["&optional" &rest
242 &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
243 [&optional [[&or "&rest" "&body"] cl-macro-arg]]
244 [&optional ["&key" [&rest
245 [&or ([&or (symbolp cl-macro-arg) arg]
246 &optional def-form cl-macro-arg)
247 arg]]
248 &optional "&allow-other-keys"]]
249 [&optional ["&aux" &rest
250 &or (symbolp &optional def-form) symbolp]]
251 [&optional "&environment" arg]
252 )))
253
254(def-edebug-spec cl-macro-arg
255 (&or arg cl-macro-list1))
256
257(def-edebug-spec cl-macro-list1
258 (([&optional "&whole" arg] ;; only allowed at lower levels
259 [&rest cl-macro-arg]
260 [&optional ["&optional" &rest
261 &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
262 [&optional [[&or "&rest" "&body"] cl-macro-arg]]
263 [&optional ["&key" [&rest
264 [&or ([&or (symbolp cl-macro-arg) arg]
265 &optional def-form cl-macro-arg)
266 arg]]
267 &optional "&allow-other-keys"]]
268 [&optional ["&aux" &rest
269 &or (symbolp &optional def-form) symbolp]]
270 . [&or arg nil])))
271
205;;;###autoload 272;;;###autoload
206(defmacro defmacro* (name args &rest body) 273(defmacro defmacro* (name args &rest body)
207 "Define NAME as a macro. 274 "Define NAME as a macro.
@@ -209,15 +276,32 @@ Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
209and BODY is implicitly surrounded by (block NAME ...). 276and BODY is implicitly surrounded by (block NAME ...).
210 277
211\(fn NAME ARGLIST [DOCSTRING] BODY...)" 278\(fn NAME ARGLIST [DOCSTRING] BODY...)"
279 (declare (debug
280 (&define name cl-macro-list cl-declarations-or-string def-body)))
212 (let* ((res (cl-transform-lambda (cons args body) name)) 281 (let* ((res (cl-transform-lambda (cons args body) name))
213 (form (list* 'defmacro name (cdr res)))) 282 (form (list* 'defmacro name (cdr res))))
214 (if (car res) (list 'progn (car res) form) form))) 283 (if (car res) (list 'progn (car res) form) form)))
215 284
285(def-edebug-spec cl-lambda-expr
286 (&define ("lambda" cl-lambda-list
287 ;;cl-declarations-or-string
288 ;;[&optional ("interactive" interactive)]
289 def-body)))
290
291;; Redefine function-form to also match function*
292(def-edebug-spec function-form
293 ;; form at the end could also handle "function",
294 ;; but recognize it specially to avoid wrapping function forms.
295 (&or ([&or "quote" "function"] &or symbolp lambda-expr)
296 ("function*" function*)
297 form))
298
216;;;###autoload 299;;;###autoload
217(defmacro function* (func) 300(defmacro function* (func)
218 "Introduce a function. 301 "Introduce a function.
219Like normal `function', except that if argument is a lambda form, 302Like normal `function', except that if argument is a lambda form,
220its argument list allows full Common Lisp conventions." 303its argument list allows full Common Lisp conventions."
304 (declare (debug (&or symbolp cl-lambda-expr)))
221 (if (eq (car-safe func) 'lambda) 305 (if (eq (car-safe func) 'lambda)
222 (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) 306 (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
223 (form (list 'function (cons 'lambda (cdr res))))) 307 (form (list 'function (cons 'lambda (cdr res)))))
@@ -471,6 +555,7 @@ It is a list of elements of the form either:
471 555
472;;;###autoload 556;;;###autoload
473(defmacro destructuring-bind (args expr &rest body) 557(defmacro destructuring-bind (args expr &rest body)
558 (declare (debug (&define cl-macro-list def-form cl-declarations def-body)))
474 (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) 559 (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
475 (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil)) 560 (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
476 (cl-do-arglist (or args '(&aux)) expr) 561 (cl-do-arglist (or args '(&aux)) expr)
@@ -491,6 +576,7 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
491If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. 576If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
492 577
493\(fn (WHEN...) BODY...)" 578\(fn (WHEN...) BODY...)"
579 (declare (debug ((&rest &or "compile" "load" "eval") body)))
494 (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) 580 (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
495 (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge 581 (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
496 (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) 582 (let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
@@ -519,6 +605,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
519(defmacro load-time-value (form &optional read-only) 605(defmacro load-time-value (form &optional read-only)
520 "Like `progn', but evaluates the body at load time. 606 "Like `progn', but evaluates the body at load time.
521The result of the body appears to the compiler as a quoted constant." 607The result of the body appears to the compiler as a quoted constant."
608 (declare (debug (form &optional sexp)))
522 (if (cl-compiling-file) 609 (if (cl-compiling-file)
523 (let* ((temp (gentemp "--cl-load-time--")) 610 (let* ((temp (gentemp "--cl-load-time--"))
524 (set (list 'set (list 'quote temp) form))) 611 (set (list 'set (list 'quote temp) form)))
@@ -548,6 +635,7 @@ place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
548allowed only in the final clause, and matches if no other keys match. 635allowed only in the final clause, and matches if no other keys match.
549Key values are compared by `eql'. 636Key values are compared by `eql'.
550\n(fn EXPR (KEYLIST BODY...)...)" 637\n(fn EXPR (KEYLIST BODY...)...)"
638 (declare (debug (form &rest (sexp body))))
551 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) 639 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
552 (head-list nil) 640 (head-list nil)
553 (body (cons 641 (body (cons
@@ -578,6 +666,7 @@ Key values are compared by `eql'.
578 "Like `case', but error if no case fits. 666 "Like `case', but error if no case fits.
579`otherwise'-clauses are not allowed. 667`otherwise'-clauses are not allowed.
580\n(fn EXPR (KEYLIST BODY...)...)" 668\n(fn EXPR (KEYLIST BODY...)...)"
669 (declare (debug case))
581 (list* 'case expr (append clauses '((ecase-error-flag))))) 670 (list* 'case expr (append clauses '((ecase-error-flag)))))
582 671
583;;;###autoload 672;;;###autoload
@@ -588,6 +677,7 @@ satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
588typecase returns nil. A TYPE of t or `otherwise' is allowed only in the 677typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
589final clause, and matches if no other keys match. 678final clause, and matches if no other keys match.
590\n(fn EXPR (TYPE BODY...)...)" 679\n(fn EXPR (TYPE BODY...)...)"
680 (declare (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
591 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) 681 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
592 (type-list nil) 682 (type-list nil)
593 (body (cons 683 (body (cons
@@ -612,6 +702,7 @@ final clause, and matches if no other keys match.
612 "Like `typecase', but error if no case fits. 702 "Like `typecase', but error if no case fits.
613`otherwise'-clauses are not allowed. 703`otherwise'-clauses are not allowed.
614\n(fn EXPR (TYPE BODY...)...)" 704\n(fn EXPR (TYPE BODY...)...)"
705 (declare (debug typecase))
615 (list* 'typecase expr (append clauses '((ecase-error-flag))))) 706 (list* 'typecase expr (append clauses '((ecase-error-flag)))))
616 707
617 708
@@ -627,6 +718,7 @@ quoted symbol or other form; and second, NAME is lexically rather than
627dynamically scoped: Only references to it within BODY will work. These 718dynamically scoped: Only references to it within BODY will work. These
628references may appear inside macro expansions, but not inside functions 719references may appear inside macro expansions, but not inside functions
629called from BODY." 720called from BODY."
721 (declare (debug (symbolp body)))
630 (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) 722 (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
631 (list 'cl-block-wrapper 723 (list 'cl-block-wrapper
632 (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) 724 (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
@@ -636,6 +728,7 @@ called from BODY."
636(defmacro return (&optional result) 728(defmacro return (&optional result)
637 "Return from the block named nil. 729 "Return from the block named nil.
638This is equivalent to `(return-from nil RESULT)'." 730This is equivalent to `(return-from nil RESULT)'."
731 (declare (debug (&optional form)))
639 (list 'return-from nil result)) 732 (list 'return-from nil result))
640 733
641;;;###autoload 734;;;###autoload
@@ -645,6 +738,7 @@ This jumps out to the innermost enclosing `(block NAME ...)' form,
645returning RESULT from that form (or nil if RESULT is omitted). 738returning RESULT from that form (or nil if RESULT is omitted).
646This is compatible with Common Lisp, but note that `defun' and 739This is compatible with Common Lisp, but note that `defun' and
647`defmacro' do not create implicit blocks as they do in Common Lisp." 740`defmacro' do not create implicit blocks as they do in Common Lisp."
741 (declare (debug (symbolp &optional form)))
648 (let ((name2 (intern (format "--cl-block-%s--" name)))) 742 (let ((name2 (intern (format "--cl-block-%s--" name))))
649 (list 'cl-block-throw (list 'quote name2) result))) 743 (list 'cl-block-throw (list 'quote name2) result)))
650 744
@@ -674,6 +768,7 @@ Valid clauses are:
674 finally return EXPR, named NAME. 768 finally return EXPR, named NAME.
675 769
676\(fn CLAUSE...)" 770\(fn CLAUSE...)"
771 (declare (debug (&rest &or symbolp form)))
677 (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args)))))) 772 (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args))))))
678 (list 'block nil (list* 'while t loop-args)) 773 (list 'block nil (list* 'while t loop-args))
679 (let ((loop-name nil) (loop-bindings nil) 774 (let ((loop-name nil) (loop-bindings nil)
@@ -725,6 +820,158 @@ Valid clauses are:
725 (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) 820 (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
726 (list* 'block loop-name body))))) 821 (list* 'block loop-name body)))))
727 822
823;; Below is a complete spec for loop, in several parts that correspond
824;; to the syntax given in CLtL2. The specs do more than specify where
825;; the forms are; it also specifies, as much as Edebug allows, all the
826;; syntactically valid loop clauses. The disadvantage of this
827;; completeness is rigidity, but the "for ... being" clause allows
828;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
829
830;; (def-edebug-spec loop
831;; ([&optional ["named" symbolp]]
832;; [&rest
833;; &or
834;; ["repeat" form]
835;; loop-for-as
836;; loop-with
837;; loop-initial-final]
838;; [&rest loop-clause]
839;; ))
840
841;; (def-edebug-spec loop-with
842;; ("with" loop-var
843;; loop-type-spec
844;; [&optional ["=" form]]
845;; &rest ["and" loop-var
846;; loop-type-spec
847;; [&optional ["=" form]]]))
848
849;; (def-edebug-spec loop-for-as
850;; ([&or "for" "as"] loop-for-as-subclause
851;; &rest ["and" loop-for-as-subclause]))
852
853;; (def-edebug-spec loop-for-as-subclause
854;; (loop-var
855;; loop-type-spec
856;; &or
857;; [[&or "in" "on" "in-ref" "across-ref"]
858;; form &optional ["by" function-form]]
859
860;; ["=" form &optional ["then" form]]
861;; ["across" form]
862;; ["being"
863;; [&or "the" "each"]
864;; &or
865;; [[&or "element" "elements"]
866;; [&or "of" "in" "of-ref"] form
867;; &optional "using" ["index" symbolp]];; is this right?
868;; [[&or "hash-key" "hash-keys"
869;; "hash-value" "hash-values"]
870;; [&or "of" "in"]
871;; hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
872;; "hash-key" "hash-keys"] sexp)]]
873
874;; [[&or "symbol" "present-symbol" "external-symbol"
875;; "symbols" "present-symbols" "external-symbols"]
876;; [&or "in" "of"] package-p]
877
878;; ;; Extensions for Emacs Lisp, including Lucid Emacs.
879;; [[&or "frame" "frames"
880;; "screen" "screens"
881;; "buffer" "buffers"]]
882
883;; [[&or "window" "windows"]
884;; [&or "of" "in"] form]
885
886;; [[&or "overlay" "overlays"
887;; "extent" "extents"]
888;; [&or "of" "in"] form
889;; &optional [[&or "from" "to"] form]]
890
891;; [[&or "interval" "intervals"]
892;; [&or "in" "of"] form
893;; &optional [[&or "from" "to"] form]
894;; ["property" form]]
895
896;; [[&or "key-code" "key-codes"
897;; "key-seq" "key-seqs"
898;; "key-binding" "key-bindings"]
899;; [&or "in" "of"] form
900;; &optional ["using" ([&or "key-code" "key-codes"
901;; "key-seq" "key-seqs"
902;; "key-binding" "key-bindings"]
903;; sexp)]]
904;; ;; For arbitrary extensions, recognize anything else.
905;; [symbolp &rest &or symbolp form]
906;; ]
907
908;; ;; arithmetic - must be last since all parts are optional.
909;; [[&optional [[&or "from" "downfrom" "upfrom"] form]]
910;; [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
911;; [&optional ["by" form]]
912;; ]))
913
914;; (def-edebug-spec loop-initial-final
915;; (&or ["initially"
916;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
917;; &rest loop-non-atomic-expr]
918;; ["finally" &or
919;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
920;; ["return" form]]))
921
922;; (def-edebug-spec loop-and-clause
923;; (loop-clause &rest ["and" loop-clause]))
924
925;; (def-edebug-spec loop-clause
926;; (&or
927;; [[&or "while" "until" "always" "never" "thereis"] form]
928
929;; [[&or "collect" "collecting"
930;; "append" "appending"
931;; "nconc" "nconcing"
932;; "concat" "vconcat"] form
933;; [&optional ["into" loop-var]]]
934
935;; [[&or "count" "counting"
936;; "sum" "summing"
937;; "maximize" "maximizing"
938;; "minimize" "minimizing"] form
939;; [&optional ["into" loop-var]]
940;; loop-type-spec]
941
942;; [[&or "if" "when" "unless"]
943;; form loop-and-clause
944;; [&optional ["else" loop-and-clause]]
945;; [&optional "end"]]
946
947;; [[&or "do" "doing"] &rest loop-non-atomic-expr]
948
949;; ["return" form]
950;; loop-initial-final
951;; ))
952
953;; (def-edebug-spec loop-non-atomic-expr
954;; ([&not atom] form))
955
956;; (def-edebug-spec loop-var
957;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
958;; ;; loop-var =>
959;; ;; (loop-var . [&or nil loop-var])
960;; ;; (symbolp . [&or nil loop-var])
961;; ;; (symbolp . loop-var)
962;; ;; (symbolp . (symbolp . [&or nil loop-var]))
963;; ;; (symbolp . (symbolp . loop-var))
964;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
965;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
966
967;; (def-edebug-spec loop-type-spec
968;; (&optional ["of-type" loop-d-type-spec]))
969
970;; (def-edebug-spec loop-d-type-spec
971;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
972
973
974
728(defun cl-parse-loop-clause () ; uses loop-* 975(defun cl-parse-loop-clause () ; uses loop-*
729 (let ((word (pop loop-args)) 976 (let ((word (pop loop-args))
730 (hash-types '(hash-key hash-keys hash-value hash-values)) 977 (hash-types '(hash-key hash-keys hash-value hash-values))
@@ -1232,6 +1479,10 @@ Valid clauses are:
1232 "The Common Lisp `do' loop. 1479 "The Common Lisp `do' loop.
1233 1480
1234\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" 1481\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
1482 (declare (debug
1483 ((&rest &or symbolp (symbolp &optional form form))
1484 (form body)
1485 cl-declarations body)))
1235 (cl-expand-do-loop steps endtest body nil)) 1486 (cl-expand-do-loop steps endtest body nil))
1236 1487
1237;;;###autoload 1488;;;###autoload
@@ -1239,6 +1490,7 @@ Valid clauses are:
1239 "The Common Lisp `do*' loop. 1490 "The Common Lisp `do*' loop.
1240 1491
1241\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" 1492\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
1493 (declare (debug do))
1242 (cl-expand-do-loop steps endtest body t)) 1494 (cl-expand-do-loop steps endtest body t))
1243 1495
1244(defun cl-expand-do-loop (steps endtest body star) 1496(defun cl-expand-do-loop (steps endtest body star)
@@ -1270,6 +1522,7 @@ Then evaluate RESULT to get return value, default nil.
1270An implicit nil block is established around the loop. 1522An implicit nil block is established around the loop.
1271 1523
1272\(fn (VAR LIST [RESULT]) BODY...)" 1524\(fn (VAR LIST [RESULT]) BODY...)"
1525 (declare (debug ((symbolp form &optional form) cl-declarations body)))
1273 (let ((temp (make-symbol "--cl-dolist-temp--"))) 1526 (let ((temp (make-symbol "--cl-dolist-temp--")))
1274 ;; FIXME: Copy&pasted from subr.el. 1527 ;; FIXME: Copy&pasted from subr.el.
1275 `(block nil 1528 `(block nil
@@ -1303,6 +1556,7 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
1303nil. 1556nil.
1304 1557
1305\(fn (VAR COUNT [RESULT]) BODY...)" 1558\(fn (VAR COUNT [RESULT]) BODY...)"
1559 (declare (debug dolist))
1306 (let ((temp (make-symbol "--cl-dotimes-temp--")) 1560 (let ((temp (make-symbol "--cl-dotimes-temp--"))
1307 (end (nth 1 spec))) 1561 (end (nth 1 spec)))
1308 ;; FIXME: Copy&pasted from subr.el. 1562 ;; FIXME: Copy&pasted from subr.el.
@@ -1335,6 +1589,7 @@ Evaluate BODY with VAR bound to each interned symbol, or to each symbol
1335from OBARRAY. 1589from OBARRAY.
1336 1590
1337\(fn (VAR [OBARRAY [RESULT]]) BODY...)" 1591\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
1592 (declare (debug ((symbolp &optional form form) cl-declarations body)))
1338 ;; Apparently this doesn't have an implicit block. 1593 ;; Apparently this doesn't have an implicit block.
1339 (list 'block nil 1594 (list 'block nil
1340 (list 'let (list (car spec)) 1595 (list 'let (list (car spec))
@@ -1345,6 +1600,7 @@ from OBARRAY.
1345 1600
1346;;;###autoload 1601;;;###autoload
1347(defmacro do-all-symbols (spec &rest body) 1602(defmacro do-all-symbols (spec &rest body)
1603 (declare (debug ((symbolp &optional form) cl-declarations body)))
1348 (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) 1604 (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
1349 1605
1350 1606
@@ -1357,6 +1613,7 @@ This is like `setq', except that all VAL forms are evaluated (in order)
1357before assigning any symbols SYM to the corresponding values. 1613before assigning any symbols SYM to the corresponding values.
1358 1614
1359\(fn SYM VAL SYM VAL ...)" 1615\(fn SYM VAL SYM VAL ...)"
1616 (declare (debug setq))
1360 (cons 'psetf args)) 1617 (cons 'psetf args))
1361 1618
1362 1619
@@ -1370,6 +1627,7 @@ Each symbol in the first list is bound to the corresponding value in the
1370second list (or made unbound if VALUES is shorter than SYMBOLS); then the 1627second list (or made unbound if VALUES is shorter than SYMBOLS); then the
1371BODY forms are executed and their result is returned. This is much like 1628BODY forms are executed and their result is returned. This is much like
1372a `let' form, except that the list of symbols can be computed at run-time." 1629a `let' form, except that the list of symbols can be computed at run-time."
1630 (declare (debug (form form body)))
1373 (list 'let '((cl-progv-save nil)) 1631 (list 'let '((cl-progv-save nil))
1374 (list 'unwind-protect 1632 (list 'unwind-protect
1375 (list* 'progn (list 'cl-progv-before symbols values) body) 1633 (list* 'progn (list 'cl-progv-before symbols values) body)
@@ -1385,6 +1643,7 @@ function definitions in place, then the definitions are undone (the FUNCs
1385go back to their previous definitions, or lack thereof). 1643go back to their previous definitions, or lack thereof).
1386 1644
1387\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 1645\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
1646 (declare (debug ((&rest (defun*)) cl-declarations body)))
1388 (list* 'letf* 1647 (list* 'letf*
1389 (mapcar 1648 (mapcar
1390 (function 1649 (function
@@ -1417,6 +1676,7 @@ This is like `flet', except the bindings are lexical instead of dynamic.
1417Unlike `flet', this macro is fully compliant with the Common Lisp standard. 1676Unlike `flet', this macro is fully compliant with the Common Lisp standard.
1418 1677
1419\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" 1678\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
1679 (declare (debug flet))
1420 (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment)) 1680 (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
1421 (while bindings 1681 (while bindings
1422 ;; Use `gensym' rather than `make-symbol'. It's important that 1682 ;; Use `gensym' rather than `make-symbol'. It's important that
@@ -1441,6 +1701,10 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
1441This is like `flet', but for macros instead of functions. 1701This is like `flet', but for macros instead of functions.
1442 1702
1443\(fn ((NAME ARGLIST BODY...) ...) FORM...)" 1703\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
1704 (declare (debug
1705 ((&rest (&define name (&rest arg) cl-declarations-or-string
1706 def-body))
1707 cl-declarations body)))
1444 (if (cdr bindings) 1708 (if (cdr bindings)
1445 (list 'macrolet 1709 (list 'macrolet
1446 (list (car bindings)) (list* 'macrolet (cdr bindings) body)) 1710 (list (car bindings)) (list* 'macrolet (cdr bindings) body))
@@ -1459,6 +1723,7 @@ Within the body FORMs, references to the variable NAME will be replaced
1459by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). 1723by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
1460 1724
1461\(fn ((NAME EXPANSION) ...) FORM...)" 1725\(fn ((NAME EXPANSION) ...) FORM...)"
1726 (declare (debug ((&rest (symbol sexp)) cl-declarations body)))
1462 (if (cdr bindings) 1727 (if (cdr bindings)
1463 (list 'symbol-macrolet 1728 (list 'symbol-macrolet
1464 (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) 1729 (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
@@ -1475,6 +1740,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
1475The main visible difference is that lambdas inside BODY will create 1740The main visible difference is that lambdas inside BODY will create
1476lexical closures as in Common Lisp. 1741lexical closures as in Common Lisp.
1477\n(fn BINDINGS BODY)" 1742\n(fn BINDINGS BODY)"
1743 (declare (debug let))
1478 (let* ((cl-closure-vars cl-closure-vars) 1744 (let* ((cl-closure-vars cl-closure-vars)
1479 (vars (mapcar (function 1745 (vars (mapcar (function
1480 (lambda (x) 1746 (lambda (x)
@@ -1527,6 +1793,7 @@ successive bindings within BINDINGS, will create lexical closures
1527as in Common Lisp. This is similar to the behavior of `let*' in 1793as in Common Lisp. This is similar to the behavior of `let*' in
1528Common Lisp. 1794Common Lisp.
1529\n(fn BINDINGS BODY)" 1795\n(fn BINDINGS BODY)"
1796 (declare (debug let))
1530 (if (null bindings) (cons 'progn body) 1797 (if (null bindings) (cons 'progn body)
1531 (setq bindings (reverse bindings)) 1798 (setq bindings (reverse bindings))
1532 (while bindings 1799 (while bindings
@@ -1552,6 +1819,7 @@ simulate true multiple return values. For compatibility, (values A B C) is
1552a synonym for (list A B C). 1819a synonym for (list A B C).
1553 1820
1554\(fn (SYM...) FORM BODY)" 1821\(fn (SYM...) FORM BODY)"
1822 (declare (debug ((&rest symbolp) form body)))
1555 (let ((temp (make-symbol "--cl-var--")) (n -1)) 1823 (let ((temp (make-symbol "--cl-var--")) (n -1))
1556 (list* 'let* (cons (list temp form) 1824 (list* 'let* (cons (list temp form)
1557 (mapcar (function 1825 (mapcar (function
@@ -1569,6 +1837,7 @@ each of the symbols SYM in turn. This is analogous to the Common Lisp
1569values. For compatibility, (values A B C) is a synonym for (list A B C). 1837values. For compatibility, (values A B C) is a synonym for (list A B C).
1570 1838
1571\(fn (SYM...) FORM)" 1839\(fn (SYM...) FORM)"
1840 (declare (debug ((&rest symbolp) form)))
1572 (cond ((null vars) (list 'progn form nil)) 1841 (cond ((null vars) (list 'progn form nil))
1573 ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) 1842 ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
1574 (t 1843 (t
@@ -1588,9 +1857,13 @@ values. For compatibility, (values A B C) is a synonym for (list A B C).
1588;;; Declarations. 1857;;; Declarations.
1589 1858
1590;;;###autoload 1859;;;###autoload
1591(defmacro locally (&rest body) (cons 'progn body)) 1860(defmacro locally (&rest body)
1861 (declare (debug t))
1862 (cons 'progn body))
1592;;;###autoload 1863;;;###autoload
1593(defmacro the (type form) form) 1864(defmacro the (type form)
1865 (declare (debug (cl-type-spec form)))
1866 form)
1594 1867
1595(defvar cl-proclaim-history t) ; for future compilers 1868(defvar cl-proclaim-history t) ; for future compilers
1596(defvar cl-declare-stack t) ; for future compilers 1869(defvar cl-declare-stack t) ; for future compilers
@@ -1670,6 +1943,8 @@ list, a store-variables list (of length one), a store-form, and an access-
1670form. See `defsetf' for a simpler way to define most setf-methods. 1943form. See `defsetf' for a simpler way to define most setf-methods.
1671 1944
1672\(fn NAME ARGLIST BODY...)" 1945\(fn NAME ARGLIST BODY...)"
1946 (declare (debug
1947 (&define name cl-lambda-list cl-declarations-or-string def-body)))
1673 (append '(eval-when (compile load eval)) 1948 (append '(eval-when (compile load eval))
1674 (if (stringp (car body)) 1949 (if (stringp (car body))
1675 (list (list 'put (list 'quote func) '(quote setf-documentation) 1950 (list (list 'put (list 'quote func) '(quote setf-documentation)
@@ -1699,6 +1974,11 @@ Example:
1699 (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v)) 1974 (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
1700 1975
1701\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" 1976\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
1977 (declare (debug
1978 (&define name
1979 [&or [symbolp &optional stringp]
1980 [cl-lambda-list (symbolp)]]
1981 cl-declarations-or-string def-body)))
1702 (if (and (listp arg1) (consp args)) 1982 (if (and (listp arg1) (consp args))
1703 (let* ((largs nil) (largsr nil) 1983 (let* ((largs nil) (largsr nil)
1704 (temps nil) (tempsr nil) 1984 (temps nil) (tempsr nil)
@@ -2037,6 +2317,7 @@ For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
2037The return value is the last VAL in the list. 2317The return value is the last VAL in the list.
2038 2318
2039\(fn PLACE VAL PLACE VAL ...)" 2319\(fn PLACE VAL PLACE VAL ...)"
2320 (declare (debug (&rest [place form])))
2040 (if (cdr (cdr args)) 2321 (if (cdr (cdr args))
2041 (let ((sets nil)) 2322 (let ((sets nil))
2042 (while args (push (list 'setf (pop args) (pop args)) sets)) 2323 (while args (push (list 'setf (pop args) (pop args)) sets))
@@ -2054,6 +2335,7 @@ This is like `setf', except that all VAL forms are evaluated (in order)
2054before assigning any PLACEs to the corresponding values. 2335before assigning any PLACEs to the corresponding values.
2055 2336
2056\(fn PLACE VAL PLACE VAL ...)" 2337\(fn PLACE VAL PLACE VAL ...)"
2338 (declare (debug setf))
2057 (let ((p args) (simple t) (vars nil)) 2339 (let ((p args) (simple t) (vars nil))
2058 (while p 2340 (while p
2059 (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars)) 2341 (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
@@ -2089,6 +2371,7 @@ before assigning any PLACEs to the corresponding values.
2089 "Remove TAG from property list PLACE. 2371 "Remove TAG from property list PLACE.
2090PLACE may be a symbol, or any generalized variable allowed by `setf'. 2372PLACE may be a symbol, or any generalized variable allowed by `setf'.
2091The form returns true if TAG was found and removed, nil otherwise." 2373The form returns true if TAG was found and removed, nil otherwise."
2374 (declare (debug (place form)))
2092 (let* ((method (cl-setf-do-modify place t)) 2375 (let* ((method (cl-setf-do-modify place t))
2093 (tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--"))) 2376 (tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--")))
2094 (val-temp (and (not (cl-simple-expr-p place)) 2377 (val-temp (and (not (cl-simple-expr-p place))
@@ -2112,6 +2395,7 @@ Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
2112Each PLACE may be a symbol, or any generalized variable allowed by `setf'. 2395Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
2113 2396
2114\(fn PLACE... VAL)" 2397\(fn PLACE... VAL)"
2398 (declare (debug (&rest place)))
2115 (cond 2399 (cond
2116 ((null args) place) 2400 ((null args) place)
2117 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args)))) 2401 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
@@ -2128,6 +2412,7 @@ Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil.
2128Each PLACE may be a symbol, or any generalized variable allowed by `setf'. 2412Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
2129 2413
2130\(fn PLACE...)" 2414\(fn PLACE...)"
2415 (declare (debug (&rest place)))
2131 (if (not (memq nil (mapcar 'symbolp args))) 2416 (if (not (memq nil (mapcar 'symbolp args)))
2132 (and (cdr args) 2417 (and (cdr args)
2133 (let ((sets nil) 2418 (let ((sets nil)
@@ -2159,6 +2444,7 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
2159the PLACE is not modified before executing BODY. 2444the PLACE is not modified before executing BODY.
2160 2445
2161\(fn ((PLACE VALUE) ...) BODY...)" 2446\(fn ((PLACE VALUE) ...) BODY...)"
2447 (declare (debug ((&rest (gate place &optional form)) body)))
2162 (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) 2448 (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
2163 (list* 'let bindings body) 2449 (list* 'let bindings body)
2164 (let ((lets nil) (sets nil) 2450 (let ((lets nil) (sets nil)
@@ -2216,6 +2502,7 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
2216the PLACE is not modified before executing BODY. 2502the PLACE is not modified before executing BODY.
2217 2503
2218\(fn ((PLACE VALUE) ...) BODY...)" 2504\(fn ((PLACE VALUE) ...) BODY...)"
2505 (declare (debug letf))
2219 (if (null bindings) 2506 (if (null bindings)
2220 (cons 'progn body) 2507 (cons 'progn body)
2221 (setq bindings (reverse bindings)) 2508 (setq bindings (reverse bindings))
@@ -2230,6 +2517,7 @@ FUNC should be an unquoted function name. PLACE may be a symbol,
2230or any generalized variable allowed by `setf'. 2517or any generalized variable allowed by `setf'.
2231 2518
2232\(fn FUNC PLACE ARGS...)" 2519\(fn FUNC PLACE ARGS...)"
2520 (declare (debug (function* place &rest form)))
2233 (let* ((method (cl-setf-do-modify place (cons 'list args))) 2521 (let* ((method (cl-setf-do-modify place (cons 'list args)))
2234 (rargs (cons (nth 2 method) args))) 2522 (rargs (cons (nth 2 method) args)))
2235 (list 'let* (car method) 2523 (list 'let* (car method)
@@ -2244,6 +2532,7 @@ or any generalized variable allowed by `setf'.
2244Like `callf', but PLACE is the second argument of FUNC, not the first. 2532Like `callf', but PLACE is the second argument of FUNC, not the first.
2245 2533
2246\(fn FUNC ARG1 PLACE ARGS...)" 2534\(fn FUNC ARG1 PLACE ARGS...)"
2535 (declare (debug (function* form place &rest form)))
2247 (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func)) 2536 (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
2248 (list 'setf place (list* func arg1 place args)) 2537 (list 'setf place (list* func arg1 place args))
2249 (let* ((method (cl-setf-do-modify place (cons 'list args))) 2538 (let* ((method (cl-setf-do-modify place (cons 'list args)))
@@ -2260,6 +2549,9 @@ Like `callf', but PLACE is the second argument of FUNC, not the first.
2260 "Define a `setf'-like modify macro. 2549 "Define a `setf'-like modify macro.
2261If NAME is called, it combines its PLACE argument with the other arguments 2550If NAME is called, it combines its PLACE argument with the other arguments
2262from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" 2551from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
2552 (declare (debug
2553 (&define name cl-lambda-list ;; should exclude &key
2554 symbolp &optional stringp)))
2263 (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) 2555 (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
2264 (let ((place (make-symbol "--cl-place--"))) 2556 (let ((place (make-symbol "--cl-place--")))
2265 (list 'defmacro* name (cons place arglist) doc 2557 (list 'defmacro* name (cons place arglist) doc
@@ -2288,6 +2580,25 @@ one keyword is supported, `:read-only'. If this has a non-nil
2288value, that slot cannot be set via `setf'. 2580value, that slot cannot be set via `setf'.
2289 2581
2290\(fn NAME SLOTS...)" 2582\(fn NAME SLOTS...)"
2583 (declare (debug
2584 (&define ;Makes top-level form not be wrapped.
2585 [&or symbolp
2586 (gate
2587 symbolp &rest
2588 (&or [":conc-name" symbolp]
2589 [":constructor" symbolp &optional cl-lambda-list]
2590 [":copier" symbolp]
2591 [":predicate" symbolp]
2592 [":include" symbolp &rest sexp] ;; Not finished.
2593 ;; The following are not supported.
2594 ;; [":print-function" ...]
2595 ;; [":type" ...]
2596 ;; [":initial-offset" ...]
2597 ))]
2598 [&optional stringp]
2599 ;; All the above is for the following def-form.
2600 &rest &or symbolp (symbolp def-form
2601 &optional ":read-only" sexp))))
2291 (let* ((name (if (consp struct) (car struct) struct)) 2602 (let* ((name (if (consp struct) (car struct) struct))
2292 (opts (cdr-safe struct)) 2603 (opts (cdr-safe struct))
2293 (slots nil) 2604 (slots nil)
@@ -2536,6 +2847,7 @@ value, that slot cannot be set via `setf'.
2536(defmacro deftype (name arglist &rest body) 2847(defmacro deftype (name arglist &rest body)
2537 "Define NAME as a new data type. 2848 "Define NAME as a new data type.
2538The type name can then be used in `typecase', `check-type', etc." 2849The type name can then be used in `typecase', `check-type', etc."
2850 (declare (debug defmacro*))
2539 (list 'eval-when '(compile load eval) 2851 (list 'eval-when '(compile load eval)
2540 (cl-transform-function-property 2852 (cl-transform-function-property
2541 name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body)))) 2853 name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body))))
@@ -2587,6 +2899,7 @@ TYPE is a Common Lisp-style type specifier."
2587(defmacro check-type (form type &optional string) 2899(defmacro check-type (form type &optional string)
2588 "Verify that FORM is of type TYPE; signal an error if not. 2900 "Verify that FORM is of type TYPE; signal an error if not.
2589STRING is an optional description of the desired type." 2901STRING is an optional description of the desired type."
2902 (declare (debug (place cl-type-spec &optional stringp)))
2590 (and (or (not (cl-compiling-file)) 2903 (and (or (not (cl-compiling-file))
2591 (< cl-optimize-speed 3) (= cl-optimize-safety 3)) 2904 (< cl-optimize-speed 3) (= cl-optimize-safety 3))
2592 (let* ((temp (if (cl-simple-expr-p form 3) 2905 (let* ((temp (if (cl-simple-expr-p form 3)
@@ -2605,6 +2918,7 @@ Second arg SHOW-ARGS means to include arguments of FORM in message.
2605Other args STRING and ARGS... are arguments to be passed to `error'. 2918Other args STRING and ARGS... are arguments to be passed to `error'.
2606They are not evaluated unless the assertion fails. If STRING is 2919They are not evaluated unless the assertion fails. If STRING is
2607omitted, a default message listing FORM itself is used." 2920omitted, a default message listing FORM itself is used."
2921 (declare (debug (form &rest form)))
2608 (and (or (not (cl-compiling-file)) 2922 (and (or (not (cl-compiling-file))
2609 (< cl-optimize-speed 3) (= cl-optimize-safety 3)) 2923 (< cl-optimize-speed 3) (= cl-optimize-safety 3))
2610 (let ((sargs (and show-args 2924 (let ((sargs (and show-args
@@ -2635,6 +2949,7 @@ compiler macros are expanded repeatedly until no further expansions are
2635possible. Unlike regular macros, BODY can decide to \"punt\" and leave the 2949possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
2636original function call alone by declaring an initial `&whole foo' parameter 2950original function call alone by declaring an initial `&whole foo' parameter
2637and then returning foo." 2951and then returning foo."
2952 (declare (debug defmacro*))
2638 (let ((p args) (res nil)) 2953 (let ((p args) (res nil))
2639 (while (consp p) (push (pop p) res)) 2954 (while (consp p) (push (pop p) res))
2640 (setq args (nconc (nreverse res) (and p (list '&rest p))))) 2955 (setq args (nconc (nreverse res) (and p (list '&rest p)))))
@@ -2709,6 +3024,7 @@ ARGLIST allows full Common Lisp conventions, and BODY is implicitly
2709surrounded by (block NAME ...). 3024surrounded by (block NAME ...).
2710 3025
2711\(fn NAME ARGLIST [DOCSTRING] BODY...)" 3026\(fn NAME ARGLIST [DOCSTRING] BODY...)"
3027 (declare (debug defun*))
2712 (let* ((argns (cl-arglist-args args)) (p argns) 3028 (let* ((argns (cl-arglist-args args)) (p argns)
2713 (pbody (cons 'progn body)) 3029 (pbody (cons 'progn body))
2714 (unsafe (not (cl-safe-expr-p pbody)))) 3030 (unsafe (not (cl-safe-expr-p pbody))))
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el
deleted file mode 100644
index dbadf06944f..00000000000
--- a/lisp/emacs-lisp/cl-specs.el
+++ /dev/null
@@ -1,471 +0,0 @@
1;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
2
3;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
4;; Author: Daniel LaLiberte <liberte@holonexus.org>
5;; Keywords: lisp, tools, maint
6;; Package: emacs
7
8;; LCD Archive Entry:
9;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
10;; |Edebug specs for cl.el
11
12;; This file is part of GNU Emacs.
13
14;; GNU Emacs is free software: you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation, either version 3 of the License, or
17;; (at your option) any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26
27;;; Commentary:
28
29;; These specs are to be used with edebug.el version 3.3 or later and
30;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
31
32;; This file need not be byte-compiled, but it shouldn't hurt.
33
34;;; Code:
35
36(provide 'cl-specs)
37;; Do the above provide before the following require.
38;; Otherwise if you load this before edebug if cl is already loaded
39;; an infinite loading loop would occur.
40(require 'edebug)
41
42;; Blocks
43
44(def-edebug-spec block (symbolp body))
45(def-edebug-spec return (&optional form))
46(def-edebug-spec return-from (symbolp &optional form))
47
48;; Loops
49
50(def-edebug-spec case (form &rest (sexp body)))
51(def-edebug-spec ecase case)
52(def-edebug-spec do
53 ((&rest &or symbolp (symbolp &optional form form))
54 (form body)
55 cl-declarations body))
56(def-edebug-spec do* do)
57(def-edebug-spec dolist
58 ((symbolp form &optional form) cl-declarations body))
59(def-edebug-spec dotimes dolist)
60(def-edebug-spec do-symbols
61 ((symbolp &optional form form) cl-declarations body))
62(def-edebug-spec do-all-symbols
63 ((symbolp &optional form) cl-declarations body))
64
65;; Multiple values
66
67(def-edebug-spec multiple-value-list (form))
68(def-edebug-spec multiple-value-call (function-form body))
69(def-edebug-spec multiple-value-bind
70 ((&rest symbolp) form body))
71(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
72(def-edebug-spec multiple-value-prog1 (form body))
73
74;; Bindings
75
76(def-edebug-spec lexical-let let)
77(def-edebug-spec lexical-let* let)
78
79(def-edebug-spec psetq setq)
80(def-edebug-spec progv (form form body))
81
82(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
83(def-edebug-spec labels flet)
84
85(def-edebug-spec macrolet
86 ((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
87 cl-declarations body))
88
89(def-edebug-spec symbol-macrolet
90 ((&rest (symbol sexp)) cl-declarations body))
91
92(def-edebug-spec destructuring-bind
93 (&define cl-macro-list def-form cl-declarations def-body))
94
95;; Setf
96
97(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
98(def-edebug-spec psetf setf)
99
100(def-edebug-spec letf ;; *not* available in Common Lisp
101 ((&rest (gate place &optional form))
102 body))
103(def-edebug-spec letf* letf)
104
105
106(def-edebug-spec defsetf
107 (&define name
108 [&or [symbolp &optional stringp]
109 [cl-lambda-list (symbolp)]]
110 cl-declarations-or-string def-body))
111
112(def-edebug-spec define-setf-method
113 (&define name cl-lambda-list cl-declarations-or-string def-body))
114
115(def-edebug-spec define-modify-macro
116 (&define name cl-lambda-list ;; should exclude &key
117 symbolp &optional stringp))
118
119(def-edebug-spec callf (function* place &rest form))
120(def-edebug-spec callf2 (function* form place &rest form))
121
122;; Other operations on places
123
124(def-edebug-spec remf (place form))
125
126(def-edebug-spec incf (place &optional form))
127(def-edebug-spec decf incf)
128(def-edebug-spec push (form place)) ; different for CL
129(def-edebug-spec pushnew
130 (form place &rest
131 &or [[&or ":test" ":test-not" ":key"] function-form]
132 [keywordp form]))
133(def-edebug-spec pop (place)) ; different for CL
134
135(def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form
136(def-edebug-spec rotatef (&rest place))
137
138
139;; Functions with function args. These are only useful if the
140;; function arg is quoted with ' instead of function.
141
142(def-edebug-spec some (function-form form &rest form))
143(def-edebug-spec every some)
144(def-edebug-spec notany some)
145(def-edebug-spec notevery some)
146
147;; Mapping
148
149(def-edebug-spec map (form function-form form &rest form))
150(def-edebug-spec maplist (function-form form &rest form))
151(def-edebug-spec mapc maplist)
152(def-edebug-spec mapl maplist)
153(def-edebug-spec mapcan maplist)
154(def-edebug-spec mapcon maplist)
155
156;; Sequences
157
158(def-edebug-spec reduce (function-form form &rest form))
159
160;; Types and assertions
161
162(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
163
164(def-edebug-spec deftype defmacro*)
165(def-edebug-spec check-type (place cl-type-spec &optional stringp))
166;; (def-edebug-spec assert (form &optional form stringp &rest form))
167(def-edebug-spec assert (form &rest form))
168(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
169(def-edebug-spec etypecase typecase)
170
171(def-edebug-spec ignore-errors t)
172
173;; Time of Evaluation
174
175(def-edebug-spec eval-when
176 ((&rest &or "compile" "load" "eval") body))
177(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
178
179;; Declarations
180
181(def-edebug-spec cl-decl-spec
182 ((symbolp &rest sexp)))
183
184(def-edebug-spec cl-declarations
185 (&rest ("declare" &rest cl-decl-spec)))
186
187(def-edebug-spec cl-declarations-or-string
188 (&or stringp cl-declarations))
189
190(def-edebug-spec declaim (&rest cl-decl-spec))
191(def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed.
192(def-edebug-spec locally (cl-declarations &rest form))
193(def-edebug-spec the (cl-type-spec form))
194
195;;======================================================
196;; Lambda things
197
198(def-edebug-spec cl-lambda-list
199 (([&rest arg]
200 [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
201 [&optional ["&rest" arg]]
202 [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
203 &optional "&allow-other-keys"]]
204 [&optional ["&aux" &rest
205 &or (symbolp &optional def-form) symbolp]]
206 )))
207
208(def-edebug-spec cl-&optional-arg
209 (&or (arg &optional def-form arg) arg))
210
211(def-edebug-spec cl-&key-arg
212 (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
213
214;; The lambda list for macros is different from that of normal lambdas.
215;; Note that &environment is only allowed as first or last items in the
216;; top level list.
217
218(def-edebug-spec cl-macro-list
219 (([&optional "&environment" arg]
220 [&rest cl-macro-arg]
221 [&optional ["&optional" &rest
222 &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
223 [&optional [[&or "&rest" "&body"] cl-macro-arg]]
224 [&optional ["&key" [&rest
225 [&or ([&or (symbolp cl-macro-arg) arg]
226 &optional def-form cl-macro-arg)
227 arg]]
228 &optional "&allow-other-keys"]]
229 [&optional ["&aux" &rest
230 &or (symbolp &optional def-form) symbolp]]
231 [&optional "&environment" arg]
232 )))
233
234(def-edebug-spec cl-macro-arg
235 (&or arg cl-macro-list1))
236
237(def-edebug-spec cl-macro-list1
238 (([&optional "&whole" arg] ;; only allowed at lower levels
239 [&rest cl-macro-arg]
240 [&optional ["&optional" &rest
241 &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
242 [&optional [[&or "&rest" "&body"] cl-macro-arg]]
243 [&optional ["&key" [&rest
244 [&or ([&or (symbolp cl-macro-arg) arg]
245 &optional def-form cl-macro-arg)
246 arg]]
247 &optional "&allow-other-keys"]]
248 [&optional ["&aux" &rest
249 &or (symbolp &optional def-form) symbolp]]
250 . [&or arg nil])))
251
252
253(def-edebug-spec defun*
254 ;; Same as defun but use cl-lambda-list.
255 (&define [&or name
256 ("setf" :name setf name)]
257 cl-lambda-list
258 cl-declarations-or-string
259 [&optional ("interactive" interactive)]
260 def-body))
261(def-edebug-spec defsubst* defun*)
262
263(def-edebug-spec defmacro*
264 (&define name cl-macro-list cl-declarations-or-string def-body))
265(def-edebug-spec define-compiler-macro defmacro*)
266
267
268(def-edebug-spec function*
269 (&or symbolp cl-lambda-expr))
270
271(def-edebug-spec cl-lambda-expr
272 (&define ("lambda" cl-lambda-list
273 ;;cl-declarations-or-string
274 ;;[&optional ("interactive" interactive)]
275 def-body)))
276
277;; Redefine function-form to also match function*
278(def-edebug-spec function-form
279 ;; form at the end could also handle "function",
280 ;; but recognize it specially to avoid wrapping function forms.
281 (&or ([&or "quote" "function"] &or symbolp lambda-expr)
282 ("function*" function*)
283 form))
284
285;;======================================================
286;; Structures
287;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
288
289;; defstruct may contain forms that are evaluated when a structure is created.
290(def-edebug-spec defstruct
291 (&define ; makes top-level form not be wrapped
292 [&or symbolp
293 (gate
294 symbolp &rest
295 (&or [":conc-name" symbolp]
296 [":constructor" symbolp &optional cl-lambda-list]
297 [":copier" symbolp]
298 [":predicate" symbolp]
299 [":include" symbolp &rest sexp];; not finished
300 ;; The following are not supported.
301 ;; [":print-function" ...]
302 ;; [":type" ...]
303 ;; [":initial-offset" ...]
304 ))]
305 [&optional stringp]
306 ;; All the above is for the following def-form.
307 &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
308
309;;======================================================
310;; Loop
311
312;; The loop macro is very complex, and a full spec is found below.
313;; The following spec only minimally specifies that
314;; parenthesized forms are executable, but single variables used as
315;; expressions will be missed. You may want to use this if the full
316;; spec causes problems for you.
317
318(def-edebug-spec loop
319 (&rest &or symbolp form))
320
321;; Below is a complete spec for loop, in several parts that correspond
322;; to the syntax given in CLtL2. The specs do more than specify where
323;; the forms are; it also specifies, as much as Edebug allows, all the
324;; syntactically valid loop clauses. The disadvantage of this
325;; completeness is rigidity, but the "for ... being" clause allows
326;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
327
328(def-edebug-spec loop
329 ([&optional ["named" symbolp]]
330 [&rest
331 &or
332 ["repeat" form]
333 loop-for-as
334 loop-with
335 loop-initial-final]
336 [&rest loop-clause]
337 ))
338
339(def-edebug-spec loop-with
340 ("with" loop-var
341 loop-type-spec
342 [&optional ["=" form]]
343 &rest ["and" loop-var
344 loop-type-spec
345 [&optional ["=" form]]]))
346
347(def-edebug-spec loop-for-as
348 ([&or "for" "as"] loop-for-as-subclause
349 &rest ["and" loop-for-as-subclause]))
350
351(def-edebug-spec loop-for-as-subclause
352 (loop-var
353 loop-type-spec
354 &or
355 [[&or "in" "on" "in-ref" "across-ref"]
356 form &optional ["by" function-form]]
357
358 ["=" form &optional ["then" form]]
359 ["across" form]
360 ["being"
361 [&or "the" "each"]
362 &or
363 [[&or "element" "elements"]
364 [&or "of" "in" "of-ref"] form
365 &optional "using" ["index" symbolp]];; is this right?
366 [[&or "hash-key" "hash-keys"
367 "hash-value" "hash-values"]
368 [&or "of" "in"]
369 hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
370 "hash-key" "hash-keys"] sexp)]]
371
372 [[&or "symbol" "present-symbol" "external-symbol"
373 "symbols" "present-symbols" "external-symbols"]
374 [&or "in" "of"] package-p]
375
376 ;; Extensions for Emacs Lisp, including Lucid Emacs.
377 [[&or "frame" "frames"
378 "screen" "screens"
379 "buffer" "buffers"]]
380
381 [[&or "window" "windows"]
382 [&or "of" "in"] form]
383
384 [[&or "overlay" "overlays"
385 "extent" "extents"]
386 [&or "of" "in"] form
387 &optional [[&or "from" "to"] form]]
388
389 [[&or "interval" "intervals"]
390 [&or "in" "of"] form
391 &optional [[&or "from" "to"] form]
392 ["property" form]]
393
394 [[&or "key-code" "key-codes"
395 "key-seq" "key-seqs"
396 "key-binding" "key-bindings"]
397 [&or "in" "of"] form
398 &optional ["using" ([&or "key-code" "key-codes"
399 "key-seq" "key-seqs"
400 "key-binding" "key-bindings"]
401 sexp)]]
402 ;; For arbitrary extensions, recognize anything else.
403 [symbolp &rest &or symbolp form]
404 ]
405
406 ;; arithmetic - must be last since all parts are optional.
407 [[&optional [[&or "from" "downfrom" "upfrom"] form]]
408 [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
409 [&optional ["by" form]]
410 ]))
411
412(def-edebug-spec loop-initial-final
413 (&or ["initially"
414 ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
415 &rest loop-non-atomic-expr]
416 ["finally" &or
417 [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
418 ["return" form]]))
419
420(def-edebug-spec loop-and-clause
421 (loop-clause &rest ["and" loop-clause]))
422
423(def-edebug-spec loop-clause
424 (&or
425 [[&or "while" "until" "always" "never" "thereis"] form]
426
427 [[&or "collect" "collecting"
428 "append" "appending"
429 "nconc" "nconcing"
430 "concat" "vconcat"] form
431 [&optional ["into" loop-var]]]
432
433 [[&or "count" "counting"
434 "sum" "summing"
435 "maximize" "maximizing"
436 "minimize" "minimizing"] form
437 [&optional ["into" loop-var]]
438 loop-type-spec]
439
440 [[&or "if" "when" "unless"]
441 form loop-and-clause
442 [&optional ["else" loop-and-clause]]
443 [&optional "end"]]
444
445 [[&or "do" "doing"] &rest loop-non-atomic-expr]
446
447 ["return" form]
448 loop-initial-final
449 ))
450
451(def-edebug-spec loop-non-atomic-expr
452 ([&not atom] form))
453
454(def-edebug-spec loop-var
455 ;; The symbolp must be last alternative to recognize e.g. (a b . c)
456 ;; loop-var =>
457 ;; (loop-var . [&or nil loop-var])
458 ;; (symbolp . [&or nil loop-var])
459 ;; (symbolp . loop-var)
460 ;; (symbolp . (symbolp . [&or nil loop-var]))
461 ;; (symbolp . (symbolp . loop-var))
462 ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
463 (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
464
465(def-edebug-spec loop-type-spec
466 (&optional ["of-type" loop-d-type-spec]))
467
468(def-edebug-spec loop-d-type-spec
469 (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
470
471;;; cl-specs.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 2b56e8a9e4b..c5af1d8a4f1 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -120,6 +120,7 @@ a future Emacs interpreter will be able to use it.")
120 "Increment PLACE by X (1 by default). 120 "Increment PLACE by X (1 by default).
121PLACE may be a symbol, or any generalized variable allowed by `setf'. 121PLACE may be a symbol, or any generalized variable allowed by `setf'.
122The return value is the incremented value of PLACE." 122The return value is the incremented value of PLACE."
123 (declare (debug (place &optional form)))
123 (if (symbolp place) 124 (if (symbolp place)
124 (list 'setq place (if x (list '+ place x) (list '1+ place))) 125 (list 'setq place (if x (list '+ place x) (list '1+ place)))
125 (list 'callf '+ place (or x 1)))) 126 (list 'callf '+ place (or x 1))))
@@ -128,6 +129,7 @@ The return value is the incremented value of PLACE."
128 "Decrement PLACE by X (1 by default). 129 "Decrement PLACE by X (1 by default).
129PLACE may be a symbol, or any generalized variable allowed by `setf'. 130PLACE may be a symbol, or any generalized variable allowed by `setf'.
130The return value is the decremented value of PLACE." 131The return value is the decremented value of PLACE."
132 (declare (debug incf))
131 (if (symbolp place) 133 (if (symbolp place)
132 (list 'setq place (if x (list '- place x) (list '1- place))) 134 (list 'setq place (if x (list '- place x) (list '1- place)))
133 (list 'callf '- place (or x 1)))) 135 (list 'callf '- place (or x 1))))
@@ -140,6 +142,7 @@ The return value is the decremented value of PLACE."
140Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more 142Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
141careful about evaluating each argument only once and in the right order. 143careful about evaluating each argument only once and in the right order.
142PLACE may be a symbol, or any generalized variable allowed by `setf'." 144PLACE may be a symbol, or any generalized variable allowed by `setf'."
145 (declare (debug (place)))
143 (if (symbolp place) 146 (if (symbolp place)
144 (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) 147 (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
145 (cl-do-pop place))) 148 (cl-do-pop place)))
@@ -149,6 +152,7 @@ PLACE may be a symbol, or any generalized variable allowed by `setf'."
149Analogous to (setf PLACE (cons X PLACE)), though more careful about 152Analogous to (setf PLACE (cons X PLACE)), though more careful about
150evaluating each argument only once and in the right order. PLACE may 153evaluating each argument only once and in the right order. PLACE may
151be a symbol, or any generalized variable allowed by `setf'." 154be a symbol, or any generalized variable allowed by `setf'."
155 (declare (debug (form place)))
152 (if (symbolp place) (list 'setq place (list 'cons x place)) 156 (if (symbolp place) (list 'setq place (list 'cons x place))
153 (list 'callf2 'cons x place))) 157 (list 'callf2 'cons x place)))
154 158
@@ -158,6 +162,10 @@ Like (push X PLACE), except that the list is unmodified if X is `eql' to
158an element already on the list. 162an element already on the list.
159\nKeywords supported: :test :test-not :key 163\nKeywords supported: :test :test-not :key
160\n(fn X PLACE [KEYWORD VALUE]...)" 164\n(fn X PLACE [KEYWORD VALUE]...)"
165 (declare (debug
166 (form place &rest
167 &or [[&or ":test" ":test-not" ":key"] function-form]
168 [keywordp form])))
161 (if (symbolp place) 169 (if (symbolp place)
162 (if (null keys) 170 (if (null keys)
163 `(let ((x ,x)) 171 `(let ((x ,x))