From bb06facb0188b9f335b852a705d2ea6424561b0e Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Tue, 14 Jul 2009 14:16:39 -0500
Subject: [PATCH] new is inlined in the propagation pass when the class is
 known

---
 .../propagation/known-words/known-words.factor     | 14 +++++++++++++-
 .../tree/propagation/propagation-tests.factor      | 13 +++++++++++++
 basis/stack-checker/transforms/transforms.factor   |  9 ---------
 3 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index b3c8026bc4..aec61608f1 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
 arrays assocs classes classes.algebra combinators generic.math
 splitting fry locals classes.tuple alien.accessors
 classes.tuple.private slots.private definitions strings.private
-vectors hashtables generic
+vectors hashtables generic quotations
 stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
@@ -360,3 +360,15 @@ generic-comparison-ops [
         [ swap equal? ] f ?
     ] [ drop f ] if
 ] "custom-inlining" set-word-prop
+
+: inline-new ( class -- quot/f )
+    dup tuple-class? [
+        dup inlined-dependency depends-on
+        [ all-slots [ initial>> literalize ] map ]
+        [ tuple-layout '[ _ <tuple-boa> ] ]
+        bi append [ drop ] prepend >quotation
+    ] [ drop f ] if ;
+
+\ new [
+    in-d>> first value-info literal>> inline-new
+] "custom-inlining" set-word-prop
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 32c9f4ed0b..108afad296 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -704,3 +704,16 @@ TUPLE: circle me ;
 
 ! Joe found an oversight
 [ V{ integer } ] [ [ >integer ] final-classes ] unit-test
+
+TUPLE: foo bar ;
+
+[ t ] [ [ foo new ] { new } inlined? ] unit-test
+
+GENERIC: whatever ( x -- y )
+M: number whatever drop foo ;
+
+[ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test
+
+: that-thing ( -- class ) foo ;
+
+[ f ] [ [ that-thing new ] { new } inlined? ] unit-test
diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 017594a4eb..9d1ab1332a 100755
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -108,15 +108,6 @@ IN: stack-checker.transforms
 
 \ boa t "no-compile" set-word-prop
 
-\ new [
-    dup tuple-class? [
-        dup inlined-dependency depends-on
-        [ all-slots [ initial>> literalize ] map ]
-        [ tuple-layout '[ _ <tuple-boa> ] ]
-        bi append
-    ] [ drop f ] if
-] 1 define-transform
-
 ! Fast at for integer maps
 CONSTANT: lookup-table-at-max 256