handling top-level-renames and mark-barriers

(cherry picked from commit 8df94dd746)

original commit: 06c829d8c0
This commit is contained in:
Blake Johnson 2010-07-15 15:35:54 -06:00 committed by Eli Barzilay
parent c64f9c5582
commit 1325701f82
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) k)
(vector-set! vec (+ 2 i len) v)) (vector-set! vec (+ 2 i len) v))
vec] vec]
[(struct top-level-rename (flag))
flag]
[(struct mark-barrier (value))
value]
[(struct prune (syms)) [(struct prune (syms))
(box syms)] (box syms)]
[(struct wrap-mark (val)) [(struct wrap-mark (val))

View File

@ -624,9 +624,9 @@
(and plus-kern? 'plus-kern)))] (and plus-kern? 'plus-kern)))]
[else (error "bad module rename: ~e" a)]))] [else (error "bad module rename: ~e" a)]))]
[(boolean? a) [(boolean? a)
`(#%top-level-rename ,a)] (make-top-level-rename a)]
[(symbol? a) [(symbol? a)
'(#%mark-barrier)] (make-mark-barrier a)]
[(box? a) [(box? a)
(match (unbox a) (match (unbox a)
[(list (? symbol?) ...) (make-prune (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] ...)) (define-syntax-rule (define-form-struct* id id+par ([field-id field-contract] ...))
(begin (begin
(define-struct id+par (field-id ...) #:prefab) (define-struct id+par (field-id ...) #:prefab)
#;(provide (struct-out id))
(provide/contract (provide/contract
[struct id ([field-id field-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 (define-form-struct (primval expr) ([id exact-nonnegative-integer?])) ; direct preference to a kernel primitive
;; Top-level `require' ;; 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 (define-form-struct (lexical-rename wrap) ([bool1 boolean?] ; this needs a name
[bool2 boolean?] ; this needs a name [bool2 boolean?] ; this needs a name
@ -194,6 +195,12 @@
[mark-renames any/c] [mark-renames any/c]
[plus-kern? boolean?])) [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)]))) (provide/contract (struct indirect ([v (or/c closure? #f)])))