From 5f107b22b84b603d6bf4a554a4be729883fd6d7c Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 26 Mar 2018 06:59:09 -0700 Subject: compiler: implement handler-bind special op. * share/txr/stdlib/compiler.tl (compiler compile): Handle defmacro via comp-handler-bind method. (comp-handler-bind): New method. --- share/txr/stdlib/compiler.tl | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index ad78295c..0c2a2b86 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -178,6 +178,7 @@ ((block block*) me.(comp-block oreg env form)) ((return-from sys:abscond-from) me.(comp-return-from oreg env form)) (return me.(comp-return oreg env form)) + (handler-bind me.(comp-handler-bind oreg env form)) ((let let*) me.(comp-let oreg env form)) ((sys:fbind sys:lbind) me.(comp-fbind oreg env form)) (lambda me.(comp-lambda oreg env form)) @@ -459,6 +460,19 @@ (mac-param-bind form (op value) form me.(comp-return-from oreg env ^(,op nil ,value)))) +(defmeth compiler comp-handler-bind (me oreg env form) + (mac-param-bind form (op func-form ex-syms . body) form + (let* ((ffrag me.(compile oreg env func-form)) + (sreg me.(get-dreg ex-syms)) + (bfrag me.(comp-progn oreg env body))) + (new (frag bfrag.oreg + ^(,*ffrag.code + (handle ,ffrag.oreg ,sreg) + ,*bfrag.code + (end ,bfrag.oreg)) + (uni ffrag.fvars bfrag.fvars) + (uni ffrag.ffuns bfrag.ffuns)))))) + (defmeth compiler comp-let (me oreg env form) (mac-param-bind form (sym raw-vis . body) form (let* ((vis (mapcar [iffi atom list] raw-vis)) -- cgit v1.2.3