diff --git a/quad/quadwriter/query.rkt b/quad/quadwriter/query.rkt index e0dffa91..35ad2d58 100644 --- a/quad/quadwriter/query.rkt +++ b/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]"))) ) \ No newline at end of file