handling top-level-renames and mark-barriers

This commit is contained in:
Blake Johnson 2010-07-15 15:35:54 -06:00 committed by Jay McCarthy
parent d17deb5fef
commit 8df94dd746
3 changed files with 14 additions and 3 deletions

View File

@ -609,6 +609,10 @@
(vector-set! vec (+ 2 i) k)
(vector-set! vec (+ 2 i len) v))
vec]
[(struct top-level-rename (flag))
flag]
[(struct mark-barrier (value))
value]
[(struct prune (syms))
(box syms)]
[(struct wrap-mark (val))

View File

@ -624,9 +624,9 @@
(and plus-kern? 'plus-kern)))]
[else (error "bad module rename: ~e" a)]))]
[(boolean? a)
`(#%top-level-rename ,a)]
(make-top-level-rename a)]
[(symbol? a)
'(#%mark-barrier)]
(make-mark-barrier a)]
[(box? a)
(match (unbox a)
[(list (? symbol?) ...) (make-prune (unbox a))]

View File

@ -23,6 +23,7 @@
(define-syntax-rule (define-form-struct* id id+par ([field-id field-contract] ...))
(begin
(define-struct id+par (field-id ...) #:prefab)
#;(provide (struct-out id))
(provide/contract
[struct id ([field-id field-contract] ...)])))
@ -147,7 +148,7 @@
(define-form-struct (primval expr) ([id exact-nonnegative-integer?])) ; direct preference to a kernel primitive
;; Top-level `require'
(define-form-struct (req form) ([reqs syntax?] [dummy toplevel?]))
(define-form-struct (req form) ([reqs stx?] [dummy toplevel?]))
(define-form-struct (lexical-rename wrap) ([bool1 boolean?] ; this needs a name
[bool2 boolean?] ; this needs a name
@ -194,6 +195,12 @@
[mark-renames any/c]
[plus-kern? boolean?]))
; XXX better name for 'flag'
(define-form-struct (top-level-rename wrap) ([flag boolean?]))
; XXX better name for 'value'
(define-form-struct (mark-barrier wrap) ([value symbol?]))
(provide/contract (struct indirect ([v (or/c closure? #f)])))