diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2017-10-26 00:02:59 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2017-10-26 00:02:59 -0700 |
commit | 0f815d2e4552c71783f302189c67db8ad34343fb (patch) | |
tree | 03b92f4c7ecaf75579e4048da9ec10063aec4903 | |
parent | d066056a22bfea38901da258bd039fc4588c8251 (diff) | |
download | txr-0f815d2e4552c71783f302189c67db8ad34343fb.tar.gz txr-0f815d2e4552c71783f302189c67db8ad34343fb.tar.bz2 txr-0f815d2e4552c71783f302189c67db8ad34343fb.zip |
awk: bugfix: lack of hygiene in range implementation.
The code is using a non-hygienic variable called flag
as a placelet alias. This binding is visible to range
expressions. For instance (rng #/x/ flag) actually
references the range expression's internal flag, rather
than producing a warning about an unbound variable.
* share/txr/stdlib/awk.tl (sys:awk-mac-let): Allocate a gensym
for the flag. Then use ,flag throughout the code templates
rather than flag to insert the gensym wherever the symbol
flag previously appeared.
-rw-r--r-- | share/txr/stdlib/awk.tl | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl index 88509ccd..57ac3b1b 100644 --- a/share/txr/stdlib/awk.tl +++ b/share/txr/stdlib/awk.tl @@ -304,6 +304,7 @@ (rng-temp (gensym)) (from-expr-ex (sys:expand from-expr e)) (to-expr-ex (sys:expand to-expr e)) + (flag (gensym)) (flag-old (gensym)) (flag-act (gensym)) (flag-deact (gensym)) @@ -335,8 +336,8 @@ (set-diff te-ef te-ff) 'functions) (push rng-temp (qref ,awc rng-expr-temps)) - (push ^(placelet ((flag (vecref ,(qref ,awc rng-vec-temp) ,ix))) - (let ((,flag-old flag) ,flag-act ,flag-deact + (push ^(placelet ((,flag (vecref ,(qref ,awc rng-vec-temp) ,ix))) + (let ((,flag-old ,flag) ,flag-act ,flag-deact ,*(if need-mid ^(,flag-mid (,from-expr-val ,from-expr-ex)))) ,*(if need-mid ^((when (and ,flag-old (not ,from-expr-val)) @@ -367,17 +368,17 @@ ,*(if need-mid ^((set ,flag-mid nil))))) ,*(caseq style - ((rng rng+) ^((or (set flag ,flag-act) + ((rng rng+) ^((or (set ,flag ,flag-act) ,(if (and (plusp sys:compat) (<= sys:compat 177)) flag-old flag-deact)))) - (-rng- ^((and (set flag ,flag-act) ,flag-old))) - (rng- ^((set flag ,flag-act))) - (-rng ^((set flag ,flag-act) ,flag-old)) - (-rng+ ^((set flag ,flag-act) (if ,flag-act ,flag-old))) - (--rng- ^((set flag ,flag-act) ,flag-mid)) - ((--rng --rng+) ^((set flag ,flag-act) (or ,flag-mid ,flag-deact)))))) + (-rng- ^((and (set ,flag ,flag-act) ,flag-old))) + (rng- ^((set ,flag ,flag-act))) + (-rng ^((set ,flag ,flag-act) ,flag-old)) + (-rng+ ^((set ,flag ,flag-act) (if ,flag-act ,flag-old))) + (--rng- ^((set ,flag ,flag-act) ,flag-mid)) + ((--rng --rng+) ^((set ,flag ,flag-act) (or ,flag-mid ,flag-deact)))))) (qref ,awc rng-exprs)) rng-temp))) (rng (:form form from-expr to-expr) |