started fld clause

inconvergent · Dec 27, 2023 · 173a3f3 · 173a3f3
1 parent 0461f8f
commit 173a3f3
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 15 deletions.
diff --git a/README.md b/README.md
@@ -127,19 +127,14 @@ But for convenience there are a few special functions defined in `jqn`.
  - `(fi [k])` index of the file that is the source for the current data; or `0`.
 
 ### Clause Context
- - `($_ k [default])` returns this key from current data object (`_`).
-   In `*map`, `[]`, `#[]`, and `#{}`.
- - `(par)` returns the parent data object.
-   In `*map`, `[]`, `#[]`, and `#{}`.
- - `(num)` returns length of the `vector` being iterated.
-   In `*map`, `[]`, `#[]`, and `#{}`.
- - `(cnt [k])` counts from `k`, or `0`.
-   In `*map`, `[]`, `#[]`, and `#{}`.
+ - `($_ k [default])` returns this key from current data object (`_`). In `*map`, `[]`, `#[]`, and `#{}`.
+ - `(par)` returns the parent data object. In `*map`, `[]`, `#[]`, and `#{}`.
+ - `(num)` returns length of the `vector` being iterated. In `*map`, `[]`, `#[]`, and `#{}`.
+ - `(cnt [k])` counts from `k`, or `0`. In `*map`, `[]`, `#[]`, and `#{}`.
 
 ### Generic
  - `(?? fx a ...)` execute `(fx a ...)` only if `a` is not `nil`; otherwise `nil`.
  - `(>< a)` condense `a`. Remove `nil`, empty `vectors`, empty `kvs` and keys with empty `kvs`.
- - `(<> a)` ?
 
 ### Strings
  - `(mkstr a ...)` stringify and concatenate all arguments.

diff --git a/src/qry.lisp b/src/qry.lisp
@@ -60,6 +60,7 @@ got: ~a" o))))
 (defun **itr? (d) (and (symbolp d) (eq (kv d) :**)))
 (defun *>itr? (d) (and (symbolp d) (eq (kv d) :*>)))
 (defun *map?  (d) (and (symbolp d) (eq (kv d) :*map)))
+(defun *fld?  (d) (and (symbolp d) (eq (kv d) :*fld)))
 (defun pipe?  (d) (and (symbolp d) (eq (kv d) :||)))
 (defun jqnfx? (d) (and (symbolp d) (member (kv d) *fxns* :test #'eq)))
 
@@ -168,6 +169,22 @@ got: ~a" k))))
         (3 (apply #'do-map (funcall rec `((:dat . ,dat*) ,@conf) d))) ; TODO: almost redundant
         (otherwise (error "*map: bad args: ~a" d))))))
 
+(defun compile/*fld (rec conf d &aux (dat* (gk conf :dat)))
+  (awg (i ires dat)
+    (labels ((do-map (vv curr expr)
+               `(loop with ,ires = (mav)
+                      for ,curr across ,vv for ,i from 0
+                      do (labels (,@(*itr/labels vv curr i))
+                           (*add+ ,ires nil
+                             ,(funcall rec `((:dat . ,curr) ,@conf) expr)))
+                      finally (return ,ires))))
+      (case (length d)
+        (1 (typecase (car d) (symbol (do-map dat* dat `(,(car d) ,dat)))
+                             (cons (do-map dat* dat (car d)))))
+        (2 (apply #'do-map dat* d))
+        (3 (apply #'do-map (funcall rec `((:dat . ,dat*) ,@conf) d))) ; TODO: almost redundant
+        (otherwise (error "*fld: bad args: ~a" d))))))
+
 (defun new-conf (conf kk) `((:dat . ($_ ,kk)) ,@conf))
 
 (defun compile/$$ (rec conf d) ; {...}
@@ -233,16 +250,16 @@ got: ~a" k))))
   (labels
     ((rec (conf d &aux (dat (gk conf :dat)))
        (cond ((all? d) dat) ((atom d) d)
-             ((car- pipe? d)  (compile/pipe  #'rec conf (cdr d)))
+             ((car- pipe?  d) (compile/pipe #'rec conf (cdr d)))
              ((car- **itr? d) (compile/** #'rec conf (preproc/**itr (cdr d))))
              ((car- *$itr? d) (compile/*$ #'rec conf (preproc/$$itr (cdr d))))
              ((car- $$itr? d) (compile/$$ #'rec conf (preproc/$$itr (cdr d))))
              ((car- *>itr? d) (compile/*> #'rec conf (preproc/$$itr (cdr d))))
-             ((car- *map? d)  (compile/*map #'rec conf (cdr d)))
-             ((car- *new? d)  (rec conf (compile/*new (cdr d))))
-             ((car- $new? d)  (rec conf (compile/$new (cdr d))))
-             ((car- jqnfx? d) `(,(psymb 'jqn (car d))
-                               ,@(rec conf (cdr d))))
+             ((car- *new?  d) (rec conf (compile/*new (cdr d))))
+             ((car- $new?  d) (rec conf (compile/$new (cdr d))))
+             ((car- *map?  d) (compile/*map #'rec conf (cdr d)))
+             ((car- *fld?  d) (compile/*fld #'rec conf (cdr d)))
+             ((car- jqnfx? d) `(,(psymb 'jqn (car d)) ,@(rec conf (cdr d))))
              ((consp d) (cons (rec conf (car d)) (rec conf (cdr d))))
              (t (error "jqn compile error for: ~a" d)))))
     `(labels ((ctx () ,(gk conf* :ctx t))