diff options
| -rw-r--r-- | share/txr/stdlib/awk.tl | 164 | ||||
| -rw-r--r-- | tests/015/awk-rng.expected | 26 | ||||
| -rw-r--r-- | txr.1 | 17 |
3 files changed, 133 insertions, 74 deletions
diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl index c31d8d0f..2d8c4bc6 100644 --- a/share/txr/stdlib/awk.tl +++ b/share/txr/stdlib/awk.tl @@ -208,6 +208,80 @@ ((regex fun) (call val rec)) (t val))) +(defun sys:awk%--rng (rng-vec idx from-val to-val) + (placelet ((state (vecref rng-vec idx))) + (caseq state + (nil (cond + ((and from-val to-val) nil) + (from-val (set state :mid) nil))) + (:mid (cond + (to-val (set state nil) (not from-val)) + (from-val nil) + (t (set state t)))) + (t (cond + (to-val (set (vecref rng-vec idx) nil) t) + (t t)))))) + +(defun sys:awk%--rng- (rng-vec idx from-val to-val) + (placelet ((state (vecref rng-vec idx))) + (caseq state + (nil (cond + ((and from-val to-val) nil) + (from-val (set state :mid) nil))) + (:mid (cond + (to-val (set state nil)) + (from-val nil) + (t (set state t)))) + (t (cond + (to-val (set (vecref rng-vec idx) nil)) + (t t)))))) + +(defun sys:awk%rng+ (rng-vec idx from-val to-val) + (placelet ((state (vecref rng-vec idx))) + (caseq state + (nil (cond + ((and from-val to-val) (set state :end) t) + (from-val (set state t)))) + (:end (cond + (to-val t) + (from-val (set state t)) + (t (set state nil) nil))) + (t (cond + (to-val (set state :end) t) + (t t)))))) + +(defun sys:awk%-rng+ (rng-vec idx from-val to-val) + (placelet ((state (vecref rng-vec idx))) + (caseq state + (nil (cond + ((and from-val to-val) (set state :end) nil) + (from-val (set state t) nil))) + (:end (cond + (to-val t) + (from-val (set state t) nil) + (t (set state nil) nil))) + (t (cond + (to-val (set state :end) t) + (t t)))))) + +(defun sys:awk%--rng+ (rng-vec idx from-val to-val) + (placelet ((state (vecref rng-vec idx))) + (caseq state + (nil (cond + ((and from-val to-val) (set state :mid) nil) + (from-val (set state :mid) nil))) + (:mid (cond + (to-val (set state :end) (not from-val)) + (from-val nil) + (t (set state t)))) + (:end (cond + (to-val t) + (from-val (set state t) nil) + (t (set state nil) nil))) + (t (cond + (to-val (set state :end) t) + (t t)))))) + (defmacro sys:awk-redir (aws-sym stream-var kind mode path body) (with-gensyms (res-sym) ^(let ((,stream-var (qref ,aws-sym (ensure-stream ,kind ,path, mode)))) @@ -297,19 +371,23 @@ (again () '(return-from :awk-rec :awk-again)) (next-file () '(return-from :awk-file)) (sys:rng (form from-expr to-expr :env e) - (let ((style (car form)) - (need-mid (member (car form) '(--rng --rng- --rng+))) - (need-end (member (car form) '(rng+ -rng+ --rng+))) - (ix (pinc (qref ,awc nranges))) - (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)) - (flag-mid (gensym)) - (from-expr-val (gensym))) + (let* ((style (car form)) + (ix (pinc (qref ,awc nranges))) + (rng-temp (gensym)) + (from-expr-ex (sys:expand from-expr e)) + (from-expr-val (gensym)) + (to-expr-ex (sys:expand to-expr e)) + (to-expr-val (gensym)) + (vec-temp (qref ,awc rng-vec-temp)) + (emul-broken (and (plusp sys:compat) (<= sys:compat 177))) + (rng-fun + (caseq style + (--rng 'sys:awk%--rng) + (--rng- 'sys:awk%--rng-) + (rng+ 'sys:awk%rng+) + (-rng+ 'sys:awk%-rng+) + (--rng+ 'sys:awk%--rng+))) + (state (gensym))) (tree-bind ((from-expr-ex fe-fv fe-ff fe-ev fe-ef) (to-expr-ex te-fv te-ff te-ev te-ef) (from-expr-orig to-expr-orig)) @@ -336,46 +414,26 @@ (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 - ,*(if need-mid ^((,from-expr-val ,from-expr-ex)))) - ,*(if need-mid - ^((set ,flag-act - (caseq ,flag-old - (nil (set ,flag-act (true ,from-expr-val))) - (:end :end) - (:mid :mid) - ((t) (if ,from-expr-val t :mid))))) - ^((cond - (,flag-old (set ,flag-act ,flag-old)) - (,from-expr-ex (set ,flag-act t))))) - ,(if need-end - ^(caseq ,flag-act - ((t ,*(if need-mid '(:mid))) (when ,to-expr-ex - (set ,flag-act :end) - (set ,flag-deact t))) - (:end (cond - (,to-expr-ex (set ,flag-deact t)) - (,(if need-mid from-expr-val from-expr-ex) - (set ,flag-act t ,flag-old nil)) - (t (set ,flag-act nil))))) - ^(when (and ,flag-act ,to-expr-ex) - (set ,flag-act nil) - (set ,flag-deact t))) - ,*(caseq style - ((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) (eq ,flag-act :mid))) - ((--rng --rng+) ^((set ,flag ,flag-act) - (or (eq ,flag-act :mid) ,flag-deact)))))) - (qref ,awc rng-exprs)) + (caseq style + ((--rng --rng- rng+ -rng+ --rng+) + (push + ^(,rng-fun ,vec-temp ,ix ,from-expr-ex ,to-expr-ex) + (qref ,awc rng-exprs))) + (t (push + ^(placelet ((,state (vecref ,(qref ,awc rng-vec-temp) ,ix))) + (let ((,to-expr-val ,to-expr-ex)) + (caseq ,state + (nil (let ((,from-expr-val ,from-expr-ex)) + (cond + ((and ,from-expr-val ,to-expr-val) + ,(if (and (eq style 'rng) (not emul-broken)) t)) + (,from-expr-val (set ,state t) + ,(if (memq style '(rng rng-)) t))))) + (t (cond + (,to-expr-val (set ,state nil) + ,(if (memq style '(rng -rng)) t)) + (t t)))))) + (qref ,awc rng-exprs)))) rng-temp))) (rng (:form form from-expr to-expr) ^(sys:rng ,form diff --git a/tests/015/awk-rng.expected b/tests/015/awk-rng.expected index aa79a932..25c4626b 100644 --- a/tests/015/awk-rng.expected +++ b/tests/015/awk-rng.expected @@ -8,22 +8,22 @@ X2 t t t t t t 1 t t t t t t t t t 2 t t t t t t t t t 3 t t t t t t t t t -Y1 t t t end t t t -r end end t t -s end end t t -Y2 end end t t +Y1 t t t t t t t +r t t t t +s t t t t +Y2 t t t t t Y2 X1X2 t t t -Y1Y2 t t t end t t t +Y1Y2 t t t t t t t X1X2 t t t -Y1 t t t end t t t -a end end t t -Y2 end end t t -X1X2Y1Y2 t t end end t t +Y1 t t t t t t t +a t t t t +Y2 t t t t +X1X2Y1Y2 t t t t t a -X1X2Y1Y2 t t end t t -X1X2Y1Y2 t t end end t t +X1X2Y1Y2 t t t +X1X2Y1Y2 t t t t X1 t t t -b t t t t t t -X2 t t t t t t +b t t t t t t t +X2 t t t t t t t @@ -47280,17 +47280,20 @@ However, the range expression yields .code nil for the entire leading sequence of consecutive records for which .meta from -is true. Regardless of this, it yields true for the last record -for which +is true. If +.meta from +is true of the .meta to -is true. +record which terminates the range, +.code nil +is returned for that record also. .meIP (--rng- < from << to ) This type of range is active under the same conditions as However, the range expression yields .code nil for the entire leading sequence of consecutive records for which .meta from -is true, and also yields nil for the last record which trigger the +is true, and also yields nil for the last record which triggers the .meta to condition. .meIP (rng+ < from << to ) @@ -47326,11 +47329,9 @@ However, the range expression yields .code nil for the entire leading sequence of consecutive records for which .meta from -is true, and for which -.meta to -is false. For the terminating records for which +is true. This is the case even for those for which the .meta to -is true, it yields true. +expression is true. .RE .coNP Macro @ ff |