The Revised Maclisp ManualThe PitmanualPage A-7
Published by HyperMeta Inc.
 
Prev | Index | Next
[Blue Marble]
Climate Change
Are we doing enough?


Definitional Forms

Anonymous Functions


LAMBDAConceptFunctional Description

A lambda expression is a piece of Lisp data (as it happens, a list) which is recognized as a description of an anonymous function. Lambda expressions can be used in all places in Lisp where the name of a function might be expected. In fact, a named function in Maclisp (until compiled) is nothing more than an association between a name (a symbol) and an anonymous function (lambda expression) which the evaluator knows how to interpret. Hence, if we knew some function ADD2 to have a description given by

(LAMBDA (Y) (PLUS Y 2))

then anyplace we saw something like

(ADD2 X), 

we could instead write

((LAMBDA (Y) (PLUS Y 2)) X) 

without changing the meaning of the code.

The syntax for a lambda expression is

(LAMBDA bvl . body). 

If the bound variable list (bvl) is a list of symbols, then the lambda expression is called an expr lambda, and it expects a fixed number of actual arguments (one corresponding to each of the formal names given in the bvl).

((LAMBDA (X Y) (+ (* 5 X) (* 2 Y))) ; function computes 5X+2Y
 3 4)
=> 23.

If the bvl is a symbol, then the lambda expression is a lexpr lambda and can accept a variable number of arguments. The way in which the arguments to these functions may be referred to from within the body of the definition is somewhat inelegant but evolved primarily due to efficiency considerations. The number of actual arguments received by any given call to a lexpr lambda is bound to the symbol which is in the bvl position. Individual arguments (numbering beginning with 1) are extracted with the function ARG. For example,

(LAMBDA N (ARG 3)) 

would return its third argument if at least 3 arguments were supplied and err otherwise. The program is expected to test the number of arguments supplied before calling ARG.

Since it is frequent that a sequence of arguments is desirable, the function LISTIFY will return the first n arguments if given a positive n or the last -n arguments for a negative n. So

(LAMBDA N (LISTIFY N)) 

describes a function which returns a list of its arguments.

There is one ambiguous case, of course. NIL is both a symbol and a list in Maclisp. By convention, therefore, it is taken to denote the empty list in lambda expressions, so (LAMBDA NIL ...) denotes a function of exactly zero arguments, not a lexpr with an ignored number-of-args variable (see the discussion of ignored arguments farther down in this section if this is not a familiar concept).

It is an important point in Lisp terminology that LAMBDA expressions describe functions, but LAMBDA is not itself a function. It is merely a syntactic marker used in functional descriptions. Typing (LAMBDA (X) X) in to a read-eval-print loop of lisp will induce Lisp to complain (rightly) that LAMBDA is an undefined function. A lambda expression is a piece of Lisp data which is interpreted in many places to describe a functional definition. There is nothing magic about this, though. It is simply a list whose car is the symbol LAMBDA, whose cadr is a symbol or list naming the formal parameters, and whose cddr is a list of forms to be executed when the definition is invoked.

