Matthew Butterick 4 years ago
parent ea5469052b
commit 61144b9248

@ -32,50 +32,48 @@
[(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
(define-values (start end step)
(cond
;; if lidx is bigger, search backward
[(> start-arg end-arg) (values start-arg (sub1 end-arg) -1)]
[else (values start-arg (add1 end-arg) 1)]))
(for/fold ([start-1 (sub1 start)]) ; sub1 for reason below
([seen (in-range count)]
#:break (not start-1))
;; add 1 so on next iteration, we can find next matcher
;; and won't re-find this one immediately
(for/first ([idx (in-range (add1 start-1) end step)]
#:when (pred (vector-ref vec idx)))
idx)))
(define (query quad-or-index query-str [starting-q #false])
(define vec (match quad-or-index
[(? quad? q) (make-query-index q)]
[idx idx]))
(define (next-occurrence-between pred lidx ridx)
(cond
[(or (not lidx) (not ridx)) ridx]
;; we are searching between, so add 1 to left idx
[(for/first ([idx (in-range (add1 lidx) ridx)]
#:when (pred (vector-ref vec idx)))
idx)]
[else (vector-length vec)]))
(for/fold ([vidx 0]
[maxidx (vector-length vec)]
[maxidx (sub1 (vector-length vec))]
#:result (and vidx (vector-ref vec vidx)))
([query-piece (in-list (parse-query query-str))]
#:break (not vidx))
(match-define (cons pred count) query-piece)
(define res-idx
(match count
[(or (== 'this eq?) (== 'last eq?))
;; find a starting point, then search backward
(for/first ([vidx (in-range (if (eq? count 'this)
;; start at querying quad
(vector-memq starting-q vec)
;; start at end
(sub1 maxidx)) -1 -1)]
#:when (pred (vector-ref vec vidx)))
vidx)]
[(== 'prev eq?) (error 'unimplemented)]
[(== 'next eq?) (error 'unimplemented)]
[count
(for/fold ([vidx vidx]
;; sub 1 because return values add 1
;; and final result should be location of matching quad
#:result (and vidx (sub1 vidx)))
([seen (in-range count)]
#:break (not vidx))
(for/first ([vidx (in-range vidx maxidx)]
#:when (pred (vector-ref vec vidx)))
;; add 1 so on next iteration, we can find next matcher
;; and won't re-find this one immediately
(add1 vidx)))]))
(values res-idx (next-occurrence-between pred res-idx maxidx))))
[(== 'this eq?) ; start at querying quad, then search backward
(find-inclusive vec pred (sub1 (vector-memq starting-q vec)) 0)]
[(== 'last eq?) ; search backward from end
(find-inclusive vec pred maxidx 0)]
[(== 'prev eq?) (find-inclusive vec pred (sub1 (vector-memq starting-q vec)) 0 2)]
[(== 'next eq?) (find-inclusive vec pred (add1 (vector-memq starting-q vec)) maxidx)]
[count (find-inclusive vec pred vidx maxidx count)]))
(define next-maxidx
(cond
[(not res-idx) maxidx]
;; try searching for next occurence after this one, up to max.
[(find-inclusive vec pred (add1 res-idx) maxidx)]
[else maxidx]))
(values res-idx next-maxidx)))
(module+ test
(require rackunit)
@ -99,9 +97,15 @@
(define (count q) (and q (quad-ref q 'count)))
(define doc (factory doc-quad sec))
(check-eq? (query doc "page[this]" (query doc "line[2]")) (query doc "page[1]"))
(check-equal? (count (query doc "sec[2]")) 242)
(check-false (query doc "sec[102]:line[1]"))
(check-equal? (count (query doc "sec[2]:pg[1]")) 162)
(check-equal? (count (query doc "sec[2]:pg[1]:ln[3]")) 128))
(check-equal? (count (query doc "sec[2]:pg[1]:ln[3]")) 128)
(check-eq? (query doc "page[this]" (query doc "line[2]")) (query doc "page[1]"))
(check-equal? (count (query doc "page[this]:line[last]" (query doc "line[2]"))) 41)
(check-equal? (count (query doc "sec[2]")) (count (query doc "sec[next]" (query doc "sec[1]"))))
(check-equal? (count (query doc "sec[1]")) (count (query doc "sec[prev]" (query doc "sec[2]"))))
)
Loading…
Cancel
Save