diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 88 |
1 files changed, 72 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c75d3b9f9f0..9e078d04be3 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1,4 +1,4 @@ -;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*- +;;; cl-macs.el --- Common Lisp macros ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 ;; Free Software Foundation, Inc. @@ -58,8 +58,8 @@ (defvar cl-optimize-speed) -;;; This kludge allows macros which use cl-transform-function-property -;;; to be called at compile-time. +;; This kludge allows macros which use cl-transform-function-property +;; to be called at compile-time. (require (progn @@ -75,6 +75,7 @@ (defvar cl-old-bc-file-form nil) +;;;###autoload (defun cl-compile-time-init () (run-hooks 'cl-hack-bytecomp-hook)) @@ -165,6 +166,7 @@ ;;; Symbols. (defvar *gensym-counter*) +;;;###autoload (defun gensym (&optional prefix) "Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"." @@ -174,6 +176,7 @@ The name is made by appending a number to PREFIX, default \"G\"." (setq *gensym-counter* (1+ *gensym-counter*)))))) (make-symbol (format "%s%d" pfix num)))) +;;;###autoload (defun gentemp (&optional prefix) "Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"." @@ -186,6 +189,7 @@ The name is made by appending a number to PREFIX, default \"G\"." ;;; Program structure. +;;;###autoload (defmacro defun* (name args &rest body) "Define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, @@ -196,6 +200,7 @@ and BODY is implicitly surrounded by (block NAME ...). (form (list* 'defun name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) +;;;###autoload (defmacro defmacro* (name args &rest body) "Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, @@ -206,6 +211,7 @@ and BODY is implicitly surrounded by (block NAME ...). (form (list* 'defmacro name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) +;;;###autoload (defmacro function* (func) "Introduce a function. Like normal `function', except that if argument is a lambda form, @@ -426,6 +432,7 @@ its argument list allows full Common Lisp conventions." (setq res (nconc res (cl-arglist-args arg)))))) (nconc res (and args (list args)))))) +;;;###autoload (defmacro destructuring-bind (args expr &rest body) (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) (bind-defs nil) (bind-block 'cl-none)) @@ -439,6 +446,7 @@ its argument list allows full Common Lisp conventions." (defvar cl-not-toplevel nil) +;;;###autoload (defmacro eval-when (when &rest body) "Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. @@ -470,6 +478,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. form))) (t (eval form) form))) +;;;###autoload (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." @@ -492,6 +501,7 @@ The result of the body appears to the compiler as a quoted constant." ;;; Conditional control structures. +;;;###autoload (defmacro case (expr &rest clauses) "Eval EXPR and choose among clauses on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared @@ -526,12 +536,14 @@ Key values are compared by `eql'. (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) +;;;###autoload (defmacro ecase (expr &rest clauses) "Like `case', but error if no case fits. `otherwise'-clauses are not allowed. \n(fn EXPR (KEYLIST BODY...)...)" (list* 'case expr (append clauses '((ecase-error-flag))))) +;;;###autoload (defmacro typecase (expr &rest clauses) "Evals EXPR, chooses among clauses on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it @@ -558,6 +570,7 @@ final clause, and matches if no other keys match. (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) +;;;###autoload (defmacro etypecase (expr &rest clauses) "Like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. @@ -567,6 +580,7 @@ final clause, and matches if no other keys match. ;;; Blocks and exits. +;;;###autoload (defmacro block (name &rest body) "Define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' @@ -602,11 +616,13 @@ called from BODY." (if cl-found (setcdr cl-found t))) (byte-compile-normal-call (cons 'throw (cdr cl-form)))) +;;;###autoload (defmacro return (&optional result) "Return from the block named nil. This is equivalent to `(return-from nil RESULT)'." (list 'return-from nil result)) +;;;###autoload (defmacro return-from (name &optional result) "Return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, @@ -626,6 +642,7 @@ This is compatible with Common Lisp, but note that `defun' and (defvar loop-result) (defvar loop-result-explicit) (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) +;;;###autoload (defmacro loop (&rest args) "The Common Lisp `loop' macro. Valid clauses are: @@ -1185,12 +1202,14 @@ Valid clauses are: ;;; Other iteration control structures. +;;;###autoload (defmacro do (steps endtest &rest body) "The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body nil)) +;;;###autoload (defmacro do* (steps endtest &rest body) "The Common Lisp `do*' loop. @@ -1218,6 +1237,7 @@ Valid clauses are: (apply 'append sets))))))) (or (cdr endtest) '(nil))))) +;;;###autoload (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. @@ -1234,6 +1254,7 @@ Then evaluate RESULT to get return value, default nil. (cons (list 'setq (car spec) nil) (cdr (cdr spec))) '(nil)))))) +;;;###autoload (defmacro dotimes (spec &rest body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, @@ -1248,6 +1269,7 @@ nil. (append body (list (list 'incf (car spec))))) (or (cdr (cdr spec)) '(nil)))))) +;;;###autoload (defmacro do-symbols (spec &rest body) "Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol @@ -1262,12 +1284,14 @@ from OBARRAY. (and (cadr spec) (list (cadr spec)))) (caddr spec)))) +;;;###autoload (defmacro do-all-symbols (spec &rest body) (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) ;;; Assignments. +;;;###autoload (defmacro psetq (&rest args) "Set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) @@ -1279,6 +1303,7 @@ before assigning any symbols SYM to the corresponding values. ;;; Binding control structures. +;;;###autoload (defmacro progv (symbols values &rest body) "Bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. @@ -1292,6 +1317,7 @@ a `let' form, except that the list of symbols can be computed at run-time." '(cl-progv-after)))) ;;; This should really have some way to shadow 'byte-compile properties, etc. +;;;###autoload (defmacro flet (bindings &rest body) "Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC @@ -1319,6 +1345,7 @@ go back to their previous definitions, or lack thereof). bindings) body)) +;;;###autoload (defmacro labels (bindings &rest body) "Make temporary function bindings. This is like `flet', except the bindings are lexical instead of dynamic. @@ -1343,6 +1370,7 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. ;; The following ought to have a better definition for use with newer ;; byte compilers. +;;;###autoload (defmacro macrolet (bindings &rest body) "Make temporary macro definitions. This is like `flet', but for macros instead of functions. @@ -1359,6 +1387,7 @@ This is like `flet', but for macros instead of functions. (cons (list* name 'lambda (cdr res)) cl-macro-environment)))))) +;;;###autoload (defmacro symbol-macrolet (bindings &rest body) "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced @@ -1375,6 +1404,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). cl-macro-environment))))) (defvar cl-closure-vars nil) +;;;###autoload (defmacro lexical-let (bindings &rest body) "Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create @@ -1418,6 +1448,7 @@ lexical closures as in Common Lisp. vars)) ebody)))) +;;;###autoload (defmacro lexical-let* (bindings &rest body) "Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create @@ -1438,6 +1469,7 @@ lexical closures as in Common Lisp. ;;; Multiple values. +;;;###autoload (defmacro multiple-value-bind (vars form &rest body) "Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements @@ -1455,6 +1487,7 @@ a synonym for (list A B C). vars)) body))) +;;;###autoload (defmacro multiple-value-setq (vars form) "Collect multiple return values. FORM must return a list; the first N elements of this list are stored in @@ -1481,7 +1514,9 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). ;;; Declarations. +;;;###autoload (defmacro locally (&rest body) (cons 'progn body)) +;;;###autoload (defmacro the (type form) form) (defvar cl-proclaim-history t) ; for future compilers @@ -1519,15 +1554,11 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). byte-compile-delete-errors (nth 1 safety))))) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) - (if (eq byte-compile-warnings t) - (setq byte-compile-warnings byte-compile-warning-types)) (while (setq spec (cdr spec)) (if (consp (car spec)) (if (eq (cadar spec) 0) - (setq byte-compile-warnings - (delq (caar spec) byte-compile-warnings)) - (setq byte-compile-warnings - (adjoin (caar spec) byte-compile-warnings))))))) + (byte-compile-disable-warning (caar spec)) + (byte-compile-enable-warning (caar spec))))))) nil) ;;; Process any proclamations made before cl-macs was loaded. @@ -1536,6 +1567,7 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). (while p (cl-do-proclaim (pop p) t)) (setq cl-proclaims-deferred nil)) +;;;###autoload (defmacro declare (&rest specs) (if (cl-compiling-file) (while specs @@ -1547,6 +1579,7 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). ;;; Generalized variables. +;;;###autoload (defmacro define-setf-method (func args &rest body) "Define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). @@ -1565,8 +1598,9 @@ form. See `defsetf' for a simpler way to define most setf-methods. func 'setf-method (cons args body))))) (defalias 'define-setf-expander 'define-setf-method) +;;;###autoload (defmacro defsetf (func arg1 &rest args) - "(defsetf NAME FUNC): define a `setf' method. + "Define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro @@ -1840,6 +1874,7 @@ Example: (list 'substring (nth 4 method) from-temp to-temp)))) ;;; Getting and optimizing setf-methods. +;;;###autoload (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to @@ -1907,6 +1942,7 @@ a macro like `setf' or `incf'." (not (eq (car-safe (symbol-function (car form))) 'macro)))) ;;; The standard modify macros. +;;;###autoload (defmacro setf (&rest args) "Set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic @@ -1925,6 +1961,7 @@ The return value is the last VAL in the list. (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) (if (car method) (list 'let* (car method) store) store))))) +;;;###autoload (defmacro psetf (&rest args) "Set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) @@ -1948,6 +1985,7 @@ before assigning any PLACEs to the corresponding values. (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) (list 'progn expr nil))))) +;;;###autoload (defun cl-do-pop (place) (if (cl-simple-expr-p place) (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) @@ -1960,6 +1998,7 @@ before assigning any PLACEs to the corresponding values. (list 'car temp) (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) +;;;###autoload (defmacro remf (place tag) "Remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. @@ -1980,6 +2019,7 @@ The form returns true if TAG was found and removed, nil otherwise." t) (list 'cl-do-remf tval ttag))))) +;;;###autoload (defmacro shiftf (place &rest args) "Shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. @@ -1995,6 +2035,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (prog1 ,(nth 2 method) ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args)))))))) +;;;###autoload (defmacro rotatef (&rest args) "Rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. @@ -2020,6 +2061,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (list 'let* (append (car method) (list (list temp (nth 2 method)))) (cl-setf-do-store (nth 1 method) form) nil))))) +;;;###autoload (defmacro letf (bindings &rest body) "Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the @@ -2076,6 +2118,7 @@ the PLACE is not modified before executing BODY. rev (cdr rev)))) (list* 'let* lets body)))) +;;;###autoload (defmacro letf* (bindings &rest body) "Temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the @@ -2094,6 +2137,7 @@ the PLACE is not modified before executing BODY. (setq body (list (list* 'letf (list (pop bindings)) body)))) (car body))) +;;;###autoload (defmacro callf (func place &rest args) "Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, @@ -2108,6 +2152,7 @@ or any generalized variable allowed by `setf'. (list* 'funcall (list 'function func) rargs)))))) +;;;###autoload (defmacro callf2 (func arg1 place &rest args) "Set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. @@ -2124,6 +2169,7 @@ Like `callf', but PLACE is the second argument of FUNC, not the first. (list* 'funcall (list 'function func) rargs))))))) +;;;###autoload (defmacro define-modify-macro (name arglist func &optional doc) "Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments @@ -2138,6 +2184,7 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" ;;; Structures. +;;;###autoload (defmacro defstruct (struct &rest descs) "Define a struct type. This macro defines a new Lisp data type called NAME, which contains data @@ -2362,6 +2409,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. forms) (cons 'progn (nreverse (cons (list 'quote name) forms))))) +;;;###autoload (defun cl-struct-setf-expander (x name accessor pred-form pos) (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--"))) (list (list temp) (list x) (list store) @@ -2430,11 +2478,13 @@ The type name can then be used in `typecase', `check-type', etc." ((eq (car type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) +;;;###autoload (defun typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." (eval (cl-make-type-test 'object type))) +;;;###autoload (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." @@ -2449,6 +2499,7 @@ STRING is an optional description of the desired type." (if (eq temp form) (list 'progn body nil) (list 'let (list (list temp form)) body nil))))) +;;;###autoload (defmacro assert (form &optional show-args string &rest args) "Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. @@ -2470,6 +2521,7 @@ omitted, a default message listing FORM itself is used." (list* 'list (list 'quote form) sargs)))) nil)))) +;;;###autoload (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. Otherwise, return result of last form in BODY." @@ -2478,6 +2530,7 @@ Otherwise, return result of last form in BODY." ;;; Compiler macros. +;;;###autoload (defmacro define-compiler-macro (func args &rest body) "Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to @@ -2501,6 +2554,7 @@ and then returning foo." (list 'put (list 'quote func) '(quote byte-compile) '(quote cl-byte-compile-compiler-macro))))) +;;;###autoload (defun compiler-macroexpand (form) (while (let ((func (car-safe form)) (handler nil)) @@ -2556,9 +2610,9 @@ surrounded by (block NAME ...). (if lets (list 'let lets body) body)))) -;;; Compile-time optimizations for some functions defined in this package. -;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, -;;; mainly to make sure these macros will be present. +;; Compile-time optimizations for some functions defined in this package. +;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, +;; mainly to make sure these macros will be present. (put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) @@ -2669,9 +2723,11 @@ surrounded by (block NAME ...). (run-hooks 'cl-macs-load-hook) -;;; Local variables: -;;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime) -;;; End: +;; Local variables: +;; byte-compile-dynamic: t +;; byte-compile-warnings: (not cl-functions) +;; generated-autoload-file: "cl-loaddefs.el" +;; End: ;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46 ;;; cl-macs.el ends here |