From 754bae07e36032617557a7c485ba530666fc88f0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 23 Jan 2020 15:25:22 -0700 Subject: [PATCH] add `enable-unsafe-application` original commit: 4c0750d292999dbc476b2b0a80cad3b8beaab660 --- csug/system.stex | 12 ++++++++++++ makefiles/Mf-install.in | 2 +- mats/misc.ms | 18 ++++++++++++++++++ s/cmacros.ss | 2 +- s/compile.ss | 1 + s/cprep.ss | 3 ++- s/front.ss | 2 ++ s/primdata.ss | 1 + s/syntax.ss | 7 ++++--- 9 files changed, 42 insertions(+), 6 deletions(-) diff --git a/csug/system.stex b/csug/system.stex index b57f48e9ee..de4d5b9c2b 100644 --- a/csug/system.stex +++ b/csug/system.stex @@ -1132,6 +1132,7 @@ generate-interrupt-trap enable-cross-library-optimization enable-arithmetic-left-associative enable-error-source-expression +enable-unsafe-application enable-type-recovery \endschemedisplay @@ -2611,6 +2612,17 @@ This parameter controls whether the compiler can convert erroneous expressions into a call to an error function that shows the expression as an S-expression. The default is \scheme{#t}. +%---------------------------------------------------------------------------- +\entryheader +\formdef{enable-unsafe-application}{\categorythreadparameter}{enable-unsafe-application} +\listlibraries +\endentryheader + +This parameter controls whether application forms are compiled as +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 +default is \scheme{#f}. + %---------------------------------------------------------------------------- \entryheader \formdef{generate-wpo-files}{\categorythreadparameter}{generate-wpo-files} diff --git a/makefiles/Mf-install.in b/makefiles/Mf-install.in index 4d50ed6721..13d002db2c 100644 --- a/makefiles/Mf-install.in +++ b/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.3.13 +Version=csv9.5.3.14 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/mats/misc.ms b/mats/misc.ms index 747916fd29..86aeb03724 100644 --- a/mats/misc.ms +++ b/mats/misc.ms @@ -5526,6 +5526,24 @@ (find-define-m-as-one (expand '(let () (import (define-m-as-one)) m))) ) +(mat enable-unsafe-application + (begin + (define (get-uncprep-form e) + (let ([r #f]) + (parameterize ([run-cp0 (lambda (cp0 e) + (parameterize ([enable-unsafe-application #f]) + (set! r (#%$uncprep e))) + e)]) + (expand/optimize e)) + r)) + #t) + (equivalent-expansion? (get-uncprep-form '(lambda (x) (x))) + '(lambda (x) (x))) + (equivalent-expansion? (parameterize ([enable-unsafe-application #t]) + (get-uncprep-form '(lambda (x) (x)))) + '(lambda (x) (#3%$app x))) + ) + (mat phantom-bytevector (phantom-bytevector? (make-phantom-bytevector 0)) (not (phantom-bytevector? 10)) diff --git a/s/cmacros.ss b/s/cmacros.ss index 7c8807e171..812f5dc57d 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -328,7 +328,7 @@ [(_ foo e1 e2) e1] ... [(_ bar e1 e2) e2]))))]))) -(define-constant scheme-version #x0905030D) +(define-constant scheme-version #x0905030E) (define-syntax define-machine-types (lambda (x) diff --git a/s/compile.ss b/s/compile.ss index eaffb64c0e..ce95912daf 100644 --- a/s/compile.ss +++ b/s/compile.ss @@ -586,6 +586,7 @@ [enable-cross-library-optimization (enable-cross-library-optimization)] [enable-arithmetic-left-associative (enable-arithmetic-left-associative)] [enable-error-source-expression (enable-error-source-expression)] + [enable-unsafe-application (enable-unsafe-application)] [enable-type-recovery (enable-type-recovery)]) (emit-header op (constant machine-type)) (when hostop (emit-header hostop (host-machine-type))) diff --git a/s/cprep.ss b/s/cprep.ss index 63f15aea3f..d6acc3d189 100644 --- a/s/cprep.ss +++ b/s/cprep.ss @@ -164,7 +164,8 @@ (if (or (preinfo-call-check? preinfo) ;; Reporting `#3%$app` is redundant for unsafe mode. ;; Note that we're losing explicit `#2%$app`s. - (>= (optimize-level) 3)) + (>= (optimize-level) 3) + (enable-unsafe-application)) (if (preinfo-call-can-inline? preinfo) a (cons '$app/no-inline a)) diff --git a/s/front.ss b/s/front.ss index 6680b47bed..d647b7a248 100644 --- a/s/front.ss +++ b/s/front.ss @@ -106,6 +106,8 @@ (define enable-arithmetic-left-associative ($make-thread-parameter #f (lambda (x) (and x #t)))) +(define enable-unsafe-application ($make-thread-parameter #f (lambda (x) (and x #t)))) + (define-who current-generate-id ($make-thread-parameter (lambda (sym) diff --git a/s/primdata.ss b/s/primdata.ss index da1539ced3..b280ee5cf1 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -958,6 +958,7 @@ (enable-object-counts [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-unsafe-application [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags]) (expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags]) diff --git a/s/syntax.ss b/s/syntax.ss index 088fc2e948..34855b1439 100644 --- a/s/syntax.ss +++ b/s/syntax.ss @@ -550,9 +550,10 @@ (define build-call (lambda (ae e e*) (build-profile ae - (let ([flags (if (fx< (optimize-level) 3) - (preinfo-call-mask) - (preinfo-call-mask unchecked))]) + (let ([flags (if (or (fx>= (optimize-level) 3) + (enable-unsafe-application)) + (preinfo-call-mask unchecked) + (preinfo-call-mask))]) `(call ,(make-preinfo-call (ae->src ae) #f flags) ,e ,e* ...))))) (define build-application