From 02bd3d7142dee563cb94fc1419b8084fb3076f78 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Date: Mon, 19 Apr 2010 16:01:09 -0500
Subject: [PATCH] splitting generic word callsites when only one method is
 applicable

---
 .../tree/propagation/inlining/inlining.factor | 24 ++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 4a227cfa77..ad3de5d8f7 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -47,12 +47,34 @@ M: callable splicing-nodes splicing-body ;
         ] if
     ] [ 2drop undo-inlining ] if ;
 
+:: split-code ( class generic -- quot/f )
+    class generic method-for-class :> method
+    method [
+        dup class instance?
+        [ method execute ]
+        [ generic no-method ] if
+    ] and ;
+
+:: split-method-call ( class generic -- quot/f )
+    class object = [ f ] [
+        object generic method-classes 
+        [| last-class new-class |
+            class new-class classes-intersect? [
+                new-class class class<= [
+                    last-class new-class class<=
+                    last-class new-class ? f
+                ] [ object t ] if
+            ] [ last-class f ] if
+        ] any?
+        [ drop f ] [ generic split-code ] if
+    ] if ;
+
 : inlining-standard-method ( #call word -- class/f method/f )
     dup "methods" word-prop assoc-empty? [ 2drop f f ] [
         2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
             [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
             [ swap nth value-info class>> dup ] dip
-            method-for-class
+            { [ method-for-class ] [ split-method-call ] } 2||
         ] if
     ] if ;