compiler: implement defvarl special op.

* share/txr/stdlib/compiler.tl (compiler compile): Handle
defvarl via expand-defvarl expander.
(expand-defvarl): New function.

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"