Skip to content

Commit

Permalink
block names
Browse files Browse the repository at this point in the history
  • Loading branch information
@inconvergent
inconvergent committed May 11, 2024
1 parent 9d438f5 commit 48b1190
Show file tree
Hide file tree
Showing 3 changed files with 64 additions and 58 deletions.
2 changes: 1 addition & 1 deletion docs/lqn.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# Lisp Query Notation Symbol Documentation (2.0.1)
# Lisp Query Notation Symbol Documentation (2.0.2)

#### LQN:??

Expand Down
14 changes: 7 additions & 7 deletions src/pre-qry.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,11 +84,11 @@

(defun pre/scan-clauses (qq &optional (ctx "pre-compile") ign)
(declare (list qq))
(let ((isect (intersection
(mapcar (λ (k) (kw (ssym? k))) qq)
(set-difference *operators* ign)
:test #'equal)))
(when isect (error "~a: unexpected bare operator(s) ~a~%in: ~a." ctx isect qq)))
(let ((isect (intersection (mapcar (λ (k) (kw (ssym? k))) qq)
(set-difference *operators* ign)
:test #'equal)))
(when isect (error "~a: unexpected bare operator(s) ~a~%in: ~a."
ctx isect qq)))
(loop for q in qq collect (pre/scan-clause q)))

(defun pre/|| (qq) (unless qq (warn "||: missing args.")) ; pipe
Expand All @@ -104,8 +104,8 @@
(unpack- (o) ; NOTE: can we use modes here?
(dsb (m sk) (unpack-mode o mm)
(unless (eq m :+) (error "?map: expected mode :+, got: ~a. in: ~a" m q))
(etypecase sk (sequence sk)
(keyword sk)
(etypecase sk (sequence sk)
(keyword sk)
(symbol (do-symbol sk))))))
(let* ((q* (remove-if #'dat? (pre/scan-clauses q '#:?map '(:@))))
(res (mapcar #'unpack- q*))
Expand Down
106 changes: 56 additions & 50 deletions src/qry-operators.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,13 @@
(in-package :lqn)

(defmacro o∈ (s ∇ expr) (declare (ignore s)) `(setf ,∇ ,expr))
(defun compile/|| (rec conf d) ; (|| ...) pipe
(awg (∇-)
(if (< (length d) 2) (funcall rec conf (car d))
`(let ((,∇- ,(gk conf :dat)))
,@(loop for op in d collect `(setf ,∇- ,(funcall rec (dat/new conf ∇-) op)))
,@(loop for op in d
collect `(o∈ ,(sdwn (head (str! op) 50)) ,∇-
,(funcall rec (dat/new conf ∇-) op)))
,∇-))))

(defun compile/@ (rec conf d &aux (dat (gk conf :dat)))
Expand All @@ -21,22 +24,22 @@
(labels ((do-map ()
`(let ((,par ,(gk conf :dat)))
(labels
((do-ht ()
((map-do-ht ()
(loop with ,kres = (new$) for ,i from 0
for ,itr being the hash-values of ,par using (hash-key ,k)
do (∈ (:par ,par :cnt ,i :itr ,itr :key ,k)
(setf (gethash ,k ,kres)
,expr))
finally (return ,kres)))
(do-vec ()
(map-do-vec ()
(loop with ,vres = (mav) with ,par = (vec! ,par) for ,i from 0
for ,itr across ,par
do (∈ (:par ,par :cnt ,i :itr ,itr :key ,i)
(vex ,vres ,expr))
finally (return ,vres))))
(typecase ,par
(null nil) (hash-table (do-ht)) (list (do-vec))
(vector (do-vec)) (simple-vector (do-vec))
(null nil) (hash-table (map-do-ht)) (list (map-do-vec))
(vector (map-do-vec)) (simple-vector (map-do-vec))
(otherwise (error "RT: ?map: bad type. expected hash-table or vector:~%got: ~a." ,par)))))))
(typecase expr
(list (do-map)) (vector (do-map))
Expand All @@ -49,19 +52,19 @@
(error "?fld: expected symbols, got: ~a/~a." acc itr))
(unless (consp expr) (error "?fld: expected cons or got: ~a." expr))
`(let ((,par ,(gk conf :dat)) (,acc ,init))
(labels ((do-ht ()
(labels ((fld-do-ht ()
(loop for ,i from 0
for ,itr being the hash-values of ,par using (hash-key ,k)
do (∈ (:par ,par :cnt ,i :key ,k :itr ,itr)
(setf ,acc ,(funcall rec (dat/new conf itr) expr)))))
(do-vec ()
(fld-do-vec ()
(loop with ,par = (vec! ,par)
for ,itr across ,par for ,i from 0
do (∈ (:par ,par :cnt ,i :key ,i :itr ,itr)
(setf ,acc ,(funcall rec (dat/new conf itr) expr))))))
(typecase ,par
(null ,acc) (hash-table (do-ht)) (list (do-vec))
(vector (do-vec)) (simple-vector (do-vec))
(null ,acc) (hash-table (fld-do-ht)) (list (fld-do-vec))
(vector (fld-do-vec)) (simple-vector (fld-do-vec))
(otherwise (error "RT: ?fld: bad type. expected hash-table or vector:~%got: ~a." ,par))))
,acc)))
(case (length d)
Expand All @@ -80,23 +83,23 @@
(do-key (cd) (funcall rec (dat/new conf itr)
(typecase cd (keyword `(@ ,cd)) (string `(@ ,cd)) (otherwise cd)))))
`(let ((,par ,(gk conf :dat)) (,kvres (new$)))
(labels ((do-vec ()
(labels ((grp-do-vec ()
(loop with ,par = (vec! ,par)
for ,i from 0 for ,itr across ,par
for ,key = (∈ (:par ,par :key ,i :cnt ,i) ,(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 ()
for ,i from 0 for ,itr across ,par
for ,key = (∈ (:par ,par :key ,i :cnt ,i) ,(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))))))
(grp-do-ht ()
(loop for ,i from 0
for ,itr being the hash-values of ,par using (hash-key ,k)
for ,key = (∈ (:par ,par :key ,k :cnt ,i) ,(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)))))))
for ,itr being the hash-values of ,par using (hash-key ,k)
for ,key = (∈ (:par ,par :key ,k :cnt ,i) ,(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)))))))
(typecase ,par
(null nil) (hash-table (do-ht)) (list (do-vec))
(vector (do-vec)) (simple-vector (do-vec))
(null nil) (hash-table (grp-do-ht)) (list (grp-do-vec))
(vector (grp-do-vec)) (simple-vector (grp-do-vec))
(otherwise (error "RT: ?grp bad type. expected hash-table or vector:~%got: ~a." ,par))))
,kvres))))

Expand All @@ -107,7 +110,7 @@
(defun compile/?select (rec conf d) ; {...} ; sel ; select keys/exprs from ht to new ht
(awg (kres par dat)
`(let* ((,par ,(gk conf :dat)))
(labels ((do-ht (&aux (,kres ,(if (car- dat? d) `(make$ ,par) `(new$))))
(labels ((select-do-ht (&aux (,kres ,(if (car- dat? d) `(make$ ,par) `(new$))))
(∈ (:par ,par)
,@(loop for (m kk expr) in (strip-all d)
collect `(let ((,dat (@@ ,par ,kk)))
Expand All @@ -116,18 +119,18 @@
,(compile/$add rec
(dat/new conf dat) m kres kk expr))))
($nil ,kres)))
(do-vec () ; TODO: not implemented
(select-do-vec () ; TODO: not implemented
(error "vector not implemented")))
(typecase ,par
(null nil) (hash-table (do-ht)) (list (do-vec))
(vector (do-vec)) (simple-vector (do-vec))
(null nil) (hash-table (select-do-ht)) (list (select-do-vec))
(vector (select-do-vec)) (simple-vector (select-do-vec))
(otherwise (error "RT: {..} bad type. expected hash-table or vector.~%got: ~a." ,par)))))))

; TODO: ?mapsel
(defun compile/*$ (rec conf d) ; #{...} ; sel ; select from vec of hts to vec of hts
(awg (i vres kvres itr dat par)
`(let ((,par ,(gk conf :dat)))
(labels ((do-vec (&aux (,vres (mav)))
(labels ((mapsel-do-vec (&aux (,vres (mav)))
(loop with ,par of-type vector = (vec! ,par)
for ,itr of-type hash-table across ,par for ,i from 0
for ,kvres of-type hash-table = ,(if (car- dat? d) `(make$ ,itr) `(new$))
Expand All @@ -140,7 +143,7 @@
(vex ,vres ($nil ,kvres))))
,vres))
(typecase ,par (null nil)
(vector (do-vec)) (simple-vector (do-vec)) (list (do-vec))
(vector (mapsel-do-vec)) (simple-vector (mapsel-do-vec)) (list (mapsel-do-vec))
(otherwise (error "RT: #{..} bad type. expected vector, got: ~a." ,par)))))))

; TODO: vec! does the wrong thing for non-sequence
Expand All @@ -151,7 +154,7 @@
(defun compile/$* (rec conf d) ; #[...] ; sel ; select from vec of hts to vec
(awg (i vres itr dat par)
`(let ((,par ,(gk conf :dat)))
(labels ((do-vec (&aux (,vres (mav)))
(labels ((sel-do-vec (&aux (,vres (mav)))
(loop with ,par of-type vector = (vec! ,par)
for ,itr across ,par for ,i from 0
do (∈ (:par ,par :cnt ,i :itr ,itr)
Expand All @@ -163,7 +166,7 @@
(dat/new conf dat) m vres expr))))))
,vres))
(typecase ,par ; TODO: support hts
(null nil) (vector (do-vec)) (simple-vector (do-vec)) (list (do-vec))
(null nil) (vector (sel-do-vec)) (simple-vector (sel-do-vec)) (list (sel-do-vec))
(otherwise (error "RT: #[..] bad type. expected vector, got: ~a." ,par)))))))

(defun pre/?filter (q &optional (mm :?)) (unless q (warn "?filter: missing args."))
Expand All @@ -179,24 +182,26 @@
(awg (k i kres vres itr par)
`(let ((,par ,(gk conf :dat)))
(labels
((do-vec () (loop with ,par = (vec! ,par) with ,vres of-type vector = (mav) for ,i from 0
for ,itr across ,par
do ,(compile/?xpr rec
`((:par . ,par) (:dat . ,itr) (:cnt . ,i) (:itr . ,itr) (:key . ,i))
`(,@d (vex ,vres ,@(or (xpr/get-modes d :%) `(,itr)))
nil))
finally (return ,vres)))
(do-ht () (loop with ,kres of-type hash-table = (new$) for ,i from 0
for ,itr being the hash-values of ,par using (hash-key ,k)
do ,(compile/?xpr rec
`((:par . ,par) (:dat . ,itr) (:cnt . ,i) (:itr . ,itr) (:key . ,k))
`(,@d (setf (gethash ,k ,kres)
,@(or (xpr/get-modes d :%) `(,itr)))
nil))
finally (return ,kres))))
((filter-do-vec ()
(loop with ,par = (vec! ,par) with ,vres of-type vector = (mav) for ,i from 0
for ,itr across ,par
do ,(compile/?xpr rec
`((:par . ,par) (:dat . ,itr) (:cnt . ,i) (:itr . ,itr) (:key . ,i))
`(,@d (vex ,vres ,@(or (xpr/get-modes d :%) `(,itr)))
nil))
finally (return ,vres)))
(filter-do-ht ()
(loop with ,kres of-type hash-table = (new$) for ,i from 0
for ,itr being the hash-values of ,par using (hash-key ,k)
do ,(compile/?xpr rec
`((:par . ,par) (:dat . ,itr) (:cnt . ,i) (:itr . ,itr) (:key . ,k))
`(,@d (setf (gethash ,k ,kres)
,@(or (xpr/get-modes d :%) `(,itr)))
nil))
finally (return ,kres))))
(typecase ,par
(null nil) (hash-table (do-ht)) (list (do-vec))
(vector (do-vec)) (simple-vector (do-vec))
(null nil) (hash-table (filter-do-ht)) (list (filter-do-vec))
(vector (filter-do-vec)) (simple-vector (filter-do-vec))
(otherwise (error "RT: ?filter bad type. expected hash-table or vector:~%got: ~a." ,par)))))))

(defun compile/?xpr/bool (rec conf cd)
Expand Down Expand Up @@ -279,8 +284,9 @@
((car- lqnfx? d) `(,(psymb 'lqn (car d)) ,@(rec conf (cdr d))))
((consp d) (cons (rec conf (pre/scan-clause (car d))) (rec conf (cdr d))))
(t (error "lqn: unexpected clause: ~a~%in: ~a." d q)))))
`(λ (,dat ,fn ,fi) (q∈ (,dat ,fn ,fi)
,(rec `((:dat . ,dat) ,@conf*) q))))))
`(λ (,dat ,fn ,fi)
(q∈ (,dat ,fn ,fi)
,(rec `((:dat . ,dat) ,@conf*) q))))))

(defun qry/show (q cq)
(format t "
Expand Down

0 comments on commit 48b1190

Please sign in to comment.