step

quad/quadwriter/query.rkt

@@ -6,7 +6,7 @@
   (define qs (let loop ([q q])
                (cons q (append* (for/list ([elem (in-list (quad-elems q))]
                                            #:when (quad? elem))
-                                  (loop elem))))))
+                                          (loop elem))))))
   (list->vector qs))
 
 (define (string->key str)
@@ -27,10 +27,10 @@
 
 (define (parse-query str)
   (for/list ([piece (in-list (string-split str ":"))])
-    (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
-      [#false (cons (string->key piece) #false)]
-      [(list _ name arg) (cons (hash-ref preds (string->key name))
-                               (or (string->number arg) (string->symbol arg)))])))
+            (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
+              [#false (cons (string->key piece) #false)]
+              [(list _ name arg) (cons (hash-ref preds (string->key name))
+                                       (or (string->number arg) (string->symbol arg)))])))
 
 (define (find-inclusive vec pred start-arg end-arg [count 1])
   ;; search from lidx to ridx inclusive
@@ -46,43 +46,50 @@
     ;; and won't re-find the last one immediately
     (for/first ([idx (in-range (+ adjusted-start step) end step)]
                 #:when (pred (vector-ref vec idx)))
-      idx)))
+               idx)))
 
-(define (query quad-or-index query-str [query-q #false])
+(define (query-one vec pred subscript this-idx maxidx)
+  (define (find start end count) (find-inclusive vec pred start end count))
+  (define res-idx
+    (let loop ([subscript subscript])
+      (match subscript
+        [(== 'this eq?) ; start at querying quad, then search 1 back
+         (find this-idx 0 1)]
+        [(== 'last eq?) (loop -1)]
+        [(== 'prev eq?) ; search 2 back. same algo if current q is pred or not.
+         (find this-idx 0 2)]
+        [(== 'next eq?) ; search 1 ahead, but if current q is also pred, search 2 ahead
+         (find this-idx maxidx (if (pred (vector-ref vec this-idx)) 2 1))]
+        [(? number? count)
+         (cond
+           [(negative? count) ; search backward from end
+            (find maxidx this-idx (abs count))]
+           [else ; seach forward
+            (find this-idx maxidx count)])]
+        [_ #false])))
+  (define next-maxidx
+    (cond
+      [(not res-idx) maxidx]
+      ;; try searching for next occurence after this one, up to max.
+      [(find (add1 res-idx) maxidx 1)]
+      [else maxidx]))
+  (values res-idx next-maxidx))
+
+(define (multiquery? x) (memq x '(* all)))
+
+(define (query quad-or-index query-str [query-idx #false])
   (define vec (match quad-or-index
                 [(? quad? q) (make-query-index q)]
                 [idx idx]))
-  (for/fold ([this-idx (if query-q (vector-memq query-q vec) 0)]
+  (define query-pieces (parse-query query-str))
+  (define multi-mode? (ormap multiquery? (map cdr query-pieces)))
+  (for/fold ([idx (if query-idx (vector-memq query-idx vec) 0)]
              [maxidx (sub1 (vector-length vec))]
-             #:result (and this-idx (vector-ref vec this-idx)))
-            ([query-piece (in-list (parse-query query-str))]
-             #:break (not this-idx))
-    (match-define (cons pred subscript) query-piece)
-    (define (find start end count) (find-inclusive vec pred start end count))
-    (define res-idx
-      (let loop ([subscript subscript])
-        (match subscript
-          [(== 'this eq?) ; start at querying quad, then search 1 back
-           (find this-idx 0 1)]
-          [(== 'last eq?) (loop -1)]
-          [(== 'prev eq?) ; search 2 back. same algo if current q is pred or not.
-           (find this-idx 0 2)]
-          [(== 'next eq?) ; search 1 ahead, but if current q is also pred, search 2 ahead
-           (find this-idx maxidx (if (pred (vector-ref vec this-idx)) 2 1))]
-          [(? number? count)
-           (cond
-             [(negative? count) ; search backward from end
-              (find maxidx this-idx (abs count))]
-             [else ; seach forward
-              (find this-idx maxidx count)])]
-          [_ #false])))
-    (define next-maxidx
-      (cond
-        [(not res-idx) maxidx]
-        ;; try searching for next occurence after this one, up to max.
-        [(find (add1 res-idx) maxidx 1)]
-        [else maxidx]))
-    (values res-idx next-maxidx)))
+             #:result (and idx (vector-ref vec idx)))
+            ([query-piece (in-list query-pieces)]
+             #:break (not idx))
+    (match query-piece
+      [(cons pred subscript) (query-one vec pred subscript idx maxidx)])))
           
 (module+ test
   (require rackunit)
@@ -91,12 +98,12 @@
   (define-syntax-rule (factory type proc)
     (make-quad #:type type
                #:elems (for/list ([i (in-range 3)])
-                         (set! counter (add1 counter))
-                         (define new-q (proc))
-                         (quad-update! new-q
-                                       [tag (format "~a[~a]-~a" 'proc counter (gensym))])
-                         (hash-set! (quad-attrs new-q) 'count counter)
-                         new-q)))
+                                 (set! counter (add1 counter))
+                                 (define new-q (proc))
+                                 (quad-update! new-q
+                                               [tag (format "~a[~a]-~a" 'proc counter (gensym))])
+                                 (hash-set! (quad-attrs new-q) 'count counter)
+                                 new-q)))
 
   (define (line) (make-quad #:type line-quad))
   (define (block) (factory block-quad line))
@@ -128,7 +135,7 @@
   (check-equal? (count (query doc "page[next]:page[next]" (query doc "page[1]:line[1]")))
                 (count (query doc "page[3]")))
 
-    (check-equal? (count (query doc "page[next]:page[this]:page[prev]" (query doc "page[1]:line[1]")))
+  (check-equal? (count (query doc "page[next]:page[this]:page[prev]" (query doc "page[1]:line[1]")))
                 (count (query doc "page[1]")))
   
   )