I'm gratified to have gotten a lot of mail about the PLet macros. Most
everyone liked the idea of posting code and pointers to code. But be
warned, your code had better be good!
As several people pointed out, the macros make assumptions about the
relationship between the Compiler and Run time environments which are
not required in CLtL. The remedy which these people have propoesed
has been using a lexically enclosed function. Stylistically they're
correct, but on most systems lexical closures seem to be inefficiently
implemented (about 30x the cost of FunCall on an Outer Level function).
Here is a "new, improved" version of the PLet file. I've tested it on
all the Common Lisp implementations I could get hold of and it seems to
work properly.
;;; -*- Mode:Lisp; Syntax:Common-Lisp; Package: USER -*-
;;; -----------------------------------------------------------------------
;;; File: plet.l
;;;
;;; Description: Provides Macros PLet and PLet*.
;;;
;;; PLet is like LET except that each variable's binding
;;; is evaluated only the first time the PLet is evaluated.
;;; Thereafter, each variable's value is saved away on a
;;; GenSym each time the body is exited, and reloaded each
;;; time the PLet is reentered.
;;;
;;; PLet* is like LET* with the same exceptions as PLet.
;;;
;;; Declarations, including (Special) are accepted.
;;;
;;; Note that since Common Lisp doesn't provide Symbol
;;; Macros (albeit CLOS does), the values are Loaded and
;;; Saved upon entrance and exit from the PLet body. This
;;; means that in Recursive calls, all nested activations
;;; get the same bindings, those which the outer-most
;;; level received. Also, Recursive Calls don't effect
;;; each other's values, and the Outer Most values are
;;; effectively the only ones permanently saved.
;;;
;;; Example: > (DeFun Fibonacci ()
;;; (PLet ((arg1 1) (arg2 0))
;;; (PSetQ arg1 arg2
;;; arg2 (+ arg1 arg2))
;;; arg2))
;;; FIBONACCI
;;; > (DoTimes (i 4 (VALUES)) (PRINT (Fibonacci)))
;;;
;;; 1
;;; 1
;;; 2
;;; 3
;;; >
;;;
;;; Author: Matthew Kamerman
;;; Created: 29 Aug 1989
;;; Modified: 27 Nov 1989 for greater CLtL compatibility
;;; Package: USER
;;; -----------------------------------------------------------------------
(In-Package 'User)
;;;====================================================================;;;
(DefMacro PLet ((&Rest vars-and-bindings) &Body body)
"(PLet (&Rest vars-and-bindings) &Body body)
PLet functions in a manner similar to Let with the exceptions that
bindings are evaluated only when the PLet is first evaluated, and
thereafter variable values are loaded and saved upon entrance and
exit of the PLet body. All declarations, including (Special) are
accepted.
Note that since values are saved only upon exit from a PLet,
recursive calls to a function containing a PLet will find each
with values initialized to the same values as the outer level
initially received."
(LET (vars bindings syms declarations)
(DoList (var-and-binding vars-and-bindings
(SetQ vars (NReverse vars)
bindings (NReverse bindings)))
(PUSH (GenSym) syms)
(COND
((ListP var-and-binding)
(PUSH (FIRST var-and-binding) vars)
(PUSH (SECOND var-and-binding) bindings))
(T
(PUSH var-and-binding vars)
(PUSH NIL bindings))))
(DO ((sexp (FIRST body) (FIRST body)))
((NOT (AND body (ListP sexp) (EQL (FIRST sexp) 'DECLARE)))
(SetQ declarations (NReverse declarations)))
(PUSH (POP body) declarations))
(IF vars
`(LET ,(MapCar
#'(LAMBDA (var binding sym)
`(,var (IF (BoundP ',sym) ,sym ,binding)))
vars bindings syms)
(DECLARE (Special ,@syms))
,@declarations
(UnWind-Protect
,(AND body `(ProgN ,@body))
(SetQ ,@(MapCan #'LIST syms vars))))
`(LET () ,@declarations ,@body))))
;;;--------------------------------------------------------------------;;;
(DefMacro PLet* ((&Rest vars-and-bindings) &Body body)
"(PLet* (&Rest vars-and-bindings) &Body body)
PLet* functions in a manner similar to Let with the exceptions that
bindings are evaluated only when the PLet* is first evaluated, and
thereafter variable values are loaded and saved upon entrance and
exit of the PLet* body. All declarations, including (Special) are
accepted.
Note that since values are saved only upon exit from a PLet*,
recursive calls to a function containing a PLet* will find each
with values initialized to the same values as the outer level
initially received."
(LET (vars bindings syms declarations)
(DoList (var-and-binding vars-and-bindings
(SetQ vars (NReverse vars)
bindings (NReverse bindings)))
(PUSH (GenSym) syms)
(COND
((ListP var-and-binding)
(PUSH (FIRST var-and-binding) vars)
(PUSH (SECOND var-and-binding) bindings))
(T
(PUSH var-and-binding vars)
(PUSH NIL bindings))))
(DO ((sexp (FIRST body) (FIRST body)))
((NOT (AND body (ListP sexp) (EQL (FIRST sexp) 'DECLARE)))
(SetQ declarations (NReverse declarations)))
(PUSH (POP body) declarations))
(IF vars
`(LET* ,(MapCar
#'(LAMBDA (var binding sym)
`(,var (IF (BoundP ',sym) ,sym ,binding)))
vars bindings syms)
(DECLARE (Special ,@syms))
,@declarations
(UnWind-Protect
,(AND body `(ProgN ,@body))
(SetQ ,@(MapCan #'LIST syms vars))))
`(LET* () ,@declarations ,@body))))
;;;====================================================================;;;
> ((NOT (AND body (ListP sexp) (EQL (FIRST sexp) 'DECLARE)))
Since declare's can come from macro expansions, hadn't sexp better be
expanded (if a macro) before the (eql ... 'declare) test. Also, if
expanded, it has to be taken out of body to eliminate unexpected
multiple expansions.
doug
In article <···@cs.columbia.edu> ······@cs.columbia.edu (Matthew Kamerman) writes:
>As several people pointed out, the macros make assumptions about the
>relationship between the Compiler and Run time environments which are
>not required in CLtL. The remedy which these people have propoesed
>has been using a lexically enclosed function. Stylistically they're
>correct, but on most systems lexical closures seem to be inefficiently
>implemented (about 30x the cost of FunCall on an Outer Level function).
The problem with the lexically enclosed function is that you have to
wrap something around the whole function definition, as in
(let ((a (compute-a)))
(defun use-a ()
a))
Sometimes you want something more local. For example, you might have
a macro that wants to expand into something that involves a once-only
evaluation. The macro can't wrap a LET around the function it appears
in.
I`ve sometimes used the following trick, which is more or less the
same as what's at the heart of the PLET macro:
(defmacro eval-once (form)
`(let ((v ',(gensym))) ;the symbol persists between calls
(if (boundp v)
(symbol-value v)
(set v ,form))))
Instead of saying
(plet ((a (compute a)))
...)
you'd say
(let ((a (eval-once (compute-a))))
...)
Unfortunately, both my macro and PLET have a problem: they create a
new symbol each time they're expanded. Since that might be more than
once, they don't really cause the evaluation to happen only once.
For example,
1> (defun compute-a ()
(format t "~&Computing a...~%")
10))
compute-a
2> (defun f ()
(plet ((a (compute-a)))
a))
f
3> (f)
Computing a...
10
4> (f)
Computing a...
10
This is a pain, because it means that there's no way in Common Lisp to
get the effect of a static variable. There may be a solution in X3J13
Common Lisp using something called LOAD-TIME-EVAL, which could be used
to have something evaluated once, at load time. The result could be
an object (a cons cell, say) in which a value could be stored. [It't
can't always be the value directly, because it might not be possible
to compute the value at load time.]
-- Jeff
In article <····@skye.ed.ac.uk> ····@aiai.ed.ac.uk (Jeff Dalton) writes:
> The problem with the lexically enclosed function [to implement
> static variables] is that you have to
> wrap something around the whole function definition. [...]
> Sometimes you want something more local. For example, you might have
> a macro that wants to expand into something that involves a once-only
> evaluation. The macro can't wrap a LET around the function it appears
> in.
>
> I`ve sometimes used the following trick
> [macro definition deleted]
> Unfortunately, both my macro and PLET have a problem: they create a
> new symbol each time they're expanded. Since that might be more than
> once, they don't really cause the evaluation to happen only once.
There is a way to get around this: embed the MACRO definition in a let
that creates a hash table mapping macro-calls to their value. The
macro expands into something that checks the hash table to see if the
form in this call has already been evaluated. If so it just returns
that stored value, otherwise it stores the value in the hash table and
returns it. Two macro expansions are expanding the "same call" if the
macro expressions being expanded are eq.
Here is an example:
(let ((once-only-cache (make-hash-table)))
(defmacro eval-once (&whole whole form)
`(multiple-value-bind (value foundp)
(gethash ',whole ',once-only-cache)
(if foundp value
(setf (gethash ',whole ',once-only-cache)
,form)))))
For example (using setq / eval to get multiple macro expansions):
<cl> (setq compute-a '(eval-once (progn (format t "~&Computing a...~%") 10)))
<cl> (eval compute-a)
Computing a...
10
<cl> (eval compute-a)
10
Note that we hash on the "whole" rather than the argument ("form")
because the argument might be just a symbol, which might also be the
argument of some other call to this macro. However, even this
approach can be wrong - the "whole" can be eq in two different macro
calls if the whole itself comes from a constant in another macro.
E.g.:
(defmacro foo (x) `(cons (eval-once *x*) ,x))
<cl> (let ((*x* 1))
(print (eval-once 3))
(setq *x* 2)
(eval-once 3))
3
3
--
Lou Steinberg
uucp: {pretty much any major site}!rutgers!aramis.rutgers.edu!lou
arpa: ···@cs.rutgers.edu
Oops - I let my message get away before I had fixed a mistake at the
end... Let's try that again. Here is the corrected ending:
Note that we hash on the "whole" rather than the argument ("form")
because the argument might be just a symbol, which might also be the
argument of some other call to this macro. However, even this
approach can be wrong - the "whole" can be eq in two different macro
calls if the whole itself comes from a constant in another macro.
E.g.:
<cl> (defmacro foo (x) `(cons ,macro-stuff (1+ ,x)))
<cl> (defmacro fie (x) `(cons ,macro-stuff (1- ,x)))
<cl> (setq macro-stuff '(eval-once *x*))
<cl> (let ((*x* 1)) (foo 10))
(1 . 11)
<cl> (let ((*x* 2)) (fie 10))
(1 . 9)
--
Lou Steinberg
uucp: {pretty much any major site}!rutgers!aramis.rutgers.edu!lou
arpa: ···@cs.rutgers.edu
In article <························@atanasoff.rutgers.edu> ···@atanasoff.rutgers.edu (Lou Steinberg) writes:
>In article <····@skye.ed.ac.uk> ····@aiai.ed.ac.uk (Jeff Dalton) writes:
>> Unfortunately, both my macro and PLET have a problem: they create a
>> new symbol each time they're expanded. Since that might be more than
>> once, they don't really cause the evaluation to happen only once.
Note that this is a problem for interpreted code, but not for
compiled, because no further expansions of the eval-once macro
will take place after compilation. Some people have suggested
that my macro won't work for compiled code because the required
EQ distinctions might not be maintained. I think that shouldn't
be a problem, but I'm not sure the spec agrees with me. [For
those who don't remember how the once-only macro worked, it
used a ganerated symbol to hold the value and used boundp to
see if it had been computed yet.]
>There is a way to get around this: embed the MACRO definition in a let
>that creates a hash table mapping macro-calls to their value. The
>macro expands into something that checks the hash table to see if the
>form in this call has already been evaluated. If so it just returns
>that stored value, otherwise it stores the value in the hash table and
>returns it. Two macro expansions are expanding the "same call" if the
>macro expressions being expanded are eq.
>(let ((once-only-cache (make-hash-table)))
> (defmacro eval-once (&whole whole form)
> `(multiple-value-bind (value foundp)
> (gethash ',whole ',once-only-cache)
> (if foundp value
> (setf (gethash ',whole ',once-only-cache)
> ,form)))))
So,
(eval-once (f x))
expands to
(multiple-value-bind (value foundp)
(gethash '(eval-once (f x)) ',#<hash table 1>)
(if foundp
value
(setf (gethash '(eval-once (f x)) '#<hash table 1>)
(f x))))
This is a good idea, but it may not work when compiled.
>Note that we hash on the "whole" rather than the argument ("form")
>because the argument might be just a symbol, which might also be the
>argument of some other call to this macro. However, even this
>approach can be wrong - the "whole" can be eq in two different macro
>calls if the whole itself comes from a constant in another macro.
That's true, and there are two other problems:
1. Compilers are allowed to "coalesce" quoted values that are EQUAL
into one value. Thus, when your compiled code is loaded in, the
different copies of (eval-once (f x)) may all be EQ. So the
"wholes" can end up EQ even if they didn't start that way.
2. Having objects like hash tables in quoted constants may not
work.
Another, but correctable, problem is that DEFMACRO inside LET doesn't
work in all Common Lisps. So you may have to use a global variable
instead. That can be used to deal with problem (2) as well.
So it seems that it isn't possible to write a once-only or Plet macro
that works both interpreted and compiled in every Common Lisp. I hope
I'm wrong, though.
-- Jeff
Jeff Dalton, JANET: ········@uk.ac.ed
AI Applications Institute, ARPA: ·················@nsfnet-relay.ac.uk
Edinburgh University. UUCP: ...!ukc!ed.ac.uk!J.Dalton