summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2016-12-01 06:49:26 -0800
committerKaz Kylheku <kaz@kylheku.com>2016-12-01 06:49:26 -0800
commit98ee5f2a78af025538662cd3aab877a405cb97f1 (patch)
treea517afa3a99a0666ca5463c2ce71ba663a28fb30 /share
parent203b85801e0bade02af3b9e09205041e97771799 (diff)
downloadtxr-98ee5f2a78af025538662cd3aab877a405cb97f1.tar.gz
txr-98ee5f2a78af025538662cd3aab877a405cb97f1.tar.bz2
txr-98ee5f2a78af025538662cd3aab877a405cb97f1.zip
Awk macro prn becomes function.
* share/txr/stdlib/awk.tl (sys:awk-let): Renamed to sys:awk-mac-let. Macrolet prn removed from here. (sys:awk-fun-let): New macro, provides awk functions. The prn function removed from sys:awk-mac-let is generated here. (sys:awk-fun-shadowing-env): New function. (awk): Follow rename of sys:awk-let. When expanding p-action forms, use only sys:awk-mac-let; do not include the awk functions, which do not "vaporize" unlike local macros. To compensate for not including the functions, extend the macro environment with one that shadows the functions, so that during this expansion, any global macros of the same name as awk local functions are properlly hidden. In the final expansion, include the awk functions. * txr.1: Updated documentation to consistently call prn an awk function everywhere.
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/awk.tl86
1 files changed, 47 insertions, 39 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)))))))))