(defmacro compile-time-defun (name args &body body)
"Define a function which can be used by macros during the compilation
-process."
+ process."
`(eval-when (:compile-toplevel :load-toplevel)
(defun ,name ,args ,@body)))
(defun stringify (str)
"Return a string representation of STR. Strings are returned unchanged;
-symbols are converted to their names (unqualified!). Other objects are
-converted to their print representations."
+ symbols are converted to their names (unqualified!). Other objects are
+ converted to their print representations."
(typecase str
(string str)
(symbol (symbol-name str))
(compile-time-defun fix-pair (x &optional (y nil defaultp))
"Return two values extracted from X. It works as follows:
- (A) -> A, Y
- (A B) -> A, B
- (A B . C) -> error
- (A . B) -> A, B
- A -> A, Y
-where Y defaults to A if not specified."
+ (A) -> A, Y
+ (A B) -> A, B
+ (A B . C) -> error
+ (A . B) -> A, B
+ A -> A, Y
+ where Y defaults to A if not specified."
(do-fix-pair x y defaultp))
(compile-time-defun pairify (x &optional (y nil defaultp))
(declaim (ftype (function nil ()) slot-unitialized))
(defun slot-uninitialized ()
"A function which signals an error. Can be used as an initializer form in
-structure definitions without doom ensuing."
+ structure definitions without doom ensuing."
(error "No initializer for slot."))
(compile-time-defun parse-body (body)
"Given a BODY (a list of forms), parses it into three sections: a
-docstring, a list of declarations (forms beginning with the symbol `declare')
-and the body forms. The result is returned as three lists (even the
-docstring), suitable for interpolation into a backquoted list using `@,'."
+ docstring, a list of declarations (forms beginning with the symbol
+ `declare') and the body forms. The result is returned as three lists
+ (even the docstring), suitable for interpolation into a backquoted list
+ using `@,'."
(multiple-value-bind
(doc body)
(if (and (consp body)
(defmacro let*/gensyms (binds &body body)
"A macro helper. BINDS is a list of binding pairs (VAR VALUE), where VALUE
-defaults to VAR. The result is that BODY is evaluated in a context where
-each VAR is bound to a gensym, and in the final expansion, each of those
-gensyms will be bound to the corresponding VALUE."
+ defaults to VAR. The result is that BODY is evaluated in a context where
+ each VAR is bound to a gensym, and in the final expansion, each of those
+ gensyms will be bound to the corresponding VALUE."
(labels ((more (binds)
(let ((tmp (gensym "TMP")) (bind (car binds)))
`((let ((,tmp ,(cadr bind))
(defmacro case2 (vform &body clauses)
"VFORM is a form which evaluates to two values, SCRUTINEE and ARGUMENT.
-The CLAUSES have the form (CASES ([VAR]) FORMS...), where a standard `case'
-clause has the form (CASES FORMS...). The `case2' form evaluates the VFORM,
-and compares the SCRUTINEE to the various CASES, in order, just like `case'.
-If there is a match, then the corresponding FORMs are evaluated with VAR (if
-specified) bound to the value of ARGUMENT."
+ The CLAUSES have the form (CASES ([VAR]) FORMS...), where a standard
+ `case' clause has the form (CASES FORMS...). The `case2' form evaluates
+ the VFORM, and compares the SCRUTINEE to the various CASES, in order, just
+ like `case'. If there is a match, then the corresponding FORMs are
+ evaluated with VAR (if specified) bound to the value of ARGUMENT."
(do-case2-like 'case vform clauses))
(defmacro ecase2 (vform &body clauses)
(defmacro with-places ((&key environment) places &body body)
"A hairy helper, for writing setf-like macros. PLACES is a list of binding
-pairs (VAR PLACE), where PLACE defaults to VAR. The result is that BODY is
-evaluated in a context where each VAR is bound to a gensym, and in the final
-expansion, each of those gensyms will be bound to a symbol-macro capable of
-reading or setting the value of the corresponding PLACE."
+ pairs (VAR PLACE), where PLACE defaults to VAR. The result is that BODY
+ is evaluated in a context where each VAR is bound to a gensym, and in the
+ final expansion, each of those gensyms will be bound to a symbol-macro
+ capable of reading or setting the value of the corresponding PLACE."
(if (null places)
`(progn ,@body)
(let*/gensyms (environment)
(defmacro locf (place &environment env)
"Slightly cheesy locatives. (locf PLACE) returns an object which, using
-the `ref' function, can be used to read or set the value of PLACE. It's
-cheesy because it uses closures rather than actually taking the address of
-something. Also, unlike Zetalisp, we don't overload `car' to do our dirty
-work."
+ the `ref' function, can be used to read or set the value of PLACE. It's
+ cheesy because it uses closures rather than actually taking the address of
+ something. Also, unlike Zetalisp, we don't overload `car' to do our dirty
+ work."
(multiple-value-bind
(valtmps valforms newtmps setform getform)
(get-setf-expansion place env)
(defmacro with-locatives (locs &body body)
"LOCS is a list of items of the form (SYM [LOC-EXPR]), where SYM is a
-symbol and LOC-EXPR evaluates to a locative. If LOC-EXPR is omitted, it
-defaults to SYM. As an abbreviation for a common case, LOCS may be a symbol
-instead of a list. The BODY is evaluated in an environment where each SYM is
-a symbol macro which expands to (ref LOC-EXPR) -- or, in fact, something
-similar which doesn't break if LOC-EXPR has side-effects. Thus, references,
-including `setf' forms, fetch or modify the thing referred to by the
-LOC-EXPR. Useful for covering over where something uses a locative."
+ symbol and LOC-EXPR evaluates to a locative. If LOC-EXPR is omitted, it
+ defaults to SYM. As an abbreviation for a common case, LOCS may be a
+ symbol instead of a list. The BODY is evaluated in an environment where
+ each SYM is a symbol macro which expands to (ref LOC-EXPR) -- or, in fact,
+ something similar which doesn't break if LOC-EXPR has side-effects. Thus,
+ references, including `setf' forms, fetch or modify the thing referred to
+ by the LOC-EXPR. Useful for covering over where something uses a
+ locative."
(setf locs (mapcar #'pairify (listify locs)))
(let ((tt (mapcar (lambda (l) (declare (ignore l)) (gensym)) locs))
(ll (mapcar #'cadr locs))