awk: five new range operators.

* share/txr/stdlib/awk.tl (sys;awk-mac-let): Provide the
implementation for the local macros --rng, --rng-,
rng+, -rng+ and --rng+.

* tests/015/awk-rng.tl: New file.

* tests/015/awk-rng.expected: New file.

* txr.1: Documented.

1 files changed, 63 insertions, 12 deletions

diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl
index 6b2f6ee2..57e7c271 100644
--- a/share/txr/stdlib/awk.tl
+++ b/share/txr/stdlib/awk.tl
@@ -297,13 +297,17 @@
                 (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-old (gensym))
                         (flag-act (gensym))
-                        (flag-deact (gensym)))
+                        (flag-deact (gensym))
+                        (flag-mid (gensym))
+                        (from-expr-val (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))
@@ -331,21 +335,48 @@
                                                'functions)
                       (push rng-temp (qref ,awc rng-expr-temps))
                       (push ^(placelet ((flag (vecref (qref ,',aws-sym rng-vec) ,ix)))
-                               (let ((,flag-old flag) ,flag-act ,flag-deact)
-                                 (when (or ,flag-old ,from-expr-ex)
-                                   (set ,flag-act t))
-                                 (when (and ,flag-act ,to-expr-ex)
-                                   (set ,flag-act nil)
-                                   (set ,flag-deact t))
+                               (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))
+                                         (set ,flag-mid t))
+                                       (cond
+                                         (,flag-old (set ,flag-act ,flag-old))
+                                         (,from-expr-val (set ,flag-act t))))
+                                    ^((cond
+                                        (,flag-old (set ,flag-act ,flag-old))
+                                        (,from-expr-ex (set ,flag-act t)))))
+                                 ,(if need-end
+                                    ^(caseq ,flag-act
+                                       ((t) (when ,to-expr-ex
+                                              (set ,flag-act :end)
+                                              (set ,flag-deact t)
+                                              ,*(if need-mid
+                                                  ^((set ,flag-mid nil)))))
+                                       (: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)))
+                                             ,*(if need-mid
+                                                 ^((set ,flag-mid nil)))))
+                                    ^(when (and ,flag-act ,to-expr-ex)
+                                       (set ,flag-act nil)
+                                       (set ,flag-deact t)
+                                       ,*(if need-mid
+                                           ^((set ,flag-mid nil)))))
                                  ,*(caseq style
-                                     (rng ^((or (set flag ,flag-act)
-                                                ,(if (and (plusp sys:compat)
+                                     ((rng rng+) ^((or (set flag ,flag-act)
+                                                       ,(if (and (plusp sys:compat)
                                                           (<= sys:compat 177))
-                                                   flag-old
-                                                   flag-deact))))
+                                                          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) ,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)
@@ -364,6 +395,26 @@
                   ^(sys:rng ,form
                             (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
                             (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
+                (--rng (:form form from-expr to-expr)
+                  ^(sys:rng ,form
+                            (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
+                            (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
+                (--rng- (:form form from-expr to-expr)
+                  ^(sys:rng ,form
+                            (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
+                            (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
+                (rng+ (:form form from-expr to-expr)
+                  ^(sys:rng ,form
+                            (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
+                            (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
+                (-rng+ (:form form from-expr to-expr)
+                  ^(sys:rng ,form
+                            (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
+                            (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
+                (--rng+ (:form form from-expr to-expr)
+                  ^(sys:rng ,form
+                            (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
+                            (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
                 (ff (. opip-args)
                   ^(symacrolet ((f (rslot ,',aws-sym 'fields 'f-to-rec)))
                      (set f [(opip ,*opip-args) f])))