|
11 | 11 | "search.rkt"
|
12 | 12 | "enum.rkt"
|
13 | 13 | (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) |
15 | 15 | (only-in "binding-forms-definitions.rkt"
|
16 | 16 | shadow nothing bf-table-entry-pat bf-table-entry-bspec)
|
17 | 17 | racket/trace
|
|
2736 | 2736 | #:all? [return-all? #f]
|
2737 | 2737 | #:cache-all? [cache-all? (or return-all? (current-cache-all?))]
|
2738 | 2738 | #: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))) |
2740 | 2744 | (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))) |
2742 | 2750 | (define cycle? #f)
|
2743 | 2751 | (define cutoff? #f)
|
2744 | 2752 | (let loop ([term start]
|
|
2749 | 2757 | ;; 152084d5ce6ef49df3ec25c18e40069950146041
|
2750 | 2758 | ;; suggest that a hash works better than a trie.
|
2751 | 2759 | [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)] |
2756 | 2763 | [more-steps steps])
|
2757 | 2764 | (if (and goal? (goal? term))
|
2758 | 2765 | (return (search-success))
|
|
2765 | 2772 | [(stop-when term)
|
2766 | 2773 | (unless goal?
|
2767 | 2774 | (when answers
|
2768 |
| - (hash-set! answers term #t)))] |
| 2775 | + (dict-set! answers term #t)))] |
2769 | 2776 | [else
|
2770 | 2777 | (define nexts (remove-duplicates (apply-reduction-relation reductions term)))
|
2771 | 2778 | (define nexts-in-domain (remove-outside-domain reductions nexts))
|
|
2775 | 2782 | (when answers
|
2776 | 2783 | (cond
|
2777 | 2784 | [(null? nexts)
|
2778 |
| - (hash-set! answers term #t)] |
| 2785 | + (dict-set! answers term #t)] |
2779 | 2786 | [else
|
2780 | 2787 | (for ([next (in-list nexts)])
|
2781 |
| - (hash-set! answers next #t))])))] |
| 2788 | + (dict-set! answers next #t))])))] |
2782 | 2789 | [else (if (zero? more-steps)
|
2783 | 2790 | (set! cutoff? #t)
|
2784 | 2791 | (for ([next (in-list nexts-in-domain)])
|
2785 | 2792 | (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)) |
2788 | 2795 | (loop next
|
2789 | 2796 | (dict-set path term #t)
|
2790 | 2797 | (sub1 more-steps)))))])])])))
|
2791 | 2798 | (if goal?
|
2792 | 2799 | (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)) |
2794 | 2801 | string<?
|
2795 | 2802 | #:key (λ (x) (format "~s" x)))
|
2796 | 2803 | cycle?))))
|
|
0 commit comments