diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-05-24 06:48:18 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-05-24 06:48:18 -0700 |
| commit | b4f23d86dd71504405f2f26278941dd8325c14ab (patch) | |
| tree | f25ac7d6f3493f63b34d878e68ca3494732c0839 /stdlib | |
| parent | 8c249e7aa60489b353658c934b0668a045d7fa0c (diff) | |
| download | txr-b4f23d86dd71504405f2f26278941dd8325c14ab.tar.gz txr-b4f23d86dd71504405f2f26278941dd8325c14ab.tar.bz2 txr-b4f23d86dd71504405f2f26278941dd8325c14ab.zip | |
awk: widen scope of redirection macros.
This change makes it possible to use the redirection macros
like -> and ->> everywhere in the awk macro, including the
init-forms of the :let clause.
* stdlib/awk.tl (sys:awk-mac-let-outer): New macro.
(sys:awk-mac-let): Move redirection macros into
awk-mac-let-outer.
(awk): Rearrange the order of wrapping. We split the
let so the awk-retval and aws-sym are bound outermost.
Then we have the outer macros that provide the
redirection operators. Then the application-defined
lets inside of that.
* txr.1: Documented wide scope of redirection macros.
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/awk.tl | 83 |
1 files changed, 44 insertions, 39 deletions
diff --git a/stdlib/awk.tl b/stdlib/awk.tl index 1ce292ef..09065bf7 100644 --- a/stdlib/awk.tl +++ b/stdlib/awk.tl @@ -462,18 +462,21 @@ ^(symacrolet ((f (usr:rslot ,',aws-sym 'fields 'f-to-rec))) (set f (mapcar (opip ,*opip-args) f)))) (fconv (. conv-args) - ^(set f (sys:conv (,*conv-args) f))) - (-> (path . body) + ^(set f (sys:conv (,*conv-args) f)))) + ,*body))) + +(defmacro sys:awk-mac-let-outer (aws-sym . body) + ^(macrolet ((-> (path . body) ^(sys:awk-redir ,',aws-sym *stdout* :outf "w" ,path ,body)) - (->> (path . body) - ^(sys:awk-redir ,',aws-sym *stdout* :apf "a" ,path ,body)) - (<- (path . body) + (->> (path . body) + ^(sys:awk-redir ,',aws-sym *stdout* :apf "a" ,path ,body)) + (<- (path . body) ^(sys:awk-redir ,',aws-sym *stdin* :inf "r" ,path ,body)) - (!> (path . body) + (!> (path . body) ^(sys:awk-redir ,',aws-sym *stdout* :outp "w" ,path ,body)) - (<! (path . body) + (<! (path . body) ^(sys:awk-redir ,',aws-sym *stdin* :inp "r" ,path ,body))) - ,*body))) + ,*body)) (defmacro sys:awk-fun-let (aws-sym . body) ^(flet ((prn (. args) @@ -539,35 +542,37 @@ ,(sys:awk-field-name-code awc aws-sym) ,p-actions-xform))) ^(block ,(or awc.name 'awk) - (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 - (sys:awk-symac-let ,awc - (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 + (let (,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-outer ,aws-sym + (let* ,awc.lets + (sys:awk-mac-let ,awc ,aws-sym + (sys:awk-fun-let ,aws-sym + (sys:awk-symac-let ,awc + (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) + ,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) - ,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)))))))))))) |