add hashequalw to use equal-always-hash-code

equalw is short for EQUal ALWays, first 3 letters of each word

pkgs/base/info.rkt

@@ -14,7 +14,7 @@
 
 ;; In the Racket source repo, this version should change only when
 ;; "racket_version.h" changes:
-(define version "8.3.0.11")
+(define version "8.3.0.12")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/compiler-lib/compiler/private/deserialize.rkt

@@ -85,9 +85,10 @@
           (values (reverse rev) rest)]
          [(#:mpi)
           (values (vector-ref mpis (cadr r)) (cddr r))]
-         [(#:hash #:hasheq #:hasheqv #:hasheqv/phase+space)
+         [(#:hash #:hashequalw #:hasheq #:hasheqv #:hasheqv/phase+space)
           (define ht (case i
                        [(#:hash) (hash)]
+                       [(#:hashequalw) (hashequalw)]
                        [(#:hasheq) (hasheq)]
                        [(#:hasheqv  #:hasheqv/phase+space) (hasheqv)]))
           (for/fold ([ht ht] [r (cddr r)]) ([i (in-range (cadr r))])

pkgs/zo-lib/compiler/zo-marshal.rkt

@@ -753,7 +753,8 @@
         (out-number (cond
                       [(hash-eqv? v) 2]
                       [(hash-eq? v) 0]
-                      [(hash-equal? v) 1])
+                      [(hash-equal? v) 1]
+                      [(hash-equal-always? v) 3])
                     out)
         (out-number (hash-count v) out)
         (for ([(k v) (in-hash v)])

pkgs/zo-lib/compiler/zo-parse.rkt

@@ -511,7 +511,8 @@
            ((case eq
               [(0) make-hasheq-placeholder]
               [(1) make-hash-placeholder]
-              [(2) make-hasheqv-placeholder])
+              [(2) make-hasheqv-placeholder]
+              [(3) make-hashequalw-placeholder])
             (for/list ([i (in-range len)])
               (cons (read-compact cp)
                     (read-compact cp)))))]

racket/collects/racket/contract/private/helpers.rkt

@@ -281,6 +281,7 @@
          (flonum? . #t)
          (handle-evt? . #t)
          (hash-eq? . #t)
+         (hash-equal-always? . #t)
          (hash-equal? . #t)
          (hash-eqv? . #t)
          (hash-placeholder? . #t)

racket/collects/racket/fasl.rkt

@@ -114,7 +114,8 @@
 (define-constants
   (fasl-hash-eq-variant    0)
   (fasl-hash-equal-variant 1)
-  (fasl-hash-eqv-variant   2))
+  (fasl-hash-eqv-variant   2)
+  (fasl-hash-equal-always-variant 3))
 
 ;; ----------------------------------------
 
@@ -350,6 +351,7 @@
            (write-byte (cond
                          [(hash-eq? v) fasl-hash-eq-variant]
                          [(hash-eqv? v) fasl-hash-eqv-variant]
+                         [(hash-equal-always? v) fasl-hash-equal-always-variant]
                          [else fasl-hash-equal-variant])
                        o)
            (write-fasl-integer (hash-count v) o)
@@ -510,6 +512,7 @@
                   (read-byte/no-eof i)
                   [(fasl-hash-eq-variant) (make-hasheq)]
                   [(fasl-hash-eqv-variant) (make-hasheqv)]
+                  [(fasl-hash-equal-always-variant) (make-hashequalw)]
                   [else (make-hash)]))
       (define len (read-fasl-integer i))
       (for ([j (in-range len)])
@@ -520,6 +523,7 @@
                   (read-byte/no-eof i)
                   [(fasl-hash-eq-variant) #hasheq()]
                   [(fasl-hash-eqv-variant) #hasheqv()]
+                  [(fasl-hash-equal-always-variant) (hashequalw)]
                   [else #hash()]))
       (define len (read-fasl-integer i))
       (for/fold ([ht ht]) ([j (in-range len)])

racket/collects/racket/place/private/th-place.rkt

@@ -154,6 +154,9 @@
            [(hash-equal? o)
             (for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
               (hash-set nh (dcw (car p)) (dcw (cdr p))))]
+           [(hash-equal-always? o)
+            (for/fold ([nh (hashequalw)]) ([p (in-hash-pairs o)])
+              (hash-set nh (dcw (car p)) (dcw (cdr p))))]
            [(hash-eq? o)
             (for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
               (hash-set nh (dcw (car p)) (dcw (cdr p))))]

racket/collects/racket/pretty.rkt

@@ -692,7 +692,9 @@
                      'hasheq
                      (if (hash-eqv? obj)
                          'hasheqv
-                         'hash)))
+                         (if (hash-equal-always? obj)
+                             'hashequalw
+                             'hash))))
                 (apply append l))
           l)))
 
@@ -933,7 +935,9 @@
                               "#hasheq"
                               (if (hash-eqv? obj)
                                   "#hasheqv"
-                                  "#hash"))))
+                                  (if (hash-equal-always? obj)
+                                      "#hashequalw"
+                                      "#hash")))))
                    (wr-lst (convert-hash obj expr?)
                            #f depth
                            pair? car cdr "(" ")" qd))))
@@ -1141,7 +1145,9 @@
                                      "#hasheq"
                                      (if (hash-eqv? obj)
                                          "#hasheqv"
-                                         "#hash"))))
+                                         (if (hash-equal-always? obj)
+                                             "#hashequalw"
+                                             "#hash")))))
                           (pp-list (convert-hash obj expr?) extra pp-expr #f depth
                                    pair? car cdr pair-open pair-close
                                    qd))]

racket/collects/racket/private/for.rkt

@@ -33,6 +33,7 @@
              for/hash for*/hash
              for/hasheq for*/hasheq
              for/hasheqv for*/hasheqv
+             for/hashequalw for*/hashequalw
 
              for/fold/derived for*/fold/derived
              for/foldr/derived for*/foldr/derived
@@ -2011,6 +2012,14 @@
       #`(let-values ([(key val) #,x])
           (hash-set table key val))))
 
