| Here's a macro that does dynamic binding. It transforms any given fn-expression, so it can work on custom functions, let, or with. No withs support yet, though. Usage: (= x 1)
(def foo () (+ x 5))
(foo) => 6
(let x 7 (foo)) => 6
(fluid:let x 7 (foo)) => 12
Code: ; uniq-args-tree: returns a tree with uniq's for all the symbols that will
; actually be bound in the environment corresponding to the args tree (with 'o's)
(def uniq-args-tree (x)
(if (acons x) (if (is (car x) 'o) (cons 'o (uniq-args-tree (cadr x)))
(cons (uniq-args-tree (car x))
(uniq-args-tree (cdr x))))
x (uniq)
t nil))
; flatten-argsyms: flatten an argument list, but return only
; the symbols which will be bound in the new environment (without 'o's)
(def flatten-argsyms (argtree)
((rfn rec (tree tail)
(if (acons tree) (if (is (car tree) 'o) (rec (cadr tree) tail)
(rec (car tree) (rec (cdr tree) tail)))
tree (cons tree tail)
t tail))
argtree nil))
(def interleave (xs ys)
(if (no xs) ys
(cons (car xs) (interleave ys (cdr xs)))))
; value-pairs: for setting or with'ing
; allows destructuring sets and with-expansions with the same mechanism
(def binding-pairs (places vals)
(interleave (flatten-argsyms places) (flatten-argsyms vals)))
; fn-transform: tried it as a macro, but this way seems cleaner
(def fn-transform (form proc)
(let ex (macex form)
(if (no:acons ex) ex
(acons (car ex)) (cons (fn-transform (car ex) proc) (cdr ex))
(no:is (car ex) 'fn) ex
(apply proc (cdr ex))))) ; (cdr ex) chops off the 'fn symbol
; fluid: dynamic binding
; use like (fluid:let x 1 (foo))
(mac fluid (form)
(fn-transform form
(fn (args . body)
(withs (at1 (uniq-args-tree args)
at2 (uniq-args-tree args))
`(fn ,at1
(with ,(binding-pairs at2 args)
(set ,@(binding-pairs args at1))
(do1
,@body
(set ,@(binding-pairs args at2)))))))))
I tried to write it so it would leave some useful helper functions around.I'd be interested in comments on the implementation and the approach. I'm not sure yet if this is the right way to do dynamic binding. |