awk macro: revise rng eval strategy.

awk ranges must evaluate out-of-band after the
record is read, before the patterns and actions
are evaluated.

* share/txr/stdlib/awk.tl (sys:awk-compile-time): New slots,
rng-expr-temps and rng-exprs.
(sys:awk-let): Stash the code for evaluating a range into
the compile-time info into the rng-exprs list, and associate
it with a gensym in the parallel rng-expr-temps list.
Then emit that gensym as the expansion for the rng form.
(awk): Process the pattern code in two steps. First, expand
it, to get it to drop the rng-exprs into the awk compile-time
info structure. Then when generating the final lambda,
wrap an let* around the generated code which
binds the rng-temps with the rng-exprs. This resolves the
gensym references that replaced the ranges. let* is is used
and its bindings are reversed into discovery order because
this supports nested rng syntax. Given (rng x (rng y z)), the
(rng y z) is expanded first, and so its code and temp gensym
are pushed onto their respective lists firsts.  The outer
rng's code will thus contain a temp referring to the
code of the inner one.

1 files changed, 43 insertions, 24 deletions

diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl
index d7aa6891..a2d03361 100644
--- a/share/txr/stdlib/awk.tl
+++ b/share/txr/stdlib/awk.tl
@@ -41,7 +41,9 @@
       (set self.output (open-file self.output "w")))))
 
 (defstruct sys:awk-compile-time ()
-  (nranges 0))
+  (nranges 0)
+  rng-expr-temps
+  rng-exprs)
 
 (defmeth sys:awk-state rec-to-f (self)
   (cond
@@ -137,31 +139,48 @@
      (macrolet ((next () '(return-from :awk-rec))
                 (next-file () '(return-from :awk-file))
                 (prn (. args) ^(qref ,',aws-sym (prn ,*args)))
-                (rng (from-expr to-expr)
-                  (let ((ix (pinc (qref ,awc nranges))))
-                    ^(symacrolet ((flag (vecref (qref ,',aws-sym rng-vec) ,ix)))
-                       (cond
-                         (,from-expr (set flag t))
-                         (,to-expr (zap flag) t)
-                         (flag))))))
+                (rng (from-expr to-expr :env e)
+                  (let ((ix (pinc (qref ,awc nranges)))
+                        (rng-temp (gensym))
+                        (from-expr-ex (sys:expand from-expr e))
+                        (to-expr-ex (sys:expand to-expr e)))
+                    (push rng-temp (qref ,awc rng-expr-temps))
+                    (push ^(symacrolet ((flag (vecref (qref ,',aws-sym rng-vec) ,ix)))
+                             (cond
+                               (,from-expr-ex (set flag t))
+                               (,to-expr-ex (zap flag) t)
+                               (flag)))
+                          (qref ,awc rng-exprs))
+                    rng-temp)))
        ,*body)))
 
-(defmacro awk (. clauses)
+(defmacro awk (:env e . clauses)
   (tree-bind (awc inputs output name lets b-actions e-actions p-actions)
              (sys:awk-expander clauses)
     (with-gensyms (aws-sym awk-fun awk-retval)
-      ^(let* (,*lets ,awk-retval)
-         (let ((,awk-fun (lambda (,aws-sym)
-                           (sys:awk-let ,awc ,aws-sym
-                             ,*(mapcar (aret ^(when ,@1 ,*@rest)) p-actions))))
-               (,aws-sym (new sys:awk-state
-                              ,*(if inputs ^(inputs (list ,*inputs)))
-                              ,*(if output ^(output ,output))
-                              rng-n (macro-time (qref ,awc nranges)))))
-           (sys:awk-let ,awc ,aws-sym
-             ,*b-actions)
-           (block ,name
-             (unwind-protect
-               (qref ,aws-sym (loop ,awk-fun))
-               (set ,awk-retval (progn ,*e-actions)))
-             ,awk-retval))))))
+      (let* ((p-actions-xform-unex (mapcar (aret ^(when ,@1 ,*@rest))
+                                           p-actions))
+             (p-actions-xform (sys:expand
+                                ^(sys:awk-let ,awc ,aws-sym
+                                   ,*p-actions-xform-unex)
+                                e)))
+        ^(let* (,*lets ,awk-retval)
+           (let* ((,aws-sym (new sys:awk-state
+                                ,*(if inputs ^(inputs (list ,*inputs)))
+                                ,*(if output ^(output ,output))
+                                rng-n (macro-time (qref ,awc nranges))))
+                  (,awk-fun (lambda (,aws-sym)
+                              (sys:awk-let ,awc ,aws-sym
+                                ,(if awc.rng-exprs
+                                   ^(let* ,(nreverse
+                                             (zip awc.rng-expr-temps
+                                                  awc.rng-exprs))
+                                      ,p-actions-xform)
+                                   p-actions-xform)))))
+             (sys:awk-let ,awc ,aws-sym
+               ,*b-actions)
+             (block ,name
+               (unwind-protect
+                 (qref ,aws-sym (loop ,awk-fun))
+                 (set ,awk-retval (progn ,*e-actions)))
+               ,awk-retval)))))))