+  (define-for-variants (for/hashequalw for*/hashequalw)
+    ([table (hashequalw)])
+    (lambda (x) x)
+    (lambda (rhs) rhs)
+    (lambda (x)
+      #`(let-values ([(key val) #,x])
+          (hash-set table key val))))
+
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;  specific sequences
 

racket/collects/racket/private/hash.rkt

@@ -59,16 +59,19 @@
      [(immutable? table)
       (cond
        [(hash-equal? table) (hash)]
+       [(hash-equal-always? table) (hashequalw)]
        [(hash-eqv? table) (hasheqv)]
        [(hash-eq? table) (hasheq)])]
      [(hash-weak? table)
       (cond
        [(hash-equal? table) (make-weak-hash)]
+       [(hash-equal-always? table) (make-weak-hashequalw)]
        [(hash-eqv? table) (make-weak-hasheqv)]
        [(hash-eq? table) (make-weak-hasheq)])]
      [else
       (cond
        [(hash-equal? table) (make-hash)]
+       [(hash-equal-always? table) (make-hashequalw)]
        [(hash-eqv? table) (make-hasheqv)]
        [(hash-eq? table) (make-hasheq)])]))
 

racket/collects/racket/private/qq-and-or.rkt

@@ -430,7 +430,9 @@
                                                               (quote-syntax make-immutable-hasheq)
                                                               (if (hash-eqv? (syntax-e x))
                                                                   (quote-syntax make-immutable-hasheqv)
-                                                                  (quote-syntax make-immutable-hash)))
+                                                                  (if (hash-equal-always? (syntax-e x))
+                                                                      (quote-syntax make-immutable-hashequalw)
+                                                                      (quote-syntax make-immutable-hash))))
                                                           l)))))
                                           x)))))))))
 	      (qq form 0))

racket/collects/racket/private/serialize.rkt

