diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index f54ce74b47..496010b59f 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/pkgs/racket-test-core/tests/racket/module.rktl @@ -1006,6 +1006,29 @@ (compile-eval m1-expr) (compile-eval m2-expr))) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; disabling module constants + +(parameterize ([current-namespace (make-base-namespace)]) + (eval '(module m racket/base (define x 1) (provide x))) + (eval '(require 'm)) + (err/rt-test (eval '(module m racket/base (define x 2) (provide x))) + exn:fail:contract:variable?)) + +(parameterize ([current-namespace (make-base-namespace)] + [compile-enforce-module-constants #f]) + (eval '(module m racket/base (define x 1) (provide x))) + (eval '(require 'm)) + (eval '(module m racket/base (define x 2) (provide x))) + (test 2 eval 'x)) + +(parameterize ([current-namespace (make-base-namespace)]) + (eval '(module m racket/base (define x 1) (provide x))) + (eval '(require 'm)) + (parameterize ([compile-enforce-module-constants #f]) + (err/rt-test (eval '(module m racket/base (define x 2) (provide x))) + exn:fail:contract:variable?))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check JIT treatement of seemingly constant imports diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 17ff22ac52..17555ffd61 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -507,6 +507,8 @@ (let ([m (|#%app| current-compile-target-machine)]) (and (not (eq? m (machine-type))) m)))) + (define enforce-constant? (|#%app| compile-enforce-module-constants)) + (define inline? (not (|#%app| compile-context-preservation-enabled))) (performance-region 'schemify (define jitify-mode? @@ -523,6 +525,8 @@ jitify-mode? (|#%app| compile-allow-set!-undefined) #f ;; safe mode + enforce-constant? + inline? (not use-prompt?) prim-knowns ;; Callback to get a specific linklet for a diff --git a/racket/src/schemify/mutated.rkt b/racket/src/schemify/mutated.rkt index 3468eb2b3b..61f60f44b4 100644 --- a/racket/src/schemify/mutated.rkt +++ b/racket/src/schemify/mutated.rkt @@ -21,7 +21,7 @@ ;; definition of an identifier, because that will abort the enclosing ;; linklet. -(define (mutated-in-body l exports prim-knowns knowns imports unsafe-mode?) +(define (mutated-in-body l exports prim-knowns knowns imports unsafe-mode? enforce-constant?) ;; Find all `set!`ed variables, and also record all bindings ;; that might be used too early (define mutated (make-hasheq)) @@ -35,7 +35,11 @@ (match form [`(define-values (,ids ...) ,rhs) (for ([id (in-list ids)]) - (hash-set! mutated (unwrap id) 'not-ready))] + (hash-set! mutated (unwrap id) (if enforce-constant? + 'not-ready + ;; If constants should not be enforced, then + ;; treat all variable as mutated: + 'set!ed)))] [`,_ (void)])) ;; Walk through the body: (for/fold ([prev-knowns knowns]) ([form (in-list l)]) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 8838d223d2..ef7f0511dd 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -73,7 +73,7 @@ ;; linklet imports, where #t to means that a value is expected, and #f ;; means that a variable (which boxes a value) is expected. (define (schemify-linklet lk serializable? datum-intern? for-jitify? allow-set!-undefined? - unsafe-mode? no-prompt? + unsafe-mode? enforce-constant? allow-inline? no-prompt? prim-knowns get-import-knowns import-keys) (define (im-int-id id) (unwrap (if (pair? id) (cadr id) id))) (define (im-ext-id id) (unwrap (if (pair? id) (car id) id))) @@ -132,7 +132,8 @@ ;; Schemify the body, collecting information about defined names: (define-values (new-body defn-info mutated) (schemify-body* bodys/constants-lifted prim-knowns imports exports - for-jitify? allow-set!-undefined? add-import! #f unsafe-mode? no-prompt?)) + for-jitify? allow-set!-undefined? add-import! #f + unsafe-mode? enforce-constant? allow-inline? no-prompt?)) (define all-grps (append grps (reverse new-grps))) (values ;; Build `lambda` with schemified body: @@ -184,16 +185,16 @@ (define-values (new-body defn-info mutated) (schemify-body* l prim-knowns imports exports #f #f (lambda (im ext-id index) #f) - for-cify? unsafe-mode? no-prompt?)) + for-cify? unsafe-mode? #t #t no-prompt?)) new-body) (define (schemify-body* l prim-knowns imports exports for-jitify? allow-set!-undefined? add-import! - for-cify? unsafe-mode? no-prompt?) + for-cify? unsafe-mode? enforce-constant? allow-inline? no-prompt?) ;; Various conversion steps need information about mutated variables, ;; where "mutated" here includes visible implicit mutation, such as ;; a variable that might be used before it is defined: - (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports unsafe-mode?)) + (define mutated (mutated-in-body l exports prim-knowns (hasheq) imports unsafe-mode? enforce-constant?)) ;; Make another pass to gather known-binding information: (define knowns (for/fold ([knowns (hasheq)]) ([form (in-list l)]) @@ -242,7 +243,7 @@ allow-set!-undefined? add-import! for-cify? for-jitify? - unsafe-mode? no-prompt?)) + unsafe-mode? allow-inline? no-prompt?)) ;; For the case that the right-hand side won't capture a ;; continuation or return multiple times, we can generate a ;; simple definition: @@ -378,7 +379,7 @@ ;; Schemify `let-values` to `let`, etc., and ;; reorganize struct bindings. (define (schemify v prim-knowns knowns mutated imports exports allow-set!-undefined? add-import! - for-cify? for-jitify? unsafe-mode? no-prompt?) + for-cify? for-jitify? unsafe-mode? allow-inline? no-prompt?) (let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [v v]) (define (schemify v) (define s-v @@ -628,7 +629,8 @@ [`,_ #f])) (define (inline-rator) (define u-rator (unwrap rator)) - (and (symbol? u-rator) + (and allow-inline? + (symbol? u-rator) (let-values ([(k im) (find-known+import u-rator prim-knowns knowns imports mutated)]) (and (known-procedure/can-inline? k) (left-left-lambda-convert