From 0da50195d575904acf55e363117ad98db242923b Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 4 Oct 2021 22:05:52 -0700
Subject: awk: :fields specifies conversions.
* stdlib/awk.tl (sys:awk-compile-time): Slot field-names renamed to
field-name-conv.
(sys:awk-expander): Parse the new syntax which allows (sym fn)
pairs with optional fn, creating a list of normalized items
in the field-name-conv slot of the compile-time structure.
(sys:awk-symac-let): Adjust the code to the pair representation in
field-name-conv.
(sys:awk-field-name-code): New function for generating the
field conversion code.
(awk): Now that we have two optional pieces of code to wrap around
p-actions form, we factor that out of the awk-lambda, to a series
of conditional assignments. Here we handle the generation of the
field conversionns.
* conv.tl (sys:conv-expand-sym): New macro, used in
sys:awk-field-name-code and sys:conv-let.
(sys:conv-let): Simplify with sys:conv-expand-sym. Drop optional
argument from i; it connects with no documented feature, and is
not usable from fconv.
* tests/015/awk-fields.tl: New tests.
* txr.1: Updated, including cruft in fconv documentation.
Change-Id: Ie42819f58af039fdbcdb1ae365c89dc1add55c93
---
stdlib/awk.tl | 77 ++++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 58 insertions(+), 19 deletions(-)
(limited to 'stdlib/awk.tl')
diff --git a/stdlib/awk.tl b/stdlib/awk.tl
index 497b9e17..5eb409d3 100644
--- a/stdlib/awk.tl
+++ b/stdlib/awk.tl
@@ -59,7 +59,7 @@
begin-file-actions end-file-actions
begin-actions end-actions
cond-actions
- field-names
+ field-name-conv
(nranges 0)
(rng-rec-temp (gensym))
(rng-vec-temp (gensym))
@@ -324,14 +324,24 @@
(:set-file (push ^((set ,*actions)) awc.begin-actions))
(:end-file (push actions awc.end-file-actions))
(:fields
- (when awc.field-names
+ (when awc.field-name-conv
(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))
+ (let ((fnames
+ (collect-each ((fn actions))
+ (match-case fn
+ (@(bindable @sym) (list sym))
+ ((@(bindable @sym) @(bindable @fun))
+ (if (eq sym '-)
+ (awk-error "type given for unnamed field"))
+ fn)
+ ((@(bindable) @type)
+ (awk-error "bad fconv function: ~s" type))
+ (@else (awk-error "bad :fields item: ~s"
+ else))))))
+ (let ((nodash [remq '- fnames car]))
+ (unless (equal nodash [unique nodash car])
+ (awk-error "duplicate field names")))
+ (set awc.field-name-conv fnames)))
(t (push (if actions
cl
^(,pattern (prn)))
@@ -475,12 +485,34 @@
,*body))
(defmacro sys:awk-symac-let (awc . body)
- ^(symacrolet ,(append-each ((fn awc.field-names)
+ ^(symacrolet ,(append-each ((fn awc.field-name-conv)
(ix 0))
- (if (neq fn '-)
- (list ^(,fn [f ,ix]))))
+ (if (neq (car fn) '-)
+ (list ^(,(car fn) [f ,ix]))))
,*body))
+(defun sys:awk-field-name-code (awc aws-sym)
+ (with-gensyms (fiter)
+ (let* ((nf 0)
+ (code (append-each ((fnc awc.field-name-conv)
+ (i 0))
+ (set nf (succ i))
+ (if (cadr fnc)
+ ^((rplaca ,fiter
+ (sys:conv-expand-sym ,(cadr fnc)
+ (car ,fiter)))
+ (set ,fiter (cdr ,fiter)))
+ ^((set ,fiter (cdr ,fiter)))))))
+ (while-match @(end ((set . @nil))) code
+ (upd code butlast))
+ ^(let ((,fiter (qref ,aws-sym fields)))
+ (if (< (len ,fiter) ,nf)
+ (set ,fiter (take ,nf (append ,fiter (repeat '(""))))
+ (qref ,aws-sym fields) ,fiter
+ (qref ,aws-sym nf) ,nf))
+ ,*code
+ (qref ,aws-sym (f-to-rec))))))
+
(defun sys:awk-fun-shadowing-env (up-env)
(make-env nil '((prn . sys:special)) up-env))
@@ -494,6 +526,20 @@
^(sys:awk-mac-let ,awc ,aws-sym
,*p-actions-xform-unex)
(sys:awk-fun-shadowing-env outer-env))))
+ (if awc.rng-exprs
+ (set p-actions-xform
+ ^(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)))
+ (if (and awc.field-name-conv
+ [some awc.field-name-conv cdr])
+ (set p-actions-xform
+ ^(progn
+ ,(sys:awk-field-name-code awc aws-sym)
+ ,p-actions-xform)))
^(block ,(or awc.name 'awk)
(let* (,*awc.lets ,awk-retval
(,aws-sym (new sys:awk-state
@@ -514,14 +560,7 @@
,*(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))))))
+ ,p-actions-xform)))))
,*awc.begin-actions
(unwind-protect
,(if (or awc.cond-actions awc.begin-file-actions
--
cgit v1.2.3