handling top-level-renames and mark-barriers
(cherry picked from commit8df94dd746
) original commit:06c829d8c0
This commit is contained in:
parent
c64f9c5582
commit
1325701f82
|
@ -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))
|
||||||
|
|
|
@ -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))]
|
||||||
|
|
|
@ -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)])))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user