diff options
| -rw-r--r-- | share/txr/stdlib/awk.tl | 86 | ||||
| -rw-r--r-- | txr.1 | 21 |
2 files changed, 60 insertions, 47 deletions
diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl index d36426f3..b6f26c01 100644 --- a/share/txr/stdlib/awk.tl +++ b/share/txr/stdlib/awk.tl @@ -238,7 +238,7 @@ awc.cond-actions (nreverse awc.cond-actions)) awc)) -(defmacro sys:awk-let (awc aws-sym . body) +(defmacro sys:awk-mac-let (awc aws-sym . body) ^(symacrolet ((rec (rslot ,aws-sym 'rec 'rec-to-f)) (orec (rslot ,aws-sym 'orig-rec 'rec-to-f)) (f (rslot ,aws-sym 'fields 'f-to-rec)) @@ -255,7 +255,6 @@ (ors (qref ,aws-sym ors))) (macrolet ((next () '(return-from :awk-rec)) (next-file () '(return-from :awk-file)) - (prn (. args) ^(qref ,',aws-sym (prn ,*args))) (sys:rng (from-expr to-expr :env e) (let ((ix (pinc (qref ,awc nranges))) (rng-temp (gensym)) @@ -296,6 +295,14 @@ ^(sys:awk-redir ,',aws-sym *stdin* :inp "w" ,path ,body))) ,*body))) +(defmacro sys:awk-fun-let (aws-sym . body) + ^(flet ((prn (. args) + (qref ,aws-sym (prn . args)))) + ,*body)) + +(defun sys:awk-fun-shadowing-env (up-env) + (make-env nil '((prn . sys:special)) up-env)) + (defmacro awk (:env e . clauses) (let ((awc (sys:awk-expander clauses))) (with-gensyms (aws-sym awk-begf-fun awk-fun awk-endf-fun awk-retval) @@ -303,43 +310,44 @@ ,*@rest)) awc.cond-actions)) (p-actions-xform (sys:expand - ^(sys:awk-let ,awc ,aws-sym + ^(sys:awk-mac-let ,awc ,aws-sym ,*p-actions-xform-unex) - e))) + (sys:awk-fun-shadowing-env e)))) ^(block ,(or awc.name 'awk) - (let* (,*awc.lets ,awk-retval) - (sys:awk-let ,awc ,aws-sym - (let* ((,aws-sym (new sys:awk-state - ,*(if awc.inputs ^(inputs (list ,*awc.inputs))) - ,*(if awc.output ^(output ,awc.output)) - rng-n (macro-time (qref ,awc nranges)))) - ,*(if awc.output - ^((*stdout* (qref ,aws-sym output)))) - ,*(if (and awc.cond-actions awc.begin-file-actions) - ^((,awk-begf-fun (lambda (,aws-sym) - ,*awc.begin-file-actions)))) - ,*(if (and awc.cond-actions awc.end-file-actions) - ^((,awk-endf-fun (lambda (,aws-sym) - ,*awc.end-file-actions)))) - ,*(if (or awc.cond-actions awc.begin-file-actions + (let* (,*awc.lets ,awk-retval + (,aws-sym (new sys:awk-state + ,*(if awc.inputs ^(inputs (list ,*awc.inputs))) + ,*(if awc.output ^(output ,awc.output)) + rng-n (macro-time (qref ,awc nranges))))) + (sys:awk-mac-let ,awc ,aws-sym + (sys:awk-fun-let ,aws-sym + (let* (,*(if awc.output + ^((*stdout* (qref ,aws-sym output)))) + ,*(if (and awc.cond-actions awc.begin-file-actions) + ^((,awk-begf-fun (lambda (,aws-sym) + ,*awc.begin-file-actions)))) + ,*(if (and awc.cond-actions awc.end-file-actions) + ^((,awk-endf-fun (lambda (,aws-sym) + ,*awc.end-file-actions)))) + ,*(if (or awc.cond-actions awc.begin-file-actions + awc.end-file-actions awc.end-actions) + ^((,awk-fun (lambda (,aws-sym) + ,(if awc.rng-exprs + ^(let* ((,awc.rng-rec-temp rec) + ,*(nreverse + (zip awc.rng-expr-temps + awc.rng-exprs))) + ,p-actions-xform) + p-actions-xform)))))) + ,*awc.begin-actions + (unwind-protect + ,(if (or awc.cond-actions awc.begin-file-actions awc.end-file-actions awc.end-actions) - ^((,awk-fun (lambda (,aws-sym) - ,(if awc.rng-exprs - ^(let* ((,awc.rng-rec-temp rec) - ,*(nreverse - (zip awc.rng-expr-temps - awc.rng-exprs))) - ,p-actions-xform) - p-actions-xform)))))) - ,*awc.begin-actions - (unwind-protect - ,(if (or awc.cond-actions awc.begin-file-actions - awc.end-file-actions awc.end-actions) - ^(qref ,aws-sym (loop ,awk-fun - ,(if awc.begin-file-actions - awk-begf-fun) - ,(if awc.end-file-actions - awk-endf-fun)))) - (set ,awk-retval (progn ,*awc.end-actions)) - (call-finalizers ,aws-sym)) - ,awk-retval)))))))) + ^(qref ,aws-sym (loop ,awk-fun + ,(if awc.begin-file-actions + awk-begf-fun) + ,(if awc.end-file-actions + awk-endf-fun)))) + (set ,awk-retval (progn ,*awc.end-actions)) + (call-finalizers ,aws-sym)) + ,awk-retval))))))))) @@ -41267,7 +41267,7 @@ forms, the .code awk macro substitutes the single action equivalent to the form .codn "(prn)" : -a call to the local awk macro +a call to the local awk function .codn prn . The behavior of this macro, when called with no arguments, as above, is to print the current @@ -41328,10 +41328,15 @@ If multiple clauses are present, they are effectively consolidated into a single clause, in the order they appear. -Note that the lexical variables and macros established by the +Note that the lexical variables, functions and macros established by the .code awk macro -(awk macros and awk variables) are in an inner scope relative to +(called, respectively, +.IR "awk macros" , +.I "awk functions" +and +.IR "awk variables" ) +are in an inner scope relative to .code :let bindings. For instance if .code :let @@ -42055,7 +42060,7 @@ consisting of a single space character. When the .code prn -macro prints two or more arguments, or fields, +function prints two or more arguments, or fields, the value of .code ofs is used to separate them. @@ -42081,7 +42086,7 @@ variable in Awk. Each call to the .code prn -macro terminates its output by emitting the value of +function terminates its output by emitting the value of .codn ors . The initial value of @@ -42089,14 +42094,14 @@ The initial value of is a character string consisting of a single newline, and so the .code prn -macro prints lines. +function prints lines. -.coNP Macro @ prn +.coNP Function @ prn .synb .mets (prn << form *) .syne .desc -The awk macro +The awk function .code prn performs output into the .code *stdout* |