From e81cb61b871b0bc8537403f1cff64b35d80a2cf7 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Mon, 20 Nov 2017 23:21:25 +0100
Subject: [PATCH] mes: Nyacc support: with-fluids.

* module/mes/fluids.mes (with-fluids): New macro.
* tests/fluids.test ("with-fluids"): Test it.
---
 module/mes/fluids.mes | 13 +++++++------
 tests/fluids.test     | 29 ++++++++++++++---------------
 2 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/module/mes/fluids.mes b/module/mes/fluids.mes
index 07bf8098..b9f88c45 100644
--- a/module/mes/fluids.mes
+++ b/module/mes/fluids.mes
@@ -79,12 +79,13 @@
 ;; (define (with-fluids* fluids values thunk)
 ;;   (primitive-eval (with-fluids*-next fluids values thunk)))
 
-;; (define-macro (with-fluids bindings . bodies)
-;;   `(let ()
-;;     (define (expand bindings a)
-;;       (if (null? bindings)
-;;           (cons (car bindings) (expand (cdr bindings) a))))
-;;     (eval (begin ,@bodies) (expand ',bindings (current-module)))))
+(define-macro (with-fluids bindings . bodies)
+  (let ((syms (map gensym bindings)))
+    `(let ,(map (lambda (b s) `(,s (,b))) (map car bindings) syms)
+       ,@(map (lambda (o) `(fluid-set! ,(car o) ,(cadr o))) bindings)
+       (let ((r (begin ,@bodies)))
+         `,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
+         r))))
 
 (define (dynamic-wind in-guard thunk out-guard)
   (in-guard)
diff --git a/tests/fluids.test b/tests/fluids.test
index 1fedb16a..7e77cb08 100755
--- a/tests/fluids.test
+++ b/tests/fluids.test
@@ -50,20 +50,19 @@ exit $?
 ;;     0 (with-fluids* (list a b) '(0 1)
 ;;                     (lambda () (fluid-ref a))))
 
-;; (pass-if-equal "with-fluids"
-;;     0 (with-fluids ((a 1)
-;;                     (a 2)
-;;                     (a 3))
-;;         (begin (fluid-set! a 0))
-;;         (begin (fluid-ref a))))
+(pass-if-equal "with-fluids"
+    0 (with-fluids ((a 1)
+                    (a 2)
+                    (a 3))
+        (fluid-set! a 0)
+        (fluid-ref a)))
 
-;; (pass-if-equal "with-fluids"
-;;     #f (begin
-;;          (with-fluids ((a 1)
-;;                        (a 2)
-;;                        (a 3))
-;;            (begin (fluid-set! a 0))
-;;            (begin (display "X:") (display (fluid-ref a)) (newline)))
-;;          (fluid-ref a)))
+(pass-if-equal "with-fluids" ; FIXME: fails with Mes
+    #f (begin
+         (with-fluids ((a 1)
+                       (b 2))
+           (fluid-set! a 0)
+           (display "X:") (display (fluid-ref a)) (newline))
+         (fluid-ref a)))
 
-(result 'report)
+(result 'report (if mes? 1 0))