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

mes: Use a hash table for fluids. 

If 'make-fluid' is a macro that calls 'gensym' directly, any attempt
to wrap 'make-fluid' will result in only one symbol being produced
at expansion time.

* mes/module/mes/fluids.mes (make-fluid): Rewrite to generate a
symbol at evaluation time, and use that symbol as a key for a hash
table.
(fluid?, fluid-ref, fluid-set!): Adjust accordingly.
(with-fluid*, with-fluids): Use 'fluid-ref' instead of applying a
fluid directly.
* tests/fluids.test: Add test.
This commit is contained in:
Timothy Sample 2022-04-09 13:19:04 -06:00
parent 0f167b03f3
commit 9ed7460eba
2 changed files with 39 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
mes/module/mes/fluids.mes
View File

@ -2,6 +2,7 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Mes.
;;;
@ -24,34 +25,36 @@
(mes-use-module (mes scm))
(define-macro (make-fluid . default)
((lambda (fluid)
`(begin
(hashq-set!
(initial-module)
',fluid
(make-variable
((lambda (v)
(lambda ( . rest)
(if (null? rest) v
(set! v (car rest)))))
,(and (pair? default) (car default)))))
',fluid))
(symbol-append 'fluid: (gensym))))
;; Hide the fluid table in a lexical binding.
(let ((fluids (make-hash-table)))
(define (fluid-ref fluid)
(fluid))
(define (make-fluid . default)
(let ((fluid (symbol-append 'fld: (gensym))))
(hashq-set! fluids fluid (and (pair? default) (car default)))
fluid))
(define (fluid-set! fluid value)
(fluid value))
(define (fluid? fluid)
(and (hashq-get-handle fluids fluid) #t))
(define-macro (fluid? fluid)
`(begin
(and (symbol? ,fluid)
(symbol-prefix? 'fluid: ,fluid))))
(define (fluid-ref fluid)
(let ((handle (hashq-get-handle fluids fluid)))
(if handle
(cdr handle)
(error "invalid fluid" fluid))))
(define (fluid-set! fluid value)
(let ((handle (hashq-get-handle fluids fluid)))
(if handle
(set-cdr! handle value)
(error "invalid fluid" fluid))))
(hashq-set! (initial-module) 'make-fluid (make-variable make-fluid))
(hashq-set! (initial-module) 'fluid? (make-variable fluid?))
(hashq-set! (initial-module) 'fluid-ref (make-variable fluid-ref))
(hashq-set! (initial-module) 'fluid-set! (make-variable fluid-set!)))
(define (with-fluid* fluid value thunk)
(let ((v (fluid)))
(let ((v (fluid-ref fluid)))
(fluid-set! fluid value)
(let ((r (thunk)))
(fluid-set! fluid v)
@ -70,7 +73,7 @@
(define-macro (with-fluids bindings . bodies)
(let ((syms (map gensym bindings)))
`(let ,(map (lambda (b s) `(,s (,b))) (map car bindings) syms)
`(let ,(map (lambda (b s) `(,s (fluid-ref ,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)

12
tests/fluids.test
View File

@ -7,6 +7,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Mes.
;;;
@ -66,4 +67,15 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(display "X:") (display (fluid-ref a)) (newline))
(fluid-ref a)))
(define (make-fluid-2)
(make-fluid 'hi))
(pass-if-eq "make-fluid wrapped"
'hi
((lambda (f1 f2)
(fluid-set! f1 'bye)
(fluid-ref f2))
(make-fluid-2)
(make-fluid-2)))
(result 'report)