refactor ?grp operator

inconvergent · Mar 7, 2024 · 908f2d5 · 908f2d5
1 parent 224cea4
commit 908f2d5
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 25 deletions.
diff --git a/bin/ex.lisp b/bin/ex.lisp
@@ -68,7 +68,6 @@
                             (?grp :a (str! (key) "-" (@ :b))))))
 ;; ((1  . #("1-23"))
 ;;  (11 . #("11-123" "11-123")))
-(print :-----------------)
 
 (print (lqn:ldnout (lqn::qrydb (lqn:jsnloads "{\"a\": 1, \"b\": 23}")
                             (?grp _ (key)))))
diff --git a/src/qry.lisp b/src/qry.lisp
@@ -71,30 +71,28 @@
 
 (defun compile/?grp (rec conf d)
   (unless (< 0 (length d) 3) (error "?grp: expected 1 or 2 args. got: ~a." d))
-  (awg (i k kvres key itr par dat acc)
-    (labels ((getter (cd) (funcall rec (dat/new conf itr)
-                            (typecase cd (keyword `(@ ,cd)) (string `(@ ,cd)) (otherwise cd))))
-             (do-vec ()
-               `(loop for ,i from 0 for ,itr across ,par ; TODO: this wont work for lists
-                      for ,key =  ,(getter (car d))
-                      for ,acc = (gethash ,key ,kvres (new*))
-                  do (∈ (:cnt ,i :itr ,itr :key ,key)
-                        (let ((,dat ,(case (length d) (1 itr) (2 (getter (second d))))))
-                         (setf (gethash ,key ,kvres) (psh* ,acc ,dat))))))
-             (do-ht ()
-               `(loop for ,i from 0
-                      for ,itr being the hash-values of ,par using (hash-key ,k)
-                      for ,key =  ,(getter (car d))
-                      for ,acc = (gethash ,key ,kvres (new*))
-                  do (∈ (:cnt ,i :itr ,itr :key ,k)
-                        (let ((,dat ,(case (length d) (1 itr) (2 (getter (second d))))))
-                          (setf (gethash ,key ,kvres) (psh* ,acc ,dat)))))))
+  (awg (i k kvres key itr par acc)
+    (labels ((do-dat () (case (length d) (1 itr) (2 (do-key (second d)))))
+             (do-key (cd) (funcall rec (dat/new conf itr)
+                            (typecase cd (keyword `(@ ,cd)) (string `(@ ,cd)) (otherwise cd)))))
       `(let ((,par ,(gk conf :dat)) (,kvres (make$)))
-         (∈ (:par ,par)
-            (typecase ,par (hash-table ,(do-ht))
-                           (vector ,(do-vec)) (simple-vector ,(do-vec))
-                           (otherwise (error "RT: ?grp bad type. expected hash-table or vector:~%got: ~a." ,par)))
-            ,kvres)))))
+         (labels ((do-vec () (loop with ,par = (vec! ,par)
+                               for ,i from 0 for ,itr across ,par
+                               for ,key = ,(do-key (car d))
+                               for ,acc = (gethash ,key ,kvres (new*))
+                               do (∈ (:par ,par :cnt ,i :itr ,itr :key ,key)
+                                     (setf (gethash ,key ,kvres) (psh* ,acc ,(do-dat))))))
+                  (do-ht () (loop for ,i from 0
+                              for ,itr being the hash-values of ,par using (hash-key ,k)
+                              for ,key = ,(do-key (car d))
+                              for ,acc = (gethash ,key ,kvres (new*))
+                              do (∈ (:par ,par :cnt ,i :itr ,itr :key ,k)
+                                    (setf (gethash ,key ,kvres) (psh* ,acc ,(do-dat)))))))
+          (typecase ,par
+            (null nil) (hash-table (do-ht)) (list (do-vec))
+            (vector (do-vec)) (simple-vector (do-vec))
+            (otherwise (error "RT: ?grp bad type. expected hash-table or vector:~%got: ~a." ,par))))
+         ,kvres))))
 
 (defun compile/$$ (rec conf d) ; {...} ; sel
   (awg (kres par dat)
@@ -107,7 +105,7 @@
        ($nil ,kres))))
 
 (defun compile/$* (rec conf d) ; #[...] ; sel
-  (awg (i ires itr dat par)
+  (awg (i ires itr dat par) ; TODO: adapt to support hts?
     `(loop with ,ires of-type vector = (mav)
            with ,par of-type vector = (vec! ,(gk conf :dat))
            for ,itr across ,par for ,i from 0