main
Matthew Butterick 4 years ago
parent ad20e50294
commit 2a4ca8b9df

@ -10,7 +10,7 @@
(define qs (let loop ([q q]) (define qs (let loop ([q q])
(cons q (append* (for/list ([elem (in-list (quad-elems q))] (cons q (append* (for/list ([elem (in-list (quad-elems q))]
#:when (quad? elem)) #:when (quad? elem))
(loop elem)))))) (loop elem))))))
(query-index qs (reverse qs))) (query-index qs (reverse qs)))
(define (string->key str #:this [this? #false]) (define (string->key str #:this [this? #false])
@ -31,17 +31,18 @@
(define (parse-query str) (define (parse-query str)
(for/list ([piece (in-list (string-split str ":"))]) (for/list ([piece (in-list (string-split str ":"))])
(match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece) (match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
[#false (cons (string->key piece) #false)] [#false (cons (string->key piece) #false)]
[(list _ name arg) (cons (hash-ref preds (string->key name)) (or (string->number arg) [(list _ name arg) (cons (hash-ref preds (string->key name)) (or (string->number arg)
(string->symbol arg)))]))) (string->symbol arg)))])))
(define (query quad-or-index query-str [querying-q #false]) (define (query quad-or-index query-str [querying-q #false])
(define qi (match quad-or-index (define qi (match quad-or-index
[(? quad? q) (make-query-index q)] [(? quad? q) (make-query-index q)]
[idx idx])) [idx idx]))
(for/fold ([qs (query-index-forward qi)] (define vec (list->vector (query-index-forward qi)))
#:result (and qs (car qs))) (for/fold ([vidx 0]
#:result (and vidx (vector-ref vec vidx)))
([query-piece (in-list (parse-query query-str))]) ([query-piece (in-list (parse-query query-str))])
(match query-piece (match query-piece
[(cons pred 'this) [(cons pred 'this)
@ -50,13 +51,17 @@
;; once we have this-thing, locate it in the forward index and keep going ;; once we have this-thing, locate it in the forward index and keep going
(memq this-thing (query-index-forward qi))] (memq this-thing (query-index-forward qi))]
[(cons pred count) [(cons pred count)
(let loop ([qs qs][seen 0]) (let loop ([vidx vidx][seen 0])
(define maybe-tail (memf pred qs)) (define idx (for*/first ([vi (in-range vidx (vector-length vec))]
(and maybe-tail [val (in-value (vector-ref vec vi))]
#:when (pred val))
vi))
(and idx
(let ([seen (add1 seen)]) (let ([seen (add1 seen)])
(cond (cond
[(= seen count) maybe-tail] [(= seen count) idx]
[else (loop (cdr maybe-tail) seen)]))))]))) [else (loop (add1 idx) seen)]))))])))
(module+ test (module+ test
(require rackunit) (require rackunit)
@ -65,12 +70,12 @@
(define-syntax-rule (factory type proc) (define-syntax-rule (factory type proc)
(make-quad #:type type (make-quad #:type type
#:elems (for/list ([i (in-range 3)]) #:elems (for/list ([i (in-range 3)])
(set! counter (add1 counter)) (set! counter (add1 counter))
(define new-q (proc)) (define new-q (proc))
(quad-update! new-q (quad-update! new-q
[tag (format "~a[~a]-~a" 'proc counter (gensym))]) [tag (format "~a[~a]-~a" 'proc counter (gensym))])
(hash-set! (quad-attrs new-q) 'count counter) (hash-set! (quad-attrs new-q) 'count counter)
new-q))) new-q)))
(define (line) (make-quad #:type line-quad)) (define (line) (make-quad #:type line-quad))
(define (block) (factory block-quad line)) (define (block) (factory block-quad line))

Loading…
Cancel
Save