diff options
| -rw-r--r-- | stdlib/awk.tl | 78 | ||||
| -rw-r--r-- | tests/015/awk-fields.tl | 18 | ||||
| -rw-r--r-- | txr.1 | 34 |
3 files changed, 100 insertions, 30 deletions
diff --git a/stdlib/awk.tl b/stdlib/awk.tl index a2150b89..497b9e17 100644 --- a/stdlib/awk.tl +++ b/stdlib/awk.tl @@ -59,6 +59,7 @@ begin-file-actions end-file-actions begin-actions end-actions cond-actions + field-names (nranges 0) (rng-rec-temp (gensym)) (rng-vec-temp (gensym)) @@ -322,6 +323,15 @@ (:begin-file (push actions awc.begin-file-actions)) (:set-file (push ^((set ,*actions)) awc.begin-actions)) (:end-file (push actions awc.end-file-actions)) + (:fields + (when awc.field-names + (awk-error "duplicate :fields clauses")) + (whenlet ((fn (member-if [notf bindable] actions))) + (awk-error "~s isn't a valid field name" (car fn))) + (let ((syms (remq '- actions))) + (unless (equal syms (uniq syms)) + (awk-error "duplicate field names"))) + (set awc.field-names actions)) (t (push (if actions cl ^(,pattern (prn))) @@ -464,6 +474,13 @@ (qref ,aws-sym (prn . args)))) ,*body)) +(defmacro sys:awk-symac-let (awc . body) + ^(symacrolet ,(append-each ((fn awc.field-names) + (ix 0)) + (if (neq fn '-) + (list ^(,fn [f ,ix])))) + ,*body)) + (defun sys:awk-fun-shadowing-env (up-env) (make-env nil '((prn . sys:special)) up-env)) @@ -485,34 +502,35 @@ 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 + (sys:awk-symac-let ,awc + (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) + (,awc.rng-vec-temp (qref ,aws-sym rng-vec)) + ,*(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) - (,awc.rng-vec-temp (qref ,aws-sym rng-vec)) - ,*(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)))))))))) diff --git a/tests/015/awk-fields.tl b/tests/015/awk-fields.tl new file mode 100644 index 00000000..7f27e9e4 --- /dev/null +++ b/tests/015/awk-fields.tl @@ -0,0 +1,18 @@ +(load "../common") + +(mtest + (awk (:fields) (:begin (return-from awk))) nil + (awk (:fields t) (:begin (return-from awk))) :error + (awk (:fields nil) (:begin (return-from awk))) :error + (awk (:fields - -) (:begin (return-from awk))) nil + (awk (:fields a - - b) (:begin (return-from awk))) nil + (awk (:fields a - - a) (:begin (return-from awk))) :error + (awk (:fields a) (:fields b) (:begin (return-from awk))) :error) + +(test + (build + (awk + (:inputs '("How now brown cow")) + (:fields h n - c) + (t (add h n c)))) + ("How" "now" "cow")) @@ -64061,6 +64061,40 @@ clause performs a nonlocal transfer, .code :end-file processing is not triggered, because the processing of the input source is deemed not to have taken place. + +.meIP (:fields << sym *) +The +.code :fields +clause may be used to give symbolic names to fields. Every +.meta sym +argument must be either a bindable symbol. The symbol +.code - +has a special meaning. Symbols other than +.code - +may not be repeated, and the +.code :fields +clause may appear at most once in a given instance of the +.code awk +macro. +Each entry in the +.meta sym +list is understood to correspond to a field expression for a successive field, +starting with the leftmost +.meta sym +corresponding with the first field, +.codn "[f 0]" . +Each +.meta sym +other than +.code - +becomes the name of a symbol macro which denotes its corresponding +field expression, expanded over the scope of the +.code awk +macro. The +.code - +symbol is a place holder which doesn't bind a symbol macro to the +corresponding field. + .meIP >> ( condition << action *) Clauses which do not have one of the specially recognized keywords in the first position are ordinary condition-action clauses. After |