From 97a17b79dd558c8ee8648a0acf2d50299e3c5125 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 8 Sep 2016 06:33:30 -0700 Subject: Range operators for awk macro. * share/txr/stdlib/awk.tl (sys:awk-state): New slot, rng-vec: holds boolean flags for ranges. New slot, rng-n, holds size for rng-vec. New :postinit handler for creating vector for rng-vec. (sys:awk-compile-time): New struct. (sys:awk-expander): Construct an awk compile time, and return that as one of the values. (sys:awk-let): Provide (rng) local macro: the two argument range operator. Generates code and keeps track of number of ranges and their association to a position in rng-vec using the compile-time info structure. (awk): Capture awk compile-time object from expander. Initialize rng-n slot of awk state with number of ranges indicated in compile time info. Pass compile-time info to awk:let macro. Binding of lambda and of awk state had to be reordered because macro-expansion of the lambda fills in the compile time info which is then used in the expansion of the constructing expression for the awk state. --- share/txr/stdlib/awk.tl | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl index dc19a55a..f625fa53 100644 --- a/share/txr/stdlib/awk.tl +++ b/share/txr/stdlib/awk.tl @@ -32,7 +32,13 @@ (file-num 0) (file-rec-num 0) (rec-num 0) - rec fields nf) + rec fields nf rng-vec (rng-n 0) + (:postinit (self) + (if (plusp self.rng-n) + (set self.rng-vec (vector self.rng-n))))) + +(defstruct sys:awk-compile-time () + (nranges 0)) (defmeth sys:awk-state rec-to-f (self) (cond @@ -107,13 +113,14 @@ ^(,pattern (prn))) pattern-actions)))) (junk (throwf 'eval-error "awk: bad clause syntax ~s" junk)))) - (list inputs output name + (list (new sys:awk-compile-time) + inputs output name [apply append (nreverse lets)] [apply append (nreverse begin-actions)] [apply append (nreverse end-actions)] (nreverse pattern-actions)))) -(defmacro sys:awk-let (aws-sym . body) +(defmacro sys:awk-let (awc aws-sym . body) ^(symacrolet ((rec (rslot ,aws-sym 'rec 'rec-to-f)) (f (rslot ,aws-sym 'fields 'f-to-rec)) (nf (rslot ,aws-sym 'nf 'nf-to-f)) @@ -125,21 +132,29 @@ (ofs (qref ,aws-sym ofs))) (macrolet ((next () '(return-from :awk-rec)) (next-file () '(return-from :awk-file)) - (prn (. args) ^(qref ,',aws-sym (prn ,*args)))) + (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)))))) ,*body))) (defmacro awk (. clauses) - (tree-bind (inputs output name lets b-actions e-actions p-actions) + (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 ((,aws-sym (new sys:awk-state + (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)))) - (,awk-fun (lambda (,aws-sym) - (sys:awk-let ,aws-sym - ,*(mapcar (aret ^(when ,@1 ,*@rest)) p-actions))))) - (sys:awk-let ,aws-sym + ,*(if output ^(output ,output)) + rng-n (macro-time (qref ,awc nranges))))) + (sys:awk-let ,awc ,aws-sym ,*b-actions) (block ,name (unwind-protect -- cgit v1.2.3