Skip to content

Commit 35da193

Browse files
howellrfindler
authored andcommitted
change some hash tables to be alpha hashes and use make-α-hash in
a few places that were doing things the hard way closes #102
1 parent d763cbc commit 35da193

File tree

3 files changed

+27
-29
lines changed

3 files changed

+27
-29
lines changed

redex-gui-lib/redex/private/stepper.rkt

Lines changed: 4 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,15 +67,10 @@ todo:
6767
;; all-nodes-ht : hash[sexp -o> (is-a/c node%)]
6868

6969
(define all-nodes-ht
70-
(let* ([lang (reduction-relation/IO-jf-lang red)]
71-
[term-equal? (lambda (x y) (α-equal? (compiled-lang-binding-table lang)
72-
(compiled-lang-literals lang)
73-
match-pattern x y))]
74-
[term-hash (lambda (x) (α-equal-hash-code (compiled-lang-binding-table lang)
75-
(compiled-lang-literals lang)
76-
match-pattern x))])
77-
(make-custom-hash term-equal? term-hash)))
78-
70+
(let ([lang (reduction-relation/IO-jf-lang red)])
71+
(make-α-hash (compiled-lang-binding-table lang)
72+
(compiled-lang-literals lang)
73+
match-pattern)))
7974
(define root (new node%
8075
[pp pp]
8176
[all-nodes-ht all-nodes-ht]

redex-gui-lib/redex/private/traces.rkt

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -351,13 +351,9 @@
351351
(reduction-relation/IO-jf-lang reductions))
352352

353353
(define snip-cache
354-
(let* ([term-equal? (lambda (x y) (α-equal? (compiled-lang-binding-table reductions-lang)
355-
(compiled-lang-literals reductions-lang)
356-
match-pattern x y))]
357-
[term-hash (lambda (x) (α-equal-hash-code (compiled-lang-binding-table reductions-lang)
358-
(compiled-lang-literals reductions-lang)
359-
match-pattern x))])
360-
(make-custom-hash term-equal? term-hash)))
354+
(make-α-hash (compiled-lang-binding-table reductions-lang)
355+
(compiled-lang-literals reductions-lang)
356+
match-pattern))
361357

362358
;; call-on-eventspace-main-thread : (-> any) -> any
363359
;; =reduction thread=

redex-lib/redex/private/reduction-semantics.rkt

Lines changed: 20 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
"search.rkt"
1212
"enum.rkt"
1313
(only-in "binding-forms.rkt"
14-
safe-subst binding-forms-opened? make-immutable-α-hash)
14+
safe-subst binding-forms-opened? make-immutable-α-hash make-α-hash)
1515
(only-in "binding-forms-definitions.rkt"
1616
shadow nothing bf-table-entry-pat bf-table-entry-bspec)
1717
racket/trace
@@ -2736,9 +2736,17 @@
27362736
#:all? [return-all? #f]
27372737
#:cache-all? [cache-all? (or return-all? (current-cache-all?))]
27382738
#:stop-when [stop-when (λ (x) #f)])
2739-
(define visited (and (or cache-all? return-all?) (make-hash)))
2739+
(define lang (reduction-relation/IO-jf-lang reductions))
2740+
(define visited (and (or cache-all? return-all?)
2741+
(make-α-hash (compiled-lang-binding-table lang)
2742+
(compiled-lang-literals lang)
2743+
match-pattern)))
27402744
(let/ec return
2741-
(define answers (if return-all? #f (make-hash)))
2745+
(define answers (if return-all?
2746+
#f
2747+
(make-α-hash (compiled-lang-binding-table lang)
2748+
(compiled-lang-literals lang)
2749+
match-pattern)))
27422750
(define cycle? #f)
27432751
(define cutoff? #f)
27442752
(let loop ([term start]
@@ -2749,10 +2757,9 @@
27492757
;; 152084d5ce6ef49df3ec25c18e40069950146041
27502758
;; suggest that a hash works better than a trie.
27512759
[path
2752-
(let ([lang (reduction-relation/IO-jf-lang reductions)])
2753-
(make-immutable-α-hash (compiled-lang-binding-table lang)
2754-
(compiled-lang-literals lang)
2755-
match-pattern))]
2760+
(make-immutable-α-hash (compiled-lang-binding-table lang)
2761+
(compiled-lang-literals lang)
2762+
match-pattern)]
27562763
[more-steps steps])
27572764
(if (and goal? (goal? term))
27582765
(return (search-success))
@@ -2765,7 +2772,7 @@
27652772
[(stop-when term)
27662773
(unless goal?
27672774
(when answers
2768-
(hash-set! answers term #t)))]
2775+
(dict-set! answers term #t)))]
27692776
[else
27702777
(define nexts (remove-duplicates (apply-reduction-relation reductions term)))
27712778
(define nexts-in-domain (remove-outside-domain reductions nexts))
@@ -2775,22 +2782,22 @@
27752782
(when answers
27762783
(cond
27772784
[(null? nexts)
2778-
(hash-set! answers term #t)]
2785+
(dict-set! answers term #t)]
27792786
[else
27802787
(for ([next (in-list nexts)])
2781-
(hash-set! answers next #t))])))]
2788+
(dict-set! answers next #t))])))]
27822789
[else (if (zero? more-steps)
27832790
(set! cutoff? #t)
27842791
(for ([next (in-list nexts-in-domain)])
27852792
(when (or (not visited)
2786-
(not (hash-ref visited next #f)))
2787-
(when visited (hash-set! visited next #t))
2793+
(not (dict-ref visited next #f)))
2794+
(when visited (dict-set! visited next #t))
27882795
(loop next
27892796
(dict-set path term #t)
27902797
(sub1 more-steps)))))])])])))
27912798
(if goal?
27922799
(search-failure cutoff?)
2793-
(values (sort (hash-map (or answers visited) (λ (x y) x))
2800+
(values (sort (dict-map (or answers visited) (λ (x y) x))
27942801
string<?
27952802
#:key (λ (x) (format "~s" x)))
27962803
cycle?))))

0 commit comments

Comments
 (0)