Path: utzoo!yunexus!ists!jarvis.csri.toronto.edu!mailrus!uwm.edu!gem.mps.ohio-state.edu!brutus.cs.uiuc.edu!psuvax1!rutgers!columbia!cs!mkamer
From: mkamer@cs.columbia.edu (Matthew Kamerman)
Newsgroups: comp.lang.lisp
Subject: code
Summary: Portable Code for persisting variable bindings
Message-ID: <464@cs.columbia.edu>
Date: 16 Nov 89 01:40:00 GMT
Article-I.D.: cs.464
Organization: Columbia University Department of Computer Science
Lines: 112

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))))

;;;====================================================================;;;