add syntax/strip-context

svn: r13846
This commit is contained in:
Matthew Flatt 2009-02-26 13:11:11 +00:00
parent 8c4e8236a8
commit 50dff6234c

View File

@ -0,0 +1,20 @@
#lang scheme/base
(define (strip-context e)
(cond
[(syntax? e)
(datum->syntax #f
(strip-context (syntax-e e))
e
e)]
[(pair? e) (cons (strip-context (car e))
(strip-context (cdr e)))]
[(vector? e) (list->vector
(map strip-context
(vector->list e)))]
[(box? e) (box (strip-context (unbox e)))]
[(prefab-struct-key e)
=> (lambda (k)
(apply make-prefab-struct
(strip-context (cdr (vector->list (struct->vector e))))))]
[else e]))