andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mes: Nyacc support: with-fluids. 

* module/mes/fluids.mes (with-fluids): New macro.
* tests/fluids.test ("with-fluids"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-11-20 23:21:25 +01:00
parent 448b167c09
commit e81cb61b87
2 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
module/mes/fluids.mes
View File

@ -79,12 +79,13 @@
;; (define (with-fluids* fluids values thunk) ;; (define (with-fluids* fluids values thunk)
;; (primitive-eval (with-fluids*-next fluids values thunk))) ;; (primitive-eval (with-fluids*-next fluids values thunk)))
;; (define-macro (with-fluids bindings . bodies) (define-macro (with-fluids bindings . bodies)
;; `(let () (let ((syms (map gensym bindings)))
;; (define (expand bindings a) `(let ,(map (lambda (b s) `(,s (,b))) (map car bindings) syms)
;; (if (null? bindings) ,@(map (lambda (o) `(fluid-set! ,(car o) ,(cadr o))) bindings)
;; (cons (car bindings) (expand (cdr bindings) a)))) (let ((r (begin ,@bodies)))
;; (eval (begin ,@bodies) (expand ',bindings (current-module))))) `,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
r))))
(define (dynamic-wind in-guard thunk out-guard) (define (dynamic-wind in-guard thunk out-guard)
(in-guard) (in-guard)

29
tests/fluids.test
View File

@ -50,20 +50,19 @@ exit $?
;; 0 (with-fluids* (list a b) '(0 1) ;; 0 (with-fluids* (list a b) '(0 1)
;; (lambda () (fluid-ref a)))) ;; (lambda () (fluid-ref a))))
;; (pass-if-equal "with-fluids" (pass-if-equal "with-fluids"
;; 0 (with-fluids ((a 1) 0 (with-fluids ((a 1)
;; (a 2) (a 2)
;; (a 3)) (a 3))
;; (begin (fluid-set! a 0)) (fluid-set! a 0)
;; (begin (fluid-ref a)))) (fluid-ref a)))
;; (pass-if-equal "with-fluids" (pass-if-equal "with-fluids" ; FIXME: fails with Mes
;; #f (begin #f (begin
;; (with-fluids ((a 1) (with-fluids ((a 1)
;; (a 2) (b 2))
;; (a 3)) (fluid-set! a 0)
;; (begin (fluid-set! a 0)) (display "X:") (display (fluid-ref a)) (newline))
;; (begin (display "X:") (display (fluid-ref a)) (newline))) (fluid-ref a)))
;; (fluid-ref a)))
(result 'report) (result 'report (if mes? 1 0))