;;; Program structure.
+(def-edebug-spec cl-declarations
+ (&rest ("declare" &rest sexp)))
+
+(def-edebug-spec cl-declarations-or-string
+ (&or stringp cl-declarations))
+
+(def-edebug-spec cl-lambda-list
+ (([&rest arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" arg]]
+ [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ )))
+
+(def-edebug-spec cl-&optional-arg
+ (&or (arg &optional def-form arg) arg))
+
+(def-edebug-spec cl-&key-arg
+ (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
+
;;;###autoload
(defmacro defun* (name args &rest body)
"Define NAME as a function.
and BODY is implicitly surrounded by (block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ ;; Same as defun but use cl-lambda-list.
+ (&define [&or name ("setf" :name setf name)]
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body)))
(let* ((res (cl-transform-lambda (cons args body) name))
(form (list* 'defun name (cdr res))))
(if (car res) (list 'progn (car res) form) form)))
+;; The lambda list for macros is different from that of normal lambdas.
+;; Note that &environment is only allowed as first or last items in the
+;; top level list.
+
+(def-edebug-spec cl-macro-list
+ (([&optional "&environment" arg]
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ [&optional "&environment" arg]
+ )))
+
+(def-edebug-spec cl-macro-arg
+ (&or arg cl-macro-list1))
+
+(def-edebug-spec cl-macro-list1
+ (([&optional "&whole" arg] ;; only allowed at lower levels
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ . [&or arg nil])))
+
;;;###autoload
(defmacro defmacro* (name args &rest body)
"Define NAME as a macro.
and BODY is implicitly surrounded by (block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ (&define name cl-macro-list cl-declarations-or-string def-body)))
(let* ((res (cl-transform-lambda (cons args body) name))
(form (list* 'defmacro name (cdr res))))
(if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-lambda-expr
+ (&define ("lambda" cl-lambda-list
+ ;;cl-declarations-or-string
+ ;;[&optional ("interactive" interactive)]
+ def-body)))
+
+;; Redefine function-form to also match function*
+(def-edebug-spec function-form
+ ;; form at the end could also handle "function",
+ ;; but recognize it specially to avoid wrapping function forms.
+ (&or ([&or "quote" "function"] &or symbolp lambda-expr)
+ ("function*" function*)
+ form))
+
;;;###autoload
(defmacro function* (func)
"Introduce a function.
Like normal `function', except that if argument is a lambda form,
its argument list allows full Common Lisp conventions."
+ (declare (debug (&or symbolp cl-lambda-expr)))
(if (eq (car-safe func) 'lambda)
(let* ((res (cl-transform-lambda (cdr func) 'cl-none))
(form (list 'function (cons 'lambda (cdr res)))))
;;;###autoload
(defmacro destructuring-bind (args expr &rest body)
+ (declare (debug (&define cl-macro-list def-form cl-declarations def-body)))
(let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
(bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
(cl-do-arglist (or args '(&aux)) expr)
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
\(fn (WHEN...) BODY...)"
+ (declare (debug ((&rest &or "compile" "load" "eval") body)))
(if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
(not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(defmacro load-time-value (form &optional read-only)
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
+ (declare (debug (form &optional sexp)))
(if (cl-compiling-file)
(let* ((temp (gentemp "--cl-load-time--"))
(set (list 'set (list 'quote temp) form)))
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
\n(fn EXPR (KEYLIST BODY...)...)"
+ (declare (debug (form &rest (sexp body))))
(let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(head-list nil)
(body (cons
"Like `case', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (KEYLIST BODY...)...)"
+ (declare (debug case))
(list* 'case expr (append clauses '((ecase-error-flag)))))
;;;###autoload
typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
+ (declare (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
(let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
(type-list nil)
(body (cons
"Like `typecase', but error if no case fits.
`otherwise'-clauses are not allowed.
\n(fn EXPR (TYPE BODY...)...)"
+ (declare (debug typecase))
(list* 'typecase expr (append clauses '((ecase-error-flag)))))
dynamically scoped: Only references to it within BODY will work. These
references may appear inside macro expansions, but not inside functions
called from BODY."
+ (declare (debug (symbolp body)))
(if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
(list 'cl-block-wrapper
(list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
(defmacro return (&optional result)
"Return from the block named nil.
This is equivalent to `(return-from nil RESULT)'."
+ (declare (debug (&optional form)))
(list 'return-from nil result))
;;;###autoload
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp."
+ (declare (debug (symbolp &optional form)))
(let ((name2 (intern (format "--cl-block-%s--" name))))
(list 'cl-block-throw (list 'quote name2) result)))
finally return EXPR, named NAME.
\(fn CLAUSE...)"
+ (declare (debug (&rest &or symbolp form)))
(if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args))))))
(list 'block nil (list* 'while t loop-args))
(let ((loop-name nil) (loop-bindings nil)
(setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
(list* 'block loop-name body)))))
+;; Below is a complete spec for loop, in several parts that correspond
+;; to the syntax given in CLtL2. The specs do more than specify where
+;; the forms are; it also specifies, as much as Edebug allows, all the
+;; syntactically valid loop clauses. The disadvantage of this
+;; completeness is rigidity, but the "for ... being" clause allows
+;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
+
+;; (def-edebug-spec loop
+;; ([&optional ["named" symbolp]]
+;; [&rest
+;; &or
+;; ["repeat" form]
+;; loop-for-as
+;; loop-with
+;; loop-initial-final]
+;; [&rest loop-clause]
+;; ))
+
+;; (def-edebug-spec loop-with
+;; ("with" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]
+;; &rest ["and" loop-var
+;; loop-type-spec
+;; [&optional ["=" form]]]))
+
+;; (def-edebug-spec loop-for-as
+;; ([&or "for" "as"] loop-for-as-subclause
+;; &rest ["and" loop-for-as-subclause]))
+
+;; (def-edebug-spec loop-for-as-subclause
+;; (loop-var
+;; loop-type-spec
+;; &or
+;; [[&or "in" "on" "in-ref" "across-ref"]
+;; form &optional ["by" function-form]]
+
+;; ["=" form &optional ["then" form]]
+;; ["across" form]
+;; ["being"
+;; [&or "the" "each"]
+;; &or
+;; [[&or "element" "elements"]
+;; [&or "of" "in" "of-ref"] form
+;; &optional "using" ["index" symbolp]];; is this right?
+;; [[&or "hash-key" "hash-keys"
+;; "hash-value" "hash-values"]
+;; [&or "of" "in"]
+;; hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
+;; "hash-key" "hash-keys"] sexp)]]
+
+;; [[&or "symbol" "present-symbol" "external-symbol"
+;; "symbols" "present-symbols" "external-symbols"]
+;; [&or "in" "of"] package-p]
+
+;; ;; Extensions for Emacs Lisp, including Lucid Emacs.
+;; [[&or "frame" "frames"
+;; "screen" "screens"
+;; "buffer" "buffers"]]
+
+;; [[&or "window" "windows"]
+;; [&or "of" "in"] form]
+
+;; [[&or "overlay" "overlays"
+;; "extent" "extents"]
+;; [&or "of" "in"] form
+;; &optional [[&or "from" "to"] form]]
+
+;; [[&or "interval" "intervals"]
+;; [&or "in" "of"] form
+;; &optional [[&or "from" "to"] form]
+;; ["property" form]]
+
+;; [[&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; [&or "in" "of"] form
+;; &optional ["using" ([&or "key-code" "key-codes"
+;; "key-seq" "key-seqs"
+;; "key-binding" "key-bindings"]
+;; sexp)]]
+;; ;; For arbitrary extensions, recognize anything else.
+;; [symbolp &rest &or symbolp form]
+;; ]
+
+;; ;; arithmetic - must be last since all parts are optional.
+;; [[&optional [[&or "from" "downfrom" "upfrom"] form]]
+;; [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
+;; [&optional ["by" form]]
+;; ]))
+
+;; (def-edebug-spec loop-initial-final
+;; (&or ["initially"
+;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
+;; &rest loop-non-atomic-expr]
+;; ["finally" &or
+;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
+;; ["return" form]]))
+
+;; (def-edebug-spec loop-and-clause
+;; (loop-clause &rest ["and" loop-clause]))
+
+;; (def-edebug-spec loop-clause
+;; (&or
+;; [[&or "while" "until" "always" "never" "thereis"] form]
+
+;; [[&or "collect" "collecting"
+;; "append" "appending"
+;; "nconc" "nconcing"
+;; "concat" "vconcat"] form
+;; [&optional ["into" loop-var]]]
+
+;; [[&or "count" "counting"
+;; "sum" "summing"
+;; "maximize" "maximizing"
+;; "minimize" "minimizing"] form
+;; [&optional ["into" loop-var]]
+;; loop-type-spec]
+
+;; [[&or "if" "when" "unless"]
+;; form loop-and-clause
+;; [&optional ["else" loop-and-clause]]
+;; [&optional "end"]]
+
+;; [[&or "do" "doing"] &rest loop-non-atomic-expr]
+
+;; ["return" form]
+;; loop-initial-final
+;; ))
+
+;; (def-edebug-spec loop-non-atomic-expr
+;; ([¬ atom] form))
+
+;; (def-edebug-spec loop-var
+;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
+;; ;; loop-var =>
+;; ;; (loop-var . [&or nil loop-var])
+;; ;; (symbolp . [&or nil loop-var])
+;; ;; (symbolp . loop-var)
+;; ;; (symbolp . (symbolp . [&or nil loop-var]))
+;; ;; (symbolp . (symbolp . loop-var))
+;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
+;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+
+;; (def-edebug-spec loop-type-spec
+;; (&optional ["of-type" loop-d-type-spec]))
+
+;; (def-edebug-spec loop-d-type-spec
+;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+
+
+
(defun cl-parse-loop-clause () ; uses loop-*
(let ((word (pop loop-args))
(hash-types '(hash-key hash-keys hash-value hash-values))
"The Common Lisp `do' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (debug
+ ((&rest &or symbolp (symbolp &optional form form))
+ (form body)
+ cl-declarations body)))
(cl-expand-do-loop steps endtest body nil))
;;;###autoload
"The Common Lisp `do*' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+ (declare (debug do))
(cl-expand-do-loop steps endtest body t))
(defun cl-expand-do-loop (steps endtest body star)
An implicit nil block is established around the loop.
\(fn (VAR LIST [RESULT]) BODY...)"
+ (declare (debug ((symbolp form &optional form) cl-declarations body)))
(let ((temp (make-symbol "--cl-dolist-temp--")))
;; FIXME: Copy&pasted from subr.el.
`(block nil
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
+ (declare (debug dolist))
(let ((temp (make-symbol "--cl-dotimes-temp--"))
(end (nth 1 spec)))
;; FIXME: Copy&pasted from subr.el.
from OBARRAY.
\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
+ (declare (debug ((symbolp &optional form form) cl-declarations body)))
;; Apparently this doesn't have an implicit block.
(list 'block nil
(list 'let (list (car spec))
;;;###autoload
(defmacro do-all-symbols (spec &rest body)
+ (declare (debug ((symbolp &optional form) cl-declarations body)))
(list* 'do-symbols (list (car spec) nil (cadr spec)) body))
before assigning any symbols SYM to the corresponding values.
\(fn SYM VAL SYM VAL ...)"
+ (declare (debug setq))
(cons 'psetf args))
second list (or made unbound if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
+ (declare (debug (form form body)))
(list 'let '((cl-progv-save nil))
(list 'unwind-protect
(list* 'progn (list 'cl-progv-before symbols values) body)
go back to their previous definitions, or lack thereof).
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (debug ((&rest (defun*)) cl-declarations body)))
(list* 'letf*
(mapcar
(function
Unlike `flet', this macro is fully compliant with the Common Lisp standard.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (debug flet))
(let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
(while bindings
;; Use `gensym' rather than `make-symbol'. It's important that
This is like `flet', but for macros instead of functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
+ (declare (debug
+ ((&rest (&define name (&rest arg) cl-declarations-or-string
+ def-body))
+ cl-declarations body)))
(if (cdr bindings)
(list 'macrolet
(list (car bindings)) (list* 'macrolet (cdr bindings) body))
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
\(fn ((NAME EXPANSION) ...) FORM...)"
+ (declare (debug ((&rest (symbol sexp)) cl-declarations body)))
(if (cdr bindings)
(list 'symbol-macrolet
(list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp.
\n(fn BINDINGS BODY)"
+ (declare (debug let))
(let* ((cl-closure-vars cl-closure-vars)
(vars (mapcar (function
(lambda (x)
as in Common Lisp. This is similar to the behavior of `let*' in
Common Lisp.
\n(fn BINDINGS BODY)"
+ (declare (debug let))
(if (null bindings) (cons 'progn body)
(setq bindings (reverse bindings))
(while bindings
a synonym for (list A B C).
\(fn (SYM...) FORM BODY)"
+ (declare (debug ((&rest symbolp) form body)))
(let ((temp (make-symbol "--cl-var--")) (n -1))
(list* 'let* (cons (list temp form)
(mapcar (function
values. For compatibility, (values A B C) is a synonym for (list A B C).
\(fn (SYM...) FORM)"
+ (declare (debug ((&rest symbolp) form)))
(cond ((null vars) (list 'progn form nil))
((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
(t
;;; Declarations.
;;;###autoload
-(defmacro locally (&rest body) (cons 'progn body))
+(defmacro locally (&rest body)
+ (declare (debug t))
+ (cons 'progn body))
;;;###autoload
-(defmacro the (type form) form)
+(defmacro the (type form)
+ (declare (debug (cl-type-spec form)))
+ form)
(defvar cl-proclaim-history t) ; for future compilers
(defvar cl-declare-stack t) ; for future compilers
form. See `defsetf' for a simpler way to define most setf-methods.
\(fn NAME ARGLIST BODY...)"
+ (declare (debug
+ (&define name cl-lambda-list cl-declarations-or-string def-body)))
(append '(eval-when (compile load eval))
(if (stringp (car body))
(list (list 'put (list 'quote func) '(quote setf-documentation)
(defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
+ (declare (debug
+ (&define name
+ [&or [symbolp &optional stringp]
+ [cl-lambda-list (symbolp)]]
+ cl-declarations-or-string def-body)))
(if (and (listp arg1) (consp args))
(let* ((largs nil) (largsr nil)
(temps nil) (tempsr nil)
The return value is the last VAL in the list.
\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug (&rest [place form])))
(if (cdr (cdr args))
(let ((sets nil))
(while args (push (list 'setf (pop args) (pop args)) sets))
before assigning any PLACEs to the corresponding values.
\(fn PLACE VAL PLACE VAL ...)"
+ (declare (debug setf))
(let ((p args) (simple t) (vars nil))
(while p
(if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
"Remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise."
+ (declare (debug (place form)))
(let* ((method (cl-setf-do-modify place t))
(tag-temp (and (not (cl-const-expr-p tag)) (make-symbol "--cl-remf-tag--")))
(val-temp (and (not (cl-simple-expr-p place))
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE... VAL)"
+ (declare (debug (&rest place)))
(cond
((null args) place)
((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE...)"
+ (declare (debug (&rest place)))
(if (not (memq nil (mapcar 'symbolp args)))
(and (cdr args)
(let ((sets nil)
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
+ (declare (debug ((&rest (gate place &optional form)) body)))
(if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
(list* 'let bindings body)
(let ((lets nil) (sets nil)
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
+ (declare (debug letf))
(if (null bindings)
(cons 'progn body)
(setq bindings (reverse bindings))
or any generalized variable allowed by `setf'.
\(fn FUNC PLACE ARGS...)"
+ (declare (debug (function* place &rest form)))
(let* ((method (cl-setf-do-modify place (cons 'list args)))
(rargs (cons (nth 2 method) args)))
(list 'let* (car method)
Like `callf', but PLACE is the second argument of FUNC, not the first.
\(fn FUNC ARG1 PLACE ARGS...)"
+ (declare (debug (function* form place &rest form)))
(if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
(list 'setf place (list* func arg1 place args))
(let* ((method (cl-setf-do-modify place (cons 'list args)))
"Define a `setf'-like modify macro.
If NAME is called, it combines its PLACE argument with the other arguments
from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
+ (declare (debug
+ (&define name cl-lambda-list ;; should exclude &key
+ symbolp &optional stringp)))
(if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
(let ((place (make-symbol "--cl-place--")))
(list 'defmacro* name (cons place arglist) doc
value, that slot cannot be set via `setf'.
\(fn NAME SLOTS...)"
+ (declare (debug
+ (&define ;Makes top-level form not be wrapped.
+ [&or symbolp
+ (gate
+ symbolp &rest
+ (&or [":conc-name" symbolp]
+ [":constructor" symbolp &optional cl-lambda-list]
+ [":copier" symbolp]
+ [":predicate" symbolp]
+ [":include" symbolp &rest sexp] ;; Not finished.
+ ;; The following are not supported.
+ ;; [":print-function" ...]
+ ;; [":type" ...]
+ ;; [":initial-offset" ...]
+ ))]
+ [&optional stringp]
+ ;; All the above is for the following def-form.
+ &rest &or symbolp (symbolp def-form
+ &optional ":read-only" sexp))))
(let* ((name (if (consp struct) (car struct) struct))
(opts (cdr-safe struct))
(slots nil)
(defmacro deftype (name arglist &rest body)
"Define NAME as a new data type.
The type name can then be used in `typecase', `check-type', etc."
+ (declare (debug defmacro*))
(list 'eval-when '(compile load eval)
(cl-transform-function-property
name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body))))
(defmacro check-type (form type &optional string)
"Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type."
+ (declare (debug (place cl-type-spec &optional stringp)))
(and (or (not (cl-compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let* ((temp (if (cl-simple-expr-p form 3)
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
+ (declare (debug (form &rest form)))
(and (or (not (cl-compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let ((sargs (and show-args
possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
+ (declare (debug defmacro*))
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
surrounded by (block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug defun*))
(let* ((argns (cl-arglist-args args)) (p argns)
(pbody (cons 'progn body))
(unsafe (not (cl-safe-expr-p pbody))))
+++ /dev/null
-;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Keywords: lisp, tools, maint
-;; Package: emacs
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
-;; |Edebug specs for cl.el
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; These specs are to be used with edebug.el version 3.3 or later and
-;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
-
-;; This file need not be byte-compiled, but it shouldn't hurt.
-
-;;; Code:
-
-(provide 'cl-specs)
-;; Do the above provide before the following require.
-;; Otherwise if you load this before edebug if cl is already loaded
-;; an infinite loading loop would occur.
-(require 'edebug)
-
-;; Blocks
-
-(def-edebug-spec block (symbolp body))
-(def-edebug-spec return (&optional form))
-(def-edebug-spec return-from (symbolp &optional form))
-
-;; Loops
-
-(def-edebug-spec case (form &rest (sexp body)))
-(def-edebug-spec ecase case)
-(def-edebug-spec do
- ((&rest &or symbolp (symbolp &optional form form))
- (form body)
- cl-declarations body))
-(def-edebug-spec do* do)
-(def-edebug-spec dolist
- ((symbolp form &optional form) cl-declarations body))
-(def-edebug-spec dotimes dolist)
-(def-edebug-spec do-symbols
- ((symbolp &optional form form) cl-declarations body))
-(def-edebug-spec do-all-symbols
- ((symbolp &optional form) cl-declarations body))
-
-;; Multiple values
-
-(def-edebug-spec multiple-value-list (form))
-(def-edebug-spec multiple-value-call (function-form body))
-(def-edebug-spec multiple-value-bind
- ((&rest symbolp) form body))
-(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
-(def-edebug-spec multiple-value-prog1 (form body))
-
-;; Bindings
-
-(def-edebug-spec lexical-let let)
-(def-edebug-spec lexical-let* let)
-
-(def-edebug-spec psetq setq)
-(def-edebug-spec progv (form form body))
-
-(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
-(def-edebug-spec labels flet)
-
-(def-edebug-spec macrolet
- ((&rest (&define name (&rest arg) cl-declarations-or-string def-body))
- cl-declarations body))
-
-(def-edebug-spec symbol-macrolet
- ((&rest (symbol sexp)) cl-declarations body))
-
-(def-edebug-spec destructuring-bind
- (&define cl-macro-list def-form cl-declarations def-body))
-
-;; Setf
-
-(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
-(def-edebug-spec psetf setf)
-
-(def-edebug-spec letf ;; *not* available in Common Lisp
- ((&rest (gate place &optional form))
- body))
-(def-edebug-spec letf* letf)
-
-
-(def-edebug-spec defsetf
- (&define name
- [&or [symbolp &optional stringp]
- [cl-lambda-list (symbolp)]]
- cl-declarations-or-string def-body))
-
-(def-edebug-spec define-setf-method
- (&define name cl-lambda-list cl-declarations-or-string def-body))
-
-(def-edebug-spec define-modify-macro
- (&define name cl-lambda-list ;; should exclude &key
- symbolp &optional stringp))
-
-(def-edebug-spec callf (function* place &rest form))
-(def-edebug-spec callf2 (function* form place &rest form))
-
-;; Other operations on places
-
-(def-edebug-spec remf (place form))
-
-(def-edebug-spec incf (place &optional form))
-(def-edebug-spec decf incf)
-(def-edebug-spec push (form place)) ; different for CL
-(def-edebug-spec pushnew
- (form place &rest
- &or [[&or ":test" ":test-not" ":key"] function-form]
- [keywordp form]))
-(def-edebug-spec pop (place)) ; different for CL
-
-(def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form
-(def-edebug-spec rotatef (&rest place))
-
-
-;; Functions with function args. These are only useful if the
-;; function arg is quoted with ' instead of function.
-
-(def-edebug-spec some (function-form form &rest form))
-(def-edebug-spec every some)
-(def-edebug-spec notany some)
-(def-edebug-spec notevery some)
-
-;; Mapping
-
-(def-edebug-spec map (form function-form form &rest form))
-(def-edebug-spec maplist (function-form form &rest form))
-(def-edebug-spec mapc maplist)
-(def-edebug-spec mapl maplist)
-(def-edebug-spec mapcan maplist)
-(def-edebug-spec mapcon maplist)
-
-;; Sequences
-
-(def-edebug-spec reduce (function-form form &rest form))
-
-;; Types and assertions
-
-(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
-
-(def-edebug-spec deftype defmacro*)
-(def-edebug-spec check-type (place cl-type-spec &optional stringp))
-;; (def-edebug-spec assert (form &optional form stringp &rest form))
-(def-edebug-spec assert (form &rest form))
-(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
-(def-edebug-spec etypecase typecase)
-
-(def-edebug-spec ignore-errors t)
-
-;; Time of Evaluation
-
-(def-edebug-spec eval-when
- ((&rest &or "compile" "load" "eval") body))
-(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
-
-;; Declarations
-
-(def-edebug-spec cl-decl-spec
- ((symbolp &rest sexp)))
-
-(def-edebug-spec cl-declarations
- (&rest ("declare" &rest cl-decl-spec)))
-
-(def-edebug-spec cl-declarations-or-string
- (&or stringp cl-declarations))
-
-(def-edebug-spec declaim (&rest cl-decl-spec))
-(def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed.
-(def-edebug-spec locally (cl-declarations &rest form))
-(def-edebug-spec the (cl-type-spec form))
-
-;;======================================================
-;; Lambda things
-
-(def-edebug-spec cl-lambda-list
- (([&rest arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" arg]]
- [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- )))
-
-(def-edebug-spec cl-&optional-arg
- (&or (arg &optional def-form arg) arg))
-
-(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-
-;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the
-;; top level list.
-
-(def-edebug-spec cl-macro-list
- (([&optional "&environment" arg]
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- [&optional "&environment" arg]
- )))
-
-(def-edebug-spec cl-macro-arg
- (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
- (([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- . [&or arg nil])))
-
-
-(def-edebug-spec defun*
- ;; Same as defun but use cl-lambda-list.
- (&define [&or name
- ("setf" :name setf name)]
- cl-lambda-list
- cl-declarations-or-string
- [&optional ("interactive" interactive)]
- def-body))
-(def-edebug-spec defsubst* defun*)
-
-(def-edebug-spec defmacro*
- (&define name cl-macro-list cl-declarations-or-string def-body))
-(def-edebug-spec define-compiler-macro defmacro*)
-
-
-(def-edebug-spec function*
- (&or symbolp cl-lambda-expr))
-
-(def-edebug-spec cl-lambda-expr
- (&define ("lambda" cl-lambda-list
- ;;cl-declarations-or-string
- ;;[&optional ("interactive" interactive)]
- def-body)))
-
-;; Redefine function-form to also match function*
-(def-edebug-spec function-form
- ;; form at the end could also handle "function",
- ;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr)
- ("function*" function*)
- form))
-
-;;======================================================
-;; Structures
-;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
-
-;; defstruct may contain forms that are evaluated when a structure is created.
-(def-edebug-spec defstruct
- (&define ; makes top-level form not be wrapped
- [&or symbolp
- (gate
- symbolp &rest
- (&or [":conc-name" symbolp]
- [":constructor" symbolp &optional cl-lambda-list]
- [":copier" symbolp]
- [":predicate" symbolp]
- [":include" symbolp &rest sexp];; not finished
- ;; The following are not supported.
- ;; [":print-function" ...]
- ;; [":type" ...]
- ;; [":initial-offset" ...]
- ))]
- [&optional stringp]
- ;; All the above is for the following def-form.
- &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
-
-;;======================================================
-;; Loop
-
-;; The loop macro is very complex, and a full spec is found below.
-;; The following spec only minimally specifies that
-;; parenthesized forms are executable, but single variables used as
-;; expressions will be missed. You may want to use this if the full
-;; spec causes problems for you.
-
-(def-edebug-spec loop
- (&rest &or symbolp form))
-
-;; Below is a complete spec for loop, in several parts that correspond
-;; to the syntax given in CLtL2. The specs do more than specify where
-;; the forms are; it also specifies, as much as Edebug allows, all the
-;; syntactically valid loop clauses. The disadvantage of this
-;; completeness is rigidity, but the "for ... being" clause allows
-;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
-
-(def-edebug-spec loop
- ([&optional ["named" symbolp]]
- [&rest
- &or
- ["repeat" form]
- loop-for-as
- loop-with
- loop-initial-final]
- [&rest loop-clause]
- ))
-
-(def-edebug-spec loop-with
- ("with" loop-var
- loop-type-spec
- [&optional ["=" form]]
- &rest ["and" loop-var
- loop-type-spec
- [&optional ["=" form]]]))
-
-(def-edebug-spec loop-for-as
- ([&or "for" "as"] loop-for-as-subclause
- &rest ["and" loop-for-as-subclause]))
-
-(def-edebug-spec loop-for-as-subclause
- (loop-var
- loop-type-spec
- &or
- [[&or "in" "on" "in-ref" "across-ref"]
- form &optional ["by" function-form]]
-
- ["=" form &optional ["then" form]]
- ["across" form]
- ["being"
- [&or "the" "each"]
- &or
- [[&or "element" "elements"]
- [&or "of" "in" "of-ref"] form
- &optional "using" ["index" symbolp]];; is this right?
- [[&or "hash-key" "hash-keys"
- "hash-value" "hash-values"]
- [&or "of" "in"]
- hash-table-p &optional ["using" ([&or "hash-value" "hash-values"
- "hash-key" "hash-keys"] sexp)]]
-
- [[&or "symbol" "present-symbol" "external-symbol"
- "symbols" "present-symbols" "external-symbols"]
- [&or "in" "of"] package-p]
-
- ;; Extensions for Emacs Lisp, including Lucid Emacs.
- [[&or "frame" "frames"
- "screen" "screens"
- "buffer" "buffers"]]
-
- [[&or "window" "windows"]
- [&or "of" "in"] form]
-
- [[&or "overlay" "overlays"
- "extent" "extents"]
- [&or "of" "in"] form
- &optional [[&or "from" "to"] form]]
-
- [[&or "interval" "intervals"]
- [&or "in" "of"] form
- &optional [[&or "from" "to"] form]
- ["property" form]]
-
- [[&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- [&or "in" "of"] form
- &optional ["using" ([&or "key-code" "key-codes"
- "key-seq" "key-seqs"
- "key-binding" "key-bindings"]
- sexp)]]
- ;; For arbitrary extensions, recognize anything else.
- [symbolp &rest &or symbolp form]
- ]
-
- ;; arithmetic - must be last since all parts are optional.
- [[&optional [[&or "from" "downfrom" "upfrom"] form]]
- [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
- [&optional ["by" form]]
- ]))
-
-(def-edebug-spec loop-initial-final
- (&or ["initially"
- ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
- &rest loop-non-atomic-expr]
- ["finally" &or
- [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
- ["return" form]]))
-
-(def-edebug-spec loop-and-clause
- (loop-clause &rest ["and" loop-clause]))
-
-(def-edebug-spec loop-clause
- (&or
- [[&or "while" "until" "always" "never" "thereis"] form]
-
- [[&or "collect" "collecting"
- "append" "appending"
- "nconc" "nconcing"
- "concat" "vconcat"] form
- [&optional ["into" loop-var]]]
-
- [[&or "count" "counting"
- "sum" "summing"
- "maximize" "maximizing"
- "minimize" "minimizing"] form
- [&optional ["into" loop-var]]
- loop-type-spec]
-
- [[&or "if" "when" "unless"]
- form loop-and-clause
- [&optional ["else" loop-and-clause]]
- [&optional "end"]]
-
- [[&or "do" "doing"] &rest loop-non-atomic-expr]
-
- ["return" form]
- loop-initial-final
- ))
-
-(def-edebug-spec loop-non-atomic-expr
- ([¬ atom] form))
-
-(def-edebug-spec loop-var
- ;; The symbolp must be last alternative to recognize e.g. (a b . c)
- ;; loop-var =>
- ;; (loop-var . [&or nil loop-var])
- ;; (symbolp . [&or nil loop-var])
- ;; (symbolp . loop-var)
- ;; (symbolp . (symbolp . [&or nil loop-var]))
- ;; (symbolp . (symbolp . loop-var))
- ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
- (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-
-(def-edebug-spec loop-type-spec
- (&optional ["of-type" loop-d-type-spec]))
-
-(def-edebug-spec loop-d-type-spec
- (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
-;;; cl-specs.el ends here
projects / emacs.git / commitdiff