(mapcar (lambda (x)
(cond
((symbolp x)
- (if (eq ?\& (aref (symbol-name x) 0))
- (setq state x)
- (make-symbol (upcase (symbol-name x)))))
+ (let ((first (aref (symbol-name x) 0)))
+ (if (eq ?\& first)
+ (setq state x)
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused.
+ (make-symbol (upcase (if (eq ?_ first)
+ (substring (symbol-name x) 1)
+ (symbol-name x)))))))
((not (consp x)) x)
((memq state '(nil &rest)) (cl--make-usage-args x))
(t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
- (intern (format ":%s" (car arg)))))
+ (let ((name (symbol-name (car arg))))
+ ;; Strip a leading underscore, since it only
+ ;; means that this argument is unused, but
+ ;; shouldn't affect the key's name (bug#12367).
+ (if (eq ?_ (aref name 0))
+ (setq name (substring name 1)))
+ (intern (format ":%s" name)))))
(varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
(or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
;;;###autoload
(defmacro cl-destructuring-bind (args expr &rest body)
+ "Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2)
(debug (&define cl-macro-list def-form cl-declarations def-body)))
(let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
;;;###autoload
(defmacro cl-loop (&rest loop-args)
- "The Common Lisp `cl-loop' macro.
+ "The Common Lisp `loop' macro.
Valid clauses are:
for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
loop-for-steps)))
(t
+ ;; This is an advertised interface: (info "(cl)Other Clauses").
(let ((handler (and (symbolp word)
- (get word 'cl--loop-for-handler))))
+ (get word 'cl-loop-for-handler))))
(if handler
(funcall handler var)
(error "Expected a `for' preposition, found %s" word)))))
,cl--loop-finish-flag nil) cl--loop-body))
(t
- (let ((handler (and (symbolp word) (get word 'cl--loop-handler))))
+ ;; This is an advertised interface: (info "(cl)Other Clauses").
+ (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
(or handler (error "Expected a cl-loop keyword, found %s" word))
(funcall handler))))
(if (eq (car cl--loop-args) 'and)
cl--loop-accum-var))))
(defun cl--loop-build-ands (clauses)
+ "Return various representations of (and . CLAUSES).
+CLAUSES is a list of Elisp expressions, where clauses of the form
+\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
+The return value has shape (COND BODY COMBO)
+such that COMBO is equivalent to (and . CLAUSES)."
(let ((ands nil)
(body nil))
+ ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
+ ;; into (progn ,@A ,@B) ,@C.
(while clauses
(if (and (eq (car-safe (car clauses)) 'progn)
(eq (car (last (car clauses))) t))
(cl-cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
+ ;; A final (progn ,@A t) is moved outside of the `and'.
(setq body (cdr (butlast (pop clauses)))))
(push (pop clauses) ands)))
(setq ands (or (nreverse ands) (list t)))
;;;###autoload
(defmacro cl-do (steps endtest &rest body)
- "The Common Lisp `cl-do' loop.
+ "The Common Lisp `do' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
(declare (indent 2)
;;;###autoload
(defmacro cl-do* (steps endtest &rest body)
- "The Common Lisp `cl-do*' loop.
+ "The Common Lisp `do*' loop.
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
(declare (indent 2) (debug cl-do))
;;;###autoload
(defmacro cl-do-all-symbols (spec &rest body)
+ "Like `cl-do-symbols', but use the default obarray.
+
+\(fn (VAR [RESULT]) BODY...)"
(declare (indent 1) (debug ((symbolp &optional form) cl-declarations body)))
`(cl-do-symbols (,(car spec) nil ,(cadr spec)) ,@body))
"Bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each symbol in the first list is bound to the corresponding value in the
-second list (or made unbound if VALUES is shorter than SYMBOLS); then the
+second list (or to nil 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 (indent 2) (debug (form form body)))
;;;###autoload
(defmacro cl-flet (bindings &rest body)
- "Make temporary function definitions.
+ "Make local function definitions.
Like `cl-labels' but the definitions are not recursive.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
;;;###autoload
(defmacro cl-flet* (bindings &rest body)
- "Make temporary function definitions.
+ "Make local function definitions.
Like `cl-flet' but the definitions can refer to previous ones.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
;;;###autoload
(defmacro cl-locally (&rest body)
+ "Equivalent to `progn'."
(declare (debug t))
(cons 'progn body))
;;;###autoload
(defmacro cl-the (_type form)
+ "At present this ignores _TYPE and is simply equivalent to FORM."
(declare (indent 1) (debug (cl-type-spec form)))
form)
You can use the accessors to set the corresponding slots, via `setf'.
NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE).
-See Info node `(cl)Structures' for a list of valid keywords.
+OPTION is either a single keyword or (KEYWORD VALUE) where
+KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
+:type, :named, :initial-offset, :print-function, or :include.
Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
SLOT-OPTS are keyword-value pairs for that slot. Currently, only
(if (= pos 0) '(car cl-x)
`(nth ,pos cl-x)))) forms)
(push (cons accessor t) side-eff)
- ;; Don't bother defining a setf-expander, since gv-get can use
- ;; the compiler macro to get the same result.
- ;;(push `(gv-define-setter ,accessor (cl-val cl-x)
- ;; ,(if (cadr (memq :read-only (cddr desc)))
- ;; `(progn (ignore cl-x cl-val)
- ;; (error "%s is a read-only slot"
- ;; ',accessor))
- ;; ;; If cl is loaded only for compilation,
- ;; ;; the call to cl--struct-setf-expander would
- ;; ;; cause a warning because it may not be
- ;; ;; defined at run time. Suppress that warning.
- ;; `(progn
- ;; (declare-function
- ;; cl--struct-setf-expander "cl-macs"
- ;; (x name accessor pred-form pos))
- ;; (cl--struct-setf-expander
- ;; cl-val cl-x ',name ',accessor
- ;; ,(and pred-check `',pred-check)
- ;; ,pos))))
- ;; forms)
+ (if (cadr (memq :read-only (cddr desc)))
+ (push `(gv-define-expander ,accessor
+ (lambda (_cl-do _cl-x)
+ (error "%s is a read-only slot" ',accessor)))
+ forms)
+ ;; For normal slots, we don't need to define a setf-expander,
+ ;; since gv-get can use the compiler macro to get the
+ ;; same result.
+ ;; (push `(gv-define-setter ,accessor (cl-val cl-x)
+ ;; ;; If cl is loaded only for compilation,
+ ;; ;; the call to cl--struct-setf-expander would
+ ;; ;; cause a warning because it may not be
+ ;; ;; defined at run time. Suppress that warning.
+ ;; (progn
+ ;; (declare-function
+ ;; cl--struct-setf-expander "cl-macs"
+ ;; (x name accessor pred-form pos))
+ ;; (cl--struct-setf-expander
+ ;; cl-val cl-x ',name ',accessor
+ ;; ,(and pred-check `',pred-check)
+ ;; ,pos)))
+ ;; forms)
+ )
(if print-auto
(nconc print-func
(list `(princ ,(format " %s" slot) cl-s)
;;;###autoload
(defun cl-compiler-macroexpand (form)
+ "Like `macroexpand', but for compiler macros.
+Expands FORM repeatedly until no further expansion is possible.
+Returns FORM unchanged if it has no compiler macro, or if it has a
+macro that returns its `&whole' argument."
(while
(let ((func (car-safe form)) (handler nil))
(while (and (symbolp func)
;; Local variables:
;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
HCoop / bpt / emacs.git / blobdiff