Better inlining heuristic

core/compiler/test/optimizer.factor

@@ -2,7 +2,7 @@ USING: arrays compiler generic hashtables inference kernel
 kernel.private math optimizer prettyprint sequences sbufs
 strings tools.test vectors words sequences.private quotations
 optimizer.backend classes inference.dataflow tuples.private
-continuations ;
+continuations growable ;
 IN: temporary
 
 [ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
@@ -291,3 +291,12 @@ TUPLE: silly-tuple a b ;
 : construct-empty-bug construct-empty ;
 
 [ ] [ [ construct-empty ] dataflow optimize drop ] unit-test
+
+! Make sure we have sane heuristics
+: should-inline? method method-word flat-length 10 <= ;
+
+[ t ] [ \ fixnum \ shift should-inline? ] unit-test
+[ f ] [ \ array \ equal? should-inline? ] unit-test
+[ f ] [ \ sequence \ hashcode* should-inline? ] unit-test
+[ t ] [ \ array \ nth-unsafe should-inline? ] unit-test
+[ t ] [ \ growable \ nth-unsafe should-inline? ] unit-test

core/compiler/test/redefine.factor

@@ -235,7 +235,7 @@ DEFER: flushable-test-2
 : bx ax ;
 [ \ bx forget ] with-compilation-unit
 
-[ f ] [ \ bx \ ax compiled-usage contains? ] unit-test
+[ f ] [ \ bx \ ax compiled-usage key? ] unit-test
 
 DEFER: defer-redefine-test-2
 

core/optimizer/backend/backend.factor

@@ -245,18 +245,32 @@ M: #dispatch optimize-node*
 : dispatching-class ( node word -- class )
     [ dispatch# node-class# ] keep specific-method ;
 
-: flat-length ( seq -- n )
+! A heuristic to avoid excessive inlining
+DEFER: (flat-length)
+
+: word-flat-length ( word -- n )
+    dup get over inline? not or
+    [ drop 1 ] [ dup dup set word-def (flat-length) ] if ;
+
+: (flat-length) ( seq -- n )
     [
-        dup quotation? over array? or
-        [ flat-length ] [ drop 1 ] if
+        {
+            { [ dup quotation? ] [ (flat-length) 1+ ] }
+            { [ dup array? ] [ (flat-length) ] }
+            { [ dup word? ] [ word-flat-length ] }
+            { [ t ] [ drop 1 ] }
+        } cond
     ] map sum ;
 
+: flat-length ( seq -- n )
+    [ word-def (flat-length) ] with-scope ;
+
 : will-inline-method ( node word -- method-spec/t quot/t )
     #! t indicates failure
     tuck dispatching-class dup [
         swap [ 2array ] 2keep
         method method-word
-        dup word-def flat-length 5 >=
+        dup flat-length 10 >=
         [ 1quotation ] [ word-def ] if
     ] [
         2drop t t