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:
parent
50f373f4d6
commit
33fd201947
|
@ -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])
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)]
|
||||
|
|
Loading…
Reference in New Issue
Block a user