map operators works on hash-tables now

src/init.lisp

@@ -6,7 +6,7 @@
 (defvar *opt* '(optimize (speed 3) (safety 1)))
 (defvar *fxns* '(:err :wrn :nope :noop :lst :lit :qt :hld :ghv :pnum :inum :cnt :λ
                  :fmt :out :jsnstr
-                 :fn :fi :ctx  :par :itr :compct :?? :@@ :@*
+                 :fn :fi :ctx  :par :itr :key :compct :?? :@@ :@*
                  :read? :some? :all? :none? :smth? :size?
                  :new* :new$ :cat* :cat$
                  :ind* :sel :seq :apply* :grp :uniq

src/pre-qry.lisp

@@ -42,14 +42,16 @@
                 (par () ,dat)
                 (pnum (&optional d) (size? (par) d))
                 (itr () (wrn "no (itr) in qry scope."))
+                (key () (wrn "no (key) in qry scope."))
                 (inum () (wrn "no (inum) in qry scope.")))
          ,@body)))))
 
-(defmacro ∈ ((par &optional i itr) &body body)
-  (declare (symbol par itr))
+(defmacro ∈ ((par &optional i itr key) &body body)
+  (declare (symbol par itr key))
   `(labels (,@(when par `((par () ,par) (pnum () (size? ,par))))
             ,@(when itr `((itr () ,itr) (inum () (size? ,itr))))
-            ,@(when i `((cnt (&optional (k 0)) (+ ,i k)))))
+            ,@(when i `((cnt (&optional (k 0)) (+ ,i k))))
+            ,@(when key `((key () ,key))))
      ,@body))
 
 
@@ -90,7 +92,9 @@
 (defun pre/|| (qq) (unless qq (warn "||: missing args.")) ; pipe
   (loop for q in (pre/scan-clauses qq '#:pipe) collect
     (if (dat? q) (kw q)
-      (typecase q (cons q) (keyword `(** ,q)) (symbol `(*map ,q))
+      (typecase q (cons q) (boolean q)
+                  (keyword `(** ,q))
+                  (symbol `(*map ,q))
                   (string `(** ,q))           (vector `(*map ,@(coerce q 'list)))
                   (otherwise q)))))
 

src/qry.lisp

@@ -16,30 +16,37 @@
 
 (defun compile/*map (rec conf d) ; (*map ...)
   (when (zerop (length d)) (error "*map: missing args."))
-  (awg (i ires itr par)
-    (labels ((do-map (expr)
-               `(loop with ,ires = (mav)
-                  with ,par = (vec! ,(gk conf :dat))
-                  for ,itr across ,par for ,i from 0
-                  do (∈ (,par ,i ,itr) ; TODO: rename i
-                       (vex ,ires ,(funcall rec (dat/new conf itr) expr)))
-                  finally (return ,ires))))
+  (awg (k i kres ires itr par)
+    (labels ((err () `(error "*map/rt: bad type. expected hash-table or vector:~%got: ~a." ,par))
+             (do-ht (expr) `(loop with ,kres = (new$)
+                                  for ,i from 0
+                                  for ,itr being the hash-values of ,par
+                                                 using (hash-key ,k)
+                                  do (∈ (,par ,i ,itr ,k)
+                                       (setf (gethash ,k ,kres)
+                                             ,(funcall rec (dat/new conf itr) expr)))
+                                  finally (return ,kres)))
+             (do-vec (expr) `(loop with ,ires = (mav) with ,par = (vec! ,par)
+                                   for ,i from 0
+                                   for ,itr across ,par
+                                   do (∈ (,par ,i ,itr ,i)
+                                        (vex ,ires ,(funcall rec (dat/new conf itr) expr)))
+                                   finally (return ,ires)))
+             (do-map (expr) `(let ((,par ,(gk conf :dat)))
+                               (typecase ,par (hash-table ,(do-ht expr))
+                                              (vector ,(do-vec expr))
+                                              (simple-vector ,(do-vec expr))
+                                              (otherwise ,(err))))))
       (let ((cd (car d)))
-        (typecase cd
-                  ; (boolean cd) ; TODO: do this more places or not at all?
-                  (cons (do-map cd))
-                  (vector (do-map cd))
-          (otherwise (error "*map: expected vector, cons. got: ~a." d)))))))
-
-; what does the || preproc do for relevant cases? eg nil/t
-; move logic from ||/preproc to map?
+        (typecase cd (list (do-map cd)) (vector (do-map cd))
+          (otherwise (error "*map: expected vector or cons. got: ~a." cd)))))))
 
 (defun compile/*fld (rec conf d) ; (*fld ...)
   (awg (i res itr par)           ; 0 + ; 0 acc (+ acc _)
     (labels ((do-fld (init acc itr expr)
                (unless (and (symbolp acc) (symbolp itr))
                        (error "*fld: expected symbols, got: ~a/~a." acc itr))
-               (unless (consp expr) (error "*fld: expected cons, got: ~a." expr))
+               (unless (consp expr) (error "*fld: expected cons or got: ~a." expr))
                `(loop with ,acc = ,init
                       with ,par = (vec! ,(gk conf :dat))
                       for ,itr across ,par for ,i from 0
@@ -176,7 +183,7 @@
 ; key: (fx _) key: (ind* _ 0)
 ; key: (gethash :key _) key: (gethash "key" _)
 (defun compile/?grp (rec conf d)
-  (unless (< 0 (length d) 3) (error "?grp: expected 1,2 args. got: ~a." d))
+  (unless (< 0 (length d) 3) (error "?grp: expected 1 or 2 args. got: ~a." d))
   (awg (i kvres key itr par dat acc)
     `(loop with ,kvres of-type hash-table = (make$)
            with ,par of-type vector = (vec! ,(gk conf :dat))

test/test-lqn-2.lisp

@@ -86,6 +86,11 @@
                (?txpr (msym? _ (progn 'xxx)) :hit))
       #((A BBBXXX :HIT) (A B C) (A B (C :HIT))) :test #'equalp)
 
+  (is (lqn:ldnout (lqn:qry (lqn:new$ :a 1 :b 2 :c 3) #(1+)))
+       '((:A . 2) (:B . 3) (:C . 4)) :test #'equalp)
+  (is (lqn:ldnout (lqn:qry (lqn:new$ :a 1 :b 2 :c 3) #((lqn:str! (key) _))))
+       '((:A . "a1") (:B . "b2") (:C . "c3")) :test #'equalp)
+
   (is (lqn:qry "aaayyy x abc x def x uuu x sss x auiuu x aaaaa"
         (splt _ :x) (*map (?xpr :a :-@b sup sdwn)))
       #("AAAYYY" "abc" "def" "uuu" "sss" "AUIUU" "AAAAA") :test #'equalp)

test/test-lqn.lisp

@@ -20,8 +20,7 @@
   (is (lqn:qry "a" _@sup) "A")
   (is (lqn:qry "a" (progn _@sup)) "A")
   (is (lqn:qry 1 (progn (s@progn _))) "1")
-  (is (lqn:qry "abc x def x hij" ∅) nil)
-  )
+  (is (lqn:qry "abc x def x hij" ∅) nil))
 
 (subtest "lqn qry identities"
   (is (lqn::jsnstr (lqn:jsnqryf *test-data-fn* _)) (lqn::jsnstr (lqn:jsnqryf *test-data-fn* ($* _))))