From 86b5da8d91d7303de130f3428fcd99f302ced195 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 25 Mar 2018 10:35:41 -0700 Subject: compiler: implement defvarl special op. * share/txr/stdlib/compiler.tl (compiler compile): Handle defvarl via expand-defvarl expander. (expand-defvarl): New function. --- share/txr/stdlib/compiler.tl | 9 +++++++++ 1 file changed, 9 insertions(+) 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" -- cgit v1.2.3