add enable-unsafe-variable-reference
original commit: 77a0ef249b6d419dcac7c8e1c28e710b30a7aa33
This commit is contained in:
parent
27e21e6e7d
commit
d13e5898c8
|
@ -2623,6 +2623,17 @@ unsafe (i.e., no check whether the target is a procedure), even when
|
||||||
the value of \scheme{optimize-level} is less than \scheme{3}. The
|
the value of \scheme{optimize-level} is less than \scheme{3}. The
|
||||||
default is \scheme{#f}.
|
default is \scheme{#f}.
|
||||||
|
|
||||||
|
%----------------------------------------------------------------------------
|
||||||
|
\entryheader
|
||||||
|
\formdef{enable-unsafe-variable-reference}{\categorythreadparameter}{enable-unsafe-variable-reference}
|
||||||
|
\listlibraries
|
||||||
|
\endentryheader
|
||||||
|
|
||||||
|
This parameter controls whether references to \scheme{letrec}-bound
|
||||||
|
variables are compiled unsafe (i.e., no check whether the variable has
|
||||||
|
a value), even when the value of \scheme{optimize-level} is less than
|
||||||
|
\scheme{3}. The default is \scheme{#f}.
|
||||||
|
|
||||||
%----------------------------------------------------------------------------
|
%----------------------------------------------------------------------------
|
||||||
\entryheader
|
\entryheader
|
||||||
\formdef{generate-wpo-files}{\categorythreadparameter}{generate-wpo-files}
|
\formdef{generate-wpo-files}{\categorythreadparameter}{generate-wpo-files}
|
||||||
|
|
|
@ -62,7 +62,7 @@ InstallLZ4Target=
|
||||||
# no changes should be needed below this point #
|
# no changes should be needed below this point #
|
||||||
###############################################################################
|
###############################################################################
|
||||||
|
|
||||||
Version=csv9.5.3.15
|
Version=csv9.5.3.16
|
||||||
Include=boot/$m
|
Include=boot/$m
|
||||||
PetiteBoot=boot/$m/petite.boot
|
PetiteBoot=boot/$m/petite.boot
|
||||||
SchemeBoot=boot/$m/scheme.boot
|
SchemeBoot=boot/$m/scheme.boot
|
||||||
|
|
35
mats/misc.ms
35
mats/misc.ms
|
@ -5546,6 +5546,41 @@
|
||||||
'(lambda (x) (#3%$app x))))
|
'(lambda (x) (#3%$app x))))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(mat enable-unsafe-variable-reference
|
||||||
|
(begin
|
||||||
|
(define (get-uncprep-form e)
|
||||||
|
(let ([r #f])
|
||||||
|
(parameterize ([run-cp0 (lambda (cp0 e)
|
||||||
|
(set! r (#%$uncprep e))
|
||||||
|
e)])
|
||||||
|
(expand/optimize e))
|
||||||
|
r))
|
||||||
|
#t)
|
||||||
|
(equivalent-expansion? (get-uncprep-form '(lambda (x) (letrec ([y y]) (+ y x))))
|
||||||
|
(if (= 3 (optimize-level))
|
||||||
|
'(lambda (x)
|
||||||
|
(letrec ([y y])
|
||||||
|
(#3%+ y x)))
|
||||||
|
'(lambda (x)
|
||||||
|
(let ([valid? #f])
|
||||||
|
(letrec ([y (begin
|
||||||
|
(if valid?
|
||||||
|
(#2%void)
|
||||||
|
(#2%$source-violation #f #f #t "attempt to reference undefined variable ~s" 'y))
|
||||||
|
y)])
|
||||||
|
(set! valid? #t)
|
||||||
|
(#2%+ y x))))))
|
||||||
|
(equivalent-expansion? (parameterize ([enable-unsafe-variable-reference #t])
|
||||||
|
(get-uncprep-form '(lambda (x) (letrec ([y y]) (+ y x)))))
|
||||||
|
(if (= 3 (optimize-level))
|
||||||
|
'(lambda (x)
|
||||||
|
(letrec ([y y])
|
||||||
|
(#3%+ y x)))
|
||||||
|
'(lambda (x)
|
||||||
|
(letrec ([y y])
|
||||||
|
(#2%+ y x)))))
|
||||||
|
)
|
||||||
|
|
||||||
(mat phantom-bytevector
|
(mat phantom-bytevector
|
||||||
(phantom-bytevector? (make-phantom-bytevector 0))
|
(phantom-bytevector? (make-phantom-bytevector 0))
|
||||||
(not (phantom-bytevector? 10))
|
(not (phantom-bytevector? 10))
|
||||||
|
|
|
@ -328,7 +328,7 @@
|
||||||
[(_ foo e1 e2) e1] ...
|
[(_ foo e1 e2) e1] ...
|
||||||
[(_ bar e1 e2) e2]))))])))
|
[(_ bar e1 e2) e2]))))])))
|
||||||
|
|
||||||
(define-constant scheme-version #x0905030F)
|
(define-constant scheme-version #x09050310)
|
||||||
|
|
||||||
(define-syntax define-machine-types
|
(define-syntax define-machine-types
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
|
|
|
@ -568,4 +568,7 @@
|
||||||
|
|
||||||
(set! $cpvalid
|
(set! $cpvalid
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(if (= (optimize-level) 3) x (cpvalid x)))))
|
(if (or (= (optimize-level) 3)
|
||||||
|
(enable-unsafe-variable-reference))
|
||||||
|
x
|
||||||
|
(cpvalid x)))))
|
||||||
|
|
|
@ -108,6 +108,8 @@
|
||||||
|
|
||||||
(define enable-unsafe-application ($make-thread-parameter #f (lambda (x) (and x #t))))
|
(define enable-unsafe-application ($make-thread-parameter #f (lambda (x) (and x #t))))
|
||||||
|
|
||||||
|
(define enable-unsafe-variable-reference ($make-thread-parameter #f (lambda (x) (and x #t))))
|
||||||
|
|
||||||
(define-who current-generate-id
|
(define-who current-generate-id
|
||||||
($make-thread-parameter
|
($make-thread-parameter
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
|
|
|
@ -959,6 +959,7 @@
|
||||||
(enable-type-recovery [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-type-recovery [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(enable-error-source-expression [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-error-source-expression [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(enable-unsafe-application [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-unsafe-application [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
|
(enable-unsafe-variable-reference [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags])
|
(eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags])
|
||||||
(expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
|
(expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user