diff options
| -rw-r--r-- | stdlib/awk.tl | 143 | ||||
| -rw-r--r-- | tests/015/awk-basic.tl | 41 | ||||
| -rw-r--r-- | tests/common.tl | 6 |
3 files changed, 126 insertions, 64 deletions
diff --git a/stdlib/awk.tl b/stdlib/awk.tl index be1c4758..50121736 100644 --- a/stdlib/awk.tl +++ b/stdlib/awk.tl @@ -42,11 +42,13 @@ rec orig-rec fields nf rng-vec (rng-n 0) par-mode par-mode-fs par-mode-prev-fs + rec-to-f (streams (hash :equal-based)) (:fini (self) (dohash (#:k v self.streams) (close-stream v))) (:postinit (self) + self.(upd-rec-to-f) (set self.inputs (or self.inputs (zap *args*) (list *stdin*))) (if (plusp self.rng-n) (set self.rng-vec (vector self.rng-n))) @@ -68,52 +70,62 @@ rng-exprs outer-env) -(defmeth sys:awk-state rec-to-f (self) - (cond - (self.fw - (unless (eq self.fw-prev self.fw) - (let ((ranges (reduce-left - (tb ((list . sum) item) - (let ((ns (+ sum item))) - ^((,*list #R(,sum ,ns)) . ,ns))) - self.fw '(nil . 0)))) - (set self.fw-prev self.fw - self.fw-ranges (car ranges)))) - (let ((i 0) end - (l (length self.rec))) - (set self.fields - (build (each ((r self.fw-ranges)) - (set end (to r)) - (if (>= (from r) l) - (return nil)) - (add [self.rec r]) - (inc i)) - (if (< end l) - (add [self.rec end..:]))) - self.nf i))) - (self.fs - (when self.ft - (awk-error "both fs and ft set")) - (if (and (not self.kfs) (equal self.rec "")) - (set self.fields nil - self.nf 0) - (let ((eff-fs (if self.par-mode - (if (equal self.fs self.par-mode-prev-fs) - self.par-mode-fs - (set self.par-mode-prev-fs self.fs - self.par-mode-fs - (regex-compile ^(or ,(if (regexp self.fs) - (regex-source self.fs) - self.fs) - "\n")))) - self.fs))) - (set self.fields (split-str self.rec eff-fs self.kfs) - self.nf (length self.fields))))) - (self.ft - (set self.fields (tok-str self.rec self.ft self.kfs) - self.nf (length self.fields))) - ((set self.fields (tok-str self.rec #/[^ \t\n]+/ self.kfs) - self.nf (length self.fields))))) +(defmeth sys:awk-state upd-rec-to-f (self) + (set self.rec-to-f + (cond + (self.fw + (unless (eq self.fw-prev self.fw) + (let ((ranges (reduce-left + (tb ((list . sum) item) + (let ((ns (+ sum item))) + ^((,*list #R(,sum ,ns)) . ,ns))) + self.fw '(nil . 0)))) + (set self.fw-prev self.fw + self.fw-ranges (car ranges)))) + (lambda (self) + (let ((i 0) end + (l (length self.rec))) + (set self.fields + (build (each ((r self.fw-ranges)) + (set end (to r)) + (if (>= (from r) l) + (return nil)) + (add [self.rec r]) + (inc i)) + (if (< end l) + (add [self.rec end..:]))) + self.nf i)))) + (self.fs + (when self.ft + (awk-error "both fs and ft set")) + (let ((eff-fs (if self.par-mode + (if (equal self.fs self.par-mode-prev-fs) + self.par-mode-fs + (set self.par-mode-prev-fs self.fs + self.par-mode-fs + (regex-compile ^(or ,(if (regexp self.fs) + (regex-source self.fs) + self.fs) + "\n")))) + self.fs))) + (if self.kfs + (lambda (self) + (set self.fields (split-str self.rec eff-fs t) + self.nf (length self.fields))) + (lambda (self) + (if (equal self.rec "") + (set self.fields nil + self.nf 0) + (set self.fields (split-str self.rec eff-fs nil) + self.nf (length self.fields))))))) + (self.ft + (lambda (self) + (set self.fields (tok-str self.rec self.ft self.kfs) + self.nf (length self.fields)))) + (t + (lambda (self) + (set self.fields (tok-str self.rec #/[^ \t\n]+/ self.kfs) + self.nf (length self.fields))))))) (defmeth sys:awk-state f-to-rec (self) (set self.rec `@{self.fields self.ofs}`)) @@ -147,23 +159,26 @@ (set cached-rr (cond ((and (equal aws.rs "\n") (not aws.krs)) - (set aws.par-mode nil) - (lambda () (get-line *stdin*))) + (set aws.par-mode nil) + aws.(upd-rec-to-f) + (lambda () (get-line *stdin*))) ((null aws.rs) - (set aws.par-mode t) - (let ((rin (record-adapter #/\n[ \n\t]*\n/)) - (flag t)) - (lambda () - (let ((r (get-line rin))) - (cond - (flag - (set flag nil) - (if (equal r "") - (get-line rin) - r)) - (t r)))))) + (set aws.par-mode t) + aws.(upd-rec-to-f) + (let ((rin (record-adapter #/\n[ \n\t]*\n/)) + (flag t)) + (lambda () + (let ((r (get-line rin))) + (cond + (flag + (set flag nil) + (if (equal r "") + (get-line rin) + r)) + (t r)))))) (t (set aws.par-mode nil) + aws.(upd-rec-to-f) (let ((rin (record-adapter (if (regexp aws.rs) aws.rs (regex-compile ^(compound, aws.rs))) @@ -377,10 +392,10 @@ (fname (qref ,aws-sym file-name)) (rs (qref ,aws-sym rs)) (krs (qref ,aws-sym krs)) - (fs (qref ,aws-sym fs)) - (ft (qref ,aws-sym ft)) - (fw (qref ,aws-sym fw)) - (kfs (qref ,aws-sym kfs)) + (fs (usr:rslot ,aws-sym 'fs 'upd-rec-to-f)) + (ft (usr:rslot ,aws-sym 'ft 'upd-rec-to-f)) + (fw (usr:rslot ,aws-sym 'fw 'upd-rec-to-f)) + (kfs (usr:rslot ,aws-sym 'kfs 'upd-rec-to-f)) (ofs (qref ,aws-sym ofs)) (ors (qref ,aws-sym ors))) (macrolet ((next () '(return-from :awk-rec)) diff --git a/tests/015/awk-basic.tl b/tests/015/awk-basic.tl new file mode 100644 index 00000000..a411d495 --- /dev/null +++ b/tests/015/awk-basic.tl @@ -0,0 +1,41 @@ +(load "../common") + +(defvarl *d0* + '("one two three" + " four five six " + " seven eight \t nine ten\t ")) + +(motest + (awk (:inputs *d0*) + (t (prn nf))) + "3\n3\n4\n" + (awk (:inputs *d0*) + (:set ofs ",") + (t (set f f) + (prn))) + "one,two,three\nfour,five,six\nseven,eight,nine,ten\n" + (awk (:inputs *d0*) + (:set ofs "," fs #/[\t ]+/) + (t (set f f) + (prn))) + "one,two,three\n,four,five,six,\n,seven,eight,nine,ten,\n" + (awk (:inputs *d0*) + (:set ofs "," fs #/[\t ]+/ kfs t) + (t (set f f) + (prn))) + "one, ,two, ,three\n, ,four, ,five, ,six, ,\n, ,seven, ,eight, \t ,nine, ,ten,\t ,\n" + (awk (:inputs *d0*) + (:set ofs "," fs #/[\t ]+/ kfs t fw '(3 2 2)) + (t (set f f) + (prn))) + "one, t,wo, three\n fo,ur, f,ive six \n ,se,ve,n eight \t nine ten\t \n" + (awk (:inputs *d0*) + (:set ofs "," fs #/[\t ]+/ ft #/./) + (t (set f f) + (prn))) + :error + (awk (:inputs *d0*) + (:set ofs "," ft #/[a-z]+/) + (t (set f f) + (prn))) + "one,two,three\nfour,five,six\nseven,eight,nine,ten\n") diff --git a/tests/common.tl b/tests/common.tl index 57f411fa..8e73faee 100644 --- a/tests/common.tl +++ b/tests/common.tl @@ -95,3 +95,9 @@ (progn ,*body) (close-stream ,stream-var) (remove-path ,name-var)))) + +(defmacro otest (expr expected-output) + ^(vtest (with-out-string-stream (*stdout*) ,expr) ',expected-output)) + +(defmacro motest (. pairs) + ^(progn ,*(mapcar (op cons 'otest) (tuples 2 pairs)))) |