fluid-let that actually works with fluids.

[Russ McManus <russell.mcmanus@gs.com>]

A while back, I was trying to learn defmacros, so I tried to write
a version of 'fluid-let'.  It turned out that I was missing some
important concepts, but finally I produced something that sort of
worked.  The person who helped me on the list challenged me to then
go produce a version of fluid-let that works for guile's fluid variables,
so that it would be useful in a threaded environment.

Finally, I've had some use for such a beast, and since I didn't find
one anywhere in the guile source, I decided to whip up a version.  It
was pretty easy for me to do, but that just probably means that I've
got some obvious bugs in there.  Can those who know macros and fluid
semantics take a look?

Something like this (assuming it works right) should be included in
the guile distribution.

-russ


#!/opt/guile/bin/guile -s
!#

(define-module (gs fluid-let))
;;; end-header

;;; Copyright (C) 1999 Russ McManus
;;; 
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
;;; 
;;; Documentation:
;;;
;;; We require that there is a fluid-variable called
;;; *fluid-let-bindings*, which will be an association list that
;;; associates the name of bound fluid variables with their previous
;;; values.  At the beginning of a 'fluid-let', we push some pairs
;;; onto this alist, and at the end, we pop them off.  Voila!
;;; 
;;; To avoid searching, we assume that items are put onto the bind
;;; stack in order, and that 'fluid-let' will pop them off in order.  We
;;; continue to keep both the names of the vars along with the values,
;;; even though this is not strictly necessary, as a help to debugging
;;; and possibly future reflection.
;;; 
;;; One can only bind fluid variables with this version fluid-let; it
;;; won't work for regular variables.  If you don't care about
;;; threads, you can get a version of fluid-let that works for normal
;;; variables out of slib.

; (define a (let ((val (make-fluid)))
; 	    (fluid-set! val 1)
; 	    val))
; (define b (let ((val (make-fluid)))
; 	    (fluid-set! val 2)
; 	    val))

; (list (fluid-ref a) (fluid-ref b))

; (fluid-let ((a 2)
; 	    (b 3))
;   (list (fluid-ref a) (fluid-ref b)))

; (list (fluid-ref a) (fluid-ref b))

(define *fluid-let-bindings*
  (let ((val (make-fluid)))
    (fluid-set! val '())
    val))

(defmacro fluid-let (clauses . body)
  (let ((%make-binding (gensym))
	(%binding-value (gensym))
	(%add-binding (gensym))
	(%pop-binding (gensym)))
    `(let ((,%make-binding (lambda (key value) (cons key value)))
	   (,%binding-value (lambda (bind) (cdr bind)))
	   (,%add-binding
	    (lambda (bind)
	      (fluid-set! *fluid-let-bindings* (cons bind (fluid-ref *fluid-let-bindings*)))))
	   (,%pop-binding
	    (lambda ()
	      (let ((bind (car (fluid-ref *fluid-let-bindings*))))
		(fluid-set! *fluid-let-bindings* (cdr (fluid-ref *fluid-let-bindings*)))
		bind))))
       (dynamic-wind
	   (lambda ()
	     ,@(map (lambda (clause)
		      `(begin
			 (,%add-binding (,%make-binding ',(car clause) (fluid-ref ,(car clause))))
			 (fluid-set! ,(car clause) ,(cadr clause))))
		    clauses))
	   (lambda ()
	     ,@body)
	   (lambda ()
	     ,@(map (lambda (clause)
		      `(fluid-set! ,(car clause) (,%binding-value (,%pop-binding))))
		    (reverse clauses)))))))

(export *fluid-let-bindings*)
(export fluid-let)


--
They don't make nostalgia like they used to.