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

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)))
+    (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 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)
+        (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)))
       (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
+         (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))
        (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))
+    (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
     (skeleton-interest (list struct:a (list struct:b #f) #f)