From 33fd201947a121fded031ff32a91215903c65d73 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 21 Dec 2020 15:46:15 -0700 Subject: [PATCH] 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. --- racket/src/ChezScheme/mats/cp0.ms | 9 ------ racket/src/ChezScheme/s/cp0.ss | 14 --------- racket/src/cs/schemified/schemify.scm | 44 ++++++++++++++++++++++++--- racket/src/schemify/schemify.rkt | 23 +++++++++----- 4 files changed, 56 insertions(+), 34 deletions(-) diff --git a/racket/src/ChezScheme/mats/cp0.ms b/racket/src/ChezScheme/mats/cp0.ms index b59d983b81..349defe450 100644 --- a/racket/src/ChezScheme/mats/cp0.ms +++ b/racket/src/ChezScheme/mats/cp0.ms @@ -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]) diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss index 8016d20240..5417093bfb 100644 --- a/racket/src/ChezScheme/s/cp0.ss +++ b/racket/src/ChezScheme/s/cp0.ss @@ -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 diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index 7ff65a7ff2..a6f20cbe4a 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -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 diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index e82dd44f71..61f8708089 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -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)]