Update apply-reduction-relation* to be sensitive to alpha-equivalence

Also add an immutable alpha hash constructor and update hashes in
the gui to use the form provided by binding-forms.rkt

Fixes racket#96

Author: howell

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

@@ -66,10 +66,8 @@ todo:
     ;; all-nodes-ht : hash[sexp -o> (is-a/c node%)]
 
     (define all-nodes-ht
-      (let* ([lang (reduction-relation-lang red)]
-             [term-equal? (lambda (x y) (α-equal? (compiled-lang-binding-table lang) match-pattern x y))]
-             [term-hash (lambda (x) (α-equal-hash-code (compiled-lang-binding-table lang) match-pattern x))])
-      (make-custom-hash term-equal? term-hash)))
+      (make-α-hash (compiled-lang-binding-table (reduction-relation-lang red))
+                   match-pattern))
 
     (define root (new node%
                       [pp pp]

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

@@ -353,9 +353,7 @@
       [(IO-judgment-form? reductions) (runtime-judgment-form-lang reductions)]))
 
   (define snip-cache
-    (let* ([term-equal? (lambda (x y) (α-equal? (compiled-lang-binding-table reductions-lang) match-pattern x y))]
-           [term-hash (lambda (x) (α-equal-hash-code (compiled-lang-binding-table reductions-lang) match-pattern x))])
-      (make-custom-hash term-equal? term-hash)))
+    (make-α-hash (compiled-lang-binding-table reductions-lang) match-pattern))
 
   ;; call-on-eventspace-main-thread : (-> any) -> any
   ;; =reduction thread=

redex-lib/redex/private/binding-forms.rkt

@@ -89,7 +89,7 @@ to traverse the whole value at once, rather than one binding form at a time.
 ;; == public interface ==
 
 (provide freshen α-equal? α-equal-hash-code safe-subst binding-forms-opened?
-         make-α-hash)
+         make-α-hash make-immutable-α-hash)
 
 ;; == parameters ==
 
@@ -137,6 +137,11 @@ to traverse the whole value at once, rather than one binding form at a time.
                     (λ (x) (α-equal-hash-code language-bf-table match-pattern x))
                     (λ (x) (α-equal-secondary-hash-code language-bf-table match-pattern x))))
 
+(define (make-immutable-α-hash language-bf-table match-pattern)
+  (make-immutable-custom-hash (λ (x y) (α-equal? language-bf-table match-pattern x y))
+                              (λ (x) (α-equal-hash-code language-bf-table match-pattern x))
+                              (λ (x) (α-equal-secondary-hash-code language-bf-table match-pattern x))))
+
 ;; α-equal? : (listof (list compiled-pattern bspec))
 ;; (compiled-pattern redex-val -> (union #f mtch)) redex-val -> boolean
 (define (α-equal? language-bf-table match-pattern redex-val-lhs redex-val-rhs)

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

@@ -12,13 +12,15 @@
          "lang-struct.rkt"
          "enum.rkt"
          (only-in "binding-forms.rkt"
-                  α-equal? safe-subst binding-forms-opened?)
+                  α-equal? α-equal-hash-code safe-subst binding-forms-opened?
+                  make-α-hash make-immutable-α-hash)
          (only-in "binding-forms-definitions.rkt"
                   shadow nothing bf-table-entry-pat bf-table-entry-bspec)
          racket/trace
          racket/contract
          racket/list
          racket/set
+         racket/dict
          racket/pretty
          rackunit/log
          (rename-in racket/match (match match:)))
@@ -2558,9 +2560,12 @@
                                   #:all? [return-all? #f]
                                   #:cache-all? [cache-all? (or return-all? (current-cache-all?))]
                                   #:stop-when [stop-when (λ (x) #f)])
-  (define visited (and (or cache-all? return-all?) (make-hash)))
+  (define lang (reduction-relation-lang reductions))
+  (define binding-table (compiled-lang-binding-table lang))
+  (define (term-equal? x y) (α-equal? binding-table match-pattern x y))
+  (define visited (and (or cache-all? return-all?) (make-α-hash binding-table match-pattern)))
   (let/ec return
-    (define answers (if return-all? #f (make-hash)))
+    (define answers (if return-all? #f (make-α-hash binding-table match-pattern)))
     (define cycle? #f)
     (define cutoff? #f)
     (let loop ([term start]
@@ -2570,39 +2575,39 @@
                ;; in commit
                ;;    152084d5ce6ef49df3ec25c18e40069950146041
                ;; suggest that a hash works better than a trie.
-               [path (make-immutable-hash '())]
+               [path (make-immutable-α-hash binding-table match-pattern)]
                [more-steps steps])
       (if (and goal? (goal? term))
           (return (search-success))
           (cond
-            [(hash-ref path term #f)
+            [(dict-ref path term #f)
              (set! cycle? #t)]
             [else
              (visit term)
              (cond
                [(stop-when term)
                 (unless goal?
                   (when answers
-                    (hash-set! answers term #t)))]
+                    (dict-set! answers term #t)))]
                [else
                 (define nexts (apply-reduction-relation reductions term))
                 (cond
                   [(null? nexts) 
                    (unless goal?
                      (when answers
-                       (hash-set! answers term #t)))]
+                       (dict-set! answers term #t)))]
                   [else (if (zero? more-steps)
                             (set! cutoff? #t)
-                            (for ([next (in-list (remove-duplicates nexts))])
+                            (for ([next (in-list (remove-duplicates nexts term-equal?))])
                               (when (or (not visited)
-                                        (not (hash-ref visited next #f)))
-                                (when visited (hash-set! visited next #t))
+                                        (not (dict-ref visited next #f)))
+                                (when visited (dict-set! visited next #t))
                                 (loop next 
-                                      (hash-set path term #t) 
+                                      (dict-set path term #t)
                                       (sub1 more-steps)))))])])])))
     (if goal?
         (search-failure cutoff?)
-        (values (sort (hash-map (or answers visited) (λ (x y) x))
+        (values (sort (dict-map (or answers visited) (λ (x y) x))
                       string<?
                       #:key (λ (x) (format "~s" x)))
                 cycle?))))