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.

1 files changed, 14 insertions, 0 deletions

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))