suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: implement compile-enforce-module-constants

Browse Source
This commit is contained in:
Matthew Flatt 2019-05-20 14:37:39 -06:00
parent b268f77ae9
commit ed5bb40109
4 changed files with 43 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -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

4
racket/src/cs/linklet.sls
View File

@ -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

8
racket/src/schemify/mutated.rkt
View File

@ -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)])

18
racket/src/schemify/schemify.rkt
View File

@ -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