Added a faster loop based remove-from-plist
[alexandria.git] / macros.lisp
blob88004cac4fd7666aa70b1901b6d3a8c4eac08148
1 (in-package :alexandria)
3 (defmacro with-gensyms (names &body forms)
4 "Binds each variable named in NAMES to a unique symbol around FORMS."
5 `(let ,(mapcar (lambda (name)
6 (multiple-value-bind (symbol string)
7 (etypecase name
8 (symbol
9 (values name (symbol-name name)))
10 ((cons symbol (cons string-designator null))
11 (values (first name) (string (second name)))))
12 `(,symbol (gensym ,string))))
13 names)
14 ,@forms))
16 (defmacro with-unique-names (names &body forms)
17 "Alias for WITH-GENSYMS."
18 `(with-gensyms ,names ,@forms))
20 (defmacro once-only (names &body forms)
21 "Evaluates FORMS with NAMES rebound to temporary variables,
22 ensuring that each is evaluated only once.
24 Example:
25 (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
26 (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
27 (let ((gensyms (make-gensym-list (length names) "ONCE-ONLY")))
28 ;; bind in user-macro
29 `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string n))))
30 gensyms names)
31 ;; bind in final expansion
32 `(let (,,@(mapcar (lambda (g n) ``(,,g ,,n)) gensyms names))
33 ;; bind in user-macro
34 ,(let ,(mapcar #'list names gensyms)
35 ,@forms)))))
37 (defun parse-body (body &key documentation whole)
38 "Parses BODY into (values remaining-forms declarations doc-string).
39 Documentation strings are recognized only if DOCUMENTATION is true.
40 Syntax errors in body are signalled and WHOLE is used in the signal
41 arguments when given."
42 (let ((doc nil)
43 (decls nil)
44 (current nil))
45 (tagbody
46 :declarations
47 (setf current (car body))
48 (when (and documentation (stringp current) (cdr body))
49 (if doc
50 (error "Too many documentation strings in ~S." (or whole body))
51 (setf doc (pop body)))
52 (go :declarations))
53 (when (starts-with 'declare current)
54 (push (pop body) decls)
55 (go :declarations)))
56 (values body (nreverse decls) doc)))