diff options
| author | Stefan Monnier | 2012-05-17 17:39:36 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-05-17 17:39:36 -0400 |
| commit | b1198e177ffc930aaf60c66f1a0b3d54db8ba3b1 (patch) | |
| tree | 599b4de0e84145db075434702d90f13fa06a2f6a | |
| parent | 4735906a0363f9a5a77f939afe9bfec07765845e (diff) | |
| download | emacs-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/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 320 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-specs.el | 471 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl.el | 8 |
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 @@ | |||
| 1 | 2012-05-17 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2012-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 | |||
| 7 | 2012-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, | |||
| 198 | and BODY is implicitly surrounded by (block NAME ...). | 220 | and 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, | |||
| 209 | and BODY is implicitly surrounded by (block NAME ...). | 276 | and 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. |
| 219 | Like normal `function', except that if argument is a lambda form, | 302 | Like normal `function', except that if argument is a lambda form, |
| 220 | its argument list allows full Common Lisp conventions." | 303 | its 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. | |||
| 491 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. | 576 | If `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. |
| 521 | The result of the body appears to the compiler as a quoted constant." | 607 | The 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 | |||
| 548 | allowed only in the final clause, and matches if no other keys match. | 635 | allowed only in the final clause, and matches if no other keys match. |
| 549 | Key values are compared by `eql'. | 636 | Key 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, | |||
| 588 | typecase returns nil. A TYPE of t or `otherwise' is allowed only in the | 677 | typecase returns nil. A TYPE of t or `otherwise' is allowed only in the |
| 589 | final clause, and matches if no other keys match. | 678 | final 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 | |||
| 627 | dynamically scoped: Only references to it within BODY will work. These | 718 | dynamically scoped: Only references to it within BODY will work. These |
| 628 | references may appear inside macro expansions, but not inside functions | 719 | references may appear inside macro expansions, but not inside functions |
| 629 | called from BODY." | 720 | called 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. |
| 638 | This is equivalent to `(return-from nil RESULT)'." | 730 | This 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, | |||
| 645 | returning RESULT from that form (or nil if RESULT is omitted). | 738 | returning RESULT from that form (or nil if RESULT is omitted). |
| 646 | This is compatible with Common Lisp, but note that `defun' and | 739 | This 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 | ;; ([¬ 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. | |||
| 1270 | An implicit nil block is established around the loop. | 1522 | An 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 | |||
| 1303 | nil. | 1556 | nil. |
| 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 | |||
| 1335 | from OBARRAY. | 1589 | from 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) | |||
| 1357 | before assigning any symbols SYM to the corresponding values. | 1613 | before 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 | |||
| 1370 | second list (or made unbound if VALUES is shorter than SYMBOLS); then the | 1627 | second list (or made unbound if VALUES is shorter than SYMBOLS); then the |
| 1371 | BODY forms are executed and their result is returned. This is much like | 1628 | BODY forms are executed and their result is returned. This is much like |
| 1372 | a `let' form, except that the list of symbols can be computed at run-time." | 1629 | a `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 | |||
| 1385 | go back to their previous definitions, or lack thereof). | 1643 | go 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. | |||
| 1417 | Unlike `flet', this macro is fully compliant with the Common Lisp standard. | 1676 | Unlike `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. | |||
| 1441 | This is like `flet', but for macros instead of functions. | 1701 | This 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 | |||
| 1459 | by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). | 1723 | by 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 ...). | |||
| 1475 | The main visible difference is that lambdas inside BODY will create | 1740 | The main visible difference is that lambdas inside BODY will create |
| 1476 | lexical closures as in Common Lisp. | 1741 | lexical 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 | |||
| 1527 | as in Common Lisp. This is similar to the behavior of `let*' in | 1793 | as in Common Lisp. This is similar to the behavior of `let*' in |
| 1528 | Common Lisp. | 1794 | Common 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 | |||
| 1552 | a synonym for (list A B C). | 1819 | a 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 | |||
| 1569 | values. For compatibility, (values A B C) is a synonym for (list A B C). | 1837 | values. 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- | |||
| 1670 | form. See `defsetf' for a simpler way to define most setf-methods. | 1943 | form. 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). | |||
| 2037 | The return value is the last VAL in the list. | 2317 | The 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) | |||
| 2054 | before assigning any PLACEs to the corresponding values. | 2335 | before 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. |
| 2090 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 2372 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 2091 | The form returns true if TAG was found and removed, nil otherwise." | 2373 | The 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. | |||
| 2112 | Each PLACE may be a symbol, or any generalized variable allowed by `setf'. | 2395 | Each 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. | |||
| 2128 | Each PLACE may be a symbol, or any generalized variable allowed by `setf'. | 2412 | Each 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)', | |||
| 2159 | the PLACE is not modified before executing BODY. | 2444 | the 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)', | |||
| 2216 | the PLACE is not modified before executing BODY. | 2502 | the 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, | |||
| 2230 | or any generalized variable allowed by `setf'. | 2517 | or 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'. | |||
| 2244 | Like `callf', but PLACE is the second argument of FUNC, not the first. | 2532 | Like `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. |
| 2261 | If NAME is called, it combines its PLACE argument with the other arguments | 2550 | If NAME is called, it combines its PLACE argument with the other arguments |
| 2262 | from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" | 2551 | from 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 | |||
| 2288 | value, that slot cannot be set via `setf'. | 2580 | value, 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. |
| 2538 | The type name can then be used in `typecase', `check-type', etc." | 2849 | The 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. |
| 2589 | STRING is an optional description of the desired type." | 2901 | STRING 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. | |||
| 2605 | Other args STRING and ARGS... are arguments to be passed to `error'. | 2918 | Other args STRING and ARGS... are arguments to be passed to `error'. |
| 2606 | They are not evaluated unless the assertion fails. If STRING is | 2919 | They are not evaluated unless the assertion fails. If STRING is |
| 2607 | omitted, a default message listing FORM itself is used." | 2920 | omitted, 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 | |||
| 2635 | possible. Unlike regular macros, BODY can decide to \"punt\" and leave the | 2949 | possible. Unlike regular macros, BODY can decide to \"punt\" and leave the |
| 2636 | original function call alone by declaring an initial `&whole foo' parameter | 2950 | original function call alone by declaring an initial `&whole foo' parameter |
| 2637 | and then returning foo." | 2951 | and 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 | |||
| 2709 | surrounded by (block NAME ...). | 3024 | surrounded 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 | ([¬ 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). |
| 121 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 121 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 122 | The return value is the incremented value of PLACE." | 122 | The 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). |
| 129 | PLACE may be a symbol, or any generalized variable allowed by `setf'. | 130 | PLACE may be a symbol, or any generalized variable allowed by `setf'. |
| 130 | The return value is the decremented value of PLACE." | 131 | The 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." | |||
| 140 | Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more | 142 | Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more |
| 141 | careful about evaluating each argument only once and in the right order. | 143 | careful about evaluating each argument only once and in the right order. |
| 142 | PLACE may be a symbol, or any generalized variable allowed by `setf'." | 144 | PLACE 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'." | |||
| 149 | Analogous to (setf PLACE (cons X PLACE)), though more careful about | 152 | Analogous to (setf PLACE (cons X PLACE)), though more careful about |
| 150 | evaluating each argument only once and in the right order. PLACE may | 153 | evaluating each argument only once and in the right order. PLACE may |
| 151 | be a symbol, or any generalized variable allowed by `setf'." | 154 | be 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 | |||
| 158 | an element already on the list. | 162 | an 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)) |