syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Avoid sets on the hot path (use hashes instead); good speed improvement

This commit is contained in:
Tony Garnock-Jones 2018-04-30 09:32:08 +01:00
parent eb3a93e32b
commit 00121d9710
1 changed files with 34 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
syndicate/skeleton.rkt
View File

@ -14,7 +14,6 @@
(require syndicate/support/struct)
(require racket/match)
(require racket/set)
(require racket/hash)
(require racket/list)
@ -112,25 +111,26 @@
'()))
(define (make-empty-skeleton)
(make-empty-skeleton/cache (mutable-set)))
(make-empty-skeleton/cache (make-hash)))
(define (skcont-add! c i)
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
(define (make-matched-constant)
(skeleton-matched-constant (for/mutable-set [(a (in-set (skeleton-continuation-cache c)))
(define assertions (make-hash))
(for [(a (in-hash-keys (skeleton-continuation-cache c)))
#:when (equal? (apply-projection a cs) cv)]
a)
(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 sc (hash-ref! cvt cv make-matched-constant))
(define (make-accumulator)
(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))
(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))
(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)))
(define (skcont-remove! c i)
@ -141,10 +141,10 @@
(when sc
(define acc (hash-ref (skeleton-matched-constant-table sc) vs #f))
(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)))
(set-remove! (skeleton-accumulator-handlers acc) h)
(when (set-empty? (skeleton-accumulator-handlers acc))
(hash-remove! (skeleton-accumulator-handlers acc) h)
(when (hash-empty? (skeleton-accumulator-handlers acc))
(hash-remove! (skeleton-matched-constant-table sc) vs)))
(when (hash-empty? (skeleton-matched-constant-table sc))
(hash-remove! cvt cv)))
@ -180,8 +180,10 @@
[(cons _selector table) table]))
(define (make-skeleton-node-with-cache)
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
(make-empty-skeleton/cache
(for/mutable-set [(a (in-set unfiltered)) #:when (subterm-matches-class? a path class)] a)))
(define filtered (make-hash))
(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))
(walk-edge! (update-path path pop-count 0) next 0 0 pieces)]
[_
@ -237,13 +239,13 @@
(walk-node! sk (list (vector 'list term0))))
(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)
(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)
(match (bag-change! (skeleton-accumulator-cache skacc) vars 1)
['absent->present
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '+ vars))]
;; 'present->absent and 'absent->absent absurd
['present->present
@ -257,15 +259,15 @@
add-term-to-skacc!))
(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)
(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 cache (skeleton-accumulator-cache skacc))
(if (bag-member? cache vars)
(match (bag-change! cache vars -1)
['present->absent
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '- vars))]
;; 'absent->absent and 'absent->present absurd
['present->present
@ -285,7 +287,7 @@
void
void
(lambda (skacc vars _term)
(for [(handler (in-set (skeleton-accumulator-handlers skacc)))]
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '! vars)))))
;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
@ -308,7 +310,8 @@
(struct d (x y z) #:transparent)
(define sk
(make-empty-skeleton/cache (mutable-set (a (b 'bee) (b 'cat))
(make-empty-skeleton/cache
(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))
@ -316,7 +319,8 @@
(d (b 'DBX) (b 'DBY) (b 'DBZ))
(d (c 'DCX) (c 'DCY) (c 'DCZ))
(b 'zot)
123)))
123))]
(cons x #t)))))
(define i1
(skeleton-interest (list struct:a (list struct:b #f) #f)