From 2440fc1ceb530ceb3fe277e5ffab6aeca6a9b020 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 22 Aug 2008 17:38:23 -0500
Subject: [PATCH] Fixing remaining issues

---
 basis/compiler/generator/generator.factor     |  18 +-
 .../generator/iterator/iterator.factor        |  26 +-
 basis/compiler/tests/alien.factor             |   8 +-
 basis/compiler/tests/optimizer.factor         | 358 ++++++++++++++++++
 basis/compiler/tests/redefine1.factor         |  11 +-
 basis/compiler/tests/simple.factor            |   2 +-
 .../compiler/tree/builder/builder-docs.factor |  26 +-
 basis/compiler/tree/builder/builder.factor    |  51 +--
 .../tree/cleanup/cleanup-tests.factor         |   7 +-
 basis/compiler/tree/cleanup/cleanup.factor    |  10 +-
 .../tree/dead-code/dead-code-tests.factor     |  11 +-
 .../tree/dead-code/simple/simple.factor       |  23 +-
 .../tree/propagation/propagation-tests.factor |  24 +-
 .../strength-reduction-tests.factor           | 238 ++++++------
 basis/concurrency/mailboxes/mailboxes.factor  |  15 +-
 basis/float-arrays/float-arrays.factor        |   8 +-
 basis/help/lint/lint.factor                   |   6 +-
 basis/hints/hints-docs.factor                 |  29 ++
 basis/hints/hints.factor                      | 102 ++++-
 basis/math/ranges/ranges.factor               |  16 +-
 basis/ui/freetype/freetype.factor             |   4 +-
 core/arrays/arrays.factor                     |   8 +-
 core/classes/classes.factor                   |   2 +-
 core/classes/tuple/tuple.factor               |   6 +-
 core/cursors/cursors.factor                   |  34 --
 core/generic/standard/standard.factor         |  18 +-
 26 files changed, 721 insertions(+), 340 deletions(-)
 create mode 100755 basis/compiler/tests/optimizer.factor
 create mode 100644 basis/hints/hints-docs.factor
 delete mode 100644 core/cursors/cursors.factor

diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor
index 0897424472..53095144ff 100755
--- a/basis/compiler/generator/generator.factor
+++ b/basis/compiler/generator/generator.factor
@@ -4,7 +4,7 @@ USING: accessors arrays assocs classes combinators
 cpu.architecture effects generic hashtables io kernel
 kernel.private layouts math math.parser namespaces prettyprint
 quotations sequences system threads words vectors sets dequeues
-cursors continuations.private summary alien alien.c-types
+continuations.private summary alien alien.c-types
 alien.structs alien.strings alien.arrays libc compiler.errors
 stack-checker.inlining
 compiler.tree compiler.tree.builder compiler.tree.combinators
@@ -60,7 +60,6 @@ SYMBOL: current-label-start
 GENERIC: generate-node ( node -- next )
 
 : generate-nodes ( nodes -- )
-    <sequence-cursor>
     [ current-node generate-node ] iterate-nodes
     end-basic-block ;
 
@@ -216,20 +215,17 @@ M: #dispatch generate-node
     2array 1array define-if-intrinsics ;
 
 : do-if-intrinsic ( pair -- next )
