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