From e0f390c8c851fc893989b881e16bff813a20875c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 2 Jul 2020 14:42:18 -0600
Subject: [PATCH] syntax/strip-context: handle hash tables

Closes racket/scribble#245
---
 .../syntax/scribblings/strip-context.scrbl    |  9 +++-
 .../racket-test-core/tests/racket/syntax.rktl | 43 +++++++++++++++++++
 racket/collects/syntax/strip-context.rkt      | 14 ++++++
 3 files changed, 64 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-doc/syntax/scribblings/strip-context.scrbl b/pkgs/racket-doc/syntax/scribblings/strip-context.scrbl
index 52db3dd716..b648b9ca75 100644
--- a/pkgs/racket-doc/syntax/scribblings/strip-context.scrbl
+++ b/pkgs/racket-doc/syntax/scribblings/strip-context.scrbl
@@ -8,10 +8,15 @@
 @defproc[(strip-context [stx syntax?]) syntax?]{
 
 Removes all lexical context from @racket[stx], preserving
-source-location information and properties.}
+source-location information and properties.
+
+@history[#:changed "7.7.0.10" @elem{Repaired to traverse hash tables in @racket[stx].}]}
+
 
 @defproc[(replace-context [ctx-stx (or/c syntax? #f)] [stx syntax?]) syntax?]{
 
 Uses the lexical context of @racket[ctx-stx] to replace the lexical
 context of all parts of @racket[stx], preserving source-location
-information and properties of @racket[stx].}
+information and properties of @racket[stx].
+
+@history[#:changed "7.7.0.10" @elem{Repaired to traverse hash tables in @racket[stx].}]}
diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl
index 6dcca5b6e7..691ee1202d 100644
--- a/pkgs/racket-test-core/tests/racket/syntax.rktl
+++ b/pkgs/racket-test-core/tests/racket/syntax.rktl
@@ -2173,6 +2173,49 @@
    (list #'define-syntax1)
    (syntax-property expanded-body-stx 'origin)))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Make sure that `strip-context` works on prefabs, hash tables, etc.
+
+(let ()
+  (define (same? a b)
+    (cond
+      [(syntax? a)
+       (and (syntax? b)
+            (equal? (for/hash ([k (in-list (hash-ref (syntax-debug-info a) 'context))])
+                      (values k #t))
+                    (for/hash ([k (in-list (hash-ref (syntax-debug-info b) 'context))])
+                      (values k #t)))
+            (same? (syntax-e a) (syntax-e b)))]
+      [(pair? a) (and (pair? b)
+                      (same? (car a) (car b))
+                      (same? (cdr a) (cdr b)))]
+      [(box? a) (and (box? b)
+                     (same? (unbox a) (unbox b)))]
+      [(vector? a) (and (vector? b)
+                        (= (vector-length a) (vector-length b))
+                        (for/and ([a (in-vector a)]
+                                  [b (in-vector b)])
+                          (same? a b)))]
+      [(hash? a) (and (eq? (hash-eq? a) (hash-eq? b))
+                      (eq? (hash-eqv? a) (hash-eqv? b))
+                      (eq? (hash-equal? a) (hash-equal? b))
+                      (for/and ([(ak av) (in-hash a)])
+                        (same? av (hash-ref b ak #f))))]
+      [(prefab-struct-key a)
+       => (lambda (ak)
+            (and (equal? ak (prefab-struct-key b))
+                 (same? (struct->vector a) (struct->vector b))))]
+      [else (eqv? a b)]))
+
+  (define (check v)
+    (same? (datum->syntax #f v)
+           (strip-context (datum->syntax #'here v))))
+
+  (test #t check '(a b))
+  (test #t check '#(a b #hash((c . 9))))
+  (test #t check '(#hasheqv((10 . 11) (12 . 13)) #&"str" #s(color r G #b0)))
+  (test #t check '(#hasheq((x . 11) (y . 13) (z . #f)) (1 . 2))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module tries-to-use-foo-before-defined racket/base
diff --git a/racket/collects/syntax/strip-context.rkt b/racket/collects/syntax/strip-context.rkt
index 6e2f2f4de7..b330f87575 100644
--- a/racket/collects/syntax/strip-context.rkt
+++ b/racket/collects/syntax/strip-context.rkt
@@ -25,4 +25,18 @@
          (apply make-prefab-struct
                 k
                 (replace-context ctx (struct->list e))))]
+   [(hash? e)
+    (cond
+      [(hash-eq? e)
+       (for/hasheq ([(k v) (in-hash e)])
+         (values (replace-context ctx k)
+                 (replace-context ctx v)))]
+      [(hash-eqv? e)
+       (for/hasheqv ([(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)
+                 (replace-context ctx v)))])]
    [else e]))