1#lang racket/base
2(require racket/struct)
3
4(provide strip-context
5         replace-context)
6
7(define (strip-context e)
8  (replace-context #f e))
9
10(define (replace-context ctx e)
11  (cond
12   [(syntax? e)
13    (datum->syntax ctx
14                   (replace-context ctx (syntax-e e))
15                   e
16                   e)]
17   [(pair? e) (cons (replace-context ctx (car e))
18                    (replace-context ctx (cdr e)))]
19   [(vector? e) (list->vector
20                 (map (lambda (e) (replace-context ctx e))
21                      (vector->list e)))]
22   [(box? e) (box (replace-context ctx (unbox e)))]
23   [(prefab-struct-key e)
24    => (lambda (k)
25         (apply make-prefab-struct
26                k
27                (replace-context ctx (struct->list e))))]
28   [(hash? e)
29    (cond
30      [(hash-eq? e)
31       (for/hasheq ([(k v) (in-hash e)])
32         (values (replace-context ctx k)
33                 (replace-context ctx v)))]
34      [(hash-eqv? e)
35       (for/hasheqv ([(k v) (in-hash e)])
36         (values (replace-context ctx k)
37                 (replace-context ctx v)))]
38      [else
39       (for/hash ([(k v) (in-hash e)])
40         (values (replace-context ctx k)
41                 (replace-context ctx v)))])]
42   [else e]))
43