@@ -401,6 +401,7 @@
 	       (if (immutable? v) '- '!)
 	       (append
 		(if (hash-equal? v) '(equal) null)
+		(if (hash-equal-always? v) '(equal-always) null)
 		(if (hash-eqv? v) '(eqv) null)
 		(if (hash-weak? v) '(weak) null))
 	       (let ([loop (serial #t)])
@@ -441,6 +442,7 @@
      [(hash? v)
       (cons 'h (append
 		(if (hash-equal? v) '(equal) null)
+		(if (hash-equal-always? v) '(equal-always) null)
 		(if (hash-eqv? v) '(eqv) null)
 		(if (hash-weak? v) '(weak) null)))]
      [else
@@ -505,6 +507,10 @@
            (if (null? (cdr v))
                (make-hash)
                (make-weak-hash))]
+          [(equal-always)
+           (if (null? (cdr v))
+               (make-hashequalw)
+               (make-weak-hashequalw))]
           [(eqv)
            (if (null? (cdr v))
                (make-hasheqv)
@@ -588,7 +594,9 @@
                          (make-immutable-hasheq al)
                          (if (eq? (caaddr v) 'equal)
                              (make-immutable-hash al)
-                             (make-immutable-hasheqv al)))))]
+                             (if (eq? (caaddr v) 'equal-always)
+                                 (make-immutable-hashequalw al)
+                                 (make-immutable-hasheqv al))))))]
 	  [(date) (apply make-date (map loop (cdr v)))]
 	  [(date*) (apply make-date* (map loop (cdr v)))]
 	  [(arity-at-least) (make-arity-at-least (loop (cdr v)))]

racket/collects/syntax/strip-context.rkt

@@ -35,6 +35,10 @@
        (for/hasheqv ([(k v) (in-hash e)])
          (values (replace-context ctx k)
                  (replace-context ctx v)))]
+      [(hash-equal-always? e)
+       (for/hashequalw ([(k v) (in-hash e)])
+         (values (replace-context ctx k)
+                 (replace-context ctx v)))]
       [else
        (for/hash ([(k v) (in-hash e)])
          (values (replace-context ctx k)

racket/src/cs/primitive/kernel.ss

@@ -420,6 +420,7 @@
   [hash-count (known-procedure/single-valued 2)]
   [hash-ephemeron? (known-procedure/single-valued 2)]
   [hash-eq? (known-procedure/single-valued 2)]
+  [hash-equal-always? (known-procedure/single-valued 2)]
   [hash-equal? (known-procedure/single-valued 2)]
   [hash-eqv? (known-procedure/single-valued 2)]
   [hash-for-each (known-procedure/single-valued 12)]
@@ -442,6 +443,7 @@
   [hash-weak? (known-procedure/single-valued 2)]
   [hash? (known-procedure/pure/folding 2)]
   [hasheq (known-procedure/single-valued -1)]
+  [hashequalw (known-procedure/single-valued -1)]
   [hasheqv (known-procedure/single-valued -1)]
   [imag-part (known-procedure/folding 2)]
   [immutable? (known-procedure/pure/folding 2)]
@@ -516,16 +518,20 @@
   [make-ephemeron (known-procedure/allocates 4)]
   [make-ephemeron-hash (known-procedure/single-valued 3)]
   [make-ephemeron-hasheq (known-procedure/no-prompt 3)]
+  [make-ephemeron-hashequalw (known-procedure/no-prompt 3)]
   [make-ephemeron-hasheqv (known-procedure/no-prompt 3)]
   [make-file-or-directory-link (known-procedure/no-prompt 4)]
   [make-hash (known-procedure/single-valued 3)]
   [make-hash-placeholder (known-procedure/no-prompt 2)]
   [make-hasheq (known-procedure/no-prompt 3)]
   [make-hasheq-placeholder (known-procedure/no-prompt 2)]
+  [make-hashequalw (known-procedure/no-prompt 3)]
+  [make-hashequalw-placeholder (known-procedure/no-prompt 2)]
   [make-hasheqv (known-procedure/no-prompt 3)]
   [make-hasheqv-placeholder (known-procedure/no-prompt 2)]
   [make-immutable-hash (known-procedure/single-valued 3)]
   [make-immutable-hasheq (known-procedure/no-prompt 3)]
+  [make-immutable-hashequalw (known-procedure/no-prompt 3)]
   [make-immutable-hasheqv (known-procedure/no-prompt 3)]
   [make-impersonator-property (known-procedure/no-prompt 2)]
   [make-input-port (known-procedure/single-valued 2032)]
@@ -559,6 +565,7 @@
   [make-weak-box (known-procedure/allocates 2)]
   [make-weak-hash (known-procedure/single-valued 3)]
   [make-weak-hasheq (known-procedure/no-prompt 3)]
+  [make-weak-hashequalw (known-procedure/no-prompt 3)]
   [make-weak-hasheqv (known-procedure/no-prompt 3)]
   [make-will-executor (known-procedure/allocates 1)]
   [map (known-procedure/single-valued -4)]

racket/src/cs/rumble.sls

@@ -271,11 +271,11 @@
           equal-always-hash-code
           equal-always-secondary-hash-code
 
-          hash hasheqv hasheq
-          make-hash make-hasheqv make-hasheq
-          make-immutable-hash make-immutable-hasheqv make-immutable-hasheq
-          make-weak-hash make-weak-hasheq make-weak-hasheqv
-          make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv
+          hash hasheqv hasheq hashequalw
+          make-hash make-hasheqv make-hasheq make-hashequalw
+          make-immutable-hash make-immutable-hasheqv make-immutable-hasheq make-immutable-hashequalw
+          make-weak-hash make-weak-hasheq make-weak-hasheqv make-weak-hashequalw
+          make-ephemeron-hash make-ephemeron-hasheq make-ephemeron-hasheqv make-ephemeron-hashequalw
           hash-ref hash-ref-key hash-set hash-set! hash-remove hash-remove!
           hash-for-each hash-map hash-copy hash-clear hash-clear!
           hash-iterate-first hash-iterate-next
@@ -295,7 +295,7 @@
           unsafe-ephemeron-hash-iterate-key+value unsafe-ephemeron-hash-iterate-pair
           unsafe-hash-seal!    ; not exported to racket
 
-          hash? hash-eq? hash-equal? hash-eqv? hash-strong? hash-weak? hash-ephemeron?
+          hash? hash-eq? hash-equal? hash-eqv? hash-equal-always? hash-strong? hash-weak? hash-ephemeron?
           hash-count
           hash-keys-subset?
           eq-hashtable->hash   ; not exported to racket
@@ -479,6 +479,7 @@
           make-hash-placeholder
           make-hasheq-placeholder
           make-hasheqv-placeholder
+          make-hashequalw-placeholder
 
           time-apply
           current-inexact-milliseconds

racket/src/cs/rumble/equal.ss

@@ -251,6 +251,22 @@
           (equal? (get-k k1) (get-k k2)))
         (equal? k1 k2))))
 
+(define (key-equal-always-hash-code k)
+  (let ([get-k (and (fx> (unbox key-equality-maybe-redirect) 0)
+                    (continuation-mark-set-first #f key-equality-wrap-key))])
+    (if get-k
+        (with-continuation-mark key-equality-wrap-key #f
+          (equal-always-hash-code (get-k k)))
+        (equal-always-hash-code k))))
+
+(define (key-equal-always? k1 k2)
+  (let ([get-k (and (fx> (unbox key-equality-maybe-redirect) 0)
+                    (continuation-mark-set-first #f key-equality-wrap-key))])
+    (if get-k
+        (with-continuation-mark key-equality-wrap-key #f
+          (equal-always? (get-k k1) (get-k k2)))
+        (equal-always? k1 k2))))
+
 (define (call-with-equality-wrap get-k key thunk)
   (unsafe-box*-cas+! key-equality-maybe-redirect 1)
   (let ([get-k