diff options
Diffstat (limited to 'fluidlet.scm')
-rw-r--r-- | fluidlet.scm | 43 |
1 files changed, 19 insertions, 24 deletions
diff --git a/fluidlet.scm b/fluidlet.scm index c93b288..59ba481 100644 --- a/fluidlet.scm +++ b/fluidlet.scm @@ -1,5 +1,5 @@ ; "fluidlet.scm", FLUID-LET for Scheme -; Copyright (c) 1992, Dorai Sitaram (dorai@cs.rice.edu) +; Copyright (c) 1998, Aubrey Jaffer ; ;Permission to copy this software, to redistribute it, and to use it ;for any purpose is granted, subject to the following restrictions and @@ -17,29 +17,24 @@ ;promotional, or sales literature without prior written consent in ;each case. -(require 'rev4-optional-procedures) -(require 'common-list-functions) (require 'dynamic-wind) -(require 'macro) +(require 'common-list-functions) ;MAKE-LIST -(define list-set! (lambda (s i v) (set-car! (list-tail s i) v))) - -(define-syntax fluid-let - (syntax-rules () - ((fluid-let ((x v) ...) . body) - (let ((%x-names (list 'x ...)) - (%x-values (list x ...)) - (%fluid-x-values (list v ...))) +(defmacro fluid-let (clauses . body) + (let ((ids (map car clauses)) + (new-tmps (map (lambda (x) (gentemp)) clauses)) + (old-tmps (map (lambda (x) (gentemp)) clauses))) + `(let (,@(map list new-tmps (map cadr clauses)) + ,@(map list old-tmps (make-list (length clauses) #f))) (dynamic-wind - (lambda () - (set! x (list-ref %fluid-x-values - (comlist:position 'x %x-names))) - ...) - (lambda () . body) - (lambda () - (let ((%x-position (comlist:position 'x %x-names))) - (list-set! %fluid-x-values %x-position x) - (set! x (list-ref %x-values %x-position))) - ...)))))) - -;--- end of file + (lambda () + ,@(map (lambda (ot id) `(set! ,ot ,id)) + old-tmps ids) + ,@(map (lambda (id nt) `(set! ,id ,nt)) + ids new-tmps)) + (lambda () ,@body) + (lambda () + ,@(map (lambda (nt id) `(set! ,nt ,id)) + new-tmps ids) + ,@(map (lambda (id ot) `(set! ,id ,ot)) + ids old-tmps)))))) |