From f1d7a4e66359c00cd132a32ab7055a4738e25bb0 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Date: Sat, 24 Apr 2010 19:46:12 -0500
Subject: [PATCH] Improving method inlining change, but there's still a bug

---
 .../tree/propagation/inlining/inlining.factor | 41 ++++++++-----------
 .../propagation/transforms/transforms.factor  | 18 ++++----
 2 files changed, 28 insertions(+), 31 deletions(-)

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index b281767e55..19b515ba12 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -47,36 +47,29 @@ M: callable splicing-nodes splicing-body ;
         ] if
     ] [ 2drop undo-inlining ] if ;
 
+ERROR: bad-splitting class generic ;
+
 :: split-code ( class generic -- quot/f )
-    class generic method-for-class :> method
-    method [
+    class generic method-for-class
+    [ class generic bad-splitting ] unless
+    [
         dup class instance?
-        [ method execute ]
+        [ generic execute ]
         [ generic no-method ] if
-    ] and ;
+    ] ;
 
-: class-min ( class1 class2 -- class/f ? )
-    2dup class<= [ drop t ] [
-        2dup swap class<=
-        [ nip t ] [ 2drop f f ] if
-    ] if ;
-
-:: find-method-call ( class generic -- subclass/f ? )
-    object generic method-classes 
-    [| last-class new-class |
-        class new-class classes-intersect? [
-            class new-class class<=
-            [ object f ] [
-                last-class new-class class-min
-            ] if
-        ] [ last-class t ] if
-    ] all? ;
+:: find-method-call ( class generic -- subclass/f )
+    generic method-classes [ f ] [
+        f swap [| last-class new-class |
+            class new-class classes-intersect? [
+                last-class [ f f ] [ new-class t ] if
+            ] [ last-class t ] if
+        ] all? swap and
+    ] if-empty ;
 
 :: split-method-call ( class generic -- quot/f )
-    class object = [ f ] [
-        class generic find-method-call
-        [ generic split-code ] [ drop f ] if
-    ] if ;
+    class generic find-method-call
+    [ generic split-code ] [ f ] if* ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
     dup "methods" word-prop assoc-empty? [ 2drop f f ] [
diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index bd85882982..a3afc8f555 100644
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -142,14 +142,18 @@ IN: compiler.tree.propagation.transforms
 ] "custom-inlining" set-word-prop
 
 :: inline-instance ( node -- quot/f )
-    node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj klass )
-    klass class? [
+    node in-d>> first2 [ value-info ] bi@ literal>> :> ( obj class )
+    class class? [
         {
-            [ klass \ f = not ]
-            [ obj class>> \ f class-not class-and klass class<= ]
-        } 0&&
-        [ [ drop >boolean ] ]
-        [ klass "predicate" word-prop '[ drop @ ] ] if
+            [ class \ f = not ]
+            [ obj class>> \ f class-not class-and class class<= ]
+        } 0&& [
+            ! TODO: replace this with an implicit null check when
+            ! profitable, once Factor gets OSR implemented
+            [ drop >boolean ]
+        ] [
+            class "predicate" word-prop '[ drop @ ]
+        ] if
     ] [ f ] if ;
 
 \ instance? [ inline-instance ] "custom-inlining" set-word-prop