diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-03-25 20:03:41 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-03-25 20:03:41 -0700 |
| commit | d4c9ac79a578f4fbbeef1a30d5b71e6ae17f4ca2 (patch) | |
| tree | d26a48c1812318116dee76fa8d90fa5a0e40e466 | |
| parent | 30d0d0fb1fa657f1b4bad642dc6ea81aee9600ba (diff) | |
| download | txr-d4c9ac79a578f4fbbeef1a30d5b71e6ae17f4ca2.tar.gz txr-d4c9ac79a578f4fbbeef1a30d5b71e6ae17f4ca2.tar.bz2 txr-d4c9ac79a578f4fbbeef1a30d5b71e6ae17f4ca2.zip | |
compiler: implement defmacro special op.
* share/txr/stdlib/compiler.tl (compiler compile): Handle
defmacro via expand-defmacro expander.
(expand-defmacro): New function.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index d35b5e7d..48a9f22d 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -197,6 +197,7 @@ (dwim me.(comp-dwim oreg env form)) (defvarl me.(compile oreg env (expand-defvarl form))) (defun me.(compile oreg env (expand-defun form))) + (defmacro me.(compile oreg env (expand-defmacro 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))) @@ -1097,6 +1098,19 @@ name)))) (t (compile-error form "~s isn't a valid function name" name)))))) +(defun expand-defmacro (form) + (mac-param-bind form (op name mac-args . body) form + (with-gensyms (form menv) + (let ((exp-lam ^(lambda (,form ,menv) + (mac-param-bind ,form ,mac-args (cdr ,form) + (sys:set-macro-ancestor + (block ,name + ,*body) + ,form))))) + ^(progn + (sys:rt-defmacro ',name '(macro ,name) ,exp-lam) + ',name))))) + (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" |