Hi folks!
Here are two Macros I've found useful. PLet and PLet* support persisting
variable values in the abscence of CLOS. The implementation causes some
subtle features/bugs if a function containing a PLet is called recursively.
The documentation goes into this in greater detail.
One of the reasons I've been reading this group is in the hope of finding
short, useful, chunks of code and getting pointers to where larger systems
can be acquired by Anonymous FTP. Seeing none, I'm submitting my own. If
you feel strongly for or against code and notifications of code appearing
in this News Group, please EMail me and if I get a lot of responses I'll
post the results and conduct myself accordingly.
I hope some of you find this useful,
Matt Kamerman
;;; -*- Mode:Lisp; Syntax:Common-Lisp; Package: USER -*-
;;; -----------------------------------------------------------------------
;;; File: plet.l
;;;
;;; Description: Provides PLet and PLet*, versions of Let and Let* with
;;; compile time evaluated variable bindings which persist.
;;; 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.
;;;
;;; Author: Matthew Kamerman
;;; Created: 29 Aug 1989
;;; 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 in the Compiler and that 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 syms declarations)
(SetQ vars (MapCan #'(LAMBDA (var)
(LIST (IF (ListP var) (FIRST var) var)))
vars-and-bindings)
syms (MapCan #'(LAMBDA (binding &Aux (sym (GenSym)))
(SetF (Symbol-Value sym) binding)
(LIST sym))
(EVAL `(LET ,vars-and-bindings (LIST ,@vars)))))
(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 #'LIST vars 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 in the Compiler and that 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 syms declarations)
(SetQ vars (MapCan #'(LAMBDA (var)
(LIST (IF (ListP var) (FIRST var) var)))
vars-and-bindings)
syms (MapCan #'(LAMBDA (binding &Aux (sym (GenSym)))
(SetF (Symbol-Value sym) binding)
(LIST sym))
(EVAL `(LET* ,vars-and-bindings (LIST ,@vars)))))
(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 #'LIST vars syms)
,@declarations
(UnWind-Protect
,(AND body `(ProgN ,@body))
(SetQ ,@(MapCan #'LIST syms vars))))
`(LET* () ,@declarations ,@body))))
;;;====================================================================;;;
In article <···@cs.columbia.edu> ······@cs.columbia.edu (Matthew Kamerman) writes:
> Here are two Macros I've found useful. PLet and PLet* support persisting
>variable values in the abscence of CLOS. The implementation causes some
>subtle features/bugs if a function containing a PLet is called recursively.
>The documentation goes into this in greater detail.
>(DefMacro PLet ((&Rest vars-and-bindings) &Body body)
> "(PLet (&Rest vars-and-bindings) &Body body)
>
[documentation omitted]"
>
> (LET (vars syms declarations)
> (SetQ vars (MapCan #'(LAMBDA (var)
> (LIST (IF (ListP var) (FIRST var) var)))
> vars-and-bindings)
> syms (MapCan #'(LAMBDA (binding &Aux (sym (GenSym)))
> (SetF (Symbol-Value sym) binding)
> (LIST sym))
> (EVAL `(LET ,vars-and-bindings (LIST ,@vars)))))
> (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 #'LIST vars syms)
> ,@declarations
> (UnWind-Protect
> ,(AND body `(ProgN ,@body))
> (SetQ ,@(MapCan #'LIST syms vars))))
> `(LET () ,@declarations ,@body))))
>
This macro has several serious problems. First off, it won't work
interpretively if the interpreter expands the PLet macro more than
once, rather than just when the surrounding function is defun'ed. I
discovered this by typing your fibonacci example into Utah Common
Lisp. You plausibly could say that this is a dumb way to write an
interpreter, but it is a valid way, and you shouldn't write macros
that depend on being expanded only once.
Secondly, the initforms for the PLet bindings can reference only
constants or special variables. If the code is being compiled, any
special variables must exist in the compiler's environment. This is
pretty limiting.
Thirdly, the gensyms that hold the values of PLet variables between
evaluations exist only in the environment of the compiler. If the
compiled code is loaded into a fresh environment, the gensyms will be unbound.
If you want persistant lexical bindings you probably should be using closures
instead. Here's you fibonacci example, rewritten to use a closure:
(defun fib-setup (&key ((:n-2 pn-2) 0) ((:n-1 pn-1) 1))
#'(lambda (&key n-2 n-1)
(and n-2 (setq pn-2 n2))
(and n-1 (setq pn-1 n1))
(psetq pn-2 pn-1 pn-1 (+ pn-2 pn-1))
pn-1))
FIB-SETUP
(setf (symbol-function 'fibonacci) (fib-setup))
#<Interpreted Closure #x1AB688>
(fibonacci)
1
(fibonacci)
2
(fibonacci)
3
(fibonacci)
5
Note: I too think it would be a good thing if people posted more code
and pointers to code.
Tim Moore ·····@cs.utah.edu {bellcore,hplabs}!utah-cs!moore
"Ah, youth. Ah, statute of limitations."
-John Waters