Note also that whenever referring to Maclisp functions either by name or by lambda expression description, the quoting operator to use is FUNCTION, not QUOTE. In the interpreter, QUOTE and FUNCTION behave identically, but when compiled, any expression quoted by FUNCTION is assumed to be intended as code, not as list structure, and is fair game for the compiler to compile. In the case of symbols in Maclisp, (QUOTE sym) is nearly always the same as (FUNCTION sym), but for consistency, readability, and compatibility with other dialects (e.g., Lisp Machine Lisp) where this is not the case, using FUNCTION is recommended in all cases where a quoted symbol is referring to the definition of that symbol. For convenience, the readmacro character sequence sharpsign quote (#') is an abbreviation for FUNCTION just as quote (') is an abbreviation for QUOTE.

(MAPCAR 'ADD2 '(3 4 5)) ;valid, but discouraged 
(MAPCAR (FUNCTION ADD2) '(3 4 5)) ;valid, and preferred 
(MAPCAR #'ADD2 '(3 4 5)) ;shorthand for (FUNCTION ADD2) 
(MAPCAR '(LAMBDA (Y) (PLUS Y 2)) '(3 4 5)) ;substandard 
(MAPCAR (FUNCTION (LAMBDA (Y) (PLUS Y 2))) '(3 4 5)) ;correct 
(MAPCAR #'(LAMBDA (Y) (PLUS Y 2)) '(3 4 5)) ;shorthand 

In fact, the compiler will recognize the case of

(MAPCAR '(LAMBDA ...) ...) 

and correctly recognize that (FUNCTION ...) was intended. This is because the compiler knows a lot about the function MAPCAR. It does not know the same amount about arbitrary user functions. If it sees

(F '(LAMBDA (X) (+ X 3))), 

it cannot know whether the function F intends to treat the expression (LAMBDA (X) (+ X 3)) functionally (in which case FUNCTION should be used, not QUOTE) or as list structure. If the function F was a function which expected list structure as an argument (e.g., it planned to CAR and CDR the argument), then QUOTE is the right thing, not FUNCTION. So it is up to the user to use the correct quoting operator.

It is occasionally of interest to write functions which do not use all of their arguments. The compiler tries to warn the user when this occurs (saying that a variable was “bound but not used”) in case it is the result of a coding error. To avoid getting this diagnostic, several independent and ad hoc mechanisms have been adopted. Choice of a particular mechanism is primarily a matter of style, though the target dialects of the code may influence the choice somewhat. Maclisp allows the user to specify ignored variables by supplying NIL in place of a bound variable name. The lambda expression

(LAMBDA (NIL X) (+ X 5)) 

describes a function of 2 arguments, the first of which is ignored and the second of which is used to help compute the function's return value. Normally, if a bound variable is unused, the compiler will warn about it in case it is an oversight that the variable was ignored. Using NIL in the bound variable list as a place holder for a variable which is intentionally ignored will suppress this warning. Actually, any symbol whose printname begins with the string "IGNORE" will also suppress this warning message; this is to help provide some measure of compatibility with the Lisp Machine where the names IGNORE and IGNORED are the only choices of variable name which can be ignored without a compiler warning. The following trick will work (and compile optimally) in most major dialects:

(DEFUN FOO (X Y) 
X ;ignored 
(+ Y 3)) 

In this case, X is used but in a trivial way that the compiler will optimize out.

;; A simple LAMBDA application would look like this.
((lambda (x) (^ x (* x 3))) 3)
=> 19683.

;; In place of a bare lambda, we usually write LET instead, however.
(let ((x 3))
  (^ x (* x 3)))
=> 19683.

;; Some functions, like MAPCAR, take functions as arguments.
(mapcar #'add1 '(1 2 3 4 5))
=> (2. 3. 4. 5. 6.)

;; If there is no pre-defined function handy, LAMBDA lets a programmer
;; build an anonymous function.
(mapcar #'(lambda (x y) (+ (^ x (* x 2)) y)) '(1 2 3) '(3 2 1))
=> (4. 18. 730.)

Named Functions


DEFUNSpecial Form(DEFUN namespec . definitionspec)

DEFUN offers a way of associating a functional definition with a symbol. It has the advantage of shielding the user, to an extent, from the implementational details of where the definition will be stored, which is of course of immense value as a tool for abstraction -- especially when considering programs which may want to be transported between various dialects. DEFUN can be used to define both normal functions and special forms (fexprs and macros).

There are several valid syntaxes for specifying a definition, many of which may seem incompatible in philosophy with others. DEFUN is certainly one of Maclisp's more cluttered primitives. Each of the syntaxes will be discussed here independently without regard to how one syntax is told from another.

;; Normal expr or lexpr function definitions 
(DEFUN name bvl . body) 
(DEFUN name EXPR bvl . body) ;valid, but archaic 
(DEFUN EXPR name bvl . body) ;obsolete (invalid) 

If name is a symbol and bvl is a list of symbols which is free of &keywords (to be described below), the definition is an expr or lexpr definition. In Maclisp, this would be essentially equivalent to writing

(DEFPROP name (LAMBDA bvl . body) EXPR)

In other dialects (e.g., NIL and Lisp Machine Lisp), definitions are not stored on the plist at all, but in “function cells,” so one should never write the DEFPROP form, since DEFUN will take care of putting the definition in the place where the interpreter expects to find it for the particular dialect in use.

Note also that the keyword EXPR is used for both expr and lexpr definitions. The only distinction between expr and lexpr definitions is whether the bvl is a symbol or a list, but they are specified in the same way and looked up from the same property. In fact, lexpr definitions are a Maclisp-only artifact and are not formally supported in Lisp Machine Lisp or NIL. For compatibility with those dialects, use a defun with &keywords (see below).

(DEFUN ADD2 (X) (+ X 2)) ;EXPR definition
=> ADD2
(ADD2 3)
=> 5

(DEFUN XLIST N-ARGS (NREVERSE (LISTIFY N-ARGS))) ;LEXPR definition
=> XLIST 
(XLIST 'A 'B 'C)
=> (C B A)

A fexpr is a function for which the formal parameters are not evaluated. The form of a fexpr definition is:

(DEFUN name FEXPR (sym) . body). 

The lambda expression which describes a fexpr should expect to receive exactly one argument which will be the list of (unevaluated) arguments given in the call to the fexpr, so usually there is only one bound variable (sym) in the bound variable list.

(DEFUN CONS-LITERALS FEXPR (ARG-LIST)
  (CONS (CAR ARG-LIST) (CADR ARG-LIST)))
=> CONS-LITERALS
(CONS-LITERALS A B)
=> (A . B)

In general, it is strongly recommended by the author that fexpr definitions be avoided in favor of definitions of functions which require the user to explicitly quote the actual arguments or that macros be used to achieve the same effect. (For more information on the motivation for this advice, see Kent Pitman's “Special Forms in Lisp” in the Proceedings of the 1980 Lisp Conference).

There is another kind of fexpr definition (the so-called “two argument fexpr”) which is used extremely rarely if at all. The intent was to get around certain bad interactions with dynamic variable binding and the context in which an EVAL might be done in a fexpr definition. An example of the bad interaction is:

(DEFUN SET-TO-3 FEXPR (X) (EVAL (LIST 'SETQ (CAR X) 3)))
=> SET-TO-3
(SET-TO-3 Y) ;Set Y to 3
=> 3
Y ;Test Y's value
=> 3 ;Good, it was set. This was the `expected' behavior
(SET-TO-3 X) ;Set X to 3
=> 3
X ;Test X's value
;X UNBOUND VARIABLE

The reason that this is true is that at the time of the EVAL, the X being SETQ'd is not the global X but a local one involved in the definition. To attempt to get around this problem, the implementors provided a kind of fexpr definition which can receive a pointer to the stack at the time of entry to the fexpr. EVAL can be called with a second arg of this stack pointer and Lisp will try to recreate the binding environment at the time of the fexpr invocation so that the binding problems interference will not occur. This will only work when all variables involved are special (i.e., in the interpreter or in the compiler when certain careful declarations have been made) and is not generally recommended as the right answer. The main reason for documenting it here is in case it occurs in code so that it will be somewhat understandable.

;; Hopefully, you'll never see code that does this, but...
(DEFUN SET-TO-3 FEXPR (ARG-LIST STACK-POINTER)
  (EVAL (LIST 'SETQ (CAR ARG-LIST) 3) STACK-POINTER))
=> SET-TO-3
(SET-TO-3 X)
=> 3
X ;Test it's value
=> 3 ;won!

DEFUN can also be used to instantiate a MACRO definition. Macros offer a means of writing source to source transformations on Lisp code which are used by the evaluator and compiler for interpreting code. A macro definition is a function of one argument (an evaluable list whose car is a symbol which is the name of the macro) which should return as its value an expansion of the macro form -- an expression to be evaluated in place of the macro form. The syntax for a macro definition is

(DEFUN name MACRO (sym) . body)

where sym will become bound to the whole macro form to be expanded (including the name). Note that this argument convention is different than fexprs, which only receive the cdr of the call form.

Note: The compiler will take note of this kind of macro definition, using the definition for expanding any subsequent references to the macro in the file in which it is defined, but it will produce no code for the macro. As a result, macros defined in this way and then compiled are not available at runtime.

(defun first macro (x) (list 'car (cadr x)))
=> FIRST

;; MACROEXPAND calls the expander function, but doesn't EVAL the result.
(macroexpand '(first '(a b c)))
=> (CAR '(A B C))	

;; The evaluator, when it encounters a macro form, expands and EVALs it.
(first '(a b c))
=> A

;; Another example...
(defun bitwise-and macro (x) `(boole 1. ,@(cdr x)))
=> BITWISE-AND

(macroexpand '(bitwise-and 3 4))
=> (BOOLE 1 3 4)

(bitwise-and 3 4)
=> 0

Because associating lambda expressions with arbitrary properties of a symbol (not just EXPR, FEXPR, and MACRO) has been seen to be useful, a more general facility has been provided to allow such definitions to be provided easily. The syntax

(DEFUN (name prop) bvl . body) 

means to associate an anonymous function described by (LAMBDA bvl . body) with the prop property of name. Having done this, one could retrieve the definition using (GET 'name 'prop), or the equivalent.

;;; Fragments of code from what might be some sort of 
;;; an editor system.

 ;; Driver loop
(DEFUN EDITOR NIL
  (*CATCH 'EDITOR-EXIT
    (DO NIL (NIL) (READ-AND-DO-EDITOR-COMMAND))))

 ;; The guts of our editor 
(DEFUN READ-AND-DO-EDITOR-COMMAND NIL
  (FUNCALL (GET (READ-EDITOR-COMMAND) 'EDITOR-ROUTINE)))

 ;; Global variable to our editor
(DEFVAR EDITOR-CURSOR 0)

 ;; Editing Routines
 ;; These are data-driven because they are found
 ;; by inspecting the EDITOR-ROUTINE property of each
 ;; command.
(DEFUN (EXIT EDITOR-ROUTINE) NIL
  (*THROW 'EDITOR-EXIT T))
(DEFUN (FORWARD EDITOR-ROUTINE) NIL
  (SETQ EDITOR-CURSOR (1+ EDITOR-CURSOR)))
...

There is a subtle difference between the treatment of (DEFUN name MACRO ...) and (DEFUN (name MACRO) ...). The former is seen only by the compiler and is not output for use in the runtime environment. The latter is available both at compile time and at runtime for debugging. The latter form is preferred in all cases except for very large systems which cannot afford the address space at runtime.

;; Some macro definitions using the (name prop) syntax.
(defun (node macro) (form)
  `(cons ,(cadr form) (cons ,@(cddr form))))
=> NODE

(defun (node-data  macro) (form)
  `(car  ,(cadr form)))
=> NODE-DATA

(defun (node-left  macro) (form)
  `(cadr ,(cadr form)))
=> NODE-LEFT

(defun (node-right macro) (form)
  `(cddr ,(cadr form)))
=> NODE-RIGHT

There is also a special notation which can be used in the bound variable list of a DEFUN which involves the use of keywords beginning with the symbol "&". Useful keywords are &OPTIONAL, &REST and &AUX.

Multics users must (%include defun) to get support for these special keywords in a DEFUN.

The keyword &OPTIONAL means that subsequent elements of the bound variable list (until an &REST, &AUX or the end of the list) are descriptions of optional variables. An optional variable spec may be a symbol (meaning take the supplied value if possible or NIL otherwise); a two-list of the variable name and a default to initialize the variable to; or a three-list of a symbol, a value to initialize the variable to and a symbol to be bound to T if the argument was received and NIL otherwise.

(defun f (x &optional (y 6.)) (list x y))
=> F

(f 14)
=> (14 6)

(f 1 'foo)
=> (1 FOO)

(defun f1 (x &optional (y 6 y?)) (list x y y?))
=> F

(f 14)
=> (14 6 NIL)

(f 1 'foo)
=> (1 FOO T)

The keyword &REST means that the next element of the bound variable list is a symbol to be bound to a list of the remaining arguments, or NIL if no more arguments were supplied.

(defun g (x &optional (y 3) (z 4 z?) &rest w) (list x y z z? w))
=> G

(g 1)
=> (1 3 4 NIL NIL)

(g 1 2)
=> (1 2 4 NIL NIL)

(g 1 2 3)
=> (1 2 3 T NIL)

(g 1 nil nil 4)
=> (1 NIL NIL T (4))

(g 'a 'b 'c 'd 'e)
=> (A B C T (D E))

The keyword &AUX denotes variables which are not expected as arguments but rather are just local to the computation in the body.

(DEFUN F (X &AUX Y (Z 4)) ...)

is the same as

(DEFUN F (X) (LET* (Y (Z 4)) ...))

It is also possible to write a defun which does argument destructuring. e.g.,

(defun f ((a . b)) (list a b))
=> F

(f '(c d e))
=> (C (D E))

(f)
;... TOO FEW ARGUMENTS - APPLY

And it's even possible (though stylistically not recommended) to mix syntaxes, as in:

(defun f ((w x) &optional ((y . z)))
  (list w x y z))
=> F

(f '(3))
=> (3 NIL NIL NIL)

(f '(3 4) (abc 5))
=> (3 4 ABC (5))

An advanced feature of DEFUN is available which uses the format

(DEFUN (name prop1 prop2) bvl . body)

It is like the (name prop) syntax, but interpreted definitions of name are placed on the prop1 property and compiled definitions (subr pointers) are placed on the prop2 property. This feature is not necessary for most applications, but some system programming applications may need to use it to achieve fine-tuned space or time efficiency. A normal expr definition could, for example, be written as

(DEFUN (name EXPR SUBR) (var1 ...) ... body).

DEFUNConceptHistorical Footnote

DEFUN was introduced into Maclisp in March, 1969. Although now it is recognized as the standard function defining form because it shields the user from the implementational details of how the function is defined, it is interesting to note that this was not why it was originally introduced. The following text is quoted from the documentation released at the time DEFUN became part of Maclisp:

DEFUN is an fsubr used to define functions. Examples are

(DEFUN ONECONS (X) (CONS 1 X)) 

which is equivalent to

(DEFPROP ONECONS (LAMBDA (X) (CONS 1 X)) EXPR) 

and

(DEFUN SMASH FEXPR (L) (RPLACD L NIL))

which is equivalent to

(DEFPROP SMASH (LAMBDA (L) (RPLACD L NIL)) FEXPR)

“The novel feature of DEFUN is that one need not be so concerned with balancing parentheses at the very end of the function definition, since the type flag may be omitted if it is EXPR, and appears near the front of the DEFUN list if it is some other. Also, the LAMBDA need not be directly inserted.”


DEFPROPFunction(DEFPROP sym val indicator)

Gives sym a property called indicator with value val. The arguments are not evaluated.

DEFPROP should not be used imbedded in other expressions. It is intended to occur at toplevel to assign properties that are set up once and never changed. In other places, use PUTPROP with three quoted arguments.

LEXPR Helpers


ARGFunction(ARG q)

The ARG subr must be called from within the [dynamic] scope of a lexpr. If q is NIL, ARG returns the number of arguments supplied to the most recent lexpr on the dynamic stack. If q is a fixnum, i, gives the value of the ith argument to the most recent lexpr on the dynamic stack. It is an error if i is less than 1 or greater than the number of arguments supplied to the lexpr.

Examples:

(defun foo nargs (list nargs (arg nil) (arg 1) (arg 2)))
=> foo
(foo 'a 'b 'c) 
=> (3 3 A B)

LISTIFYFunction(LISTIFY i)

Efficiently manufactures a list of i of the arguments of a lexpr. With a positive argument i, it returns a list of the first n arguments of the lexpr. With a negative argment i, it returns a list of the last (ABS i) arguments of the lexpr.

Definition:

;;; Main definition
(defun listify (n)
       (cond ((minusp n)
              (*listify (arg nil) (+ (arg nil) n 1)))
             (t
              (*listify n 1)) ))
;;; auxiliary function - not user accessible
(defun *listify (n m)      
       (do ((i n (1- i))
            (l nil (cons (arg i) l)))
           ((< i m) l) ))

SETARGFunction(SETARG i q)

Setarg is used only inside the dynamic scope of a lexpr. Sets the lexpr's ith argument to q. i must be greater than zero and not greater than the number of arguments passed to the lexpr. After (setarg i q) has been done, (ARG i) will return q.

Variables


DEFVARSpecial Form(DEFVAR var [val [documentation]])

The DEFVAR special form is the recommended way to declare the use of a global variable in a program. If just a variable is supplied, as in

(DEFVAR var),

then var is declared SPECIAL for the sake of the compilation. If a value is given, as in

(DEFVAR var val)

then var will be initialized to the result of evaluating val unless var already has a value, in which case it keeps that value. If documentation is supplied, it should be a string which contains a comment about the variable and its intended use.

Here are the first few lines from a file that uses DEFVAR ...

;;; -*- Mode:LISP; -*-

;;; COMP: A sample lispy compiler

;;;; Declarations, etc.

(HERALD COMP)

(DEFVAR OUTSTREAM TYO "Where to send our output")
(DEFVAR SPECIAL-CELLS '() "List of assigned special cells")
(DEFVAR SUBS '() "Constants in use by GENSUB")
(DEFVAR BOUND-SYMBOLS '() "Database of bound symbols")
(DEFVAR STACK-DEPTH 0. "Count of random pushed stack frames")
...

DEFCONSTSpecial Form(DEFCONST var [val [documentation]])

The DEFCONST special form is the same as DEFVAR except that the variable, var, will acquire the given value, val, regardless of whether it is already bound.

The rationale for Lisp's offering both DEFCONST and DEFVAR is that DEFVAR declares a global variable, whose value is initialized to something but will then be changed by the functions which use it to maintain some state. On the other hand, DEFCONST declares a constant, whose value will never be changed by the normal operation of the program, only by changes to the program. DEFCONST always sets the variable to the specified value so that if, while developing or debugging the program, you change your mind about what the constant value should be, and then you evaluate the DEFCONST form again, the variable will get the new value. It is not the intent of DEFCONST to declare that the value of variable will never change; for example, DEFCONST is not a license to the compiler to build assumptions about the value of variable into programs being compiled.

Macros


DEFMACROSpecial Form(DEFMACRO namespec pat . body)

DEFMACRO is a general purpose macro-defining macro. It defines a macro given by the namespec. The pat may be a pattern made up out of symbols and conses and the special keywords &OPTIONAL, &REST (or &BODY), &AUX and &WHOLE. In a call to the macro, the bound variable list is matched against the cdr of the macro call, binding the symbolic parts of pat to their corresponding parts of the macro call. All of the variables named in the pattern can be used in the body to construct the expansion.

The keywords &OPTIONAL, &REST, and &AUX work as with normal functions.

The keyword &WHOLE is like &REST, but gets the entire macro call instead of the rest of the body beginning with its position.

;; A simple example
(defmacro foo (x &rest y &whole z)
  (list 'bar (car z) y x))
=> FOO

(macroexpand '(foo 3 4))
=> (BAR FOO (4) 3)

;; A more practical example...
(defmacro nand (&rest forms) `(not (and ,@forms)))
=> NAND

(nand t t)
=> NIL

(nand nil t)
=> T

;; Just for fun. This is pretty random...
(defmacro sometimes (form)
  `(cond ((zerop (random 2)) ,form)))
=> SOMETIMES

(sometimes (+ 1 3))
=> 4

(sometimes (+ 1 3))
=> NIL

(sometimes (+ 1 3))
=> NIL

Multics users must (%include defmacro) to get DEFMACRO.

The keyword &BODY should be used in place of &REST whenever the forms that follow it constitute an implicit-PROGN. This provides only stylistic information to the reader and is identical to &REST as far as Maclisp is concerned, but if the code is ever ported to the Lisp Machine, the &BODY will be interpreted in a useful way by ZWEI, the Lisp Machine editor to indent calls to the macro in a nice way.

;;; A trivial definition of a FIRST macro
(defmacro first (x) `(car ,x))
=> FIRST

(first '((a b) c d))
=> (A B)

;;; Define a special form for iterating over plists
(defmacro do-over-plist (sym (var1 var2) &body body)
  (let ((var (gensym)))
    `(do ((,var (plist ,sym) (cddr ,var)))
         ((null ,var))
       (let ((,var1 (car ,var))
             (,var2 (cadr ,var)))
         ,@body))))
=> DO-OVER-PLIST

(putprop 'abc 'fooval 'fooprop)
=> FOOVAL

(putprop 'abc 'barval 'barprop)
=> BARVAL

(do-over-plist 'abc (a b)
   (print (list a b)))
(FOOPROP FOOVAL)
(BARPROP BARVAL)
=> NIL

DEFMACRO is sensitive to a number of variables such as DEFMACRO-DISPLACE-CALL, DEFMACRO-FOR-COMPILING, and DEFMACRO-CHECK-ARGS. See documentation on those variables for how they can modify DEFMACRO's behavior.


MACROSpecial Form(MACRO name (var) . body)

This is the raw way to define a macro. It creates a macro definition for name which will bind var to the whole body of the call and then execute body to produce the expansion.

Using this special form is identical to using

(DEFUN name MACRO (var) . body)

except that this syntax (the MACRO special form) is preferred. It is more abstract; the equivalent DEFUN syntax is not supported on the Lisp Machine, for example.

Multics users must (%include defmacro) to get MACRO.


DEFMACRO-DISPLACESpecial Form(DEFMACRO-DISPLACE namespec bvl . body)

[PDP-10 Only] Like DEFMACRO, except that it ignores the global value of DEFMACRO-DISPLACE-CALL; it always uses T instead (i.e., always generates a displacing call).


DEFSIMPLEMACSpecial Form(DEFSIMPLEMAC name bvl . body)

[PDP-10 Only] Like DEFMACRO, but the bvl must be simple (exactly one variable) and it will automatically `wrap' a LAMBDA around things that seem to need it to assure that double evaluation of the argument does not occur when side-effects might be possible.

Note: This feature does not exist in Lisp Machine lisp, but can be easily simulated using their ONCE-ONLY primitive.

(defsimplemac foo (x) `(list ,x ,x))
=> FOO

(macroexpand '(foo 3))
=> (LIST 3 3)

(macroexpand '(foo a))
=> (LIST A A)

(macroexpand '(foo (f)))
=> ((LAMBDA (G0001) (F G0001)) (F))

Definition-Time Macro Control

The following switches apply only to macros created by DEFMACRO or something built upon it (e.g., DEFMACRO-DISPLACE and DEFSIMPLEMAC). They do not apply to macros produced by the MACRO special form or by DEFUN with a MACRO keyword.


DEFMACRO-CHECK-ARGSValueT

[PDP-10 Only] Determines whether there should be code to carry out number-of-args checking by DEFMACRO at runtime. On Multics, DEFMACRO always behaves as if this had been T.


DEFMACRO-DISPLACE-CALLValueT

[PDP-10 Only] If not NIL, the macros produced by DEFMACRO do a runtime test of MACRO-EXPANSION-USE for possible displacement and/or "memo-izing" in a hasharray. On Multics, DEFMACRO always behaves as if this had been T (i.e., always generates displacing calls).

See also: DISPLACE, MACRO-EXPANSION-USE


DEFMACRO-FOR-COMPILINGValueT

[PDP-10 Only] If T, the macros processed by DEFMACRO will get compiled by COMPLR for use in the runtime environment. If NIL, the COMPLR will not output compiled code for the macro in the FASL file for use in the runtime environment. In either case, COMPLR “remembers” them for the remainder of its invocation unless the user does something to flush their definitions. On Multics, DEFMACRO always behaves as if this had been T (i.e., obeys the MACROS flag in the compiler).

Runtime Macro Control


MACRO-EXPANSION-USEValueMACROEXPANDED

[PDP-10 Only] The value of this variable controls what macros produced by DEFMACRO (when DEFMACRO-DISPLACE-CALL was not NIL) put out. Possible values are:

MACROEXPANDED (or MACROEXPAND) -- Return a form which is a macro containing both the original form and macro expansion (and other info that will allow one to know when the definition of the macro that was expanded has been superseded. This is good for grinding, but makes normal lisp-printed code hard to read).

DISPLACE -- Displace the original cell with the expression of the macro-form (see DISPLACE). There is no general way to undo this sort of displacement.

MACROMEMO -- Remember the expansions in a hasharray, where the global variable MACROMEMO is a dotted pair of the number of buckets and the array pointer itself. All “memorized” expansions can be forgotten merely by doing (RPLACD MACROMEMO NIL).

NIL -- Just expand the macro -- no memorizing or displacing. Any other value must be the name of a function of two arguments (which will be the unexpanded form and expanded form, respectively) and can do whatever the user wants returning the form to be returned as the macroexpansion.

On Multics, it is as if this had been set to DISPLACE.

Macro Expansion Utilities


MACROEXPANDFunction(MACROEXPAND form)

[PDP-10 Only] Macroexpands toplevel of form until its CAR is not the name of a macro. Does not dive inward recursively performing macro expansion.


MACROEXPAND-1Function(MACROEXPAND-1 form)

[PDP-10 Only] Macroexpands toplevel of form exactly once; hence, the result may also be a macro form. It doesn't dive inward performing recursive macro expansions.


MACROEXPAND-1*Function(MACROEXPAND-1* form)

[PDP-10 Only] Like MACROEXPAND-1 except that arg must be guaranteed to be non-atomic. Result is NIL if no macro expansion happens or NCONS of the result if a macro expansion does occur.

The MACROEXPANDED memo-izer


MACROEXPANDEDSpecial Form(MACROEXPANDED f i source transform)

[PDP-10 Only] This function should never be called by the user. It is a Lisp internal mechanism. However, it may frequently show up in macro-expanded code, so its meaning is documented.

Roughly speaking, If (GET 'f MACROEXPANDED) = i, then evaluates to transform. Else it assumes that f has been redefined since the last call and does

(SETF (NTH 4 wholeform) (MACROEXPAND source))

and evals the new expansion.

This form interacts with MACRO-EXPANSION-USE. If MACRO-EXPANSION-USE is set to other than MACROEXPANDED, then MACROEXPANDED forms will vanish when executed, leaving only source in their place.

Note: Because it relates to internals, this description is should not be relied on. It is provided for purely descriptive value and is subject to change without warning.


MACROEXPANDEDValueunspecified

The value of the variable MACROEXPANDED is a copy of that symbol (see COPYSYMBOL), and is the name of the property on symbols that the MACROEXPANDED scheme for defmacros will use to store version information. For example, if F has been defined by DEFMACRO (with DEFMACRO-DISPLACE-CALL being T) and MACRO-EXPANSION-USE is set to MACROEXPANDED, then (GET F MACROEXPANDED) will return version information about F's definition (see the MACROEXPANDED special form).

The DEFUN& Family


DEFUN&Special Form(DEFUN& namespec bvl . body)

DEFUN& is an obsolete way to get &keyword functionality. DEFUN now expands into DEFUN& when appropriate. Calls to DEFUN& should just be changed directly to calls to DEFUN.

Multics users must (%include defun) to get DEFUN&.


DEFUN&-CHECK-ARGSValueT

[PDP-10 Only] Controls whether or not there is run-time checking to see if a DEFUN& with &OPTIONAL or &REST arguments has too many or too few arguments passed. On Multics, DEFUN& behaves as if this had been set to T.

Definitional Properties

The Lisp system internally uses the property list of a symbol to represent its functional information. Users should only very rarely have need of this information but it is documented anyway as a debugging aid.


EXPRPropertyInterpreted Definition

Used to hold interpreted expr and lexpr function definition. (see DEFUN)


FEXPRPropertyInterpreted Definition

Used to hold interpreted fexpr definition. (see DEFUN)


SUBRPropertyCompiled Definition

Used to hold compiled expr function definition. (see DEFUN)


LSUBRPropertyCompiled Definition

Used to hold compiled lexpr function definition. (see DEFUN)


FSUBRPropertyCompiled Definition

Used to hold compiled fexpr definition. (see DEFUN)


MACROPropertyMacro Definition

Used to hold interpreted macro definition or the name of a compiled expr definition which was created when a macro definition was compiled.


AUTOLOADPropertyLoading By Need

If a symbol is not functionally defined, the AUTOLOAD property can hold the name of a file which should be loaded to define it if it is ever called as a function. See information about the AUTOLOAD variable for more details.


ARRAYPropertyArray Definition

Used to store a symbol's array property (which can act as a kind of functional definition). See information about the Array concept for more details.

Structure Definition


StructuresConceptAbstract “Datatypes”

Frequently, one will want to create a type of object which has structured primitives for accessing it. Since Maclisp doesn't have an extensible datatype system, one might often end up writing things like:

(DEFMACRO MAKE-3D-COORDINATES (X Y Z) `(LIST '3D-COORDINATES ,X ,Y ,Z))
(DEFMACRO X-PART (COORDINATES) `(CADR   ,COORDINATES))
(DEFMACRO Y-PART (COORDINATES) `(CADDR  ,COORDINATES))
(DEFMACRO Z-PART (COORDINATES) `(CADDDR ,COORDINATES))

Such a cluster of macros would allow the user elsewhere in code to refer abstractly to functions like MAKE-3D-COORDINATES and Y-PART rather than using low-level primitives such as LIST and CADDR. However, writing these sorts of macro clusters gets to be tedious since it is very repetitive, easy to make a mistake, and much more verbose than what the programmer would like to say at the high level, which is something like: “I would like to have a way of creating and accessing a structure which represents abstract coordinate triples (x, y, z).” This is a common sort of thing to want and it's the thing DEFSTRUCT was designed to do.

Note! The DEFSTRUCT facility is not primitive to Maclisp. It is an extension written by users of Maclisp. A declaration such as the following should be placed at the top of any file which proposes to use DEFSTRUCT:

(EVAL-WHEN (EVAL COMPILE)
  (COND ((NOT (GET 'DEFSTRUCT 'VERSION))
         (LOAD '((LISP) STRUCT)))))

DEFSTRUCTSpecial Form(DEFSTRUCT namespec . slots)

DEFSTRUCT is a macro defining macro. It takes a specification of a data structure and writes macros which create and access structures that conform to the given description.

In the simplest case, namespec is just a symbol naming the structure and slots are just slot names. For example,

(DEFSTRUCT KONS KAR KDR)

defines a structure called a KONS with 2 parts, called KAR and KDR. This defines the following macros:

* A constructor macro, called MAKE-KONS
* Two accessor macros, called KAR and KDR
* An alterant macro, called ALTER-KONS

The constructor macro takes a SETQ style syntax. For example,

(MAKE-KONS KDR 3 KAR 4)

will create some object whose KAR slot has 4 in it and whose KDR slot has 3. If an initialization is omitted and no default is specified (see below), the filler of the slot is not defined.

Multics users must (%include defstruct) to get DEFSTRUCT.

For example,

(SETQ X (MAKE-KONS KDR 3))

will create an object whose KDR is 3, but whose KAR is initialized to whatever was most convenient for DEFSTRUCT to put there. If you intend to rely on defaulting, it should be specified explicitly. For example,

(DEFSTRUCT QONS (QAR NIL) (QDR NIL))

will create definitions for MAKE-QONS, QAR, QDR, and ALTER-QONS, but will advise MAKE-QONS that if either QAR or QDR is not supplied explicitly, it should default to NIL. Hence,

(SETQ Y (MAKE-QONS QAR 4))

makes a QONS whose QAR is 4 and whose QDR is NIL.

Note: In spite of the resemblance to SETQ's syntax, the order of evaluation in slot initialization by DEFSTRUCT-related forms is not defined. This means that doing side-effects in the slot defaults for DEFSTRUCT or in the constructor and alterant macros is not recommended.

Structures defined with DEFSTRUCT can be accessed via their accessors and set with SETF. After the above examples, (KDR X) would return 3. To change X's KDR to 5, one could write:

(SETF (KDR X) 5).

A more general way of changing one or more slots in a structure is also provided via the alterant macro, which works in a manner similar to the constructor. Instead of the SETF we just used, we could have written:

(ALTER-KONS X KDR 5)

or we could have changed both the KAR and the KDR in parallel by saying:

(ALTER-KONS X KAR 2 KDR 3).

It is possible to define more specific information about how a structure built by DEFSTRUCT is to be laid out, how the macros it defines should be named, etc. This can be done by replacing:

(DEFSTRUCT name slot1 slot2 ...)

with:

(DEFSTRUCT (name option1 option2 ...) slot1 slot2 ...)

For example, the defstructs we've just described are created as HUNK2's by default on the PDP-10; if we had wanted KONS's to be allocated in LIST space, we could have said:

(DEFSTRUCT (KONS (TYPE LIST)) KAR KDR)

Some options (such as NAMED) require no arguments so are just atomic symbols; others (such as CONC-NAME) take an optional argument so may be either the symbol which names the option or a list whose car is that symbol and whose cdr is a list of arguments; still others (such as TYPE) require arguments always.

For further information about these special options, see the entries for each option which follow.

Note: For compatibility with Lisp Machine syntax, the names of DEFSTRUCT options may optionally be preceded by colons. So (:TYPE :LIST) would also have been valid in this last example. Code that is not intended to be Lisp Machine compatibile need not worry about this issue.

To see a list of possible DEFSTRUCT options, see the Struct Option Index.


TYPEStruct Option(TYPE typespec)

The TYPE option specifies what kind of lisp object DEFSTRUCT is going to use to implement your structure, and how that implementation is going to be carried out. The TYPE option is illegal without an argument. If the TYPE option is not specified, then DEFSTRUCT will choose an appropriate default (hunks in PDP-10 MacLisp, arrays on Lisp Machines and lists on Multics). It is possible for the user to teach DEFSTRUCT new ways to implement structures; those techniques are described later. Many useful types have already been defined for the user. A table of these "built in" types follows:

LIST Uses a list (the default on Multics). 
NAMED-LIST Uses a list whose car is the structure name. 
TREE Uses a balanced binary tree with slots as `leaves.' 
 The INCLUDE option won't work with TREE
LIST* Uses a “dotted list” (see LIST*
 The INCLUDE option won't work with LIST*
ARRAY Uses an array object. 
FIXNUM-ARRAY Uses a fixnum array. 
FLONUM-ARRAY Uses a flonum array. 
UN-GC-ARRAY Uses a type NIL array if possible. 
 These don't exist in Multics Maclisp. 
HUNK Uses a hunk (the default on the PDP-10). 
NAMED-HUNK Uses a hunk whose car is the structure name. 
 This is compatible with what (STATUS USRHUNK) needs. 
SFA Uses an SFA
 The constructor accepts the keywords SFA-FUNCTION and SFA-NAME
FIXNUM Provides an abstraction for accessing fixnums through byte pointers. 
 More description follows later. 
external [Multics Only] Uses an array of type external 
 The constructor accepts the keyword external-ptr

CONSTRUCTORStruct Option(CONSTRUCTOR [name [arglist]])

The user may specify the name of a constructor macro (more than once to have more than one such macro become defined).

Just saying CONSTRUCTOR is redundant unless one of the (CONSTRUCTOR ...) syntaxes described below is also used. It says that a constructor named MAKE-structname should be defined with SETQ style syntax; the default.

The syntax (CONSTRUCTOR name) says to create a constructor with SETQ style syntax, but to call it name. For example, if you prefer a constructor called BUILD-name, you can say (CONSTRUCTOR BUILD-name) in the options list.

The syntax (CONSTRUCTOR name arglist) allows you to specify a functional syntax for a constructor. For example, if (MAKE-KONS KAR 3 KDR 4) sounds tedious to you and you'd rather write just (KONS 3 4), you could write:

(DEFSTRUCT (KONS (CONSTRUCTOR KONS (KAR KDR))) KAR KDR)

In this case, the names of the variables in the arglist are taken to describe what the arguments to the constructor will be. The keywords &OPTIONAL and &REST are allowed. They do the “obvious” thing, allowing some items to be optionally defined. The keyword &AUX is allowed as well; it allows a default initialization (given in the slot specs of the body) to be over-ridden. This is only useful when more than one constructor macro is to be used.

Note! As with the SETQ style constructors, the order of evaluation in arguments even to functional style constructors is not defined. Hence, using code that involves side-effects to initialize a DEFSTRUCT is discouraged here as well.


ALTERANTStruct Option(ALTERANT [name])

This is like CONSTRUCTOR, but for the alterant macro. The default is to make an alterant with SETQ style syntax called “ALTER-structname.” The alterant macro updates the slots of the object in parallel, which can be handy with byte fields (described later).


COPIERStruct Option(COPIER [name])

This option causes DEFSTRUCT to generate a single argument function that will copy instances of this structure. The argument to the COPIER option is the name of the copying function. If this option is present without an argument, then the default name will be “COPY-structname.”

(DEFSTRUCT (COAT-HANGER (TYPE LIST) COPIER)
  CURRENT-CLOSET WIRE-P)

Generates, among the other things it produces, a function (called COPY-COAT-HANGER) which if called on a COAT-HANGER will produce a new COAT-HANGER with the same slot fillers.


PREDICATEStruct Option(PREDICATE [name])

The PREDICATE option causes DEFSTRUCT to generate a predicate to recognize instances of the structure. Naturally it only works for some DEFSTRUCT types. Currently it works for all the named types as well as the types SFA (on the PDP-10). The argument to the PREDICATE option is the name of the predicate. If it is present without an argument, then the name is formed by concatenating “-P” to the end of the name symbol of the structure. If the option is not present, then no predicate is generated. For example,

(DEFSTRUCT (FOO NAMED PREDICATE) FOO-A FOO-B)

generates a FOO-P function, which returns true iff its argument looks like an instance of the FOO structure type.


DEFAULT-POINTERStruct Option(DEFAULT-POINTER [code])

Normally, accessors are defined to require exactly one argument. If this option is used, accessors with one argument behave as before, but accessors with no arguments behave as if code had been given as an argument. Consider the following definition:

(DEFSTRUCT (ROOM (TYPE TREE)
                 (DEFAULT-POINTER *CURRENT-ROOM*))
  (ROOM-NAME 'Y2)
  (ROOM-CONTENTS-LIST NIL))

The expression (ROOM-NAME x) gets the ROOM-NAME of x; the expression (ROOM-NAME) is the same as (ROOM-NAME *CURRENT-ROOM*).

If code is not supplied, the default DEFAULT-POINTER is the name of the structure. For example, if we has said

(DEFSTRUCT (ROOM (TYPE TREE) DEFAULT-POINTER)
  (ROOM-NAME 'Y2)
  (ROOM-CONTENTS-LIST NIL))

then (ROOM-NAME) would be the same as saying (ROOM-NAME ROOM).


NAMEDStruct OptionNAMED

This option tells DEFSTRUCT that you desire your structure to be a “named structure.” In PDP-10 MacLisp this means you want your structure implemented with a NAMED-HUNK or NAMED-LIST. On Multics this indicates that you desire a NAMED-LIST. DEFSTRUCT bases its decision as to what named type to use on whatever value you did or didn't give to the TYPE option.

It is an error to use this option with an argument.


CONC-NAMEStruct Option(CONC-NAME [prefix])

If you have two structures with the same names for some of their slots and the slots get allocated in different ways, then the definitions of their accessor macros will interfere with each other in a destructive way.

;; This wouldn't work:
(DEFSTRUCT STRUCT1 ABC)
(DEFSTRUCT STRUCT2 XYZ QRS FGH ABC)
(DEFSTRUCT STRUCT3 QRS ABC)

The reason this wouldn't work is that each structure would have its slots laid out differently and the accessors named ABC for these structures would want to do different things. Similarly, the QRS accessor defined in two of the structures. To handle this problem, the CONC-NAME option says to make the accessors be named by the symbol resulting from

(SYMBOLCONC 'prefix 'slotname)

where prefix defaults to structname. For example,

;; This will work
(DEFSTRUCT (STRUCT1 CONC-NAME) ABC)
(DEFSTRUCT (STRUCT2 CONC-NAME) XYZ QRS FGH ABC)
(DEFSTRUCT (STRUCT3 CONC-NAME) QRS ABC)

This defines accessors called STRUCT1-ABC, STRUCT2-ABC, and STRUCT3-ABC to access the ABC components of their respective structure types. The names STRUCT2-XYZ, STRUCT2-QRS, etc. also get defined, of course.

Using CONC-NAME doesn't affect the SETQ syntax in constructor and alterant macros. One still writes, for example,

(SETQ X (MAKE-STRUCT2 QRS 4 ABC '(A B) FGH 3))

or

(ALTER-STRUCT2 X ABC 5)

but when accessing slots separately, the long names must be used instead. For example,

(SETQ Y (MAKE-STRUCT1 ABC 3))
(SETF (STRUCT1-ABC Y) (STRUCT2-ABC X))

INCLUDEStruct Option(INCLUDE structname . newdefaults)

The INCLUDE option inserts the definition of its argument at the head of the new structure's definition. In other words, the first slots of the new structure are equivalent to (i.e. have the same names as, have the same inits as, etc.) the slots of the argument to the INCLUDE option. The argument to the INCLUDE option must be the name of a previously defined structure of the same type as the new one. If no type is specified in the new structure, then it is defaulted to that of the included one. It is an error for the INCLUDE option to be present without an argument. Note that INCLUDE does not work on certain types of structures (e.g. structures of type TREE or LIST*). Note also that the CONC-NAME, DEFAULT-POINTER, BUT-FIRST and CALLABLE-ACCESSORS options only apply to the accessors defined in the current DEFSTRUCT; no new accessors are defined for the included slots.

The defaults from the included structure may be over-ridden by newdefaults.

(defstruct (person (type list)
                   conc-name)
  name age (favorite-beverage 'milk))
=> PERSON

(defstruct (spaceman (include person (favorite-beverage 'tang<tm>))
                     default-pointer)
  helmet-size (mission 'moon))
=> SPACEMAN

(progn (setq kathy (make-person name 'katherine age '6))

       (setq spaceman (make-spaceman name 'buzz
                                     age 45.
                                     helmet-size 17.5))
       'ready)
=> READY

(helmet-size)
=> 17.5

(person-name kathy)
=> KATHERINE

(person-name spaceman)
=> BUZZ

(person-age kathy)
=> 6	

(person-favorite-beverage kathy)
=> MILK

(person-favorite-beverage spaceman)
=> TANG<TM>

SFA-FUNCTIONStruct Option(SFA-FUNCTION code)

This option allows the user to specify the function that will be used in structures of type SFA. Its argument should be code that evaluates to the desired function. Constructor macros for this type of structure will take SFA-FUNCTION as a keyword whose argument is also the code to evaluate to get the function, overriding any supplied in the original DEFSTRUCT form.

If SFA-FUNCTION is not present anywhere, then the constructor will use the name-symbol of the structure as the function.


SFA-NAMEStruct Option(SFA-NAME code)

This option allows the user to specify the object that will be used in the printed representation of structures of type SFA. Its argument should be code that evaluates to that object. Constructor macros for this type of structure will take SFA-NAME as a keyword whose argument is also the code to evaluate to get the object to use, overriding any supplied in the original DEFSTRUCT form.

If SFA-NAME is not present anywhere, then the constructor will use the name-symbol of the structure as the function.


EXTERNAL-PTRStruct Option(EXTERNAL-PTR code)

[Multics Only] This option is used with structures of type external. Its argument should be a piece of code that evaluates to a fixnum “packed pointer” pointing to the first word of the external array that DEFSTRUCT is to allocate as a structure. Constructor macros for this type of structure will take external-ptr as a keyword whose argument overrides any supplied in the original defstruct form.

If external-ptr is not present anywhere, then the constructor signals an error when it expands.


SIZE-SYMBOLStruct Option(SIZE-SYMBOL [sym])

The SIZE-SYMBOL option allows a user to specify a symbol whose value will be the “size” of the structure. The exact meaning of this varies, but in general this number is the one you would need to know if you were going to allocate one of these structures yourself. The symbol will have this value both at compile time and at run time. If this option is present without an argument, then the name of the structure is concatenated with “-SIZE” to produce the symbol.


SIZE-MACROStruct Option(SIZE-MACRO [sym])

Similar to SIZE-SYMBOL. A macro of no arguments is defined that expands into the size of the structure. The name of this macro defaults as with SIZE-SYMBOL.


BUT-FIRSTStruct Option(BUT-FIRST accessor)

This option allows an implicit accessor to be specified. Consider that one might have a structure representing a person's head which had parts such as NOSE, MOUTH, EYES, etc. It might be that you would prefer to always write just (NOSE person1) rather than (NOSE (PERSON-HEAD person1)) all the time. To get this effect, you can write:

(DEFSTRUCT (HEAD (TYPE LIST)
                 (DEFAULT-POINTER PERSON)
                 (BUT-FIRST PERSON-HEAD))
  NOSE MOUTH EYES)

This specifies that the accessors must first call PERSON-HEAD on their arguments and then extract the appropriate data from that result.

It is an error for the BUT-FIRST option to be used without an argument.


CALLABLE-ACCESSORSStruct Option(CALLABLE-ACCESSORS [flag])

This option controls whether the accessors defined by DEFSTRUCT will work as “functional arguments” (as the first argument to MAPCAR, APPLY, etc.) On the Lisp Machine and in NIL, accessors are callable by default, but in PDP-10 MacLisp it is expensive to make this work, so they are only callable if you ask for it. The flag argument to this option can be NIL to indicate that the feature should be turned off, or T to turn the feature on. If the option is present with no argument, then the feature is turned on.

This option is not available on Multics, where the compiler doesn't provide enough support to implement callable accessors.


EVAL-WHENStruct Option(EVAL-WHEN timespec)

Normally the macros defined by DEFSTRUCT are defined at eval-time, compile-time and at load-time. This option allows the user to control this behavior. For example,

(DEFSTRUCT (SAMPLE (EVAL-WHEN (EVAL COMPILE))) ...)

says that the macros are to be defined only when the code is running interpreted and inside the compiler, no trace of DEFSTRUCT will be found when running compiled code.

Using the EVAL-WHEN option is preferable to wrapping an EVAL-WHEN around a DEFSTRUCT form, since nested EVAL-WHENs can interact in unexpected ways (see EVAL-WHEN).


Byte FieldsConceptPacked Structures

The byte field feature of DEFSTRUCT allows the user to specify that several slots of his structure are bytes in a fixed point number stored in one element of the structure. For example, suppose we had the following structure:

(DEFSTRUCT (PHONE-BOOK-ENTRY (TYPE LIST))
  NAME
  ADDRESS
  (AREA-CODE 617.)
  EXCHANGE
  LINE-NUMBER)

This will work just fine. Except you notice that an AREA-CODE and an EXCHANGE are both always less than 1000, and so both can easily fit in 10 bits, and the line-number is always less than 10000 and can thus fit in 14 bits. Thus you can pack all three parts of a phone number in 34 bits. If you have a lisp with 36 bit fixnums (all Maclisp implementations have at least that much) then you should be able to put the entire phone number in one fixnum in a structure. DEFSTRUCT allows you to do this as follows:

(DEFSTRUCT (PHONE-BOOK-ENTRY (TYPE LIST))
  NAME
  ADDRESS
  ((AREA-CODE #o3012 617.) (EXCHANGE #o1612) (LINE-NUMBER #o0016)))

The magic numbers #o3012, #o1612 and #o0016 are byte specifiers suitable for use with the functions LDB and DPB. Accessors will become defined which access the appropriate bytes out of a fixnum. Here's an example using the above DEFSTRUCT...

(progn (setq pbe (make-phone-book-entry 
                   name "Fred Derf"
                   address "259 Octal Street"
                   exchange 555.
                   line-number 1212.))
       'ready)
=> READY

(area-code pbe)
=> 617.

(exchange pbe)
=> 555.

(name pbe)
=> "Fred Derf"

(progn (alter-phone-book-entry pbe exchange 936. line-number 7669.)
       'ready)
=> READY

(exchange pbe)
=> 936.

DEFSTRUCT tries to be maximally clever about constructing and altering structures with byte fields.

The byte specifiers are actually pieces of code that are expected to evaluate to byte specifiers, but DEFSTRUCT will try to understand fixnums if you supply them. (In the MAKE-PHONE-BOOK example, DEFSTRUCT was able to make use of its knowledge of the LINE-NUMBER and AREA-CODE byte specifiers to assemble the constant number #o115100017154 and produce code to just deposit in the EXCHANGE.)

A NIL in the place of the byte specifier code means to define an accessor for the entire word. So we could say:

(DEFSTRUCT (PHONE-BOOK-ENTRY (TYPE LIST))
  NAME
  ADDRESS
  ((PHONE-NUMBER NIL)
   (AREA-CODE #o3012 617.)
   (EXCHANGE #o1612)
   (LINE-NUMBER #o0016)))

to enable us to do things like:

(SETF (PHONE-NUMBER PBE1) (PHONE-NUMBER PBE2))

to cause two entries to have the same phone numbers. Just saying ((PHONE-NUMBER) ...) would have worked, too, but NIL is useful as a place-holder if you want to supply an initial value for the whole word as in

((PHONE-NUMBER NIL init) (AREA-CODE #o3012 617.) (EXCHANGE #o1612) ...)

Constructor macros initialize words divided into byte fields as if they were deposited in the following order:

(1) Initializations for the entire word given in the DEFSTRUCT form. 
(2) Initializations for the byte fields given in the DEFSTRUCT form. 
(3) Initializations for the entire word given in the constructor macro form.  
(4) Initializations for the byte fields given in the constructor macro form.  

Alterant macros operate in a similar manner. That is, as if the entire word was modified first, and then the byte fields were deposited. Results will be unpredictable in constructing and altering if byte fields that overlap are given.

On Multics, the byte field feature will not work unless the user has arranged to define the functions LDB and DPB. They are not yet present in the default environment, but they are available as part of the extension library.


PRINTStruct Option(PRINT formatstring . formatargs)

[Not Yet Implemented] This option exists on the Lisp Machine and NIL and will hopefully soon be added to PDP-10 Maclisp at least for structures of type NAMED-HUNK.

The PRINT option allows the user to control the printed representation of his structure in an implementation independent way:

(DEFSTRUCT (PAIR NAMED
                 (PRINT "{~S . ~S}"
                        (PAIR-FIRST PAIR)
                        (PAIR-SECOND PAIR)))
  PAIR-FIRST PAIR-SECOND)

The arguments to the PRINT option are used as if they were arguments to the FORMAT function, except that the first argument (the stream) is omitted. They are evaluated in an environment where the name symbol of the structure (PAIR in this case) is bound to the instance of the structure to be printed.

If you just specify the NAMED option without giving an explicit TYPE option, each DEFSTRUCT implementation will default to a named type that can control printing if at all possible.


[Blue Marble]
Climate Change
Does driving a hybrid vehicle fix Climate Change?

The Revised Maclisp Manual (Sunday Morning Edition)
Published Sunday, December 16, 2007 06:17am EST, and updated Sunday, July 6, 2008.
Prev | Index | Next