-    <label> [
-        swap do-template
-        node> next dup >node
-    ] keep generate-if ;
+    <label> [ swap do-template skip-next ] keep generate-if ;
 
 : find-intrinsic ( #call -- pair/f )
     intrinsics find-template ;
 
 : find-if-intrinsic ( #call -- pair/f )
-    node@ next #if? [
-        if-intrinsics find-template
-    ] [
-        drop f
-    ] if ;
+    node@ {
+        { [ dup length 2 < ] [ 2drop f ] }
+        { [ dup second #if? ] [ drop if-intrinsics find-template ] }
+        [ 2drop f ]
+    } cond ;
 
 M: #call generate-node
     dup node-input-infos [ class>> ] map set-operand-classes
diff --git a/basis/compiler/generator/iterator/iterator.factor b/basis/compiler/generator/iterator/iterator.factor
index 1654ea515c..34a0cf149f 100644
--- a/basis/compiler/generator/iterator/iterator.factor
+++ b/basis/compiler/generator/iterator/iterator.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces sequences cursors kernel compiler.tree ;
+USING: namespaces sequences kernel compiler.tree ;
 IN: compiler.generator.iterator
 
 SYMBOL: node-stack
@@ -8,15 +8,15 @@ SYMBOL: node-stack
 : >node ( cursor -- ) node-stack get push ;
 : node> ( -- cursor ) node-stack get pop ;
 : node@ ( -- cursor ) node-stack get peek ;
-: current-node ( -- node ) node@ value ;
-
-: iterate-next ( -- cursor ) node@ next ;
+: current-node ( -- node ) node@ first ;
+: iterate-next ( -- cursor ) node@ rest-slice ;
+: skip-next ( -- next ) node> rest-slice [ first ] [ >node ] bi ;
 
 : iterate-nodes ( cursor quot: ( -- ) -- )
-    over [
-        [ swap >node call node> drop ] keep iterate-nodes
-    ] [
+    over empty? [
         2drop
+    ] [
+        [ swap >node call node> drop ] keep iterate-nodes
     ] if ; inline recursive
 
 : with-node-iterator ( quot -- )
@@ -25,21 +25,21 @@ SYMBOL: node-stack
 DEFER: (tail-call?)
 
 : tail-phi? ( cursor -- ? )
-    [ value #phi? ] [ next (tail-call?) ] bi and ;
+    [ first #phi? ] [ rest-slice (tail-call?) ] bi and ;
 
 : (tail-call?) ( cursor -- ? )
-    dup [
-        [ value [ #return? ] [ #terminate? ] bi or ]
+    dup empty? [ drop t ] [
+        [ first [ #return? ] [ #terminate? ] bi or ]
         [ tail-phi? ]
         bi or
-    ] [ drop t ] if ;
+    ] if ;
 
 : tail-call? ( -- ? )
     node-stack get [
-        next
+        rest-slice
         dup [
             [ (tail-call?) ]
-            [ value #terminate? not ]
+            [ first #terminate? not ]
             bi and
         ] [ drop t ] if
     ] all? ;
diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 220f49da41..6944849fcb 100644
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -1,9 +1,9 @@
 IN: compiler.tests
 USING: alien alien.c-types alien.syntax compiler kernel
-namespaces namespaces tools.test sequences inference words
-arrays parser quotations continuations inference.backend effects
-namespaces.private io io.streams.string memory system threads
-tools.test math ;
+namespaces namespaces tools.test sequences stack-checker
+stack-checker.errors words arrays parser quotations
+continuations effects namespaces.private io io.streams.string
+memory system threads tools.test math ;
 
 FUNCTION: void ffi_test_0 ;
 [ ] [ ffi_test_0 ] unit-test
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
new file mode 100755
index 0000000000..4d257fedd6
--- /dev/null
+++ b/basis/compiler/tests/optimizer.factor
@@ -0,0 +1,358 @@
+USING: accessors arrays compiler.units generic hashtables
+stack-checker kernel kernel.private math prettyprint sequences
+sbufs strings tools.test vectors words sequences.private
+quotations classes classes.algebra classes.tuple.private
+continuations growable namespaces hints
+compiler.tree.builder compiler.tree.optimizer ;
+IN: optimizer.tests
+
+GENERIC: xyz ( obj -- obj )
+M: array xyz xyz ;
+
+[ t ] [ \ xyz compiled>> ] unit-test
+
+! Test predicate inlining
+: pred-test-1
+    dup fixnum? [
+        dup integer? [ "integer" ] [ "nope" ] if
+    ] [
+        "not a fixnum"
+    ] if ;
+
+[ 1 "integer" ] [ 1 pred-test-1 ] unit-test
+
+TUPLE: pred-test ;
+
+: pred-test-2
+    dup tuple? [
+        dup pred-test? [ "pred-test" ] [ "nope" ] if
+    ] [
+        "not a tuple"
+    ] if ;
+
+[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test
+
+: pred-test-3
+    dup pred-test? [
+        dup tuple? [ "pred-test" ] [ "nope" ] if
+    ] [
+        "not a tuple"
+    ] if ;
+
+[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
+
+: inline-test
+    "nom" = ;
+
+[ t ] [ "nom" inline-test ] unit-test
+[ f ] [ "shayin" inline-test ] unit-test
+[ f ] [ 3 inline-test ] unit-test
+
+: fixnum-declarations >fixnum 24 shift 1234 bitxor ;
+
+[ ] [ 1000000 fixnum-declarations . ] unit-test
+
+! regression
+
+: literal-not-branch 0 not [ ] [ ] if ;
+
+[ ] [ literal-not-branch ] unit-test
+
+! regression
+
+: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline
+: bad-kill-2 bad-kill-1 drop ;
+
+[ 3 ] [ t bad-kill-2 ] unit-test
+
+! regression
+: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline
+: the-test ( -- x y ) 2 dup (the-test) ;
+
+[ 2 0 ] [ the-test ] unit-test
+
+! regression
+: (double-recursion) ( start end -- )
+    < [
+        6 1 (double-recursion)
+        3 2 (double-recursion)
+    ] when ; inline
+
+: double-recursion ( -- ) 0 2 (double-recursion) ;
+
+[ ] [ double-recursion ] unit-test
+
+! regression
+: double-label-1 ( a b c -- d )
+    [ f double-label-1 ] [ swap nth-unsafe ] if ; inline
+
+: double-label-2 ( a -- b )
+    dup array? [ ] [ ] if 0 t double-label-1 ;
+
+[ 0 ] [ 10 double-label-2 ] unit-test
+
+! regression
+GENERIC: void-generic ( obj -- * )
+: breakage ( -- * ) "hi" void-generic ;
+[ t ] [ \ breakage compiled>> ] unit-test
+[ breakage ] must-fail
+
+! regression
+: branch-fold-regression-0 ( m -- n )
+    t [ ] [ 1+ branch-fold-regression-0 ] if ; inline
+
+: branch-fold-regression-1 ( -- m )
+    10 branch-fold-regression-0 ;
+
+[ 10 ] [ branch-fold-regression-1 ] unit-test
+
+! another regression
+: constant-branch-fold-0 "hey" ; foldable
+: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
+[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
+
+! another regression
+: foo f ;
+: bar ( -- ? ) foo 4 4 = and ;
+[ f ] [ bar ] unit-test
+
+! compiling <tuple> with a non-literal class failed
+: <tuple>-regression ( class -- tuple ) <tuple> ;
+
+[ t ] [ \ <tuple>-regression compiled>> ] unit-test
+
+GENERIC: foozul ( a -- b )
+M: reversed foozul ;
+M: integer foozul ;
+M: slice foozul ;
+
+[ t ] [
+    reversed \ foozul specific-method
+    reversed \ foozul method
+    eq?
+] unit-test
+
+! regression
+: constant-fold-2 f ; foldable
+: constant-fold-3 4 ; foldable
+
+[ f t ] [
+    [ constant-fold-2 constant-fold-3 4 = ] compile-call
+] unit-test
+
+: constant-fold-4 f ; foldable
+: constant-fold-5 f ; foldable
+
+[ f ] [
+    [ constant-fold-4 constant-fold-5 or ] compile-call
+] unit-test
+
+[ 5 ] [ 5 [ 0 + ] compile-call ] unit-test
+[ 5 ] [ 5 [ 0 swap + ] compile-call ] unit-test
+
+[ 5 ] [ 5 [ 0 - ] compile-call ] unit-test
+[ -5 ] [ 5 [ 0 swap - ] compile-call ] unit-test
+[ 0 ] [ 5 [ dup - ] compile-call ] unit-test
+
+[ 5 ] [ 5 [ 1 * ] compile-call ] unit-test
+[ 5 ] [ 5 [ 1 swap * ] compile-call ] unit-test
+[ 0 ] [ 5 [ 0 * ] compile-call ] unit-test
+[ 0 ] [ 5 [ 0 swap * ] compile-call ] unit-test
+[ -5 ] [ 5 [ -1 * ] compile-call ] unit-test
+[ -5 ] [ 5 [ -1 swap * ] compile-call ] unit-test
+
+[ 0 ] [ 5 [ 1 mod ] compile-call ] unit-test
+[ 0 ] [ 5 [ 1 rem ] compile-call ] unit-test
+
+[ 5 ] [ 5 [ -1 bitand ] compile-call ] unit-test
+[ 0 ] [ 5 [ 0 bitand ] compile-call ] unit-test
+[ 5 ] [ 5 [ -1 swap bitand ] compile-call ] unit-test
+[ 0 ] [ 5 [ 0 swap bitand ] compile-call ] unit-test
+[ 5 ] [ 5 [ dup bitand ] compile-call ] unit-test
+
+[ 5 ] [ 5 [ 0 bitor ] compile-call ] unit-test
+[ -1 ] [ 5 [ -1 bitor ] compile-call ] unit-test
+[ 5 ] [ 5 [ 0 swap bitor ] compile-call ] unit-test
+[ -1 ] [ 5 [ -1 swap bitor ] compile-call ] unit-test
+[ 5 ] [ 5 [ dup bitor ] compile-call ] unit-test
+
+[ 5 ] [ 5 [ 0 bitxor ] compile-call ] unit-test
+[ 5 ] [ 5 [ 0 swap bitxor ] compile-call ] unit-test
+[ -6 ] [ 5 [ -1 bitxor ] compile-call ] unit-test
+[ -6 ] [ 5 [ -1 swap bitxor ] compile-call ] unit-test
+[ 0 ] [ 5 [ dup bitxor ] compile-call ] unit-test
+
+[ 0 ] [ 5 [ 0 swap shift ] compile-call ] unit-test
+[ 5 ] [ 5 [ 0 shift ] compile-call ] unit-test
+
+[ f ] [ 5 [ dup < ] compile-call ] unit-test
+[ t ] [ 5 [ dup <= ] compile-call ] unit-test
+[ f ] [ 5 [ dup > ] compile-call ] unit-test
+[ t ] [ 5 [ dup >= ] compile-call ] unit-test
+
+[ t ] [ 5 [ dup eq? ] compile-call ] unit-test
+[ t ] [ 5 [ dup = ] compile-call ] unit-test
+[ t ] [ 5 [ dup number= ] compile-call ] unit-test
+[ t ] [ \ vector [ \ vector = ] compile-call ] unit-test
+
+GENERIC: detect-number ( obj -- obj )
+M: number detect-number ;
+
+[ 10 f [ <array> 0 + detect-number ] compile-call ] must-fail
+
+! Regression
+[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test
+
+! Regression
+USE: sorting
+USE: binary-search
+USE: binary-search.private
+
+: old-binsearch ( elt quot seq -- elt quot i )
+    dup length 1 <= [
+        slice-from
+    ] [
+        [ midpoint swap call ] 3keep roll dup zero?
+        [ drop dup slice-from swap midpoint@ + ]
+        [ dup midpoint@ cut-slice old-binsearch ] if
+    ] if ; inline
+
+[ 10 ] [
+    10 20 >vector <flat-slice>
+    [ [ - ] swap old-binsearch ] compile-call 2nip
+] unit-test
+
+! Regression
+TUPLE: silly-tuple a b ;
+
+[ 1 2 { silly-tuple-a silly-tuple-b } ] [
+    T{ silly-tuple f 1 2 }
+    [
+        { silly-tuple-a silly-tuple-b } [ get-slots ] keep
+    ] compile-call
+] unit-test
+
+! Regression
+: empty-compound ;
+
+: node-successor-f-bug ( x -- * )
+    [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
+
+[ t ] [ \ node-successor-f-bug compiled>> ] unit-test
+
+[ ] [ [ new ] build-tree optimize-tree drop ] unit-test
+
+[ ] [ [ <tuple> ] build-tree optimize-tree drop ] unit-test
+
+! Regression
+: lift-throw-tail-regression ( obj -- obj str )
+    dup integer? [ "an integer" ] [
+        dup string? [ "a string" ] [
+            "error" throw
+        ] if
+    ] if ;
+
+[ t ] [ \ lift-throw-tail-regression compiled>> ] unit-test
+[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
+[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
+
+: lift-loop-tail-test-1 ( a quot -- )
+    over even? [
+        [ >r 3 - r> call ] keep lift-loop-tail-test-1
+    ] [
+        over 0 < [
+            2drop
+        ] [
+            [ >r 2 - r> call ] keep lift-loop-tail-test-1
+        ] if
+    ] if ; inline
+
+: lift-loop-tail-test-2
+    10 [ ] lift-loop-tail-test-1 1 2 3 ;
+
+[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
+
+! Forgot a recursive inline check
+: recursive-inline-hang ( a -- a )
+    dup array? [ recursive-inline-hang ] when ;
+
+HINTS: recursive-inline-hang array ;
+
+: recursive-inline-hang-1 ( -- a )
+    { } recursive-inline-hang ;
+
+[ t ] [ \ recursive-inline-hang-1 compiled>> ] unit-test
+
+DEFER: recursive-inline-hang-3
+
+: recursive-inline-hang-2 ( a -- a )
+    dup array? [ recursive-inline-hang-3 ] when ;
+
+HINTS: recursive-inline-hang-2 array ;
+
+: recursive-inline-hang-3 ( a -- a )
+    dup array? [ recursive-inline-hang-2 ] when ;
+
+HINTS: recursive-inline-hang-3 array ;
+
+! Regression
+USE: sequences.private
+
+[ ] [ { (3append) } compile ] unit-test
+
+! Wow
+: counter-example ( a b c d -- a' b' c' d' )
+    dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline
+
+: counter-example' ( -- a' b' c' d' )
+    1 2 3.0 3 counter-example ;
+
+[ 2 4 6.0 0 ] [ counter-example' ] unit-test
+
+: member-test ( obj -- ? ) { + - * / /i } member? ;
+
+\ member-test must-infer
+[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
+[ t ] [ \ + member-test ] unit-test
+[ f ] [ \ append member-test ] unit-test
+
+! Infinite expansion
+TUPLE: cons car cdr ;
+
+UNION: improper-list cons POSTPONE: f ;
+
+PREDICATE: list < improper-list
+    [ cdr>> list instance? ] [ t ] if* ;
+
+[ t ] [
+    T{ cons f 1 T{ cons f 2 T{ cons f 3 f } } }
+    [ list instance? ] compile-call
+] unit-test
+
+! Regression
+: interval-inference-bug ( obj -- obj x )
+    dup "a" get { array-capacity } declare >=
+    [ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
+
+\ interval-inference-bug must-infer
+
+[ ] [ 1 "a" set 2 "b" set ] unit-test
+[ 2 3 ] [ 2 interval-inference-bug ] unit-test
+[ 1 4 ] [ 1 interval-inference-bug ] unit-test
+[ 0 5 ] [ 0 interval-inference-bug ] unit-test
+
+: aggressive-flush-regression ( a -- b )
+    f over >r <array> drop r> 1 + ;
+
+[ 1.0 aggressive-flush-regression drop ] must-fail
+
+[ 1 [ "hi" + drop ] compile-call ] must-fail
+
+[ "hi" f [ <array> drop ] compile-call ] must-fail
+
+TUPLE: some-tuple x ;
+
+: allot-regression ( a -- b )
+    [ ] curry some-tuple boa ;
+
+[ T{ some-tuple f [ 3 ] } ] [ 3 allot-regression ] unit-test
diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor
index 6773eb6b6a..1b349d2296 100644
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@@ -1,7 +1,7 @@
-IN: compiler.tests
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval ;
+IN: compiler.tests
 
 GENERIC: method-redefine-test ( a -- b )
 
@@ -31,15 +31,6 @@ M: integer method-redefine-test 3 + ;
 [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
 [ t ] [ \ there compiled>> ] unit-test
 
-! Just changing the stack effect didn't mark a word for recompilation
-DEFER: change-effect
-
-[ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- b )" eval ] unit-test
-{ 1 1 } [ change-effect ] must-infer-as
-
-[ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- )" eval ] unit-test
-{ 1 0 } [ change-effect ] must-infer-as
-
 : good ( -- ) ;
 : bad ( -- ) good ;
 : ugly ( -- ) bad ;
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index c18ab3e335..671171a959 100755
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -235,6 +235,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
 10 [
     [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
     [ t ] [
-        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) (  -- ) (recursive) (recursive) ; inline : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval
+        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval
     ] unit-test
 ] times
diff --git a/basis/compiler/tree/builder/builder-docs.factor b/basis/compiler/tree/builder/builder-docs.factor
index 7829cd0460..8cf3796f0a 100644
--- a/basis/compiler/tree/builder/builder-docs.factor
+++ b/basis/compiler/tree/builder/builder-docs.factor
@@ -2,26 +2,6 @@ USING: help.markup help.syntax sequences quotations words
 compiler.tree stack-checker.errors ;
 IN: compiler.tree.builder
 
-ARTICLE: "specializers" "Word specializers"
-"The optimizer can be passed hints as to the classes of parameters a word is expected to be called with. The optimizer will then generate multiple versions of word when compiling, specialized to each class."
-$nl
-"Specialization hints are stored in the " { $snippet "\"specializer\"" } " word property. The value of this property is either a sequence of classes, or a sequence of sequences of classes. Each element in the sequence (or the sequence itself, in the former case) is a specialization hint."
-$nl
-"Specialization can help in the case where a word calls a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class, and inlining of generic methods can take place."
-$nl
-"Specialization hints are not declarations; if the inputs do not match what is specified, the word will still run, possibly slower if the compiled code cannot inline methods because of insufficient static type information."
-$nl
-"In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class."
-$nl
-"For example, the " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
-{ $code
-"\\ append"
-"{ { string string } { array array } }"
-"\"specializer\" set-word-prop"
-}
-"The specialized version of a word which will be compiled by the compiler can be inspected:"
-{ $subsection specialized-def } ;
-
 HELP: build-tree
 { $values { "quot" quotation } { "nodes" "a sequence of nodes" } }
 { $description "Attempts to construct tree SSA IR from a quotation." }
@@ -30,9 +10,5 @@ HELP: build-tree
 
 HELP: build-tree-with
 { $values { "in-stack" "a sequence of values" } { "quot" quotation } { "nodes" "a sequence of nodes" } { "out-stack" "a sequence of values" } }
-{ $description "Attempts to construct tree SSA IR from a quotaiton, starting with an initial data stack of values, and outputting stack resulting at the end." }
+{ $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values, and outputting stack resulting at the end." }
 { $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
-
-HELP: specialized-def
-{ $values { "word" word } { "quot" quotation } }
-{ $description "Outputs the definition of a word after it has been split into specialized branches. This is the definition which will actually be compiled by the compiler." } ;
diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor
index 8bc0f72ac9..a01dde3462 100644
--- a/basis/compiler/tree/builder/builder.factor
+++ b/basis/compiler/tree/builder/builder.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors quotations kernel sequences namespaces assocs
-words generic generic.standard generic.standard.engines arrays
-kernel.private combinators vectors stack-checker
+USING: fry accessors quotations kernel sequences namespaces
+assocs words arrays vectors hints combinators stack-checker
 stack-checker.state stack-checker.visitor stack-checker.errors
 stack-checker.backend compiler.tree ;
 IN: compiler.tree.builder
@@ -29,49 +28,6 @@ IN: compiler.tree.builder
     [ rot #copy suffix ]
     if ;
 
-: (make-specializer) ( class picker -- quot )
-    swap "predicate" word-prop append ;
-
-: make-specializer ( classes -- quot )
-    dup length <reversed>
-    [ (picker) 2array ] 2map
-    [ drop object eq? not ] assoc-filter
-    dup empty? [ drop [ t ] ] [
-        [ (make-specializer) ] { } assoc>map
-        unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
-    ] if ;
-
-: specializer-cases ( quot word -- default alist )
-    dup [ array? ] all? [ 1array ] unless [
-        [ make-specializer ] keep
-        '[ , declare ] pick append
-    ] { } map>assoc ;
-
-: method-declaration ( method -- quot )
-    dup "method-generic" word-prop dispatch# object <array>
-    swap "method-class" word-prop prefix ;
-
-: specialize-method ( quot method -- quot' )
-    method-declaration '[ , declare ] prepend ;
-
-: specialize-quot ( quot specializer -- quot' )
-    specializer-cases alist>quot ;
-
-: standard-method? ( method -- ? )
-    dup method-body? [
-        "method-generic" word-prop standard-generic?
-    ] [ drop f ] if ;
-
-: specialized-def ( word -- quot )
-    dup def>> swap {
-        { [ dup standard-method? ] [ specialize-method ] }
-        {
-            [ dup "specializer" word-prop ]
-            [ "specializer" word-prop specialize-quot ]
-        }
-        [ drop ]
-    } cond ;
-
 : (build-tree-from-word) ( word -- )
     dup
     [ "inline" word-prop ]
@@ -99,6 +55,3 @@ IN: compiler.tree.builder
             } cleave
         ] maybe-cannot-infer
     ] with-tree-builder ;
-
-: specialized-length ( specializer -- n )
-    dup [ array? ] all? [ first ] when length ;
diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index e969d098c7..3a645955c2 100644
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -433,7 +433,7 @@ cell-bits 32 = [
     ] { >= fixnum>= } inlined?
 ] unit-test
 
-[ ] [
+[ t ] [
     [
         4 pick array-capacity?
         [ set-slot ] [ \ array-capacity 2nip bad-slot-value ] if
@@ -451,3 +451,8 @@ cell-bits 32 = [
         if
     ] cleaned-up-tree drop
 ] unit-test
+
+[ t ] [
+    [ [ 2array ] [ 0 3array ] if first ]
+    { nth-unsafe < <= > >= } inlined?
+] unit-test
diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor
index a06c5d4dfd..9feb931c03 100644
--- a/basis/compiler/tree/cleanup/cleanup.factor
+++ b/basis/compiler/tree/cleanup/cleanup.factor
@@ -3,7 +3,7 @@
 USING: kernel accessors sequences sequences.deep combinators fry
 classes.algebra namespaces assocs math math.private
 math.partial-dispatch classes.tuple classes.tuple.private
-stack-checker.branches
+definitions stack-checker.state stack-checker.branches
 compiler.tree
 compiler.tree.intrinsics
 compiler.tree.combinators
@@ -42,14 +42,18 @@ GENERIC: cleanup* ( node -- node/nodes )
 : cleanup-folding ( #call -- nodes )
     #! Replace a #call having a known result with a #drop of its
     #! inputs followed by #push nodes for the outputs.
+    [ word>> +inlined+ depends-on ]
     [
         [ node-output-infos ] [ out-d>> ] bi
         [ [ literal>> ] dip #push ] 2map
     ]
-    [ in-d>> #drop ] bi prefix ;
+    [ in-d>> #drop ]
+    tri prefix ;
 
 : cleanup-inlining ( #call -- nodes )
-    body>> cleanup ;
+    [ dup method>> [ drop ] [ word>> +inlined+ depends-on ] if ]
+    [ body>> cleanup ]
+    bi ;
 
 ! Removing overflow checks
 : no-overflow-variant ( op -- fast-op )
diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor
index 670634e752..4c04ec3917 100644
--- a/basis/compiler/tree/dead-code/dead-code-tests.factor
+++ b/basis/compiler/tree/dead-code/dead-code-tests.factor
@@ -5,7 +5,8 @@ compiler.tree.cleanup compiler.tree.escape-analysis
 compiler.tree.tuple-unboxing compiler.tree.debugger
 compiler.tree.normalization compiler.tree.checker tools.test
 kernel math stack-checker.state accessors combinators io
-prettyprint words sequences.deep sequences.private ;
+prettyprint words sequences.deep sequences.private arrays
+classes kernel.private ;
 IN: compiler.tree.dead-code.tests
 
 \ remove-dead-code must-infer
@@ -173,3 +174,11 @@ IN: compiler.tree.dead-code.tests
 [ ] [ [ [ ] curry [ ] swap compose call-recursive-dce-6 ] optimize-quot drop ] unit-test
 
 [ ] [ [ [ ] rot [ . ] curry pick [ roll 2drop call ] [ 2nip call ] if ] optimize-quot drop ] unit-test
+
+[ [ drop ] ] [ [ array? drop ] optimize-quot ] unit-test
+
+[ [ drop ] ] [ [ array instance? drop ] optimize-quot ] unit-test
+
+[ [ drop ] ] [ [ { integer } declare f <array> drop ] optimize-quot ] unit-test
+
+[ [ f <array> drop ] ] [ [ f <array> drop ] optimize-quot ] unit-test
diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index 880ae94a1f..01c535a819 100644
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -1,13 +1,25 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors words assocs sequences arrays namespaces
-fry locals compiler.tree stack-checker.backend
+fry locals classes.algebra stack-checker.backend
+compiler.tree
+compiler.tree.propagation.info
 compiler.tree.dead-code.liveness ;
 IN: compiler.tree.dead-code.simple
 
+: flushable? ( word -- ? )
+    [ "flushable" word-prop ] [ "predicating" word-prop ] bi or ;
+
+: flushable-call? ( #call -- ? )
+    dup word>> dup flushable? [
+        "input-classes" word-prop dup [
+            [ node-input-infos ] dip
+            [ [ class>> ] dip class<= ] 2all?
+        ] [ 2drop t ] if
+    ] [ 2drop f ] if ;
+
 M: #call mark-live-values*
-    dup word>> "flushable" word-prop
-    [ drop ] [ look-at-inputs ] if ;
+    dup flushable-call? [ drop ] [ look-at-inputs ] if ;
 
 M: #alien-invoke mark-live-values* look-at-inputs ;
 
@@ -80,8 +92,9 @@ M: #push remove-dead-code*
     dup out-d>> first live-value? [ drop f ] unless ;
 
 : dead-flushable-call? ( #call -- ? )
-    [ word>> "flushable" word-prop ]
-    [ out-d>> [ live-value? not ] all? ] bi and ;
+    dup flushable-call? [
+        out-d>> [ live-value? not ] all?
+    ] [ drop f ] if ;
 
 : remove-flushable-call ( #call -- node )
     in-d>> #drop remove-dead-code* ;
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index c3b1b7a5fd..cbd51de933 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -143,10 +143,6 @@ IN: compiler.tree.propagation.tests
     [ dup string? not not >boolean [ ] [ "Oops" throw ] if ] final-classes
 ] unit-test
 
-[ V{ string } ] [
-    [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
-] unit-test
-
 [ f ] [ [ t xor ] final-classes first null-class? ] unit-test
 
 [ t ] [ [ t or ] final-classes first true-class? ] unit-test
@@ -159,20 +155,12 @@ IN: compiler.tree.propagation.tests
 
 [ t ] [ [ dup not or ] final-classes first true-class? ] unit-test
 
-[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
-
 [ t ] [ [ dup not swap or ] final-classes first true-class? ] unit-test
 
-[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
-
 [ t ] [ [ dup not and ] final-classes first false-class? ] unit-test
 
-[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
-
 [ t ] [ [ dup not swap and ] final-classes first false-class? ] unit-test
 
-[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
-
 [ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test
 
 [ V{ fixnum } ] [
@@ -571,3 +559,15 @@ M: integer infinite-loop infinite-loop ;
 : fold-throw-test ( a -- b ) "A" throw ; foldable
 
 [ ] [ [ 0 fold-throw-test ] final-info drop ] unit-test
+
+! [ V{ string } ] [
+!     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
+! ] unit-test
+
+! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
+
+! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
+
+! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
+
+! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
diff --git a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor b/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
index a940a63421..86fe74d939 100644
--- a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
+++ b/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
@@ -1,119 +1,119 @@
-TUPLE: declared-fixnum { x fixnum } ;
-
-[ t ] [
-    [ { declared-fixnum } declare [ 1 + ] change-x ]
-    { + fixnum+ >fixnum } inlined?
-] unit-test
-
-[ t ] [
-    [ { declared-fixnum } declare x>> drop ]
-    { slot } inlined?
-] unit-test
-
-[ t ] [
-    [ hashtable new ] \ new inlined?
-] unit-test
-
-[ t ] [
-    [ dup hashtable eq? [ new ] when ] \ new inlined?
-] unit-test
-
-[ f ] [
-    [ { integer } declare -63 shift 4095 bitand ]
-    \ shift inlined?
-] unit-test
-
-[ t ] [
-    [ { integer } declare 127 bitand 3 + ]
-    { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
-] unit-test
-
-[ f ] [
-    [ { integer } declare 127 bitand 3 + ]
-    { >fixnum } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { integer } declare
-        dup 0 >= [
-            615949 * 797807 + 20 2^ mod dup 19 2^ -
-        ] [ dup ] if
-    ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { fixnum } declare
-        615949 * 797807 + 20 2^ mod dup 19 2^ -
-    ] { >fixnum } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { integer } declare 0 swap
-        [
-            drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-        ] map
-    ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { fixnum } declare 0 swap
-        [
-            drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-        ] map
-    ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
-] unit-test
-
-[ t ] [
-    [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
-] unit-test
-
-[ t ] [
-    [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
-] unit-test
-
-[ t ] [
-    [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
-] unit-test
-
-
-
-[ t ] [
-    [
-        { integer } declare [ 256 mod ] map
-    ] { mod fixnum-mod } inlined?
-] unit-test
-
-
-[ f ] [
-    [
-        256 mod
-    ] { mod fixnum-mod } inlined?
-] unit-test
-
-[ f ] [
-    [
-        dup 0 >= [ 256 mod ] when
-    ] { mod fixnum-mod } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { integer } declare dup 0 >= [ 256 mod ] when
-    ] { mod fixnum-mod } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { integer } declare 256 rem
-    ] { mod fixnum-mod } inlined?
-] unit-test
-
-[ t ] [
-    [
-        { integer } declare [ 256 rem ] map
-    ] { mod fixnum-mod rem } inlined?
-] unit-test
+! TUPLE: declared-fixnum { x fixnum } ;
+! 
+! [ t ] [
+!     [ { declared-fixnum } declare [ 1 + ] change-x ]
+!     { + fixnum+ >fixnum } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ { declared-fixnum } declare x>> drop ]
+!     { slot } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ hashtable new ] \ new inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ dup hashtable eq? [ new ] when ] \ new inlined?
+! ] unit-test
+! 
+! [ f ] [
+!     [ { integer } declare -63 shift 4095 bitand ]
+!     \ shift inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ { integer } declare 127 bitand 3 + ]
+!     { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
+! ] unit-test
+! 
+! [ f ] [
+!     [ { integer } declare 127 bitand 3 + ]
+!     { >fixnum } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { integer } declare
+!         dup 0 >= [
+!             615949 * 797807 + 20 2^ mod dup 19 2^ -
+!         ] [ dup ] if
+!     ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { fixnum } declare
+!         615949 * 797807 + 20 2^ mod dup 19 2^ -
+!     ] { >fixnum } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { integer } declare 0 swap
+!         [
+!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
+!         ] map
+!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { fixnum } declare 0 swap
+!         [
+!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
+!         ] map
+!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
+! ] unit-test
+! 
+! 
+! 
+! [ t ] [
+!     [
+!         { integer } declare [ 256 mod ] map
+!     ] { mod fixnum-mod } inlined?
+! ] unit-test
+! 
+! 
+! [ f ] [
+!     [
+!         256 mod
+!     ] { mod fixnum-mod } inlined?
+! ] unit-test
+! 
+! [ f ] [
+!     [
+!         dup 0 >= [ 256 mod ] when
+!     ] { mod fixnum-mod } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { integer } declare dup 0 >= [ 256 mod ] when
+!     ] { mod fixnum-mod } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { integer } declare 256 rem
+!     ] { mod fixnum-mod } inlined?
+! ] unit-test
+! 
+! [ t ] [
+!     [
+!         { integer } declare [ 256 rem ] map
+!     ] { mod fixnum-mod rem } inlined?
+! ] unit-test
diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index 11624ab473..e4269000c9 100755
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -4,7 +4,7 @@ IN: concurrency.mailboxes
 USING: dlists dequeues threads sequences continuations
 destructors namespaces random math quotations words kernel
 arrays assocs init system concurrency.conditions accessors
-debugger debugger.threads ;
+debugger debugger.threads locals ;
 
 TUPLE: mailbox threads data disposed ;
 
@@ -23,13 +23,12 @@ M: mailbox dispose* threads>> notify-all ;
 : wait-for-mailbox ( mailbox timeout -- )
     >r threads>> r> "mailbox" wait ;
 
-: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
-    pick check-disposed
-    pick data>> over dlist-contains? [
-        3drop
-    ] [
-        >r 2dup wait-for-mailbox r> block-unless-pred
-    ] if ; inline recursive
+:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
+    mailbox check-disposed
+    mailbox data>> pred dlist-contains? [
+        mailbox timeout wait-for-mailbox
+        mailbox timeout pred block-unless-pred
+    ] unless ; inline recursive
 
 : block-if-empty ( mailbox timeout -- mailbox )
     over check-disposed
diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor
index 0aa7fa5056..ea41dc5436 100755
--- a/basis/float-arrays/float-arrays.factor
+++ b/basis/float-arrays/float-arrays.factor
@@ -47,16 +47,16 @@ M: float-array byte-length length "double" heap-size * ;
 INSTANCE: float-array sequence
 
 : 1float-array ( x -- array )
-    1 <float-array> [ set-first ] keep ; flushable
+    1 <float-array> [ set-first ] keep ; inline
 
 : 2float-array ( x y -- array )
-    T{ float-array } 2sequence ; flushable
+    T{ float-array } 2sequence ; inline
 
 : 3float-array ( x y z -- array )
-    T{ float-array } 3sequence ; flushable
+    T{ float-array } 3sequence ; inline
 
 : 4float-array ( w x y z -- array )
-    T{ float-array } 4sequence ; flushable
+    T{ float-array } 4sequence ; inline
 
 : F{ ( parsed -- parsed )
     \ } [ >float-array ] parse-literal ; parsing
diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index c4f4a46710..0f2ea38480 100755
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -109,9 +109,9 @@ M: help-error error.
     vocabs [ dup vocab-docs-path swap ] H{ } map>assoc
     H{ } clone [
         [
-            >r >r dup >link where dup
-            [ first r> at r> push-at ]
-            [ r> r> 2drop 2drop ]
+            [ dup >link where dup ] 2dip
+            [ first r> at r> push-at ] 2curry
+            [ 2drop ]
             if
         ] 2curry each
     ] keep ;
diff --git a/basis/hints/hints-docs.factor b/basis/hints/hints-docs.factor
new file mode 100644
index 0000000000..8e22966d3f
--- /dev/null
+++ b/basis/hints/hints-docs.factor
@@ -0,0 +1,29 @@
+IN: hints
+USING: help.markup help.syntax words ;
+
+ARTICLE: "hints" "Compiler specialization hints"
+"Specialization hints help the compiler generate efficient code."
+$nl
+"Specialization hints can help words which call a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class, and inlining of generic methods can take place."
+$nl
+"Specialization hints are not declarations; if the inputs do not match what is specified, the word will still run, possibly slower if the compiled code cannot inline methods because of insufficient static type information."
+$nl
+"In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class."
+$nl
+"Type hints are declared with a parsing word:"
+{ $subsection POSTPONE: HINT: }
+$nl
+"The specialized version of a word which will be compiled by the compiler can be inspected:"
+{ $subsection specialized-def } ;
+
+HELP: specialized-def
+{ $values { "word" word } { "quot" quotation } }
+{ $description "Outputs the definition of a word after it has been split into specialized branches. This is the definition which will actually be compiled by the compiler." } ;
+
+HELP: HINTS:
+{ $values { "word" word } { "hints..." "a list of sequences of classes" } }
+{ $description "Defines specialization hints for each words. Each sequence of classes in the list will cause a specialized version of the word to be compiled." }
+{ $examples "The " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
+{ $code "HINTS: append { string string } { array array } ;" } } ;
+
+ABOUT: "hints"
diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 82941a69de..59626a4f8a 100644
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -1,10 +1,110 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser words definitions kernel ;
+USING: parser words definitions kernel sequences assocs arrays
+kernel.private fry combinators accessors vectors strings sbufs
+byte-arrays byte-vectors io.binary io.streams.string splitting
+math generic generic.standard generic.standard.engines ;
 IN: hints
 
+: (make-specializer) ( class picker -- quot )
+    swap "predicate" word-prop append ;
+
+: make-specializer ( classes -- quot )
+    dup length <reversed>
+    [ (picker) 2array ] 2map
+    [ drop object eq? not ] assoc-filter
+    dup empty? [ drop [ t ] ] [
+        [ (make-specializer) ] { } assoc>map
+        unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
+    ] if ;
+
+: specializer-cases ( quot word -- default alist )
+    dup [ array? ] all? [ 1array ] unless [
+        [ make-specializer ] keep
+        '[ , declare ] pick append
+    ] { } map>assoc ;
+
+: method-declaration ( method -- quot )
+    [ "method-generic" word-prop dispatch# object <array> ]
+    [ "method-class" word-prop ]
+    bi prefix ;
+
+: specialize-method ( quot method -- quot' )
+    method-declaration '[ , declare ] prepend ;
+
+: specialize-quot ( quot specializer -- quot' )
+    specializer-cases alist>quot ;
+
+: standard-method? ( method -- ? )
+    dup method-body? [
+        "method-generic" word-prop standard-generic?
+    ] [ drop f ] if ;
+
+: specialized-def ( word -- quot )
+    dup def>> swap {
+        { [ dup standard-method? ] [ specialize-method ] }
+        {
+            [ dup "specializer" word-prop ]
+            [ "specializer" word-prop specialize-quot ]
+        }
+        [ drop ]
+    } cond ;
+
+: specialized-length ( specializer -- n )
+    dup [ array? ] all? [ first ] when length ;
+
 : HINTS:
     scan-word
     [ +inlined+ changed-definition ]
     [ parse-definition "specializer" set-word-prop ] bi ;
     parsing
+
+! Default specializers
+{ first first2 first3 first4 }
+[ { array } "specializer" set-word-prop ] each
+
+{ peek pop* pop push } [
+    { vector } "specializer" set-word-prop
+] each
+
+\ push-all
+{ { string sbuf } { array vector } { byte-array byte-vector } }
+"specializer" set-word-prop
+
+\ append
+{ { string string } { array array } }
+"specializer" set-word-prop
+
+\ subseq
+{ { fixnum fixnum string } { fixnum fixnum array } }
+"specializer" set-word-prop
+
+\ reverse-here
+{ { string } { array } }
+"specializer" set-word-prop
+
+\ mismatch
+{ string string }
+"specializer" set-word-prop
+
+\ find-last-sep { string sbuf } "specializer" set-word-prop
+
+\ >string { sbuf } "specializer" set-word-prop
+
+\ >array { { string } { vector } } "specializer" set-word-prop
+
+\ >vector { { array } { vector } } "specializer" set-word-prop
+
+\ >sbuf { string } "specializer" set-word-prop
+
+\ split, { string string } "specializer" set-word-prop
+
+\ memq? { array } "specializer" set-word-prop
+
+\ member? { fixnum string } "specializer" set-word-prop
+
+\ assoc-stack { vector } "specializer" set-word-prop
+
+\ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
+
+\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor
index 9c205a6bc8..5acdc43ca3 100755
--- a/basis/math/ranges/ranges.factor
+++ b/basis/math/ranges/ranges.factor
@@ -10,7 +10,7 @@ TUPLE: range
 : <range> ( a b step -- range )
     >r over - r>
     [ / 1+ 0 max >integer ] keep
-    range boa ;
+    range boa ; inline
 
 M: range length ( seq -- n )
     length>> ;
@@ -26,19 +26,19 @@ INSTANCE: range immutable-sequence
 
 : ,b) dup neg rot + swap ; inline
 
-: [a,b] ( a b -- range ) twiddle <range> ; foldable
+: [a,b] ( a b -- range ) twiddle <range> ; inline
 
-: (a,b] ( a b -- range ) twiddle (a, <range> ; foldable
+: (a,b] ( a b -- range ) twiddle (a, <range> ; inline
 
-: [a,b) ( a b -- range ) twiddle ,b) <range> ; foldable
+: [a,b) ( a b -- range ) twiddle ,b) <range> ; inline
 
-: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; foldable
+: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; inline
 
-: [0,b] ( b -- range ) 0 swap [a,b] ; foldable
+: [0,b] ( b -- range ) 0 swap [a,b] ; inline
 
-: [1,b] ( b -- range ) 1 swap [a,b] ; foldable
+: [1,b] ( b -- range ) 1 swap [a,b] ; inline
 
-: [0,b) ( b -- range ) 0 swap [a,b) ; foldable
+: [0,b) ( b -- range ) 0 swap [a,b) ; inline
 
 : range-increasing? ( range -- ? )
     step>> 0 > ;
diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor
index 85bf5d335e..487da931eb 100755
--- a/basis/ui/freetype/freetype.factor
+++ b/basis/ui/freetype/freetype.factor
@@ -212,7 +212,7 @@ M: freetype-renderer draw-string ( font string loc -- )
     char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;
 
 M: freetype-renderer x>offset ( x open-font string -- n )
-    dup >r run-char-widths [ <= ] with find drop
-    [ r> drop ] [ r> length ] if* ;
+    [ run-char-widths [ <= ] with find drop ] keep swap
+    [ ] [ length ] ?if ;
 
 T{ freetype-renderer } font-renderer set-global
diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor
index 02e0e45544..b023398762 100755
--- a/core/arrays/arrays.factor
+++ b/core/arrays/arrays.factor
@@ -23,12 +23,12 @@ M: array equal?
 
 INSTANCE: array sequence
 
-: 1array ( x -- array ) 1 swap <array> ; flushable
+: 1array ( x -- array ) 1 swap <array> ; inline
 
-: 2array ( x y -- array ) { } 2sequence ; flushable
+: 2array ( x y -- array ) { } 2sequence ; inline
 
-: 3array ( x y z -- array ) { } 3sequence ; flushable
+: 3array ( x y z -- array ) { } 3sequence ; inline
 
-: 4array ( w x y z -- array ) { } 4sequence ; flushable
+: 4array ( w x y z -- array ) { } 4sequence ; inline
 
 PREDICATE: pair < array length 2 number= ;
diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index 34f2fcf196..64a8630f36 100755
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -182,4 +182,4 @@ M: class forget* ( class -- )
 
 GENERIC: class ( object -- class )
 
-GENERIC: instance? ( object class -- ? )
+GENERIC: instance? ( object class -- ? ) flushable
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 585bb6ece7..4366349b58 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -298,11 +298,9 @@ M: tuple-class (classes-intersect?)
         [ swap classes-intersect? ]
     } cond ;
 
-M: tuple clone
-    (clone) dup delegate clone over set-delegate ;
+M: tuple clone (clone) ;
 
-M: tuple equal?
-    over tuple? [ tuple= ] [ 2drop f ] if ;
+M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ;
 
 M: tuple hashcode*
     [
diff --git a/core/cursors/cursors.factor b/core/cursors/cursors.factor
deleted file mode 100644
index 4bbfd469d3..0000000000
--- a/core/cursors/cursors.factor
+++ /dev/null
@@ -1,34 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences math accessors ;
-IN: cursors
-
-GENERIC: key ( cursor -- key )
-GENERIC: value ( cursor -- value )
-GENERIC: next ( cursor -- cursor/f )
-
-TUPLE: sequence-cursor { i read-only } { seq read-only } ;
-
-: (sequence-cursor) ( i seq -- cursor/f )
-    2dup bounds-check? [ sequence-cursor boa ] [ 2drop f ] if ;
-    inline
-
-: <sequence-cursor> ( seq -- cursor/f )
-    0 swap (sequence-cursor) ; inline
-
-: >sequence-cursor< ( cursor -- i seq ) [ i>> ] [ seq>> ] bi ;
-
-M: sequence-cursor key
-    i>> ;
-
-M: sequence-cursor value
-    >sequence-cursor< nth ;
-
-M: sequence-cursor next
-    >sequence-cursor< [ 1+ ] dip (sequence-cursor) ;
-
-: cursor-iterate ( cursor quot: ( cursor -- cursor' ) -- )
-    over [ call cursor-iterate ] [ 2drop ] if ; inline recursive
-
-: cursor-each ( cursor quot -- )
-    [ keep ] curry cursor-iterate ; inline
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 2a99588db8..503c72290a 100644
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -21,27 +21,11 @@ M: generic method-declaration
 M: quotation engine>quot
     assumed get generic get method-declaration prepend ;
 
-: unpickers
-    {
-        [ nip ]
-        [ >r nip r> swap ]
-        [ >r >r nip r> r> -rot ]
-    } ; inline
-
-: unpicker ( -- quot ) \ (dispatch#) get unpickers nth ;
-
 ERROR: no-method object generic ;
 
 : error-method ( word -- quot )
     picker swap [ no-method ] curry append ;
 
-: empty-method ( word -- quot )
-    [
-        picker % [ delegate dup ] %
-        unpicker over suffix ,
-        error-method \ drop prefix , \ if ,
-    ] [ ] make ;
-
 : default-method ( word -- pair )
     "default-method" word-prop
     object bootstrap-word swap 2array ;
@@ -137,7 +121,7 @@ PREDICATE: simple-generic < standard-generic
 M: standard-generic extra-values drop 0 ;
 
 M: standard-combination make-default-method
-    [ empty-method ] with-standard ;
+    [ error-method ] with-standard ;
 
 M: standard-combination perform-combination
     [ drop ] [ [ single-combination ] with-standard ] 2bi define ;