;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
+;; Old-Version: 2.02
;; Keywords: extensions
;; Package: emacs
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
\(fn (WHEN...) BODY...)"
- (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
+ (declare (indent 1) (debug (sexp 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)))
;;;###autoload
(defmacro cl-loop (&rest loop-args)
"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,
- for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND,
- always COND, never COND, thereis COND, collect EXPR into VAR,
- append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,
- count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,
- if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
- unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
- do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
- finally return EXPR, named NAME.
+Valid clauses include:
+ For clauses:
+ for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 by EXPR3
+ for VAR = EXPR1 then EXPR2
+ for VAR in/on/in-ref LIST by FUNC
+ for VAR across/across-ref ARRAY
+ for VAR being:
+ the elements of/of-ref SEQUENCE [using (index VAR2)]
+ the symbols [of OBARRAY]
+ the hash-keys/hash-values of HASH-TABLE [using (hash-values/hash-keys V2)]
+ the key-codes/key-bindings/key-seqs of KEYMAP [using (key-bindings VAR2)]
+ the overlays/intervals [of BUFFER] [from POS1] [to POS2]
+ the frames/buffers
+ the windows [of FRAME]
+ Iteration clauses:
+ repeat INTEGER
+ while/until/always/never/thereis CONDITION
+ Accumulation clauses:
+ collect/append/nconc/concat/vconcat/count/sum/maximize/minimize FORM
+ [into VAR]
+ Miscellaneous clauses:
+ with VAR = INIT
+ if/when/unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...]
+ named NAME
+ initially/finally [do] EXPRS...
+ do EXPRS...
+ [finally] return EXPR
+
+For more details, see Info node `(cl)Loop Facility'.
\(fn CLAUSE...)"
(declare (debug (&rest &or
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
-one keyword is supported, `:read-only'. If this has a non-nil
+Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
+SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
+pairs for that slot.
+Currently, only one keyword is supported, `:read-only'. If this has a non-nil
value, that slot cannot be set via `setf'.
\(fn NAME SLOTS...)"
(defun cl-typep (object type) ; See compiler macro below.
"Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier."
+ (declare (compiler-macro cl--compiler-macro-typep))
(let ((cl--object object)) ;; Yuck!!
(eval (cl--make-type-test 'cl--object type))))
+(defun cl--compiler-macro-typep (form val type)
+ (if (macroexp-const-p type)
+ (macroexp-let2 macroexp-copyable-p temp val
+ (cl--make-type-test temp (cl--const-expr-val type)))
+ form))
+
;;;###autoload
(defmacro cl-check-type (form type &optional string)
"Verify that FORM is of type TYPE; signal an error if not.
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
- `(cl-eval-when (compile load eval)
- (put ',func 'compiler-macro
- (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args)
- (cons '_cl-whole-arg args))
- ,@body)))
- ;; This is so that describe-function can locate
- ;; the macro definition.
- (let ((file ,(or buffer-file-name
- (and (boundp 'byte-compile-current-file)
- (stringp byte-compile-current-file)
- byte-compile-current-file))))
- (if file (put ',func 'compiler-macro-file
- (purecopy (file-name-nondirectory file)))))))
+ (let ((fname (make-symbol (concat (symbol-name func) "--cmacro"))))
+ `(eval-and-compile
+ ;; Name the compiler-macro function, so that `symbol-file' can find it.
+ (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
+ (cons '_cl-whole-arg args))
+ ,@body)
+ (put ',func 'compiler-macro #',fname))))
;;;###autoload
(defun cl-compiler-macroexpand (form)
(setq body (cond ((null substs) body)
((null (cdr substs))
(cl-subst (cdar substs) (caar substs) body))
- (t (cl-sublis substs body))))
+ (t (cl--sublis substs body))))
(if lets `(let ,lets ,body) body))))
+(defun cl--sublis (alist tree)
+ "Perform substitutions indicated by ALIST in TREE (non-destructively)."
+ (let ((x (assq tree alist)))
+ (cond
+ (x (cdr x))
+ ((consp tree)
+ (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
+ (t tree))))
;; Compile-time optimizations for some functions defined in this package.
;;;###autoload
(defun cl--compiler-macro-adjoin (form a list &rest keys)
- (if (and (cl--simple-expr-p a) (cl--simple-expr-p list)
- (not (memq :key keys)))
- `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
- form))
+ (if (memq :key keys) form
+ (macroexp-let2 macroexp-copyable-p va a
+ (macroexp-let2 macroexp-copyable-p vlist list
+ `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
(defun cl--compiler-macro-get (_form sym prop &optional def)
(if def
`(cl-getf (symbol-plist ,sym) ,prop ,def)
`(get ,sym ,prop)))
-(cl-define-compiler-macro cl-typep (&whole form val type)
- (if (macroexp-const-p type)
- (macroexp-let2 macroexp-copyable-p temp val
- (cl--make-type-test temp (cl--const-expr-val type)))
- form))
-
(dolist (y '(cl-first cl-second cl-third cl-fourth
cl-fifth cl-sixth cl-seventh
cl-eighth cl-ninth cl-tenth
HCoop / bpt / emacs.git / blobdiff