serapeum
Utilities beyond Alexandria.
SERAPEUM
Utilities beyond Alexandria.
-
Function
STRING-GENSYM
(x)Equivalent to (gensym (string x)). Generally preferable to calling GENSYM with a string, because it respects the current read table. The alternative to writing `(mapcar (compose #'gensym #'string) ...)' in every other macro. -
Function
UNIQUE-NAME
(x)Alias for `string-gensym'. -
Function
UNSPLICE
(form)If FORM is non-nil, wrap it in a list. This is useful with ,@ in macros, and with `mapcan'. E.g., instead of writing: `(.... ,@(when flag '((code)))) You can write: `(.... ,@(unsplice (when flag '(code)))) From Lparallel. -
Macro
WITH-THUNK
((var &rest args) &body body)A macro-writing macro for the `call-with-' style. In the `call-with-' style of writing macros, the macro is simply a syntactic convenience that wraps its body in a thunk and a call to the function that does the actual work. (defmacro with-foo (&body body) `(call-with-foo (lambda () ,@body))) The `call-with-' style has many advantages. Functions are easier to write than macros; you can change the behavior of a function without having to recompile all its callers; functions can be traced, appear in backtraces, etc. But meanwhile, all those thunks are being allocated on the heap. Can we avoid this? Yes, but at a high cost in boilerplate: the closure has to be given a name (using `flet') so it can be declared `dynamic-extent'. (defmacro with-foo (&body body) (with-gensyms (thunk) `(flet ((,thunk () ,@body)) (declare (dynamic-extent #',thunk)) (call-with-foo #',thunk)))) `with-thunk' avoids the boilerplate: (defmacro with-foo (&body body) (with-thunk (body) `(call-with-foo ,body))) It is also possible to construct a "thunk" with arguments. (with-thunk (body foo) `(call-with-foo ,body)) ? `(flet ((,thunk (,foo) ,@body)) (declare (dynamic-extent #',thunk)) (call-with-foo #',thunk)) Someday this may have a better name. -
Function
EXPAND-MACRO
(form &optional env)Like `macroexpand-1', but also expand compiler macros. From Swank. -
Function
EXPAND-MACRO-RECURSIVELY
(form &optional env)Like `macroexpand', but also expand compiler macros. From Swank. -
Function
PARTITION-DECLARATIONS
(xs declarations &optional env)Split DECLARATIONS into those that do and do not apply to XS. Return two values, one with each set. Both sets of declarations are returned in a form that can be spliced directly into Lisp code: (locally ,@(partition-declarations vars decls) ...) -
Macro
CALLF
(function place &rest args &environment env)Set PLACE to the value of calling FUNCTION on PLACE, with ARGS. -
Macro
CALLF2
(function arg1 place &rest args)Like CALLF, but with the place as the second argument. -
Macro
DEFINE-DO-MACRO
(name binds &body body)Define an iteration macro like `dolist'. Writing a macro like `dolist' is more complicated than it looks. For consistency with the rest of CL, you have to do all of the following: - The entire loop must be surrounded with an implicit `nil' block. - The body of the loop must be an implicit `tagbody'. - There must be an optional `return' form which, if given, supplies the values to return from the loop. - While this return form is being evaluated, the iteration variables must be bound to `nil'. Say you wanted to define a `do-hash' macro that iterates over hash tables. A full implementation would look like this: (defmacro do-hash ((key value hash-table &optional return) &body body) (multiple-value-bind (body decls) (parse-body body) `(block nil (maphash (lambda (,key ,value) ,@decls (tagbody ,@body)) ,hash-table) ,(when return `(let (,key ,value) ,return))))) Using `define-do-macro' takes care of all of this for you. (define-do-macro do-hash ((key value hash-table &optional return) &body body) `(maphash (lambda (,key ,value) ,@body) ,hash-table)) -
Macro
DEFINE-POST-MODIFY-MACRO
(name lambda-list function &optional documentation)Like `define-modify-macro', but arranges to return the original value. -
Macro
DEFINE-CASE-MACRO
(name macro-args params &body macro-body)Define a macro like `case'. A case-like macro is one that supports the following syntax: - A list of keys is treated as matching any key in the list. - An empty list matches nothing. - The atoms T or `otherwise' introduce a default clause. - There can only be one default clause. - The default clause must come last. - Any atom besides the empty list, T, or `otherwise' matches itself. As a consequence of the above, to match against the empty list, T, or `otherwise', they must be wrapped in a list. (case x ((nil) "Matched nil.") ((t) "Matched t.") ((otherwise) "Matched `otherwise'.") (otherwise "Didn't match anything.")) A macro defined using `define-case-macro' can ignore all of the above. It receives three arguments: the expression, already protected against multiple evaluation; a normalized list of clauses; and, optionally, a default clause. The clauses are normalized as a list of `(key . body)', where each key is an atom. (That includes nil, T, and `otherwise'.) Nonetheless, each body passed to the macro will only appear once in the expansion; there will be no duplicated code. The body of the default clause is passed separately, bound to the value of the `:default' keyword in PARAMS. (define-case-macro my-case (expr &body clauses) (:default default) ....) Note that in this case, `default' will be bound to the clause's body -- a list of forms -- and not to the whole clause. The key of the default clause is discarded. If no binding is specified for the default clause, then no default clause is allowed. One thing you do still have to consider is the handling of duplicated keys. The macro defined by `define-case-macro' will reject case sets that contains duplicate keys under `eql', but depending on the semantics of your macro, you may need to check for duplicates under a looser definition of equality. As a final example, if the `case' macro did not already exist, you could define it almost trivially using `define-case-macro': (define-case-macro my-case (expr &body clause) (:default default) `(cond ,@(loop for (key . body) in clauses collect `((eql ,expr ,key) ,@body)) (t ,@body))) -
Condition
CASE-FAILURE
(TYPE-ERROR
)A subtype of type-error specifically for case failures. -
Function
CASE-FAILURE
(expr keys)Signal an error of type `case-failure'. -
Function
EVAL-IF-CONSTANT
(form &optional env)Try to reduce FORM to a constant, using ENV. If FORM cannot be reduced, return it unaltered. Also return a second value, T if the form was reduced, or nil otherwise. This is equivalent to testing if FORM is constant, then evaluting it, except that FORM is macro-expanded in ENV (taking compiler macros into account) before doing the test. -
Type
OCTET
-
Type
OCTET-VECTOR
(&optional length)An array of octets. -
Type
WHOLENUM
A whole number. Equivalent to `(integer 0 *)'. -
Type
TUPLE
(&rest types)A proper list where each element has the same type as the corresponding element in TYPES. (typep '(1 :x #c) '(tuple integer keyword character)) => T As a shortcut, a quoted form among TYPES is expanded to an `eql' type specifier. (tuple 'function symbol) ? (tuple (eql function) symbol) The same shortcut works for keywords. (tuple :name symbol) ? (tuple (eql :name) symbol) -
Type
->
(args values)The type of a function from ARGS to VALUES. -
Macro
->
(function args values)Declaim the ftype of FUNCTION from ARGS to VALUES. (-> mod-fixnum+ (fixnum fixnum) fixnum) (defun mod-fixnum+ (x y) ...) -
Type
ASSURE
(type-spec) -
Macro
ASSURE
(type-spec &body (form) &environment env)Macro for inline type checking. `assure' is to `the' as `check-type' is to `declare'. (the string 1) => undefined (assure string 1) => error The value returned from the `assure' form is guaranteed to satisfy TYPE-SPEC. If FORM does not return a value of that type, then a correctable error is signaled. You can supply a value of the correct type with the `use-value' restart. Note that the supplied value is *not* saved into the place designated by FORM. (But see `assuref'.) From ISLISP. -
Macro
ASSUREF
(place type-spec)Like `(progn (check-type PLACE TYPE-SPEC) PLACE)`, but evaluates PLACE only once. -
Function
SUPERTYPEP
(supertype type &optional env)Is SUPERTYPE a supertype of TYPE? That is, is TYPE a subtype of SUPERTYPE? -
Function
PROPER-SUBTYPE-P
(subtype type &optional env)Is SUBTYPE a proper subtype of TYPE? This is, is it true that SUBTYPE is a subtype of TYPE, but not the same type? -
Function
PROPER-SUPERTYPE-P
(supertype type &optional env)Is SUPERTYPE a proper supertype of TYPE? That is, is it true that every value of TYPE is also of type SUPERTYPE, but not every value of SUPERTYPE is of type TYPE? -
Macro
VREF
(vec index &environment env)When used globally, same as `aref'. Inside of a with-type-dispatch form, calls to `vref' may be bound to different accessors, such as `char' or `schar', or `bit' or `sbit', depending on the type being specialized on. -
Macro
WITH-TYPE-DISPATCH
((&rest types) var &body body &environment env)A macro for writing fast sequence functions (among other things). In the simplest case, this macro produces one copy of BODY for each type in TYPES, with the appropriate declarations to induce your Lisp to optimize that version of BODY for the appropriate type. Say VAR is a string. With this macro, you can trivially emit optimized code for the different kinds of string that VAR might be. And then (ideally) instead of getting code that dispatches on the type of VAR every time you call `aref', you get code that dispatches on the type of VAR once, and then uses the appropriately specialized accessors. (But see `with-string-dispatch'.) But that's the simplest case. Using `with-type-dispatch' also provides *transparent portability*. It examines TYPES to deduplicate types that are not distinct on the current Lisp, or that are shadowed by other provided types. And the expansion strategy may differ from Lisp to Lisp: ideally, you should not have to pay for good performance on Lisps with type inference with pointless code bloat on other Lisps. There is an additional benefit for vector types. Around each version of BODY, the definition of `vref' is shadowed to expand into an appropriate accessor. E.g., within a version of BODY where VAR is known to be a `simple-string', `vref' expands into `schar'. Using `vref' instead of `aref' is obviously useful on Lisps that do not do type inference, but even on Lisps with type inference it can speed compilation times (compiling `aref' is relatively slow on SBCL). Within `with-type-dispatch', VAR should be regarded as read-only. Note that `with-type-dispatch' is intended to be used around relatively expensive code, particularly loops. For simpler code, the gains from specialized compilation may not justify the overhead of the initial dispatch and the increased code size. Note also that `with-type-dispatch' is relatively low level. You may want to use one of the other macros in the same family, such as `with-subtype-dispatch', `with-string-dispatch', or so forth. The design and implementation of `with-type-dispatch' is based on a few sources. It replaces a similar macro formerly included in Serapeum, `with-templated-body'. One possible expansion is based on the `string-dispatch' macro used internally in SBCL. But most of the credit should go to the paper "Fast, Maintable, and Portable Sequence Functions", by Ir?ne Durand and Robert Strandh. -
Macro
WITH-SUBTYPE-DISPATCH
(type (&rest subtypes) var &body body &environment env)Like `with-type-dispatch', but SUBTYPES must be subtypes of TYPE. Furthermore, if SUBTYPES are not exhaustive, an extra clause will be added to ensure that TYPE itself is handled. -
Macro
WITH-STRING-DISPATCH
((&rest types) var &body body)Like `with-subtype-dispatch' with an overall type of `string'. -
Macro
WITH-VECTOR-DISPATCH
((&rest types) var &body body)Like `with-subtype-dispatch' with an overall type of `vector'. -
Function
TRUE
(x)Coerce X to a boolean. That is, if X is null, return `nil'; otherwise return `t'. Based on an idea by Eric Naggum. -
Macro
DEF
(var &body (&optional val documentation))The famous "deflex". Define a top level (global) lexical VAR with initial value VAL, which is assigned unconditionally as with DEFPARAMETER. If a DOC string is provided, it is attached to both the name |VAR| and the name *STORAGE-FOR-DEFLEX-VAR-|VAR|* as a documentation string of kind 'VARIABLE. The new VAR will have lexical scope and thus may be shadowed by LET bindings without affecting its dynamic (global) value. The original `deflex' is due to Rob Warnock. This version of `deflex' differs from the original in the following ways: - It is possible for VAL to close over VAR. - On implementations that support it (SBCL, CCL, and LispWorks, at the moment) this version creates a backing variable that is "global" or "static", so there is not just a change in semantics, but also a gain in efficiency. - If VAR is a list that starts with `values`, each element is treated as a separate variable and initialized as if by `(setf (values VAR...) VAL)`. -
Macro
DEFINE-VALUES
(values &body (expr))Like `def', but for multiple values. Each variable in VALUES is given a global, lexical binding, as with `def', then set all at once, as with `multiple-value-setq'. -
Macro
DEFCONST
(symbol init &optional docstring)Define a constant, lexically. `defconst' defines a constant using a strategy similar to `def', so you don?t have to +cage+ your constants. The constant is only redefined on re-evaluation if INIT has a different literal representation than the old value. The name is from Emacs Lisp. -
Macro
DEFSUBST
(name params &body body)Define an inline function. (defsubst fn ...) ? (declaim (inline fn)) (defun fn ...) The advantage of a separate defining form for inline functions is that you can't forget to declaim the function inline before defining it ? without which it may not actually end up being inlined. From Emacs and other ancient Lisps. -
Macro
DEFALIAS
(alias &body (def &optional docstring) &environment env)Define a value as a top-level function. (defalias string-gensym (compose #'gensym #'string)) Like (setf (fdefinition ALIAS) DEF), but with a place to put documentation and some niceties to placate the compiler. Name from Emacs Lisp. -
Macro
DEFPLACE
(name args &body (form &optional docstring))Define NAME and (SETF NAME) in one go. Note that the body must be a single, setf-able expression. -
Macro
DEFVAR-UNBOUND
(var &body (docstring))Define VAR as if by `defvar' with no init form, and set DOCSTRING as its documentation. I believe the name comes from Edi Weitz. -
Macro
DEFLOOP
(name args &body body)Define a function, ensuring proper tail recursion. This is entirely equivalent to `defun' over `nlet'. -
Macro
DEFCONDITION
(name supers &body (slots &rest options))Alias for `define-condition'. Like (define-condition ...), but blissfully conforming to the same nomenclatural convention as every other definition form in Common Lisp. -
Macro
DEFSTRUCT-READ-ONLY
(name-and-opts &body slots)Easily define a defstruct with no mutable slots. The syntax of `defstruct-read-only' is as close as possible to that of `defstruct'. Given an existing structure definition, you can usually make it immutable simply by switching out `defstruct' for `defstruct-read-only'. There are only a few syntactic differences: 1. To prevent accidentally inheriting mutable slots, `defstruct-read-only' does not allow inheritance. 2. The `:type' option may not be used. 3. The `:copier' option is disabled, because it would be useless. 4. Slot definitions can use slot options without having to provide an initform. In this case, any attempt to make an instance of the struct without providing a value for that slot will signal an error. (my-slot :type string) ? (my-slot (required-argument 'my-slot) :read-only t :type string) The idea here is simply that an unbound slot in an immutable data structure does not make sense. A read-only struct is always externalizable; it has an implicit definition for `make-load-form'. On Lisps that support it, the structure is also marked as "pure": that is, instances may be moved into read-only memory. `defstruct-read-only' is designed to stay as close to the syntax of `defstruct' as possible. The idea is to make it easy to flag data as immutable, whether in your own code or in code you are refactoring. In new code, however, you may sometimes prefer `defconstructor', which is designed to facilitate working with immutable data. -
Function
READ-EVAL-PREFIX
(object stream)A helper for making objects readable. The obvious way to give an object a readable representation is to use the sharp-dot reader macro. However, methods are supposed to consult the values of `*print-readably*' and `*read-eval*' before doing so. This function takes care of that for you. If `*print-readably*' is false, return an empty string. If `*print-readably*' is true, and `*read-eval*' is also true, return the string "#.". If `*print-readably*' is true, but `*read-eval*' is not true, signal an error. -
Function
DECONSTRUCT
(x) -
Macro
DEFCONSTRUCTOR
(type-name &body slots)A variant of `defstruct' for modeling immutable data. The structure defined by `defconstructor' has only one constructor, which takes its arguments as required arguments (a BOA constructor). Thus, `defconstructor' is only appropriate for data structures that require no initialization. The printed representation of an instance resembles its constructor: (person "Common Lisp" 33) => (PERSON "Common Lisp" 33) While the constructor is BOA, the copier takes keyword arguments, allowing you to override the values of a selection of the slots of the structure being copied, while retaining the values of the others. (defconstructor person (name string) (age (integer 0 1000))) (defun birthday (person) (copy-person person :age (1+ (person-age person)))) (birthday (person "Common Lisp" 33)) => (PERSON "Common Lisp" 34) Obviously the copier becomes more useful the more slots the type has. When `*print-readably*' is true, the printed representation is readable: (person "Common Lisp" 33) => #.(PERSON "Common Lisp" 33) (Why override how a structure is normally printed? Structure types are not necessarily readable unless they have a default (`make-X') constructor. Since the type defined by `defconstructor' has only one constructor, we have to take over to make sure it re-readable.) Besides being re-readable, the type is also externalizable, with a method for `make-load-form': (make-load-form (person "Common Lisp" 33)) => (PERSON "Common Lisp" 33) Users of Trivia get an extra benefit: defining a type with `defconstructor' also defines a symmetrical pattern for destructuring that type. (trivia:match (person "Common Lisp" 33) ((person name age) (list name age))) => ("Common Lisp" 33) Note that the arguments to the pattern are optional: (trivia:match (person "Common Lisp" 33) ((person name) name)) => "Common Lisp" If you don't use Trivia, you can still do destructuring with `deconstruct', which returns the slots of a constructor as multiple values: (deconstruct (person "Common Lisp" 33)) => "Common Lisp", 33 Note also that no predicate is defined for the type, so to test for the type you must either use `typep' or pattern matching as above. While it is possible to inherit from a type defined with `defconstructor' (this is Lisp, I can't stop you), it's a bad idea. In particular, on Lisps which support it, a type defined with `defconstructor' is declared to be frozen (sealed), so your new subtype may not be recognized in type tests. Because `defconstructor' is implemented on top of `defstruct-read-only', it shares the limitations of `defstruct-read-only'. In particular it cannot use inheritance. The design of `defconstructor' is mostly inspired by Scala's [case classes](https://docs.scala-lang.org/tour/case-classes.html), with some implementation tricks from `cl-algebraic-data-type'. -
Macro
DEFUNIT
(name)Define a unit type. A unit type is a type with only one instance. You can think of a unit type as a singleton without state. Unit types are used for many of the same purposes as quoted symbols (or keywords) but, unlike a symbol, a unit type is tagged with its own individual type. -
Macro
DEFUNION
(union &body variants)Define an algebraic data type. Each expression in VARIANTS is either a symbol (in which case it defines a unit type, as with `defunit') or a list (in which case it defines a structure, as with `defconstructor'. -
Macro
MATCH-OF
(union expr &body clauses &environment env)Do pattern matching on an algebraic data type. UNION should be an algebraic data type. Each clause in CLAUSES has a pattern as its first element. If the pattern is a symbol, it matches a unit type. If the pattern is a list, it matches a constructor. If the pattern is an underscore, it introduces a default or fallthrough clause. If the pattern is a list that starts with `or', it is a disjunction of other patterns. -
Macro
LRET
((&rest bindings) &body body)Return the initial value of the last binding in BINDINGS. The idea is to create something, initialize it, and then return it. (lret ((x 1) (y (make-array 1))) (setf (aref y 0) x)) => #(1) `lret' may seem trivial, but it fufills the highest purpose a macro can: it eliminates a whole class of bugs (initializing an object, but forgetting to return it). Cf. `aprog1' in Anaphora. -
Macro
LRET*
((&rest bindings) &body body)Cf. `lret'. -
Macro
LETREC
((&rest bindings) &body body)Recursive LET. The idea is that functions created in BINDINGS can close over one another, and themselves. Note that `letrec' only binds variables: it can define recursive functions, but can't bind them as functions. (But see `fbindrec'.) -
Macro
LETREC*
((&rest bindings) &body body)Like LETREC, but the bindings are evaluated in order. See Waddell et al., *Fixing Letrec* for motivation. Cf. `fbindrec*'. -
Macro
RECEIVE
(formals expr &body body)Stricter version of `multiple-value-bind'. Use `receive' when you want to enforce that EXPR should return a certain number of values, or a minimum number of values. If FORMALS is a proper list, then EXPR must return exactly as many values -- no more and no less -- as there are variables in FORMALS. If FORMALS is an improper list (VARS . REST), then EXPR must return at least as many values as there are VARS, and any further values are bound, as a list, to REST. Lastly, if FORMALS is a symbol, bind that symbol to all the values returned by EXPR, as if by `multiple-value-list'. From Scheme (SRFI-8). -
Macro
MVLET*
((&rest bindings) &body body &environment env)Expand a series of nested `multiple-value-bind' forms. `mvlet*' is similar in intent to Scheme?s `let-values', but with a different and less parenthesis-intensive syntax. Each binding is a list of (var var*... expr) A simple example should suffice to show both the implementation and the motivation: (defun uptime (seconds) (mvlet* ((minutes seconds (truncate seconds 60)) (hours minutes (truncate minutes 60)) (days hours (truncate hours 24))) (declare ((integer 0 *) days hours minutes seconds)) (fmt "~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p" days hours minutes seconds))) Note that declarations work just like `let*'. -
Macro
MVLET
((&rest bindings) &body body)Parallel (`let'-like) version of `mvlet*'. -
Macro
AND-LET*
((&rest clauses) &body body &environment env)Scheme's guarded LET* (SRFI-2). Each clause should have one of the following forms: - `identifier', in which case IDENTIFIER's value is tested. - `(expression)', in which case the value of EXPRESSION is tested. - `(identifier expression)' in which case EXPRESSION is evaluated, and, if its value is not false, IDENTIFIER is bound to that value for the remainder of the clauses and the optional body. Note that, of course, the semantics are slightly different in Common Lisp than in Scheme, because our AND short-circuits on null, not false. -
Macro
EVAL-ALWAYS
(&body body)Shorthand for (eval-when (:compile-toplevel :load-toplevel :execute) ...) -
Macro
EVAL-AND-COMPILE
(&body body)Emacs's `eval-and-compile'. Alias for `eval-always'. -
Function
NO
(x)Another alias for `not' and `null'. From Arc. -
Macro
NOR
(&rest forms)Equivalent to (not (or ...)). From Arc. -
Macro
NAND
(&rest forms)Equivalent to (not (and ...)). -
Macro
TYPECASE-OF
(type x &body clauses &environment env)Like `etypecase-of', but may, and must, have an `otherwise' clause in case X is not of TYPE. -
Macro
ETYPECASE-OF
(type x &body body)Like `etypecase' but, at compile time, warn unless each clause in BODY is a subtype of TYPE, and the clauses in BODY form an exhaustive partition of TYPE. -
Macro
CASE-OF
(type x &body clauses &environment env)Like `case' but may, and must, have an `otherwise' clause. -
Macro
ECASE-OF
(type x &body body)Like `ecase' but, given a TYPE (which should be defined as `(member ...)'), warn, at compile time, unless the keys in BODY are all of TYPE and, taken together, they form an exhaustive partition of TYPE. -
Macro
CTYPECASE-OF
(type keyplace &body body &environment env)Like `etypecase-of', but providing a `store-value' restart to correct KEYPLACE and try again. -
Macro
CCASE-OF
(type keyplace &body body &environment env)Like `ecase-of', but providing a `store-value' restart to correct KEYPLACE and try again. -
Macro
DESTRUCTURING-ECASE-OF
(type expr &body body)Like `destructuring-ecase', from Alexandria, but with exhaustivness checking. TYPE is a designator for a type, which should be defined as `(member ...)'. At compile time, the macro checks that, taken together, the symbol at the head of each of the destructuring lists in BODY form an exhaustive partition of TYPE, and warns if it is not so. -
Macro
DESTRUCTURING-CASE-OF
(type expr &body body)Like `destructuring-ecase-of', but an `otherwise' clause must also be supplied. Note that the otherwise clauses must also be a list: ((otherwise &rest args) ...) -
Macro
DESTRUCTURING-CCASE-OF
(type keyplace &body body)Like `destructuring-case-of', but providing a `store-value' restart to collect KEYPLACE and try again. -
Macro
CASE-USING
(pred keyform &body clauses)ISLISP's case-using. (case-using #'eql x ...) ? (case x ...). Note that, no matter the predicate, the keys are not evaluated. (But see `selector'.) This version supports both single-item clauses (x ...) and multiple-item clauses ((x y) ...), as well as (t ...) or (otherwise ...) for the default clause. -
Macro
STRING-CASE
(stringform &body clauses)Efficient `case'-like macro with string keys. Note that string matching is always case-sensitive. This uses Paul Khuong's `string-case' macro internally. -
Macro
STRING-ECASE
(stringform &body clauses)Efficient `ecase'-like macro with string keys. Note that string matching is always case-sensitive. Cf. `string-case'. -
Macro
EIF
(&whole whole test then &optional (else nil else?))Like `cl:if', but expects two branches. Stands for ?exhaustive if?. -
Macro
EIF-LET
(&whole whole binds &body (then &optional (else nil else?)))Like `alexandria:if-let', but expects two branches. -
Condition
ECOND-FAILURE
(ERROR
)A failed ECOND form. -
Macro
ECOND
(&body clauses)Like `cond', but signal an error of type `econd-failure' if no clause succeeds. -
Macro
COND-LET
(var &body clauses)Cross between COND and LET. (cond-let x ((test ...))) ? (let (x) (cond ((setf x test) ...))) Cf. `acond' in Anaphora. -
Macro
ECOND-LET
(symbol &body clauses)Like `cond-let' for `econd'. -
Macro
COND-EVERY
(&body clauses)Like `cond', but instead of stopping after the first clause that succeeds, run all the clauses that succeed. Return the value of the last successful clause. If a clause begins with `cl:otherwise', it runs only if no preceding form has succeeded. Note that this does *not* do the same thing as a series of `when' forms: `cond-every' evaluates *all* the tests *before* it evaluates any of the forms. From Zetalisp. -
Macro
BCOND
(&body clauses)Scheme's extended COND. This is exactly like COND, except for clauses having the form (test :=> recipient) In that case, if TEST evaluates to a non-nil result, then RECIPIENT, a function, is called with that result, and the result of RECIPIENT is return as the value of the `cond`. As an extension, a clause like this: (test :=> var ...) Can be used as a shorthand for (test :=> (lambda (var) ...)) The name `bcond' for a ?binding cond? goes back at least to the days of the Lisp Machines. I do not know who was first to use it, but the oldest examples I have found are by Michael Parker and Scott L. Burson. -
Macro
CASE-LET
((var expr) &body cases)Like (let ((VAR EXPR)) (case VAR ...)) -
Macro
ECASE-LET
((var expr) &body cases)Like (let ((VAR EXPR)) (ecase VAR ...)) -
Macro
COMMENT
(&body body)A macro that ignores its body and does nothing. Useful for comments-by-example. Also, as noted in EXTENSIONS.LISP of 1992, "This may seem like a silly macro, but used inside of other macros or code generation facilities it is very useful - you can see comments in the (one-time) macro expansion!" -
Macro
EXAMPLE
(&body body)Like `comment'. -
Macro
NIX
(place &environment env)Set PLACE to nil and return the old value of PLACE. This may be more efficient than (shiftf place nil), because it only sets PLACE when it is not already null. -
Macro
ENSURE
(place &body newval &environment env)Essentially (or place (setf place newval)). PLACE is treated as unbound if it returns `nil', signals `unbound-slot', or signals `unbound-variable'. Note that ENSURE is `setf'-able, so you can do things like (incf (ensure x 0)) Cf. `ensure2'. -
Macro
ENSURE2
(place &body newval &environment env)Like `ensure', but specifically for accessors that return a second value like `gethash'. -
Macro
~>
(needle &rest holes)Threading macro from Clojure (by way of Racket). Thread NEEDLE through HOLES, where each hole is either a symbol (equivalent to `(hole needle)`) or a list (equivalent to `(hole needle args...)`). As an extension, an underscore in the argument list is replaced with the needle, so you can pass the needle as an argument other than the first. -
Macro
~>>
(needle &rest holes)Like `~>' but, by default, thread NEEDLE as the last argument instead of the first. -
Macro
NEST
(&rest things)Like ~>>, but backward. This is useful when layering `with-x' macros where the order is not important, and extra indentation would be misleading. For example: (nest (with-open-file (in file1 :direction input)) (with-open-file (in file2 :direction output)) ...) Is equivalent to: (with-open-file (in file1 :direction input) (with-open-file (in file2 :direction output) ...)) If the outer macro has no arguments, you may omit the parentheses. (nest with-standard-io-syntax ...) ? (with-standard-io-syntax ...) From UIOP, based on a suggestion by Marco Baringer. -
Macro
SELECT
(keyform &body clauses)Like `case', but with evaluated keys. Note that, like `case', `select' interprets a list as the first element of a clause as a list of keys. To use a form as a key, you must add an extra set of parentheses. (select 2 ((+ 2 2) t)) => T (select 4 (((+ 2 2)) t)) => T From Zetalisp. -
Macro
SELECTOR
(keyform fn &body clauses)Like `select', but compare using FN. Note that (unlike `case-using'), FN is not evaluated. From Zetalisp. -
Macro
SORT-VALUES
(pred &rest values)Sort VALUES with PRED and return as multiple values. Equivalent to (values-list (sort (list VALUES...) pred)) But with less consing, and potentially faster. -
Function
EQ*
(&rest xs)Variadic version of `EQ'. With no arguments, return T. With one argument, return T. With two arguments, same as `EQ'. With three or more arguments, return T only if all of XS are equivalent under `EQ'. Has a compiler macro, so there is no loss of efficiency relative to writing out the tests by hand. -
Function
EQL*
(&rest xs)Variadic version of `EQL'. With no arguments, return T. With one argument, return T. With two arguments, same as `EQL'. With three or more arguments, return T only if all of XS are equivalent under `EQL'. Has a compiler macro, so there is no loss of efficiency relative to writing out the tests by hand. -
Function
EQUAL*
(&rest xs)Variadic version of `EQUAL'. With no arguments, return T. With one argument, return T. With two arguments, same as `EQUAL'. With three or more arguments, return T only if all of XS are equivalent under `EQUAL'. Has a compiler macro, so there is no loss of efficiency relative to writing out the tests by hand. -
Function
EQUALP*
(&rest xs)Variadic version of `EQUALP'. With no arguments, return T. With one argument, return T. With two arguments, same as `EQUALP'. With three or more arguments, return T only if all of XS are equivalent under `EQUALP'. Has a compiler macro, so there is no loss of efficiency relative to writing out the tests by hand. -
Macro
SYNCHRONIZED
((&optional (object nil objectp)) &body body &environment env)Run BODY holding a unique lock associated with OBJECT. If no OBJECT is provided, run BODY as an anonymous critical section. If BODY begins with a literal string, attach the string to the lock object created (as the argument to `bt:make-recursive-lock'). -
Generic-Function
MONITOR
(object)Return a unique lock associated with OBJECT. -
Method
MONITOR
((object t)) -
Class
SYNCHRONIZED
Mixin for a class with its own monitor.-
MONITOR
Reader:MONITOR
-
-
Macro
NLET
(name (&rest bindings) &body body &environment env)Within BODY, bind NAME as a function, somewhat like LABELS, but with the guarantee that recursive calls to NAME will not grow the stack. `nlet' resembles Scheme?s named let, and is used for the same purpose: writing loops using tail recursion. You could of course do this with `labels' as well, at least under some Lisp implementations, but `nlet' guarantees tail call elimination anywhere and everywhere. (nlet rec ((i 1000000)) (if (= i 0) 0 (rec (1- i)))) => 0 Beware: because of the way it is written (literally, a GOTO with arguments), `nlet' is limited: self calls must be tail calls. That is, you cannot use `nlet' for true recursion. The name comes from `Let Over Lambda', but this is a more careful implementation: the function is not bound while the initial arguments are being evaluated, and it is safe to close over the arguments. -
Macro
WITH-COLLECTOR
((collector) &body body)Within BODY, bind COLLECTOR to a function of one argument that accumulates all the arguments it has been called with in order, like the collect clause in `loop', finally returning the collection. To see the collection so far, call COLLECTOR with no arguments. Note that this version binds COLLECTOR to a closure, not a macro: you can pass the collector around or return it like any other function. -
Macro
COLLECTING
(&body body)Like `with-collector', with the collector bound to the result of interning `collect' in the current package. -
Macro
WITH-COLLECTORS
((&rest collectors) &body body)Like `with-collector', with multiple collectors. Returns the final value of each collector as multiple values. (with-collectors (x y z) (x 1) (y 2) (z 3)) => '(1) '(2) '(3) -
Macro
SUMMING
(&body body)Within BODY, bind `sum' to a function that gathers numbers to sum. If the first form in BODY is a literal number, it is used instead of 0 as the initial sum. To see the running sum, call `sum' with no arguments. Return the total. -
Macro
IGNORING
(type &body body)An improved version of `ignore-errors`. The behavior is the same: if an error occurs in the body, the form returns two values, `nil` and the condition itself. `ignoring` forces you to specify the kind of error you want to ignore: (ignoring parse-error ...) I call it an improvement because I think `ignore-errors` is too broad: by hiding all errors it becomes itself a source of bugs. Of course you can still ignore all errors, at the cost of one extra character: (ignoring error ...) NB `(ignoring t)` is a bad idea. -
Function
MAYBE-INVOKE-RESTART
(restart &rest values)When RESTART is active, invoke it with VALUES. -
Macro
OP
(&body body &environment env)GOO's simple macro for positional lambdas. An OP is like a lambda without an argument list. Within the body of the OP form, an underscore introduces a new argument. (reduce (op (set-intersection _ _ :test #'equal)) sets) You can refer back to each argument by number, starting with _1. (funcall (op (+ _ _1)) 2) => 4 You can also use positional arguments directly: (reduce (op (funcall _2 _1)) ...) Argument lists can be sparse: (apply (op (+ _1 _3 _5)) '(1 2 3 4 5)) => 9 Note that OP with a single argument is equivalent to CONSTANTLY: (funcall (op 1)) => 1 and that OP with a single placeholder is equivalent to IDENTITY: (funcall (op _) 1) => 1 OP can also be used to define variadic functions by using _* as the placeholder. It is not necessary to use APPLY. (apply (op (+ _*)) '(1 2 3 4)) => 10 OP is intended for simple functions -- one-liners. Parameters are extracted according to a depth-first walk of BODY. Macro expansion may, or may not, be done depending on the implementation; it should not be relied on. Lexical bindings may, or may not, shadow placeholders -- again, it depends on the implementation. (This means, among other things, that nested use of `op' is not a good idea.) Because of the impossibility of a truly portable code walker, `op' will never be a true replacement for `lambda'. But even if it were possible to do better, `op' would still only be suited for one-liners. If you need more than a one-liner, then you should be giving your arguments names. {One thing you *can* count on the ability to use `op' with quasiquotes. If using placeholders inside quasiquotes does not work on your Lisp implementation, that's a bug, not a limitation.) -
Macro
OPF
(place expr)Like `(callf PLACE (op EXPR))'. From GOO. -
Function
PARTIAL
(fn &rest args)Partial application. Unlike `alexandria:curry', which is only inlined when you ask it to be, `partial' is always inlined if possible. From Clojure. -
Function
TRAMPOLINE
(fn &rest args)Use the trampoline technique to simulate mutually recursive functions. Call FN with supplied ARGS, if any. If FN returns a functions, call that function with no arguments. Repeat until the return value is not a function, and finally return that non-function value. Note that, to return a function as a final value, you must wrap it in some data structure and unpack it. Most likely to be useful for Lisp implementations that do not provide tail call elimination. From Clojure. -
Macro
DEFINE-TRAIN
(name args &body body)Define a higher-order function and its compiler macro at once. When defining a higher-order function it is usually a good idea to write a compiler macro so compilers can inline the resulting lambda form. For the special case of a fixed-arity function that only takes other functions as arguments, you can use `define-train' to define the function and the compiler macro in one go. The catch is that you have to write the single definition as a macro. E.g., if `complement' did not exist, you could define it like so: (define-train complement (fn) `(lambda (&rest args) (not (apply ,fn args)))) Besides providing an implicit compiler macro, `define-train' also inserts the proper declarations to ensure the compiler recognizes the function arguments as functions. The term "train" is from J. -
Function
FLIP
(f)Flip around the arguments of a binary function. That is, given a binary function, return another, equivalent function that takes its two arguments in the opposite order. From Haskell. -
Function
NTH-ARG
(n)Return a function that returns only its NTH argument, ignoring all others. If you've ever caught yourself trying to do something like (mapcar #'second xs ys) then `nth-arg` is what you need. If `hash-table-keys` were not already defined by Alexandria, you could define it thus: (defun hash-table-keys (table) (maphash-return (nth-arg 0) table)) -
Function
DISTINCT
(&key (key #'identity) (test 'equal))Return a function that echoes only values it has not seen before. (defalias test (distinct)) (test 'foo) => foo, t (test 'foo) => nil, nil The second value is T when the value is distinct. TEST must be a valid test for a hash table. This has many uses, for example: (count-if (distinct) seq) ? (length (remove-duplicates seq)) -
Function
THROTTLE
(fn wait &key synchronized memoized)Wrap FN so it can be called no more than every WAIT seconds. If FN was called less than WAIT seconds ago, return the values from the last call. Otherwise, call FN normally and update the cached values. WAIT, of course, may be a fractional number of seconds. The throttled function is not thread-safe by default; use SYNCHRONIZED to get a version with a lock. You can pass MEMOIZED if you want the function to remember values between calls. -
Function
ONCE
(fn)Return a function that runs FN only once, caching the results forever. -
Function
JUXT
(&rest fns)Clojure's `juxt'. Return a function of one argument, which, in turn, returns a list where each element is the result of applying one of FNS to the argument. It?s actually quite simple, but easier to demonstrate than to explain. The classic example is to use `juxt` to implement `partition`: (defalias partition* (juxt #'filter #'remove-if)) (partition* #'evenp '(1 2 3 4 5 6 7 8 9 10)) => '((2 4 6 8 10) (1 3 5 7 9)) The general idea is that `juxt` takes things apart. -
Function
DYNAMIC-CLOSURE
(symbols fn)Create a dynamic closure. Some ancient Lisps had closures without lexical binding. Instead, you could "close over" pieces of the current dynamic environment. When the resulting closure was called, the symbols closed over would be bound to their values at the time the closure was created. These bindings would persist through subsequent invocations and could be mutated. The result was something between a closure and a continuation. This particular piece of Lisp history is worth reviving, I think, if only for use with threads. For example, to start a thread and propagate the current value of `*standard-output*': (bt:make-thread (dynamic-closure '(*standard-output*) (lambda ...))) = (let ((temp *standard-output*)) (bt:make-thread (lambda ... (let ((*standard-output* temp)) ...)))) -
Function
HOOK
(f g)Monadic hook. From J. The hook of f is defined as f(y,g(y)). For example, you can use a hook to test whether a number is an integer, by asking whether it is equal to its own floor. (hook #'= #'floor) (funcall * 2.0) => T AKA Schoenfinkel's S combinator. -
Function
FORK
(g f h)Monadic fork. The monadic fork of f, g, and h is defined as (f g h) y <-> (f y) g (h y) The usual example of a monadic fork is defining the mean. Assuming a `sum' function defined as (defun sum (xs) (reduce #'+ xs)) you can write a (numerically unstable) `mean' using `fork'. (fork #'/ #'sum #'length) (funcall * '(1.0 2.0 3.0 4.0)) => 2.5 From J. -
Function
HOOK2
(f g)Dyadic hook. The usual (only?) example of a dyadic hook is an `hour' function that takes an hour and a count of minutes and returns a fractional count of hours. (hook2 #'+ (partial (flip #'/) 60)) (funcall * 3.0 15.0) => 3.25 From J. -
Function
FORK2
(g f h)Dyadic fork. The dyadic fork of f, g, and h is defined as: x (f g h) y <-> (x f y) g (x h y) For example, say you wanted a "plus or minus" operator. Given numbers x and y, it returns a list of x+y and x-y. This can easily be written as a dyadic fork. (fork2 #'list #'+ #'-) (funcall * 10 2) => '(12 8) From J. -
Function
CAPPED-FORK
(g h)J's capped fork (monadic). Like a monadic fork, but F is omitted. Effectively the composition of G and H. -
Function
CAPPED-FORK2
(g h)J's capped fork (dyadic). Like a dyadic fork, but F is omitted. -
Function
WALK-TREE
(fun tree &optional (tag nil tagp))Call FUN in turn over each atom and cons of TREE. FUN can skip the current subtree with (throw TAG nil). -
Function
MAP-TREE
(fun tree &optional (tag nil tagp))Walk FUN over TREE and build a tree from the results. The new tree may share structure with the old tree. (eq tree (map-tree #'identity tree)) => T FUN can skip the current subtree with (throw TAG SUBTREE), in which case SUBTREE will be used as the value of the subtree. -
Function
LEAF-WALK
(fun tree)Call FUN on each leaf of TREE. -
Function
LEAF-MAP
(fn tree)Call FN on each leaf of TREE. Return a new tree possibly sharing structure with TREE. -
Function
OCCURS-IF
(test tree &key (key #'identity))Is there a node (leaf or cons) in TREE that satisfies TEST? -
Function
PRUNE-IF
(test tree &key (key #'identity))Remove any atoms satisfying TEST from TREE. -
Function
OCCURS
(leaf tree &key (key #'identity) (test #'eql))Is LEAF present in TREE? -
Function
PRUNE
(leaf tree &key (key #'identity) (test #'eql))Remove LEAF from TREE wherever it occurs. -
Macro
DO-HASH-TABLE
((key value table &optional return) &body body)Iterate over hash table TABLE, in no particular order. At each iteration, a key from TABLE is bound to KEY, and the value of that key in TABLE is bound to VALUE. -
Function
DICT
(&rest keys-and-values)A concise constructor for hash tables. (gethash :c (dict :a 1 :b 2 :c 3)) => 3, T By default, return an 'equal hash table containing each successive pair of keys and values from KEYS-AND-VALUES. If the number of KEYS-AND-VALUES is odd, then the first argument is understood as the test. (gethash "string" (dict "string" t)) => t (gethash "string" (dict 'eq "string" t)) => nil -
Function
DICT*
(dict &rest args)Merge new bindings into DICT. Roughly equivalent to `(merge-tables DICT (dict args...))'. -
Macro
DICTQ
(&rest keys-and-values)A literal hash table. Like `dict', but the keys and values are implicitly quoted. -
Function
HREF
(table &rest keys)A concise way of doings lookups in (potentially nested) hash tables. (href (dict :x 1) :x) => x (href (dict :x (dict :y 2)) :x :y) => y -
Function
HREF-DEFAULT
(default table &rest keys)Like `href', with a default. As soon as one of KEYS fails to match, DEFAULT is returned. -
Function
(setf HREF)
(value table &rest keys) -
Function
@
(table &rest keys)A concise way of doings lookups in (potentially nested) hash tables. (@ (dict :x 1) :x) => x (@ (dict :x (dict :y 2)) :x :y) => y -
Function
(setf @)
(value table key &rest keys) -
Function
POPHASH
(key hash-table)Lookup KEY in HASH-TABLE, return its value, and remove it. This is only a shorthand. It is not in itself thread-safe. From Zetalisp. -
Function
SWAPHASH
(key value hash-table)Set KEY and VALUE in HASH-TABLE, returning the old values of KEY. This is only a shorthand. It is not in itself thread-safe. From Zetalisp. -
Function
HASH-FOLD
(fn init hash-table)Reduce TABLE by calling FN with three values: a key from the hash table, its value, and the return value of the last call to FN. On the first call, INIT is supplied in place of the previous value. From Guile. -
Function
MAPHASH-RETURN
(fn hash-table)Like MAPHASH, but collect and return the values from FN. From Zetalisp. -
Function
MERGE-TABLES
(table &rest tables)Merge TABLE and TABLES, working from left to right. The resulting hash table has the same parameters as TABLE. If the same key is present in two tables, the value from the rightmost table is used. All of the tables being merged must have the same value for `hash-table-test'. Clojure's `merge'. -
Function
FLIP-HASH-TABLE
(table &key (test (constantly t)) (key #'identity))Return a table like TABLE, but with keys and values flipped. (gethash :y (flip-hash-table (dict :x :y))) => :x, t TEST allows you to filter which keys to set. (def number-names (dictq 1 one 2 two 3 three)) (def name-numbers (flip-hash-table number-names)) (def name-odd-numbers (flip-hash-table number-names :filter #'oddp)) (gethash 'two name-numbers) => 2, t (gethash 'two name-odd-numbers) => nil, nil KEY allows you to transform the keys in the old hash table. (def negative-number-names (flip-hash-table number-names :key #'-)) (gethash 'one negative-number-names) => -1, nil KEY defaults to `identity'. -
Function
SET-HASH-TABLE
(set &rest hash-table-args &key (test #'eql) (key #'identity) (strict t) &allow-other-keys)Return SET, a list considered as a set, as a hash table. This is the equivalent of Alexandria's `alist-hash-table' and `plist-hash-table' for a list that denotes a set. STRICT determines whether to check that the list actually is a set. The resulting hash table has the elements of SET for both its keys and values. That is, each element of SET is stored as if by (setf (gethash (key element) table) element) -
Function
HASH-TABLE-SET
(table &key (strict t) (test #'eql) (key #'identity))Return the set denoted by TABLE. Given STRICT, check that the table actually denotes a set. Without STRICT, equivalent to `hash-table-values'. -
Function
HASH-TABLE-PREDICATE
(hash-table)Return a predicate for membership in HASH-TABLE. The predicate returns the same two values as `gethash', but in the opposite order. -
Function
HASH-TABLE-FUNCTION
(hash-table &key read-only strict (key-type 't) (value-type 't) strict-types)Return a function for accessing HASH-TABLE. Calling the function with a single argument is equivalent to `gethash' against a copy of HASH-TABLE at the time HASH-TABLE-FUNCTION was called. (def x (make-hash-table)) (funcall (hash-table-function x) y) ? (gethash y x) If READ-ONLY is nil, then calling the function with two arguments is equivalent to `(setf (gethash ...))' against HASH-TABLE. If STRICT is non-nil, then the function signals an error if it is called with a key that is not present in HASH-TABLE. This applies to setting keys, as well as looking them up. The function is able to restrict what types are permitted as keys and values. If KEY-TYPE is specified, an error will be signaled if an attempt is made to get or set a key that does not satisfy KEY-TYPE. If VALUE-TYPE is specified, an error will be signaled if an attempt is made to set a value that does not satisfy VALUE-TYPE. However, the hash table provided is *not* checked to ensure that the existing pairings KEY-TYPE and VALUE-TYPE -- not unless STRICT-TYPES is also specified. -
Function
MAKE-HASH-TABLE-FUNCTION
(&rest args &key &allow-other-keys)Call `hash-table-function' on a fresh hash table. ARGS can be args to `hash-table-function' or args to `make-hash-table', as they are disjoint. -
Function
DELETE-FROM-HASH-TABLE
(table &rest keys)Return TABLE with KEYS removed (as with `remhash'). Cf. `delete-from-plist' in Alexandria. -
Function
PAIRHASH
(keys data &optional hash-table)Like `pairlis', but for a hash table. Unlike `pairlis', KEYS and DATA are only required to be sequences, not lists. By default, the hash table returned uses `eql' as its tests. If you want a different test, make the table yourself and pass it as the HASH-TABLE argument. -
Function
PATH-JOIN
(&rest pathnames)Build a pathname by merging from right to left. With `path-join' you can pass the elements of the pathname being built in the order they appear in it: (path-join (user-homedir-pathname) config-dir config-file) ? (uiop:merge-pathnames* config-file (uiop:merge-pathnames* config-dir (user-homedir-pathname))) Note that `path-join' does not coerce the parts of the pathname into directories; you have to do that yourself. (path-join "dir1" "dir2" "file") -> #p"file" (path-join "dir1/" "dir2/" "file") -> #p"dir1/dir2/file" -
Function
WRITE-STREAM-INTO-FILE
(stream pathname &key (if-exists :error) if-does-not-exist)Read STREAM and write the contents into PATHNAME. STREAM will be closed afterwards, so wrap it with `make-concatenated-stream' if you want it left open. -
Function
FILE=
(file1 file2 &key (buffer-size 4096))Compare FILE1 and FILE2 octet by octet, (possibly) using buffers of BUFFER-SIZE. -
Function
FILE-SIZE
(file &key (element-type '(unsigned-byte 8)))The size of FILE, in units of ELEMENT-TYPE (defaults to bytes). The size is computed by opening the file and getting the length of the resulting stream. If all you want is to read the file's size in octets from its metadata, consider `trivial-file-size:file-size-in-octets' instead. -
Function
FIND-KEYWORD
(string)If STRING has been interned as a keyword, return it. Like `make-keyword', but preferable in most cases, because it doesn't intern a keyword -- which is usually both unnecessary and unwise. -
Function
BOUND-VALUE
(s &optional default)If S is bound, return (values s t). Otherwise, return DEFAULT and nil. -
Function
(setf BOUND-VALUE)
(val sym)Like `(setf (symbol-value SYM) VAL)', but raises an error if SYM is not already bound. -
Function
ARRAY-INDEX-ROW-MAJOR
(array row-major-index)The inverse of ARRAY-ROW-MAJOR-INDEX. Given an array and a row-major index, return a list of subscripts. (apply #'aref (array-index-row-major i)) ? (array-row-major-aref i) -
Function
UNDISPLACE-ARRAY
(array)Recursively get the fundamental array that ARRAY is displaced to. Return the fundamental array, and the start and end positions into it. Borrowed from Erik Naggum. -
Struct
QUEUE
Basic cons queues, with an implementation based on PAIP and the original Norvig & Waters paper, and an API mostly borrowed from Arc. About Arc. For the most part, Arc-style identifiers are pessimal, neither quite opaque nor quite explicit, like riddles. But by using abbreviated names, we avoid the danger of clashing with special-purpose queue implementations. Create a queue with `queue', like `list': (queue 1 2 3) => #<QUEUE (1 2 3)> Get the items with `qlist': (qlist (queue 1 2 3)) => '(1 2 3) Add items with `enq': (enq 3 (queue 1 2)) => #<QUEUE (1 2 3)> Remove an item with `deq': (deq (queue 1 2 3)) => 3 To (destructively) join a list to the end of the queue, use `qconc': (qconc (queue 1 2 3) '(4 5 6)) => #<QUEUE (1 2 3 4 5 6)> The rest of the API: - `queuep' Test for a queue - `qlen' Like `(length (qlist ...))' - `clear-queue' Clear the queue - `front' Like to `(car (qlist ...))' - `queue-empty-p' Test if the queue is empty - `qappend' Non-destructively join a list to the end of the queue The idea is that *collecting* is something we do often enough to justifying making *collectors* (queues) first-class.-
CONS
-
-
Function
QUEUEP
(object) -
Function
QUEUE
(&rest initial-contents)Build a new queue with INITIAL-CONTENTS. -
Function
CLEAR-QUEUE
(queue)Return QUEUE's contents and reset it. -
Function
QLEN
(queue)The number of items in QUEUE. -
Function
QLIST
(queue)A list of the items in QUEUE. -
Function
ENQ
(item queue)Insert ITEM at the end of QUEUE. -
Function
DEQ
(queue)Remove item from the front of the QUEUE. -
Function
FRONT
(queue)The first element in QUEUE. -
Function
QUEUE-EMPTY-P
(queue)Is QUEUE empty? -
Function
QCONC
(queue list)Destructively concatenate LIST onto the end of QUEUE. Return the queue. -
Function
QAPPEND
(queue list)Append the elements of LIST onto the end of QUEUE. Return the queue. -
Struct
BOX
A box is just a mutable cell. You create a box using `box' and get and set its value using the accessor `unbox'. (def a-box (box t)) (unbox a-box) => t (setf (unbox a-box) nil) (unbox a-box) => nil At the moment, boxes are implemented as structures, but that may change. In particular, you should not depend on being able to recognize boxes using a type or predicate.-
VALUE
-
-
Function
BOX
(value) -
Function
UNBOX
(x)The value in the box X. -
Function
(setf UNBOX)
(value x)Put VALUE in box X. -
Function
FIXNUMP
(n)Same as `(typep N 'fixnum)'. -
Macro
FINC
(ref3 &optional (delta 1) &environment env4)Like `incf', but returns the old value instead of the new. An alternative to using -1 as the starting value of a counter, which can prevent optimization. -
Macro
FDEC
(ref110 &optional (delta 1) &environment env111)Like `decf', but returns the old value instead of the new. -
Function
PARSE-FLOAT
(string &key (start 0) (end (length string)) junk-allowed (type *read-default-float-format* type-supplied-p))Parse STRING as a float of TYPE. The type of the float is determined by, in order: - TYPE, if it is supplied; - The type specified in the exponent of the string; - or `*read-default-float-format*'. (parse-float "1.0") => 1.0s0 (parse-float "1.0d0") => 1.0d0 (parse-float "1.0s0" :type 'double-float) => 1.0d0 Of course you could just use `parse-number', but sometimes only a float will do. -
Function
ROUND-TO
(number &optional (divisor 1))Like `round', but return the resulting number. (round 15 10) => 2 (round-to 15 10) => 20 -
Function
BITS
(int &key big-endian)Return a bit vector of the bits in INT. Defaults to little-endian. -
Function
UNBITS
(bits &key big-endian)Turn a sequence of BITS into an integer. Defaults to little-endian. -
Function
SHRINK
(n by)Decrease N by a factor. -
Function
GROW
(n by)Increase N by a factor. -
Macro
SHRINKF
(place n &environment env)Shrink the value in a place by a factor. -
Macro
GROWF
(place n &environment env)Grow the value in a place by a factor. -
Function
RANDOM-IN-RANGE
(low high)Random number in the range [low,high). LOW and HIGH are automatically swapped if HIGH is less than LOW. Note that the value of LOW+HIGH may be greater than the range that can be represented as a number in CL. E.g., you can generate a random double float with (random-in-range most-negative-double-float most-positive-double-float) even though (+ most-negative-double-float most-positive-double-float) would cause a floating-point overflow. From Zetalisp. -
Function
FLOAT-PRECISION-CONTAGION
(&rest ns)Perform numeric contagion on the elements of NS. That is, if any element of NS is a float, then every number in NS will be returned as "a float of the largest format among all the floating-point arguments to the function". This does nothing but numeric contagion: the number of arguments returned is the same as the number of arguments given. -
Function
OCTET-VECTOR-P
(x)Is X an octet vector? -
Function
MAKE-OCTET-VECTOR
(size)Make an octet vector of SIZE elements. -
Function
OCTETS
(n &key big-endian)Return N, an integer, as an octet vector. Defaults to little-endian order. -
Function
UNOCTETS
(bytes &key big-endian)Concatenate BYTES, an octet vector, into an integer. Defaults to little-endian order. -
Function
OCTET-VECTOR=
(v1 v2 &key (start1 0) end1 (start2 0) end2)Like `string=' for octet vectors. -
Function
UNIVERSAL-TO-UNIX
(time)Convert a universal time to a Unix time. -
Function
UNIX-TO-UNIVERSAL
(time)Convert a Unix time to a universal time. -
Function
GET-UNIX-TIME
The current time as a count of seconds from the Unix epoch. -
Function
DATE-LEAP-YEAR-P
(year)Is YEAR a leap year in the Gregorian calendar? -
Function
TIME-SINCE
(time)Return seconds since TIME. -
Function
TIME-UNTIL
(time)Return seconds until TIME. -
Function
INTERVAL
(&key (seconds 0) (minutes 0) (hours 0) (days 0) (weeks 0) (months 0) (years 0) (month-days 28) (year-days 365))A verbose but readable way of specifying intervals in seconds. Intended as a more readable alternative to idioms like (let ((day-in-seconds #.(* 24 60 60))) ...) Has a compiler macro. -
Function
MAKE
(class &rest initargs &key &allow-other-keys)Shorthand for `make-instance'. After Eulisp. -
Function
CLASS-NAME-SAFE
(x)The class name of the class of X. If X is a class, the name of the class itself. -
Function
FIND-CLASS-SAFE
(x &optional env)The class designated by X. If X is a class, it designates itself. -
Macro
DEFMETHODS
(class (self . slots) &body body)Concisely define methods that specialize on the same class. You can already use `defgeneric' to define an arbitrary number of methods on a single generic function without having to repeat the name of the function: (defgeneric fn (x) (:method ((x string)) ...) (:method ((x number)) ...)) Which is equivalent to: (defgeneric fn (x)) (defmethod fn ((x string)) ...) (defmethod fn ((x number)) ...) Similarly, you can use `defmethods' to define methods that specialize on the same class, and access the same slots, without having to repeat the names of the class or the slots: (defmethods my-class (self x y) (:method initialize-instance :after (self &key) ...) (:method print-object (self stream) ...) (:method some-method ((x string) self) ...)) Which is equivalent to: (defmethod initialize-instance :after ((self my-class) &key) (with-slots (x y) self ...)) (defmethod print-object ((self my-class) stream) (with-slots (x y) self ...)) (defmethod some-method ((x string) (self my-class)) (with-slots (y) self ;! ...)) Note in particular that `self' can appear in any position, and that you can freely specialize the other arguments. (The difference from using `with-slots' is the scope of the slot bindings: they are established *outside* of the method definition, which means argument bindings shadow slot bindings: (some-method "foo" (make 'my-class :x "bar")) => "foo" Since slot bindings are lexically outside the argument bindings, this is surely correct, even if it makes `defmethods' slightly harder to explain in terms of simpler constructs.) Is `defmethods' trivial? Yes, in terms of its implementation. This docstring is far longer than the code it documents. But you may find it does a lot to keep heavily object-oriented code readable and organized, without any loss of power. This construct is very loosely inspired by impl blocks in Rust. -
Variable
*HOOK*
nil
The hook currently being run. -
Function
ADD-HOOK
(name fn &key append)Add FN to the value of NAME, a hook. -
Function
REMOVE-HOOK
(name fn)Remove fn from the symbol value of NAME. -
Function
RUN-HOOKS
(&rest hookvars)Run all the hooks in all the HOOKVARS. The variable `*hook*' is bound to the name of each hook as it is being run. -
Function
RUN-HOOK-WITH-ARGS
(*hook* &rest args)Apply each function in the symbol value of HOOK to ARGS. -
Function
RUN-HOOK-WITH-ARGS-UNTIL-FAILURE
(*hook* &rest args)Like `run-hook-with-args', but quit once a function returns nil. -
Function
RUN-HOOK-WITH-ARGS-UNTIL-SUCCESS
(*hook* &rest args)Like `run-hook-with-args', but quit once a function returns non-nil. -
Condition
LETREC-RESTRICTION-VIOLATION
(ERROR
)Violation of the letrec restriction. The "letrec restriction" means that the expressions being bound in a `letrec' cannot refer to the value of other bindings in the same `letrec'. For `fbindrec', the restriction applies everywhere. For `fbindrec*', it only applies to functions not yet bound. -
Macro
FBIND
(bindings &body body &environment *lexenv*)Binds values in the function namespace. That is, (fbind ((fn (lambda () ...)))) ? (flet ((fn () ...))), except that a bare symbol in BINDINGS is rewritten as (symbol symbol). -
Macro
FBIND*
(bindings &body body &environment env)Like `fbind', but creates bindings sequentially. -
Macro
FBINDREC
(bindings &body body &environment *lexenv*)Like `fbind', but creates recursive bindings. The consequences of referring to one binding in the expression that generates another are undefined. -
Macro
FBINDREC*
(bindings &body body &environment *lexenv*)Like `fbindrec`, but the function defined in each binding can be used in successive bindings. -
Function
FILTER-MAP
(fn list &rest lists)Map FN over (LIST . LISTS) like `mapcar', but omit empty results. (filter-map fn ...) ? (remove nil (mapcar fn ...)) -
Function
CAR-SAFE
(x)The car of X, or nil if X is not a cons. This is different from Alexandria?s `ensure-car`, which returns the atom. (ensure-car '(1 . 2)) => 1 (car-safe '(1 . 2)) => 1 (ensure-car 1) => 1 (car-safe 1) => nil From Emacs Lisp. -
Function
CDR-SAFE
(x)The cdr of X, or nil if X is not a cons. From Emacs Lisp. -
Function
APPEND1
(list item)Append an atom to a list. (append1 list item) ? (append list (list item)) -
Function
IN
(x &rest items)Is X equal to any of ITEMS? `(in x xs...)` is always equivalent to `(and (member x xs :test equal) t)`, but `in` can sometimes compile to more efficient code when the candidate matches are constant. From Arc. -
Function
MEMQ
(item list)Like (member ... :test #'eq). Should only be used for symbols. -
Function
DELQ
(item list)Like (delete ... :test #'eq), but only for lists. Almost always used as (delq nil ...). -
Function
MAPPLY
(fn list &rest lists)`mapply' is a cousin of `mapcar'. If you think of `mapcar' as using `funcall': (mapcar #'- '(1 2 3)) ? (loop for item in '(1 2 3) collect (funcall #'- item)) Then `mapply' does the same thing, but with `apply' instead. (loop for item in '((1 2 3) (4 5 6)) collect (apply #'+ item)) => (6 15) (mapply #'+ '((1 2 3) (4 5 6))) => (6 15) In variadic use, `mapply' acts as if `append' had first been used: (mapply #'+ xs ys) ? (mapply #'+ (mapcar #'append xs ys)) But the actual implementation is more efficient. `mapply' can convert a list of two-element lists into an alist: (mapply #'cons '((x 1) (y 2)) => '((x . 1) (y . 2)) -
Function
ASSOCDR
(item alist &rest args &key &allow-other-keys)Like (cdr (assoc ...)) -
Function
ASSOCADR
(item alist &rest args &key &allow-other-keys)Like `assocdr' for alists of proper lists. (assocdr 'x '((x 1))) => '(1) (assocadr 'x '((x 1))) => 1 -
Function
RASSOCAR
(item alist &rest args &key &allow-other-keys)Like (car (rassoc ...)) -
Function
FIRSTN
(n list)The first N elements of LIST, as a fresh list: (firstn 4 (iota 10)) => (0 1 2 4) (I do not why this extremely useful function did not make it into Common Lisp, unless it was deliberately left out as an exercise for Maclisp users.) -
Function
POWERSET
(set)Return the powerset of SET. Uses a non-recursive algorithm. -
Function
EFFACE
(item list)Destructively remove only the first occurence of ITEM in LIST. From Lisp 1.5. -
Macro
POP-ASSOC
(key alist &rest args &environment env)Like `assoc' but, if there was a match, delete it from ALIST. From Newlisp. -
Function
MAPCAR-INTO
(fn list)Like (map-into list fn list). From PAIP. -
Function
NTHREST
(n list)Alias for `nthcdr'. -
Function
PLIST-KEYS
(plist)Return the keys of a plist. -
Function
PLIST-VALUES
(plist)Return the values of a plist. -
Macro
DO-EACH
((var seq &optional return) &body body)Iterate over the elements of SEQ, a sequence. If SEQ is a list, this is equivalent to `dolist'. -
Function
NSUBSEQ
(seq start &optional end)Return a subsequence that may share structure with SEQ. Note that `nsubseq' gets its aposematic leading `n' not because it is itself destructive, but because, unlike `subseq', destructive operations on the subsequence returned may mutate the original. `nsubseq' also works with `setf', with the same behavior as `replace'. -
Function
(setf NSUBSEQ)
(value seq start &optional end)Destructively set SEQ between START and END to VALUE. Uses `replace' internally. -
Function
FILTER
(pred seq &rest args &key count &allow-other-keys)Almost, but not quite, an alias for `remove-if-not'. The difference is the handling of COUNT: for `filter', COUNT is the number of items to *keep*, not remove. (remove-if-not #'oddp '(1 2 3 4 5) :count 2) => '(1 3 5) (filter #'oddp '(1 2 3 4 5) :count 2) => '(1 3) -
Macro
FILTERF
(place pred &rest args &environment env)Modify-macro for FILTER. The place designed by the first argument is set to th result of calling FILTER with PRED, the place, and ARGS. -
Function
KEEP
(item seq &rest args &key (test #'eql) from-end key count &allow-other-keys)Almost, but not quite, an alias for `remove` with `:test-not` instead of `:test`. The difference is the handling of COUNT. For keep, COUNT is the number of items to keep, not remove. (remove 'x '(x y x y x y) :count 2) => '(y y x y) (keep 'x '(x y x y x y) :count 2) => '(x x) `keep' becomes useful with the KEY argument: (keep 'x ((x 1) (y 2) (x 3)) :key #'car) => '((x 1) (x 3)) -
Function
SINGLE
(seq)Is SEQ a sequence of one element? -
Function
PARTITION
(pred seq &key (start 0) end (key #'identity))Partition elements of SEQ into those for which PRED returns true and false. Return two values, one with each sequence. Exactly equivalent to: (values (remove-if-not predicate seq) (remove-if predicate seq)) except it visits each element only once. Note that `partition` is not just `assort` with an up-or-down predicate. `assort` returns its groupings in the order they occur in the sequence; `partition` always returns the ?true? elements first. (assort '(1 2 3) :key #'evenp) => ((1 3) (2)) (partition #'evenp '(1 2 3)) => (2), (1 3) -
Function
PARTITIONS
(preds seq &key (start 0) end (key #'identity))Generalized version of PARTITION. PREDS is a list of predicates. For each predicate, `partitions' returns a filtered copy of SEQ. As a second value, it returns an extra sequence of the items that do not match any predicate. Items are assigned to the first predicate they match. -
Function
ASSORT
(seq &key (key #'identity) (test #'eql) (start 0) end)Return SEQ assorted by KEY. (assort (iota 10) :key (lambda (n) (mod n 3))) => '((0 3 6 9) (1 4 7) (2 5 8)) You can think of `assort' as being akin to `remove-duplicates': (mapcar #'first (assort list)) ? (remove-duplicates list :from-end t) -
Function
RUNS
(seq &key (start 0) end (key #'identity) (test #'eql))Return a list of runs of similar elements in SEQ. The arguments START, END, and KEY are as for `reduce'. (runs '(head tail head head tail)) => '((head) (tail) (head head) (tail)) -
Function
BATCHES
(seq n &key (start 0) end even)Return SEQ in batches of N elements. (batches (iota 11) 2) => ((0 1) (2 3) (4 5) (6 7) (8 9) (10)) If EVEN is non-nil, then SEQ must be evenly divisible into batches of size N, with no leftovers. -
Function
FREQUENCIES
(seq &rest hash-table-args &key (key #'identity) &allow-other-keys)Return a hash table with the count of each unique item in SEQ. As a second value, return the length of SEQ. From Clojure. -
Function
SCAN
(fn seq &key (key #'identity) (initial-value nil initial-value?))A version of `reduce' that shows its work. Instead of returning just the final result, `scan' returns a sequence of the successive results at each step. (reduce #'+ '(1 2 3 4)) => 10 (scan #'+ '(1 2 3 4)) => '(1 3 6 10) From APL and descendants. -
Function
NUB
(seq &rest args &key start end key (test #'equal))Remove duplicates from SEQ, starting from the end. TEST defaults to `equal'. From Haskell. -
Function
GCP
(seqs &key (test #'eql))The greatest common prefix of SEQS. If there is no common prefix, return NIL. -
Function
GCS
(seqs &key (test #'eql))The greatest common suffix of SEQS. If there is no common suffix, return NIL. -
Function
OF-LENGTH
(length)Return a predicate that returns T when called on a sequence of length LENGTH. (funcall (of-length 3) '(1 2 3)) => t (funcall (of-length 1) '(1 2 3)) => nil -
Function
LENGTH<
(&rest seqs)Is each length-designator in SEQS shorter than the next? A length designator may be a sequence or an integer. -
Function
LENGTH>
(&rest seqs)Is each length-designator in SEQS longer than the next? A length designator may be a sequence or an integer. -
Function
LENGTH>=
(&rest seqs)Is each length-designator in SEQS longer or as long as the next? A length designator may be a sequence or an integer. -
Function
LENGTH<=
(&rest seqs)Is each length-designator in SEQS as long or shorter than the next? A length designator may be a sequence or an integer. -
Function
LONGER
(x y)Return the longer of X and Y. If X and Y are of equal length, return X. -
Function
LONGEST
(seqs)Return the longest seq in SEQS. -
Function
SLICE
(seq start &optional (end (length seq)))Like `subseq', but allows negative bounds to specify offsets. Both START and END accept negative bounds. (slice "string" -3 -1) => "in" Setf of `slice' is like setf of `ldb': afterwards, the place being set holds a new sequence which is not EQ to the old. -
Function
ORDERING
(seq &key unordered-to-end from-end (test 'eql) (key #'identity))Given a sequence, return a function that, when called with `sort', restores the original order of the sequence. That is, for any SEQ (without duplicates), it is always true that (equal seq (sort (reshuffle seq) (ordering seq))) FROM-END controls what to do in case of duplicates. If FROM-END is true, the last occurrence of each item is preserved; otherwise, only the first occurrence counts. TEST controls identity; it should be a valid test for a hash table. If the items cannot be compared that way, you can use KEY to transform them. UNORDERED-TO-END controls where to sort items that are not present in the original ordering. By default they are sorted first but, if UNORDERED-TO-END is true, they are sorted last. In either case, they are left in no particular order. -
Function
TAKE
(n seq)Return, at most, the first N elements of SEQ, as a *new* sequence of the same type as SEQ. If N is longer than SEQ, SEQ is simply copied. If N is negative, then |N| elements are taken (in their original order) from the end of SEQ. -
Function
DROP
(n seq)Return all but the first N elements of SEQ. The sequence returned is a new sequence of the same type as SEQ. If N is greater than the length of SEQ, returns an empty sequence of the same type. If N is negative, then |N| elements are dropped from the end of SEQ. -
Function
TAKE-WHILE
(pred seq)Return the prefix of SEQ for which PRED returns true. -
Function
DROP-WHILE
(pred seq)Return the largest possible suffix of SEQ for which PRED returns false when called on the first element. -
Function
BESTN
(n seq pred &key (key #'identity) memo)Partial sorting. Equivalent to (firstn N (sort SEQ PRED)), but much faster, at least for small values of N. With MEMO, use a decorate-sort-undecorate transform to ensure KEY is only ever called once per element. The name is from Arc. -
Function
NTH-BEST
(n seq pred &key (key #'identity))Return the Nth-best element of SEQ under PRED. Equivalent to (elt (sort (copy-seq seq) pred) n) Or even (elt (bestn (1+ n) seq pred) n) But uses a selection algorithm for better performance than either. -
Function
NTH-BEST!
(n seq pred &key (key #'identity))Destructive version of `nth-best'. Note that this function requires that SEQ be a vector. -
Function
RESHUFFLE
(seq &key (element-type '*))Like `alexandria:shuffle', but non-destructive. Regardless of the type of SEQ, the return value is always a vector. If ELEMENT-TYPE is provided, this is the element type (modulo upgrading) of the vector returned. If ELEMENT-TYPE is not provided, then the element type of the vector returned is T, if SEQ is not a vector. If SEQ is a vector, then the element type of the vector returned is the same as the as the element type of SEQ. -
Function
SORT-NEW
(seq pred &key (key #'identity) (element-type '*))Return a sorted vector of the elements of SEQ. You can think of this as a non-destructive version of `sort', except that it always returns a vector. (If you're going to copy a sequence for the express purpose of sorting it, you might as well copy it into a form that can be sorted efficiently.) ELEMENT-TYPE is interpreted as for `reshuffle'. -
Function
STABLE-SORT-NEW
(seq pred &key (key #'identity) (element-type '*))Like `sort-new', but sort as if by `stable-sort' instead of `sort'. -
Function
EXTREMA
(seq pred &key (key #'identity) (start 0) end)Like EXTREMUM, but returns both the minimum and the maximum (as two values). (extremum (iota 10) #'>) => 9 (extrema (iota 10) #'>) => 9, 0 -
Function
HALVES
(seq &optional split)Return, as two values, the first and second halves of SEQ. SPLIT designates where to split SEQ; it defaults to half the length, but can be specified. If SPLIT is not provided, the length is halved using `ceiling' rather than `truncate'. This is on the theory that, if SEQ is a single-element list, it should be returned unchanged. If SPLIT is negative, then the split is determined by counting |split| elements from the right (or, equivalently, length+split elements from the left. -
Function
DSU-SORT
(seq fn &key (key #'identity) stable)Decorate-sort-undecorate using KEY. Useful when KEY is an expensive function (e.g. database access). -
Function
DELTAS
(seq &optional (fn #'-))Return the successive differences in SEQ. (deltas '(4 9 -5 1 2)) => '(4 5 -14 6 1) Note that the first element of SEQ is also the first element of the return value. By default, the delta is the difference, but you can specify another function as a second argument: (deltas '(2 4 2 6) #'/) => '(2 2 1/2 3) From Q. -
Condition
INCONSISTENT-GRAPH
(ERROR
)A graph that cannot be consistently sorted. -
Function
TOPOSORT
(constraints &key (test #'eql) (tie-breaker #'default-tie-breaker) from-end unordered-to-end)Turn CONSTRAINTS into a predicate for use with SORT. Each constraint should be two-element list, where the first element of the list should come before the second element of the list. (def dem-bones '((toe foot) (foot heel) (heel ankle) (ankle shin) (shin knee) (knee back) (back shoulder) (shoulder neck) (neck head))) (sort (reshuffle (mapcar #'car dem-bones)) (toposort dem-bones)) => (TOE FOOT HEEL ANKLE SHIN KNEE BACK SHOULDER NECK) If the graph is inconsistent, signals an error of type `inconsistent-graph`: (toposort '((chicken egg) (egg chicken))) => Inconsistent graph: ((CHICKEN EGG) (EGG CHICKEN)) TEST, FROM-END, and UNORDERED-TO-END are passed through to `ordering'. -
Function
INTERSPERSE
(new-elt seq)Return a sequence like SEQ, but with NEW-ELT inserted between each element. -
Function
MVFOLD
(fn seq &rest seeds)Like `reduce' extended to multiple values. Calling `mvfold' with one seed is equivalent to `reduce': (mvfold fn xs seed) ? (reduce fn xs :initial-value seed) However, you can also call `mvfold' with multiple seeds: (mvfold fn xs seed1 seed2 seed3 ...) How is this useful? Consider extracting the minimum of a sequence: (reduce #'min xs) Or the maximum: (reduce #'max xs) But both? (reduce (lambda (cons item) (cons (min (car cons) item) (max (cdr cons) item))) xs :initial-value (cons (elt xs 0) (elt xs 0))) You can do this naturally with `mvfold'. (mvfold (lambda (min max item) (values (min item min) (max item max))) xs (elt xs 0) (elt xs 0)) In general `mvfold' provides a functional idiom for ?loops with book-keeping? where we might otherwise have to use recursion or explicit iteration. Has a compiler macro that generates efficient code when the number of SEEDS is fixed at compile time (as it usually is). -
Function
MVFOLDR
(fn seq &rest seeds)Like `(reduce FN SEQ :from-end t)' extended to multiple values. Cf. `mvfold'. -
Function
REPEAT-SEQUENCE
(seq n)Return a sequence like SEQ, with the same content, but repeated N times. (repeat-sequence "13" 3) => "131313" The length of the sequence returned will always be the length of SEQ times N. This means that 0 repetitions results in an empty sequence: (repeat-sequence "13" 0) => "" Conversely, N may be greater than the possible length of a sequence, as long as SEQ is empty. (repeat-sequence "" (1+ array-dimension-limit)) => "" -
Function
SEQ=
(&rest xs)Like `equal', but recursively compare sequences element-by-element. Two elements X and Y are `seq=' if they are `equal', or if they are both sequences of the same length and their elements are all `seq='. -
Function
VECT
(&rest initial-contents)Succinct constructor for adjustable vectors with fill pointers. (vect 1 2 3) ? (make-array 3 :adjustable t :fill-pointer 3 :initial-contents (list 1 2 3)) The fill pointer is placed after the last element in INITIAL-CONTENTS. -
Function
VECTOR=
(vec1 vec2 &key (test #'eql) (start1 0) (start2 0) end1 end2)Like `string=' for any vector. If no TEST is supplied, elements are tested with `eql'. -
Class
TOPMOST-OBJECT-CLASS
(STANDARD-CLASS
)-
TOPMOST-CLASS
Reader:TOPMOST-CLASS
-
-
Macro
LOCAL*
(&body body)Like `local', but leave the last form in BODY intact. (local* (defun aux-fn ...) (defun entry-point ...)) => (labels ((aux-fn ...)) (defun entry-point ...)) -
Macro
LOCAL
(&body orig-body &environment env)Make internal definitions using top-level definition forms. Within `local' you can use top-level definition forms and have them create purely local definitions, like `let', `labels', and `macrolet': (fboundp 'plus) ; => nil (local (defun plus (x y) (+ x y)) (plus 2 2)) ;; => 4 (fboundp 'plus) ; => nil Each form in BODY is subjected to partial expansion (with `macroexpand-1') until either it expands into a recognized definition form (like `defun') or it can be expanded no further. (This means that you can use macros that expand into top-level definition forms to create local definitions.) Just as at the real top level, a form that expands into `progn' (or an equivalent `eval-when') is descended into, and definitions that occur within it are treated as top-level definitions. (Support for `eval-when' is incomplete: `eval-when' is supported only when it is equivalent to `progn'). The recognized definition forms are: - `def', for lexical variables (as with `letrec') - `define-values', for multiple lexical variables at once - `defun', for local functions (as with `labels') - `defalias', to bind values in the function namespace (like `fbindrec*') - `declaim', to make declarations (as with `declare') - `defconstant' and `defconst', which behave exactly like symbol macros - `define-symbol-macro', to bind symbol macros (as with `symbol-macrolet') Also, with serious restrictions, you can use: - `defmacro', for local macros (as with `macrolet') (Note that the top-level definition forms defined by Common Lisp are (necessarily) supplemented by three from Serapeum: `def', `define-values', and `defalias'.) The exact order in which the bindings are made depends on how `local' is implemented at the time you read this. The only guarantees are that variables are bound sequentially; functions can always close over the bindings of variables, and over other functions; and macros can be used once they are defined. (local (def x 1) (def y (1+ x)) y) => 2 (local (defun adder (y) (+ x y)) (def x 2) (adder 1)) => 3 Perhaps surprisingly, `let' forms (as well as `let*' and `multiple-value-bind') *are* descended into; the only difference is that `defun' is implicitly translated into `defalias'. This means you can use the top-level idiom of wrapping `let' around `defun'. (local (let ((x 2)) (defun adder (y) (+ x y))) (adder 2)) => 4 Support for macros is sharply limited. (Symbol macros, on the other hand, are completely supported.) 1. Macros defined with `defmacro' must precede all other expressions. 2. Macros cannot be defined inside of binding forms like `let'. 3. `macrolet' is not allowed at the top level of a `local' form. These restrictions are undesirable, but well justified: it is impossible to handle the general case both correctly and portably, and while some special cases could be provided for, the cost in complexity of implementation and maintenance would be prohibitive. The value returned by the `local' form is that of the last form in BODY. Note that definitions have return values in `local' just like they do at the top level. For example: (local (plus 2 2) (defun plus (x y) (+ x y))) Returns `plus', not 4. The `local' macro is loosely based on Racket's support for internal definitions. -
Macro
BLOCK-COMPILE
((&key entry-points (block-compile t)) &body body)Shorthand for block compilation with `local*'. Only the functions in ENTRY-POINTS will have global definitions. All other functions in BODY will be compiled as purely local functions, and all of their calls to one another will be compiled as local calls. This includes calls to the entry points, and even self-calls from within the entry points. Note that `declaim' forms occuring inside of BODY will be translated into local `declare' forms. If you pass `:block-compile nil', this macro is equivalent to progn. This may be useful during development. -
Macro
TREE-CASE
(keyform &body cases)A variant of `case' optimized for when every key is an integer. Comparison is done using `eql'. -
Macro
TREE-ECASE
(keyform &body clauses)Like `tree-case', but signals an error if KEYFORM does not match any of the provided cases. -
Macro
CHAR-CASE
(keyform &body clauses)Like `case', but specifically for characters. Expands into `tree-case'. As an extension to the generalized `case' syntax, the keys of a clause can be specified as a literal string. (defun vowel? (c) (char-case c ("aeiouy" t))) Signals an error if KEYFORM does not evaluate to a character. -
Macro
CHAR-ECASE
(keyform &body clauses)Like `ecase', but specifically for characters. Expands into `tree-case'. -
Macro
DISPATCH-CASE
((&rest exprs-and-types) &body clauses)Dispatch on the types of multiple expressions, exhaustively. Say you are working on a project where you need to handle timestamps represented both as universal times, and as instances of `local-time:timestamp'. You start by defining the appropriate types: (defpackage :dispatch-case-example (:use :cl :alexandria :serapeum :local-time) (:shadow :time)) (in-package :dispatch-case-example) (deftype universal-time () '(integer 0 *)) (deftype time () '(or universal-time timestamp)) Now you want to write a `time=' function that works on universal times, timestamps, and any combination thereof. You can do this using `etypecase-of': (defun time= (t1 t2) (etypecase-of time t1 (universal-time (etypecase-of time t2 (universal-time (= t1 t2)) (timestamp (= t1 (timestamp-to-universal t2))))) (timestamp (etypecase-of time t2 (universal-time (time= t2 t1)) (timestamp (timestamp= t1 t2)))))) This has the advantage of efficiency and exhaustiveness checking, but the serious disadvantage of being hard to read: to understand what each branch matches, you have to backtrack to the enclosing branch. This is bad enough when the nesting is only two layers deep. Alternately, you could do it with `defgeneric': (defgeneric time= (t1 t2) (:method ((t1 integer) (t2 integer)) (= t1 t2)) (:method ((t1 timestamp) (t2 timestamp)) (timestamp= t1 t2)) (:method ((t1 integer) (t2 timestamp)) (= t1 (timestamp-to-universal t2))) (:method ((t1 timestamp) (t2 integer)) (time= t2 t1))) This is easy to read, but it has three potential disadvantages. (1) There is no exhaustiveness checking. If, at some point in the future, you want to add another representation of time to your project, the compiler will not warn you if you forget to update `time='. (This is bad enough with only two objects to dispatch on, but with three or more it gets rapidly easier to miss a case.) (2) You cannot use the `universal-time' type you just defined; it is a type, not a class, so you cannot specialize methods on it. (3) You are paying a run-time price for extensibility -- the inherent overhead of a generic function -- when extensibility is not what you want. Using `dispatch-case' instead gives you the readability of `defgeneric' with the efficiency and safety of `etypecase-of'. (defun time= (t1 t2) (dispatch-case ((time t1) (time t2)) ((universal-time universal-time) (= t1 t2)) ((timestamp timestamp) (timestamp= t1 t2)) ((universal-time timestamp) (= t1 (timestamp-to-universal t2))) ((timestamp universal-time) (time= t2 t1)))) The syntax of `dispatch-case' is much closer to `defgeneric' than it is to `etypecase'. The order in which clauses are defined does not matter, and you can define fallthrough clauses in the same way you would define fallthrough methods in `defgeneric'. Suppose you wanted to write a `time=' function like the one above, but always convert times to timestamps before comparing them. You could write that using `dispatch-case' like so: (defun time= (x y) (dispatch-case ((x time) (y time)) ((time universal-time) (time= x (universal-to-timestamp y))) ((universal-time time) (time= (universal-to-timestamp x) y)) ((timestamp timestamp) (timestamp= x y)))) Note that this requires only three clauses, where writing it out using nested `etypecase-of' forms would require four clauses. This is a small gain; but with more subtypes to dispatch on, or more objects, such fallthrough clauses become more useful. -
Macro
DISPATCH-CASE-LET
((&rest bindings) &body clauses &environment env)Like `dispatch-case', but establish new bindings for each expression. For example, (dispatch-case-let (((x string) (expr1)) ((y string) (expr2))) ...) is equivalent to (let ((x (expr1)) (y (expr2))) (dispatch-case ((x string) (y string)) ...)) It may be helpful to think of this as a cross between `defmethod' (where the (variable type) notation is used in the lambda list) and `let' (which has an obvious macro-expansion in terms of `lambda'). -
Function
RANGE
(start &optional (stop 0 stop?) (step 1))Return a (possibly specialized) vector of real numbers, starting from START. With three arguments, return the integers in the interval [start,end) whose difference from START is divisible by STEP. START, STOP, and STEP can be any real number, except that if STOP is greater than START, STEP must be positive, and if START is greater than STOP, STEP must be negative. The vector returned has the smallest element type that can represent numbers in the given range. E.g. the range [0,256) will usually be represented by a vector of octets, while the range [-10.0,10.0) will be represented by a vector of single floats. The exact representation, however, depends on your Lisp implementation. STEP defaults to 1. With two arguments, return all the steps in the interval [start,end). With one argument, return all the steps in the interval [0,end).
Also exports
ORG.MAPCAR.PARSE-NUMBER:PARSE-POSITIVE-REAL-NUMBER
ORG.MAPCAR.PARSE-NUMBER:INVALID-NUMBER-VALUE
ORG.MAPCAR.PARSE-NUMBER:INVALID-NUMBER
ORG.MAPCAR.PARSE-NUMBER:PARSE-NUMBER
SPLIT-SEQUENCE:SPLIT-SEQUENCE
ORG.MAPCAR.PARSE-NUMBER:PARSE-REAL-NUMBER
SPLIT-SEQUENCE:SPLIT-SEQUENCE-IF-NOT
SPLIT-SEQUENCE:SPLIT-SEQUENCE-IF
ORG.MAPCAR.PARSE-NUMBER:INVALID-NUMBER-REASON
SERAPEUM-USER
No exported symbols.
SERAPEUM/OP
No exported symbols.
SERAPEUM/VECTOR=
No exported symbols.
SERAPEUM/MOP
No exported symbols.
SERAPEUM/INTERNAL-DEFINITIONS
No exported symbols.
SERAPEUM/DISPATCH-CASE
No exported symbols.