mkamer@cs.columbia.edu (Matthew Kamerman) (11/16/89)
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)))) ;;;====================================================================;;;
moore%cdr.utah.edu@cs.utah.edu (Tim Moore) (11/19/89)
In article <464@cs.columbia.edu> mkamer@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 moore@cs.utah.edu {bellcore,hplabs}!utah-cs!moore "Ah, youth. Ah, statute of limitations." -John Waters
moore%cdr.utah.edu@cs.utah.edu (Tim Moore) (11/19/89)
In article <1989Nov18.152356.7962@hellgate.utah.edu> moore%cdr.utah.edu@cs.utah.edu (Tim Moore) writes: > >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)) Oops! That should be: (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 n-2)) (and n-1 (setq pn-1 n-1)) (psetq pn-2 pn-1 pn-1 (+ pn-2 pn-1)) pn-1)) Tim Moore moore@cs.utah.edu {bellcore,hplabs}!utah-cs!moore "Ah, youth. Ah, statute of limitations." -John Waters
jwz@teak.berkeley.edu (Jamie Zawinski) (11/19/89)
In article <1989Nov18.152356.7962@hellgate.utah.edu> Tim Moore <moore%cdr.utah.edu@cs.utah.edu> writes: > If you want persistant lexical bindings you probably should be using closures > instead. Here's you fibonacci example, rewritten to use a closure: > [ incorrect version replaced: ] > (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 n-2)) > (and n-1 (setq pn-1 n-1)) > (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 This seems to me to be a more straightforward way: (let ((pn-2 0) (pn-1 1)) (defun fibonacci () (psetq pn-2 pn-1 pn-1 (+ pn-2 pn-1)) pn-1)) Since DEFUN must expand to something that stuffs a lambda into a function-cell, it's equivalent to yours, but is shorter and easier to read. A problem with this is, some less-swift compilers might not be smart enough to compile top-level lexical closures like this. (But that's wrong.) > Note: I too think it would be a good thing if people posted more code > and pointers to code. Ok, here's one. The directory /usr/jwz/public/ on spice.cs.cmu.edu is accessible by anonymous FTP. This directory contains 4 or 5 megs of Lisp code. Most of it (about 80% I think) is TI Explorer specific, but a fair amount is common lisp; there's a good chance that a lot of the Explorer-specific code will run on Symbolics, since they share common ancestors. Most of the machine dependancies are in user-interface or graphics stuff, so it might not be hard to port to other implementations. The file "_readme.text" contains short descriptions of all of the files, along with whether they are CL-compatible. The Spice's IP address is 128.2.254.139, for those of you with brain-dead nameservers. If you have any neat tools that you'd like to see become more accessible, send them to me. -- Jamie (jwz@teak.berkeley.edu or jwz@spice.cs.cmu.edu)