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