Modules with tests for unsafe mode can be cross-phase persistent.
Also, mark several more modules as cross-phase persistent.
This commit is contained in:
Sam Tobin-Hochstadt
Sam Tobin-Hochstadt
parent
2d695be78c
commit
f7c39512ab
|
|
@ -1216,7 +1216,8 @@ and only if no module-level binding is @racket[set!]ed.
|
|||
set! quote-syntax quote with-continuation-mark
|
||||
#%plain-app
|
||||
cons list make-struct-type make-struct-type-property
|
||||
gensym string->uninterned-symbol)
|
||||
gensym string->uninterned-symbol #%variable-reference
|
||||
variable-reference-from-unsafe?)
|
||||
[cross-module (module id module-path
|
||||
(#%plain-module-begin
|
||||
cross-form ...))]
|
||||
|
|
@ -1237,7 +1238,9 @@ and only if no module-level binding is @racket[set!]ed.
|
|||
cross-expr ...+)
|
||||
(#%plain-app gensym)
|
||||
(#%plain-app gensym string)
|
||||
(#%plain-app string->uninterned-symbol string)]
|
||||
(#%plain-app string->uninterned-symbol string)
|
||||
(#%plain-app variable-reference-from-unsafe?
|
||||
(#%variable-reference))]
|
||||
[cross-datum number
|
||||
boolean
|
||||
identifier
|
||||
|
|
@ -1251,6 +1254,7 @@ module imports only from other cross-phase persistent modules, the only relevant
|
|||
expansion steps are the implicit introduction of
|
||||
@racket[#%plain-module-begin], implicit introduction of @racket[#%plain-app],
|
||||
and implicit introduction and/or expansion of @racket[#%datum].
|
||||
@history[#:changed "7.5.0.12" @elem{Allow @racket[(#%plain-app variable-reference-from-unsafe? (#%variable-reference))].}]
|
||||
|
||||
@;----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(module pre-base '#%kernel
|
||||
(module collect '#%kernel
|
||||
(#%require "qq-and-or.rkt"
|
||||
"path.rkt"
|
||||
"kw.rkt")
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
(module fixnum '#%kernel
|
||||
(#%declare #:cross-phase-persistent)
|
||||
(#%require '#%flfxnum)
|
||||
(#%provide fixnum-for-every-system?)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,19 +1,11 @@
|
|||
(module procedure-alias '#%kernel
|
||||
(#%require "define.rkt"
|
||||
"small-scheme.rkt"
|
||||
"more-scheme.rkt"
|
||||
"kw-prop-key.rkt"
|
||||
(for-syntax '#%kernel
|
||||
"stx.rkt"
|
||||
"small-scheme.rkt"
|
||||
"stxcase-scheme.rkt"
|
||||
"name.rkt"
|
||||
"norm-define.rkt"
|
||||
"qqstx.rkt"
|
||||
"sort.rkt"))
|
||||
(#%declare #:cross-phase-persistent)
|
||||
(#%require "kw-prop-key.rkt")
|
||||
|
||||
(#%provide syntax-procedure-alias-property alias-of)
|
||||
(define (syntax-procedure-alias-property stx)
|
||||
(unless (syntax? stx)
|
||||
(raise-argument-error 'syntax-procedure-alias "syntax?" stx))
|
||||
(syntax-property stx alias-of)))
|
||||
(define-values (syntax-procedure-alias-property)
|
||||
(lambda (stx)
|
||||
(if (syntax? stx)
|
||||
(void)
|
||||
(raise-argument-error 'syntax-procedure-alias "syntax?" stx))
|
||||
(syntax-property stx alias-of))))
|
||||
|
|
|
|||
|
|
@ -1,30 +1,34 @@
|
|||
(module reading-params '#%kernel
|
||||
(#%require "more-scheme.rkt" "qq-and-or.rkt")
|
||||
(#%declare #:cross-phase-persistent)
|
||||
(#%require '#%paramz)
|
||||
(#%provide call-with-default-reading-parameterization)
|
||||
|
||||
(define-values (call-with-default-reading-parameterization)
|
||||
(lambda (thunk)
|
||||
(if (and (procedure? thunk)
|
||||
(procedure-arity-includes? thunk 0))
|
||||
(parameterize ([read-case-sensitive #t]
|
||||
[read-square-bracket-as-paren #t]
|
||||
[read-curly-brace-as-paren #t]
|
||||
[read-square-bracket-with-tag #f]
|
||||
[read-curly-brace-with-tag #f]
|
||||
[read-accept-box #t]
|
||||
[read-accept-compiled #f]
|
||||
[read-accept-bar-quote #t]
|
||||
[read-accept-graph #t]
|
||||
[read-decimal-as-inexact #t]
|
||||
[read-single-flonum #f]
|
||||
[read-cdot #f]
|
||||
[read-accept-dot #t]
|
||||
[read-accept-infix-dot #t]
|
||||
[read-accept-quasiquote #t]
|
||||
[read-accept-reader #f]
|
||||
[read-accept-lang #t]
|
||||
[current-readtable #f])
|
||||
(thunk))
|
||||
(raise-argument-error 'call-with-default-reading-parameterization
|
||||
"(procedure-arity-includes/c 0)"
|
||||
thunk)))))
|
||||
(if (if (procedure? thunk) (procedure-arity-includes? thunk 0) #f)
|
||||
(with-continuation-mark
|
||||
parameterization-key
|
||||
(extend-parameterization
|
||||
(continuation-mark-set-first '#f parameterization-key)
|
||||
read-case-sensitive #t
|
||||
read-square-bracket-as-paren #t
|
||||
read-curly-brace-as-paren #t
|
||||
read-square-bracket-with-tag #f
|
||||
read-curly-brace-with-tag #f
|
||||
read-accept-box #t
|
||||
read-accept-compiled #f
|
||||
read-accept-bar-quote #t
|
||||
read-accept-graph #t
|
||||
read-decimal-as-inexact #t
|
||||
read-single-flonum #f
|
||||
read-cdot #f
|
||||
read-accept-dot #t
|
||||
read-accept-infix-dot #t
|
||||
read-accept-quasiquote #t
|
||||
read-accept-reader #f
|
||||
read-accept-lang #t
|
||||
current-readtable #f)
|
||||
(thunk))
|
||||
(raise-argument-error 'call-with-default-reading-parameterization
|
||||
"(procedure-arity-includes/c 0)"
|
||||
thunk)))))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
(module reverse '#%kernel
|
||||
(#%declare #:cross-phase-persistent)
|
||||
(#%provide (rename reverse alt-reverse))
|
||||
|
||||
(define-values (reverse)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang racket/base
|
||||
(provide table)
|
||||
(define table #f)
|
||||
;; So table definition is not inlined across modules:
|
||||
(set! table #f)
|
||||
(module runtime-path-table '#%kernel
|
||||
(#%provide table)
|
||||
(define-values (table) #f)
|
||||
;; So table definition is not inlined across modules:
|
||||
(set! table #f))
|
||||
|
|
|
|||
|
|
@ -73,6 +73,11 @@
|
|||
[(parsed-case-lambda? e)
|
||||
(for ([clause (in-list (parsed-case-lambda-clauses e))])
|
||||
(check-body-no-disallowed-expr (cadr clause)))]
|
||||
;; explicitly allow (variable-reference-from-unsafe? (#%variable-reference))
|
||||
[(and (parsed-app? e)
|
||||
(eq? 'variable-reference-from-unsafe? (cross-phase-primitive-name (parsed-app-rator e)))
|
||||
(andmap parsed-#%variable-reference? (parsed-app-rands e)))
|
||||
(void)]
|
||||
[(parsed-app? e)
|
||||
(check-no-disallowed-expr (parsed-app-rator e))
|
||||
(for ([e (in-list (parsed-app-rands e))])
|
||||
|
|
|
|||
|
|
@ -639,7 +639,7 @@ static const char *startup_source =
|
|||
" #t"
|
||||
" 1/current-readtable"
|
||||
" #f)"
|
||||
"(let-values()(thunk_0)))"
|
||||
"(thunk_0))"
|
||||
" (raise-argument-error 'call-with-default-reading-parameterization \"(procedure-arity-includes/c 0)\" thunk_0)))))"
|
||||
"(define-values"
|
||||
"(prop:keyword-impersonator keyword-impersonator? keyword-impersonator-ref)"
|
||||
|
|
@ -76257,6 +76257,14 @@ static const char *startup_source =
|
|||
" for-loop_0)"
|
||||
" lst_0)))"
|
||||
"(void)))"
|
||||
"(if(if(parsed-app? e_0)"
|
||||
"(if(eq?"
|
||||
" 'variable-reference-from-unsafe?"
|
||||
"(cross-phase-primitive-name(parsed-app-rator e_0)))"
|
||||
"(andmap2 parsed-#%variable-reference?(parsed-app-rands e_0))"
|
||||
" #f)"
|
||||
" #f)"
|
||||
"(let-values()(void))"
|
||||
"(if(parsed-app? e_0)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
|
|
@ -76336,7 +76344,8 @@ static const char *startup_source =
|
|||
"(if(pair? lst_1)"
|
||||
"(let-values(((clause_0)"
|
||||
"(unsafe-car lst_1))"
|
||||
"((rest_0)(unsafe-cdr lst_1)))"
|
||||
"((rest_0)"
|
||||
"(unsafe-cdr lst_1)))"
|
||||
"(let-values((()"
|
||||
"(let-values()"
|
||||
"(let-values((()"
|
||||
|
|
@ -76359,7 +76368,7 @@ static const char *startup_source =
|
|||
"(if(let-values(((or-part_0)(parsed-quote-syntax? e_0)))"
|
||||
"(if or-part_0 or-part_0(parsed-#%variable-reference? e_0)))"
|
||||
"(let-values()(disallow e_0))"
|
||||
"(let-values()(void)))))))))))))))"
|
||||
"(let-values()(void))))))))))))))))"
|
||||
"((check-body-no-disallowed-expr_0)"
|
||||
"(lambda(l_0)"
|
||||
"(begin"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user