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

Chez Scheme: revert incorrect cp0 simplification

Browse Source 
It's not necessarily ok to inline a function wrapper by
`make-wrapper-procedure`, because the wrapper might get mutated. We
could add immutable wrapper procedures, but we can also just revert to
a previous approach for code that needed the optimization.
This commit is contained in:
Matthew Flatt 2020-12-21 15:46:15 -07:00
parent 50f373f4d6
commit 33fd201947
4 changed files with 56 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
racket/src/ChezScheme/mats/cp0.ms
View File

@ -3226,15 +3226,6 @@
'(begin (g) 5) '(begin (g) 5)
'(begin (#3%$value (g)) 5))) '(begin (#3%$value (g)) 5)))
(equivalent-expansion?
(parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(let ([f (#2%make-wrapper-procedure (lambda (x) x) 2 'data)]) (#2%list f (f 5)))))
'(#2%list (#2%make-wrapper-procedure (lambda (x) x) 2 'data) 5))
(equivalent-expansion?
(parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(let ([f (#2%make-arity-wrapper-procedure (lambda (x) x) 2 'data)]) (#2%list f (f 5)))))
'(#2%list (#2%make-arity-wrapper-procedure (lambda (x) x) 2 'data) 5))
(not (not
(equivalent-expansion? (equivalent-expansion?
(parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f]) (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])

14
racket/src/ChezScheme/s/cp0.ss
View File

@ -1989,20 +1989,6 @@
true-rec true-rec
(residualize-ref maybe-src id sc))] (residualize-ref maybe-src id sc))]
[else (fold-primref rhs ctxt sc wd name moi)])] [else (fold-primref rhs ctxt sc wd name moi)])]
[(call ,preinfo ,pr ,e1 ,e2 ,e3)
;; inline wrapped procedure, if it's easy:
(guard (app? ctxt)
(or (eq? (primref-name pr) 'make-wrapper-procedure)
(eq? (primref-name pr) 'make-arity-wrapper-procedure))
(nanopass-case (Lsrc Expr) e2
[(quote ,d)
(and (exact? d) (integer? d)
(bitwise-bit-set? d (length (app-opnds ctxt))))]
[else #f])
(nanopass-case (Lsrc Expr) e2
[(quote ,d) #t]
[else #f]))
(loop e1)]
[else (residualize-ref maybe-src id sc)])))) [else (residualize-ref maybe-src id sc)]))))
(define fold-primref (define fold-primref

44
racket/src/cs/schemified/schemify.scm
View File

@ -29324,7 +29324,16 @@
mutated_0 mutated_0
simples_0)) simples_0))
(let ((c5_0 (let ((c5_0
(if im_0 (if (not
(let ((or-part_2
(eq?
target_0
'cify)))
(if or-part_2
or-part_2
(eq?
target_0
'system))))
(if (known-struct-constructor? (if (known-struct-constructor?
k_0) k_0)
(inline-struct-constructor_0 (inline-struct-constructor_0
@ -29337,7 +29346,16 @@
(if c5_0 (if c5_0
c5_0 c5_0
(let ((c4_0 (let ((c4_0
(if im_0 (if (not
(let ((or-part_2
(eq?
target_0
'cify)))
(if or-part_2
or-part_2
(eq?
target_0
'system))))
(if (known-struct-predicate? (if (known-struct-predicate?
k_0) k_0)
(inline-struct-predicate_0 (inline-struct-predicate_0
@ -29350,7 +29368,16 @@
(if c4_0 (if c4_0
c4_0 c4_0
(let ((c3_0 (let ((c3_0
(if im_0 (if (not
(let ((or-part_2
(eq?
target_0
'cify)))
(if or-part_2
or-part_2
(eq?
target_0
'system))))
(if (known-field-accessor? (if (known-field-accessor?
k_0) k_0)
(inline-field-access_0 (inline-field-access_0
@ -29363,7 +29390,16 @@
(if c3_0 (if c3_0
c3_0 c3_0
(let ((c2_0 (let ((c2_0
(if im_0 (if (not
(let ((or-part_2
(eq?
target_0
'cify)))
(if or-part_2
or-part_2
(eq?
target_0
'system))))
(if (known-field-mutator? (if (known-field-mutator?
k_0) k_0)
(inline-field-mutate_0 (inline-field-mutate_0

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

@ -898,22 +898,31 @@
(cdr e) (cdr e)
#f target #f target
prim-knowns knowns imports mutated simples))] prim-knowns knowns imports mutated simples))]
;; Struct procedures are only inlined for imported values, which implies [(and (not (or
;; a non-cify, non-system target; for non-imported values, we expect a ;; Don't inline in cify mode, because cify takes care of it
;; later pass to be able to handle things (aim? target 'cify)
[(and im ;; Don't inline in 'system mode, because there will
;; be no `|#%struct-constructor| in the way, and
;; it's more readable to use the normal constructor name
(aim? target 'system)))
(known-struct-constructor? k) (known-struct-constructor? k)
(inline-struct-constructor k s-rator im args)) (inline-struct-constructor k s-rator im args))
=> (lambda (e) e)] => (lambda (e) e)]
[(and im [(and (not (or
(aim? target 'cify)
(aim? target 'system)))
(known-struct-predicate? k) (known-struct-predicate? k)
(inline-struct-predicate k s-rator im args)) (inline-struct-predicate k s-rator im args))
=> (lambda (e) e)] => (lambda (e) e)]
[(and im [(and (not (or
(aim? target 'cify)
(aim? target 'system)))
(known-field-accessor? k) (known-field-accessor? k)
(inline-field-access k s-rator im args)) (inline-field-access k s-rator im args))
=> (lambda (e) e)] => (lambda (e) e)]
[(and im [(and (not (or
(aim? target 'cify)
(aim? target 'system)))
(known-field-mutator? k) (known-field-mutator? k)
(inline-field-mutate k s-rator im args)) (inline-field-mutate k s-rator im args))
=> (lambda (e) e)] => (lambda (e) e)]