diff --git a/quad/quadwriter/query.rkt b/quad/quadwriter/query.rkt index 57a6fea4..712dc8ca 100644 --- a/quad/quadwriter/query.rkt +++ b/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?] - ["page" page-quad?] - ["column" column-quad?] - ["block" block-quad?] - ["line" line-quad?])) + [(or "section" "sec" "s") section-quad?] + [(or "page" "pg" "p") page-quad?] + [(or "column" "col" "c") column-quad?] + [(or "block" "b") block-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 ([ctx q] - #:result #R ctx) - ([(pred count) (in-dict query-assocs)]) - #R pred - (define matches null) - (let loop ([this ctx]) - #R this - (cond - [(= (length matches) count) #R (car matches)] - [(quad? this) - (when (pred this) - (set! matches (cons this matches))) - (for-each loop (quad-elems this))] - [else this])))) + (for/fold ([qs (flatten-quad q)] + #:result (and qs (car qs))) + ([qa (in-list query-assocs)]) + (match-define (cons pred count) qa) + (let loop ([qs qs][seen 0]) + (define maybe-tail (memf pred qs)) + (and maybe-tail + (let ([seen (add1 seen)]) + (cond + [(= seen count) maybe-tail] + [else (loop (cdr maybe-tail) seen)])))))) + -(query doc "section[1]:line[2]") \ No newline at end of file +(query doc "sec[2]:pg[1]") \ No newline at end of file