diff options
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 9 |
1 files changed, 9 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 71c0df4d..57da0219 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -195,6 +195,7 @@ (tree-case me.(comp-tree-case oreg env form)) (sys:lisp1-value me.(comp-lisp1-value oreg env form)) (dwim me.(comp-dwim oreg env form)) + (defvarl me.(compile oreg env (expand-defvarl form))) (sys:upenv me.(compile oreg env.up (cadr form))) (sys:dvbind me.(compile oreg env (caddr form))) (sys:with-dyn-rebinds me.(comp-progn oreg env (cddr form))) @@ -1068,6 +1069,14 @@ ,*bind-code ,*body)))))) +(defun expand-defvarl (form) + (mac-param-bind form (op sym : value) form + (with-gensyms (cell) + ^(let ((,cell (sys:rt-defvarl ',sym))) + (if ,cell + (usr:rplacd ,cell (cons ',sym ,value))) + ',sym)))) + (defun sys:bind-mac-error (ctx-form params obj too-few-p) (if (atom obj) (compile-error ctx-form "extra atom ~s not matched by params ~s" |