add syntax/strip-context
svn: r13846
This commit is contained in:
parent
8c4e8236a8
commit
50dff6234c
20
collects/syntax/strip-context.ss
Normal file
20
collects/syntax/strip-context.ss
Normal 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]))
|
Loading…
Reference in New Issue
Block a user