28 lines
777 B
Scheme
28 lines
777 B
Scheme
#lang scheme/base
|
|
|
|
(provide strip-context
|
|
replace-context)
|
|
|
|
(define (strip-context e)
|
|
(replace-context #f e))
|
|
|
|
(define (replace-context ctx e)
|
|
(cond
|
|
[(syntax? e)
|
|
(datum->syntax ctx
|
|
(replace-context ctx (syntax-e e))
|
|
e
|
|
e)]
|
|
[(pair? e) (cons (replace-context ctx (car e))
|
|
(replace-context ctx (cdr e)))]
|
|
[(vector? e) (list->vector
|
|
(map (lambda (e) (replace-context ctx e))
|
|
(vector->list e)))]
|
|
[(box? e) (box (replace-context ctx (unbox e)))]
|
|
[(prefab-struct-key e)
|
|
=> (lambda (k)
|
|
(apply make-prefab-struct
|
|
k
|
|
(replace-context ctx (cdr (vector->list (struct->vector e))))))]
|
|
[else e]))
|