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

Another small speed bump from using hash-for-each over in-hash-keys

This commit is contained in:
Tony Garnock-Jones 2018-04-30 10:04:33 +01:00
parent 00121d9710
commit c2cb624e42
1 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
syndicate/skeleton.rkt
View File

@ -117,17 +117,19 @@
(match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
(define (make-matched-constant)
(define assertions (make-hash))
(for [(a (in-hash-keys (skeleton-continuation-cache c)))
#:when (equal? (apply-projection a cs) cv)]
(hash-set! assertions a #t))
(hash-for-each (skeleton-continuation-cache c)
(lambda (a _)
(when (equal? (apply-projection a cs) cv)
(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-hash-keys (skeleton-matched-constant-cache sc)))]
(define vars (apply-projection a vs))
(bag-change! cache vars 1))
(hash-for-each (skeleton-matched-constant-cache sc)
(lambda (a _)
(define vars (apply-projection a vs))
(bag-change! cache vars 1)))
(skeleton-accumulator cache (make-hasheq)))
(define acc (hash-ref! (skeleton-matched-constant-table sc) vs make-accumulator))
(hash-set! (skeleton-accumulator-handlers acc) h #t)
@ -181,8 +183,10 @@
(define (make-skeleton-node-with-cache)
(define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
(define filtered (make-hash))
(for [(a (in-hash-keys unfiltered)) #:when (subterm-matches-class? a path class)]
(hash-set! filtered a #t))
(hash-for-each unfiltered
(lambda (a _)
(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)]
@ -211,14 +215,15 @@
(match-define (skeleton-node continuation edges) sk)
(modify-skcont! continuation term0)
(for [((constant-proj key-proj-handler) (in-hash (skeleton-continuation-table continuation)))]
(define constants (apply-projection term0 constant-proj))
(define proj-handler (hash-ref key-proj-handler constants #f))
(when proj-handler
(modify-skconst! proj-handler term0)
(for [((variable-proj acc) (in-hash (skeleton-matched-constant-table proj-handler)))]
(define variables (apply-projection term0 variable-proj))
(modify-skacc! acc variables term0))))
(hash-for-each (skeleton-continuation-table continuation)
(lambda (constant-proj key-proj-handler)
(define constants (apply-projection term0 constant-proj))
(define proj-handler (hash-ref key-proj-handler constants #f))
(when proj-handler
(modify-skconst! proj-handler term0)
(for [((variable-proj acc) (in-hash (skeleton-matched-constant-table proj-handler)))]
(define variables (apply-projection term0 variable-proj))
(modify-skacc! acc variables term0)))))
(for [(edge (in-list edges))]
(match-define (cons (skeleton-selector pop-count index) table) edge)
@ -245,8 +250,8 @@
(define (add-term-to-skacc! skacc vars _term)
(match (bag-change! (skeleton-accumulator-cache skacc) vars 1)
['absent->present
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '+ vars))]
(hash-for-each (skeleton-accumulator-handlers skacc)
(lambda (handler _) (apply handler '+ vars)))]
;; 'present->absent and 'absent->absent absurd
['present->present
(void)]))
@ -267,8 +272,8 @@
(if (bag-member? cache vars)
(match (bag-change! cache vars -1)
['present->absent
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '- vars))]
(hash-for-each (skeleton-accumulator-handlers skacc)
(lambda (handler _) (apply handler '- vars)))]
;; 'absent->absent and 'absent->present absurd
['present->present
(void)])
@ -287,8 +292,8 @@
void
void
(lambda (skacc vars _term)
(for [(handler (in-hash-keys (skeleton-accumulator-handlers skacc)))]
(apply handler '! vars)))))
(hash-for-each (skeleton-accumulator-handlers skacc)
(lambda (handler _) (apply handler '! vars))))))
;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
(define (apply-projection term proj)