queryier

quad/quadwriter/query.rkt

@@ -7,45 +7,43 @@
   (make-quad #:type type
              #:elems (for/list ([i (in-range 2)])
                                (quad-update! (proc)
-                                             [tag (format "~a[~a]" 'proc (add1 i))]))))
+                                             [tag (format "~a[~a]-~a" 'proc (add1 i) (gensym))]))))
 
 (define (line) (make-quad #:type line-quad))
 (define (block) (factory block-quad line))
 (define (col) (factory column-quad block))
-(define (sec) (factory section-quad col))
+(define (page) (factory page-quad col))
+(define (sec) (factory section-quad page))
 (define doc (factory doc-quad sec))
 
 (define (parse-query-str str)
   (define (string->pred str)
     (match str
       ["doc" doc-quad?]
-      ["section" section-quad?]
+      [(or "section" "sec" "s") section-quad?]
-      ["page" page-quad?]
+      [(or "page" "pg" "p") page-quad?]
-      ["column" column-quad?]
+      [(or "column" "col" "c") column-quad?]
-      ["block" block-quad?]
+      [(or "block" "b") block-quad?]
-      ["line" line-quad?]))
+      [(or "line" "ln" "l") line-quad?]))
   (for/list ([piece (in-list (string-split str ":"))])
             (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
               [#false (cons (string->pred piece) #false)]
               [(list all name arg) (cons (string->pred name) (or (string->number arg)
-                                                                   (string->symbol arg)))])))
+                                                                 (string->symbol arg)))])))
 
 (define (query q query-str)
   (define query-assocs (parse-query-str query-str))
-  #R query-assocs
+  (for/fold ([qs (flatten-quad q)]
-  (for/fold ([ctx q]
+             #:result (and qs (car qs)))
-             #:result #R ctx)
+            ([qa (in-list query-assocs)])
-            ([(pred count) (in-dict query-assocs)])
+    (match-define (cons pred count) qa)
-    #R pred
+    (let loop ([qs qs][seen 0])
-    (define matches null)
+      (define maybe-tail (memf pred qs))
-    (let loop ([this ctx])
+      (and maybe-tail
-      #R this
+           (let ([seen (add1 seen)])
-      (cond
+             (cond
-        [(= (length matches) count) #R (car matches)]
+               [(= seen count) maybe-tail]
-        [(quad? this)
+               [else (loop (cdr maybe-tail) seen)]))))))
-         (when (pred this)
+          
-             (set! matches (cons this matches)))
-         (for-each loop (quad-elems this))]
-        [else this]))))
 
-(query doc "section[1]:line[2]")
+(query doc "sec[2]:pg[1]")