Avoid sets on the hot path (use hashes instead); good speed improvement
This commit is contained in:
parent
eb3a93e32b
commit
00121d9710
|
@ -14,7 +14,6 @@
|
||||||
|
|
||||||
(require syndicate/support/struct)
|
(require syndicate/support/struct)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require racket/set)
|
|
||||||
(require racket/hash)
|
(require racket/hash)
|
||||||
(require racket/list)
|
(require racket/list)
|
||||||
|
|
||||||
|
@ -112,25 +111,26 @@
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
(define (make-empty-skeleton)
|
(define (make-empty-skeleton)
|
||||||
(make-empty-skeleton/cache (mutable-set)))
|
(make-empty-skeleton/cache (make-hash)))
|
||||||
|
|
||||||
(define (skcont-add! c i)
|
(define (skcont-add! c i)
|
||||||
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
|
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
|
||||||
(define (make-matched-constant)
|
(define (make-matched-constant)
|
||||||
(skeleton-matched-constant (for/mutable-set [(a (in-set (skeleton-continuation-cache c)))
|
(define assertions (make-hash))
|
||||||
#:when (equal? (apply-projection a cs) cv)]
|
(for [(a (in-hash-keys (skeleton-continuation-cache c)))
|
||||||
a)
|
#:when (equal? (apply-projection a cs) cv)]
|
||||||
(make-hash)))
|
(hash-set! assertions a #t))
|
||||||
|
(skeleton-matched-constant assertions (make-hash)))
|
||||||
(define cvt (hash-ref! (skeleton-continuation-table c) cs make-hash))
|
(define cvt (hash-ref! (skeleton-continuation-table c) cs make-hash))
|
||||||
(define sc (hash-ref! cvt cv make-matched-constant))
|
(define sc (hash-ref! cvt cv make-matched-constant))
|
||||||
(define (make-accumulator)
|
(define (make-accumulator)
|
||||||
(define cache (make-bag))
|
(define cache (make-bag))
|
||||||
(for [(a (in-set (skeleton-matched-constant-cache sc)))]
|
(for [(a (in-hash-keys (skeleton-matched-constant-cache sc)))]
|
||||||
(define vars (apply-projection a vs))
|
(define vars (apply-projection a vs))
|
||||||
(bag-change! cache vars 1))
|
(bag-change! cache vars 1))
|
||||||
(skeleton-accumulator cache (mutable-seteq)))
|
(skeleton-accumulator cache (make-hasheq)))
|
||||||
(define acc (hash-ref! (skeleton-matched-constant-table sc) vs make-accumulator))
|
(define acc (hash-ref! (skeleton-matched-constant-table sc) vs make-accumulator))
|
||||||
(set-add! (skeleton-accumulator-handlers acc) h)
|
(hash-set! (skeleton-accumulator-handlers acc) h #t)
|
||||||
(for [(vars (in-bag (skeleton-accumulator-cache acc)))] (apply h '+ vars)))
|
(for [(vars (in-bag (skeleton-accumulator-cache acc)))] (apply h '+ vars)))
|
||||||
|
|
||||||
(define (skcont-remove! c i)
|
(define (skcont-remove! c i)
|
||||||
|
@ -141,10 +141,10 @@
|
||||||
(when sc
|
(when sc
|
||||||
(define acc (hash-ref (skeleton-matched-constant-table sc) vs #f))
|
(define acc (hash-ref (skeleton-matched-constant-table sc) vs #f))
|
||||||
(when acc
|
(when acc
|
||||||
(when (and cleanup (set-member? (skeleton-accumulator-handlers acc) h))
|
(when (and cleanup (hash-has-key? (skeleton-accumulator-handlers acc) h))
|
||||||
(cleanup (skeleton-accumulator-cache acc)))
|
(cleanup (skeleton-accumulator-cache acc)))
|
||||||
(set-remove! (skeleton-accumulator-handlers acc) h)
|
(hash-remove! (skeleton-accumulator-handlers acc) h)
|
||||||
(when (set-empty? (skeleton-accumulator-handlers acc))
|
(when (hash-empty? (skeleton-accumulator-handlers acc))
|
||||||
(hash-remove! (skeleton-matched-constant-table sc) vs)))
|
(hash-remove! (skeleton-matched-constant-table sc) vs)))
|
||||||
(when (hash-empty? (skeleton-matched-constant-table sc))
|
(when (hash-empty? (skeleton-matched-constant-table sc))
|
||||||
(hash-remove! cvt cv)))
|
(hash-remove! cvt cv)))
|
||||||
|
@ -180,8 +180,10 @@
|
||||||
[(cons _selector table) table]))
|
[(cons _selector table) table]))
|
||||||
(define (make-skeleton-node-with-cache)
|
(define (make-skeleton-node-with-cache)
|
||||||
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
|
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
|
||||||
(make-empty-skeleton/cache
|
(define filtered (make-hash))
|
||||||
(for/mutable-set [(a (in-set unfiltered)) #:when (subterm-matches-class? a path class)] a)))
|
(for [(a (in-hash-keys unfiltered)) #:when (subterm-matches-class? a path class)]
|
||||||
|
(hash-set! filtered a #t))
|
||||||
|
(make-empty-skeleton/cache filtered))
|
||||||
(define next (hash-ref! table class make-skeleton-node-with-cache))
|
(define next (hash-ref! table class make-skeleton-node-with-cache))
|
||||||
(walk-edge! (update-path path pop-count 0) next 0 0 pieces)]
|
(walk-edge! (update-path path pop-count 0) next 0 0 pieces)]
|
||||||
[_
|
[_
|
||||||
|
@ -237,13 +239,13 @@
|
||||||
(walk-node! sk (list (vector 'list term0))))
|
(walk-node! sk (list (vector 'list term0))))
|
||||||
|
|
||||||
(define (add-term-to-skcont! skcont term)
|
(define (add-term-to-skcont! skcont term)
|
||||||
(set-add! (skeleton-continuation-cache skcont) term))
|
(hash-set! (skeleton-continuation-cache skcont) term #t))
|
||||||
(define (add-term-to-skconst! skconst term)
|
(define (add-term-to-skconst! skconst term)
|
||||||
(set-add! (skeleton-matched-constant-cache skconst) term))
|
(hash-set! (skeleton-matched-constant-cache skconst) term #t))
|
||||||
(define (add-term-to-skacc! skacc vars _term)
|
(define (add-term-to-skacc! skacc vars _term)
|
||||||
(match (bag-change! (skeleton-accumulator-cache skacc) vars 1)
|
(match (bag-change! (skeleton-accumulator-cache skacc) vars 1)
|
||||||
['absent->present
|
['absent->present
|
||||||
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
|
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
|
||||||
(apply handler '+ vars))]
|
(apply handler '+ vars))]
|
||||||
;; 'present->absent and 'absent->absent absurd
|
;; 'present->absent and 'absent->absent absurd
|
||||||
['present->present
|
['present->present
|
||||||
|
@ -257,15 +259,15 @@
|
||||||
add-term-to-skacc!))
|
add-term-to-skacc!))
|
||||||
|
|
||||||
(define (remove-term-from-skcont! skcont term)
|
(define (remove-term-from-skcont! skcont term)
|
||||||
(set-remove! (skeleton-continuation-cache skcont) term))
|
(hash-remove! (skeleton-continuation-cache skcont) term))
|
||||||
(define (remove-term-from-skconst! skconst term)
|
(define (remove-term-from-skconst! skconst term)
|
||||||
(set-remove! (skeleton-matched-constant-cache skconst) term))
|
(hash-remove! (skeleton-matched-constant-cache skconst) term))
|
||||||
(define (remove-term-from-skacc! skacc vars _term)
|
(define (remove-term-from-skacc! skacc vars _term)
|
||||||
(define cache (skeleton-accumulator-cache skacc))
|
(define cache (skeleton-accumulator-cache skacc))
|
||||||
(if (bag-member? cache vars)
|
(if (bag-member? cache vars)
|
||||||
(match (bag-change! cache vars -1)
|
(match (bag-change! cache vars -1)
|
||||||
['present->absent
|
['present->absent
|
||||||
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
|
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
|
||||||
(apply handler '- vars))]
|
(apply handler '- vars))]
|
||||||
;; 'absent->absent and 'absent->present absurd
|
;; 'absent->absent and 'absent->present absurd
|
||||||
['present->present
|
['present->present
|
||||||
|
@ -285,7 +287,7 @@
|
||||||
void
|
void
|
||||||
void
|
void
|
||||||
(lambda (skacc vars _term)
|
(lambda (skacc vars _term)
|
||||||
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
|
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
|
||||||
(apply handler '! vars)))))
|
(apply handler '! vars)))))
|
||||||
|
|
||||||
;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
|
;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
|
||||||
|
@ -308,15 +310,17 @@
|
||||||
(struct d (x y z) #:transparent)
|
(struct d (x y z) #:transparent)
|
||||||
|
|
||||||
(define sk
|
(define sk
|
||||||
(make-empty-skeleton/cache (mutable-set (a (b 'bee) (b 'cat))
|
(make-empty-skeleton/cache
|
||||||
(a (b 'foo) (c 'bar))
|
(make-hash (for/list [(x (list (a (b 'bee) (b 'cat))
|
||||||
(a (b 'foo) (c 'BAR))
|
(a (b 'foo) (c 'bar))
|
||||||
(a (c 'bar) (b 'foo))
|
(a (b 'foo) (c 'BAR))
|
||||||
(a (c 'dog) (c 'fox))
|
(a (c 'bar) (b 'foo))
|
||||||
(d (b 'DBX) (b 'DBY) (b 'DBZ))
|
(a (c 'dog) (c 'fox))
|
||||||
(d (c 'DCX) (c 'DCY) (c 'DCZ))
|
(d (b 'DBX) (b 'DBY) (b 'DBZ))
|
||||||
(b 'zot)
|
(d (c 'DCX) (c 'DCY) (c 'DCZ))
|
||||||
123)))
|
(b 'zot)
|
||||||
|
123))]
|
||||||
|
(cons x #t)))))
|
||||||
|
|
||||||
(define i1
|
(define i1
|
||||||
(skeleton-interest (list struct:a (list struct:b #f) #f)
|
(skeleton-interest (list struct:a (list struct:b #f) #f)
|
||||||
|
|
Loading…
Reference in New Issue