From bd9733926076885e3417b74de76e4c9c7bc56254 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2c7

---
 fluidlet.scm | 43 +++++++++++++++++++------------------------
 1 file changed, 19 insertions(+), 24 deletions(-)

(limited to 'fluidlet.scm')

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))))))
-- 
cgit v1.2.3