Chez Scheme: revert incorrect cp0 simplification

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

View File

@ -3226,15 +3226,6 @@
'(begin (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
(equivalent-expansion?
(parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])

View File

@ -1989,20 +1989,6 @@
true-rec
(residualize-ref maybe-src id sc))]
[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)]))))
(define fold-primref

View File

@ -29324,7 +29324,16 @@
mutated_0
simples_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?
k_0)
(inline-struct-constructor_0
@ -29337,7 +29346,16 @@
(if c5_0
c5_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?
k_0)
(inline-struct-predicate_0
@ -29350,7 +29368,16 @@
(if c4_0
c4_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?
k_0)
(inline-field-access_0
@ -29363,7 +29390,16 @@
(if c3_0
c3_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?
k_0)
(inline-field-mutate_0

View File

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