From 3ed4a82475329872564b06e224c1cc6302db4290 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Date: Mon, 19 Apr 2010 16:57:17 -0500
Subject: [PATCH] Fixing another bug in the method inlining improvement
---
.../tree/propagation/inlining/inlining.factor | 19 +++++++++++--------
.../tree/propagation/propagation-tests.factor | 2 ++
2 files changed, 13 insertions(+), 8 deletions(-)
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 07ff719d09..26639bc015 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -61,16 +61,19 @@ M: callable splicing-nodes splicing-body ;
[ 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? [
+ new-class class class< [
+ last-class new-class class-min
+ ] [ object f ] if
+ ] [ last-class t ] if
+ ] all? ;
+
:: 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-min
- ] [ object f ] if
- ] [ last-class t ] if
- ] all?
+ class generic find-method-call
[ generic split-code ] [ drop f ] if
] if ;
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 4fc623b7dc..3b831aeb54 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -997,3 +997,5 @@ UNION: ?fixnum fixnum POSTPONE: f ;
[ t ] [ [ { ?fixnum } declare >fixnum ] { >fixnum } inlined? ] unit-test
[ f ] [ [ { integer } declare >fixnum ] { >fixnum } inlined? ] unit-test
+
+[ f ] [ [ { word } declare parent-word ] { parent-word } inlined? ] unit-test