compiler: handle dohash special form

* share/txr/stdlib/compiler.tl (compiler compile): Handle
dohash by rewriting the form via expand-dohash, then compiling
result.
(expand-dohash): New function.

1 files changed, 12 insertions, 0 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 986902a3..fdbf0138 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -153,6 +153,7 @@
             (progn me.(comp-progn oreg env (cdr form)))
             (prog1 me.(comp-prog1 oreg env form))
             (sys:quasi me.(comp-quasi oreg env form))
+            (dohash me.(compile oreg env (expand-dohash form)))
             (sys:dvbind me.(compile oreg env (caddr form)))
             (sys:with-dyn-rebinds me.(comp-progn oreg env (cddr form)))
             ((macrolet symacrolet macro-time)
@@ -604,6 +605,17 @@
   (let ((qa (expand-quasi-args form)))
     ^(append ,*qa)))
 
+(defun expand-dohash (form)
+  (mac-param-bind form (op (key-var val-var hash-form : res-form) . body) form
+    (with-gensyms (iter-var cell-var)
+      ^(let (,key-var ,val-var (,iter-var (hash-begin ,hash-form)) ,cell-var)
+         (sys:for-op ((sys:setq ,cell-var (hash-next ,iter-var)))
+                     (,cell-var ,res-form)
+                     ((sys:setq ,cell-var (hash-next ,iter-var)))
+            (sys:setq ,key-var (car ,cell-var))
+            (sys:setq ,val-var (cdr ,cell-var))
+            ,*body)))))
+
 (defun usr:compile-toplevel (exp)
   (let ((co (new compiler))
         (as (new assembler)))