X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/9d3ccec7414eecee223bf9aa045924f2416ff609..0ff9df03bb54ba792cefa551face51748ae34259:/mdw-base.lisp diff --git a/mdw-base.lisp b/mdw-base.lisp index 1f5a3eb..cde1d7a 100644 --- a/mdw-base.lisp +++ b/mdw-base.lisp @@ -45,7 +45,7 @@ (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))) @@ -58,8 +58,8 @@ process." (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)) @@ -81,12 +81,12 @@ converted to their print representations." (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)) @@ -102,14 +102,15 @@ where Y defaults to A if not specified." (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) @@ -134,9 +135,9 @@ docstring), suitable for interpolation into a backquoted list using `@,'." (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)) @@ -188,11 +189,11 @@ gensyms will be bound to the corresponding VALUE." (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) @@ -213,10 +214,10 @@ specified) bound to the value of ARGUMENT." (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) @@ -278,10 +279,10 @@ reading or setting the value of the corresponding PLACE." (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) @@ -301,13 +302,14 @@ work." (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))