From 00121d9710940a41fa7512e68d4400823f015c80 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 30 Apr 2018 09:32:08 +0100 Subject: [PATCH] Avoid sets on the hot path (use hashes instead); good speed improvement --- syndicate/skeleton.rkt | 64 ++++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/syndicate/skeleton.rkt b/syndicate/skeleton.rkt index 14a33c2..bbae7cf 100644 --- a/syndicate/skeleton.rkt +++ b/syndicate/skeleton.rkt @@ -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))) - #:when (equal? (apply-projection a cs) cv)] - a) - (make-hash))) + (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)) + (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,15 +310,17 @@ (struct d (x y z) #:transparent) (define sk - (make-empty-skeleton/cache (mutable-set (a (b 'bee) (b 'cat)) - (a (b 'foo) (c 'bar)) - (a (b 'foo) (c 'BAR)) - (a (c 'bar) (b 'foo)) - (a (c 'dog) (c 'fox)) - (d (b 'DBX) (b 'DBY) (b 'DBZ)) - (d (c 'DCX) (c 'DCY) (c 'DCZ)) - (b 'zot) - 123))) + (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)) + (a (c 'dog) (c 'fox)) + (d (b 'DBX) (b 'DBY) (b 'DBZ)) + (d (c 'DCX) (c 'DCY) (c 'DCZ)) + (b 'zot) + 123))] + (cons x #t))))) (define i1 (skeleton-interest (list struct:a (list struct:b #f) #f)