mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

avoid work

Browse Source
main
Matthew Butterick 4 years ago
parent bce98d2e48
commit e8bf5b99dc
1 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File

72
quad/quadwriter/query.rkt
Unescape Escape View File

@ -75,34 +75,46 @@
[idx idx])) [idx idx]))
(when query-q (unless (quad? query-q) (when query-q (unless (quad? query-q)
(raise-argument-error 'query "quad" query-q))) (raise-argument-error 'query "quad" query-q)))
(define query-pieces (parse-query query-str)) (define all-query-pieces (parse-query query-str))
(and (pair? query-pieces) (and (pair? all-query-pieces)
;; initial subtree is whole tree ;; initial subtree is whole tree
(for/fold ([subtrees (list (cons (if query-q (vector-memq query-q vec) 0) (sub1 (vector-length vec))))] ;; each subtree is a pair of start idx (initial node) + end idx (boundary of subtree)
#:result (and (pair? subtrees) (let loop ([subtrees (list (cons (if query-q (vector-memq query-q vec) 0) (sub1 (vector-length vec))))]
;; multi mode means one of the query subscripts is a wildcard [query-pieces all-query-pieces])
(let ([multi-mode? (for/or ([(_ subscript) (in-dict query-pieces)]) (cond
(multiquery? subscript))]) ;; if subtrees are null, we have eliminated all searchable domains
(match (for/list ([(idx _) (in-dict subtrees)]) [(null? subtrees) #false]
(vector-ref vec idx)) [(null? query-pieces)
[vals #:when multi-mode? vals] ; in multi mode, return list ;; multi mode means one of the query subscripts is a wildcard
[(list val) val] ; otherwise return single value (define multi-mode? (for/or ([(_ subscript) (in-dict all-query-pieces)])
[_ (error 'should-never-have-multiple-vals-in-single-mode)])))) (multiquery? subscript)))
([(pred subscript) (in-dict query-pieces)] (match (for/list ([(idx _) (in-dict subtrees)])
#:break (null? subtrees)) ; if subtrees are null, we have eliminated all searchable domains (vector-ref vec idx))
(for*/list ([(start-idx end-idx) (in-dict subtrees)] [vals #:when multi-mode? vals] ; in multi mode, return list
[idx (cond [(list val) val] ; otherwise return single value
[(multiquery? subscript) [_ (error 'should-never-have-multiple-vals-in-single-mode)])]
(in-list (for/list ([idx (in-range start-idx (add1 end-idx))] [else
#:when (pred (vector-ref vec idx))) (match-define (cons (cons pred subscript) other-query-pieces) query-pieces)
idx))] (define finish-proc
[else (in-value (query-one vec pred subscript start-idx end-idx))])] (if (null? other-query-pieces)
#:when idx) ;; don't need to calculate end-idxs if we're at the end of the query
(cons idx (cond ;; calculate new end-idx (λ (idx end-idx) 'ignored-value)
[(not idx) end-idx] (λ (idx end-idx) (cond ;; otherwise calculate new end-idx
;; try searching for next occurence after this one, up to max. [(not idx) end-idx]
[(find-inclusive vec pred (add1 idx) end-idx 1)] ;; try searching for next occurence after this one, up to max.
[else end-idx])))))) [(find-inclusive vec pred (add1 idx) end-idx 1)]
[else end-idx]))))
(loop
(for*/list ([(start-idx end-idx) (in-dict subtrees)]
[idx (cond
[(multiquery? subscript)
(in-list (for/list ([idx (in-range start-idx (add1 end-idx))]
#:when (pred (vector-ref vec idx)))
idx))]
[else (in-value (query-one vec pred subscript start-idx end-idx))])]
#:when idx)
(cons idx (finish-proc idx end-idx)))
other-query-pieces)]))))
(module+ test (module+ test
(require rackunit) (require rackunit)
@ -152,7 +164,7 @@
(count (query doc "page[1]"))) (count (query doc "page[1]")))
(query doc "sec[*]") (andmap section-quad? (query doc "sec[*]"))
(query doc "sec[*]:page[1]") (andmap page-quad? (query doc "sec[*]:page[1]"))
(query doc "sec[*]:page[1]:line[*]") (andmap line-quad? (query doc "sec[*]:page[1]:line[*]"))
) )
Write Preview
Loading…
Cancel
Save