From 2a4ca8b9dfcc229ea4f4e786990cdb1079b17d03 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 14 Feb 2020 21:04:13 -0800 Subject: [PATCH] firstie --- quad/quadwriter/query.rkt | 41 ++++++++++++++++++++++----------------- 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/quad/quadwriter/query.rkt b/quad/quadwriter/query.rkt index 0e118fcc..60865696 100644 --- a/quad/quadwriter/query.rkt +++ b/quad/quadwriter/query.rkt @@ -10,7 +10,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)))))) (query-index qs (reverse qs))) (define (string->key str #:this [this? #false]) @@ -31,17 +31,18 @@ (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 (query quad-or-index query-str [querying-q #false]) (define qi (match quad-or-index [(? quad? q) (make-query-index q)] [idx idx])) - (for/fold ([qs (query-index-forward qi)] - #:result (and qs (car qs))) + (define vec (list->vector (query-index-forward qi))) + (for/fold ([vidx 0] + #:result (and vidx (vector-ref vec vidx))) ([query-piece (in-list (parse-query query-str))]) (match query-piece [(cons pred 'this) @@ -50,13 +51,17 @@ ;; once we have this-thing, locate it in the forward index and keep going (memq this-thing (query-index-forward qi))] [(cons pred count) - (let loop ([qs qs][seen 0]) - (define maybe-tail (memf pred qs)) - (and maybe-tail + (let loop ([vidx vidx][seen 0]) + (define idx (for*/first ([vi (in-range vidx (vector-length vec))] + [val (in-value (vector-ref vec vi))] + #:when (pred val)) + vi)) + + (and idx (let ([seen (add1 seen)]) (cond - [(= seen count) maybe-tail] - [else (loop (cdr maybe-tail) seen)]))))]))) + [(= seen count) idx] + [else (loop (add1 idx) seen)]))))]))) (module+ test (require rackunit) @@ -65,12 +70,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))