More efficient specializers

core/generator/generator.factor

@@ -3,8 +3,9 @@
 USING: arrays assocs classes combinators cpu.architecture
 effects generator.fixup generator.registers generic hashtables
 inference inference.backend inference.dataflow io kernel
-kernel.private layouts math namespaces optimizer prettyprint
-quotations sequences system threads words vectors ;
+kernel.private layouts math namespaces optimizer
+optimizer.specializers prettyprint quotations sequences system
+threads words vectors ;
 IN: generator
 
 SYMBOL: compile-queue

core/optimizer/backend/backend.factor

@@ -4,7 +4,7 @@ USING: arrays generic assocs inference inference.class
 inference.dataflow inference.backend inference.state io kernel
 math namespaces sequences vectors words quotations hashtables
 combinators classes generic.math continuations optimizer.def-use
-optimizer.pattern-match generic.standard ;
+optimizer.pattern-match generic.standard optimizer.specializers ;
 IN: optimizer.backend
 
 SYMBOL: class-substitutions
@@ -256,7 +256,7 @@ M: #dispatch optimize-node*
     tuck dispatching-class dup [
         swap [ 2array ] 2keep
         method method-word
-        dup word-def flat-length 6 >=
+        dup word-def flat-length 5 >=
         [ 1quotation ] [ word-def ] if
     ] [
         2drop t t
@@ -363,7 +363,7 @@ M: #dispatch optimize-node*
 
 : optimistic-inline? ( #call -- ? )
     dup node-param "specializer" word-prop dup [
-        >r node-input-classes r> length tail*
+        >r node-input-classes r> specialized-length tail*
         [ types length 1 = ] all?
     ] [
         2drop f

core/optimizer/known-words/known-words.factor

@@ -124,19 +124,19 @@ float-arrays combinators.private combinators ;
 ] each
 
 \ push-all
-{ { string array } { sbuf vector } }
+{ { string sbuf } { array vector } }
 "specializer" set-word-prop
 
 \ append
-{ { string array } { string array } }
+{ { string string } { array array } }
 "specializer" set-word-prop
 
 \ subseq
-{ fixnum fixnum { string array } }
+{ { fixnum fixnum string } { fixnum fixnum array } }
 "specializer" set-word-prop
 
 \ reverse-here
-{ { string array } }
+{ { string } { array } }
 "specializer" set-word-prop
 
 \ mismatch
@@ -147,9 +147,9 @@ float-arrays combinators.private combinators ;
 
 \ >string { sbuf } "specializer" set-word-prop
 
-\ >array { { string vector } } "specializer" set-word-prop
+\ >array { { string } { vector } } "specializer" set-word-prop
 
-\ >vector { { array vector } } "specializer" set-word-prop
+\ >vector { { array } { vector } } "specializer" set-word-prop
 
 \ >sbuf { string } "specializer" set-word-prop
 
@@ -163,6 +163,6 @@ float-arrays combinators.private combinators ;
 
 \ assoc-stack { vector } "specializer" set-word-prop
 
-\ >le { { fixnum bignum } fixnum } "specializer" set-word-prop
+\ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
 
-\ >be { { fixnum bignum } fixnum } "specializer" set-word-prop
+\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop

core/optimizer/optimizer-docs.factor

@@ -2,31 +2,6 @@ USING: help.markup help.syntax quotations words math
 sequences ;
 IN: optimizer
 
-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 a sequence having the same number of elements as the word has inputs; each element takes one of the following forms and gives the compiler a hint about the corresponding parameter:"
-{ $table
-    { { $snippet { $emphasis "class" } } { "a class word indicates that this parameter is expected to be an instance of the class most of the time." } }
-    { { $snippet "{ " { $emphasis "classes..." } " }" } { "a sequence of class words indicates that this parameter is expected to be an instance of one of these classes most of the time." } }
-    { { $snippet "number" } { "the " { $link number } " class word has a special behavior. It will result in a version of the word being generated for every primitive numeric type, where this parameter is assumed to have that type. A fast jump table will then determine which version is chosen at run time." } }
-    { { $snippet "*" } { "indicates no specialization should be performed on this parameter." } }
-}
-"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 array } { string array } }"
-"\"specializer\" set-word-prop"
-}
-"The specialized version of a word which will be compiled by the compiler can be inspected:"
-{ $subsection specialized-def } ;
-
 ARTICLE: "optimizer" "Optimizer"
 "The words in the " { $vocab-link "optimizer" } " vocabulary are internal to the compiler and user code has no reason to call them."
 $nl
@@ -43,7 +18,3 @@ HELP: optimize-1
 HELP: optimize
 { $values { "node" "a dataflow graph" } { "newnode" "a dataflow graph" } }
 { $description "Continues to optimize a dataflow graph until a fixed point is reached." } ;
-
-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." } ;

core/optimizer/optimizer.factor

@@ -1,10 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables kernel kernel.private math
-namespaces sequences vectors words strings layouts combinators
-combinators.private classes optimizer.backend optimizer.def-use
-optimizer.known-words optimizer.math inference.class
-generic.standard ;
+USING: kernel namespaces optimizer.backend optimizer.def-use
+optimizer.known-words optimizer.math inference.class ;
 IN: optimizer
 
 : optimize-1 ( node -- newnode ? )
@@ -22,39 +19,3 @@ IN: optimizer
 
 : optimize ( node -- newnode )
     optimize-1 [ optimize ] when ;
-
-: simple-specializer ( quot dispatch# classes -- quot )
-    swap (dispatch#) [
-        object add* swap [ 2array ] curry map
-        object method-alist>quot
-    ] with-variable ;
-
-: dispatch-specializer ( quot dispatch# symbol dispatcher -- quot )
-    rot (dispatch#) [
-        [
-            picker %
-            ,
-            get swap <array> ,
-            \ dispatch ,
-        ] [ ] make
-    ] with-variable ;
-
-: tag-specializer ( quot dispatch# -- quot )
-    num-tags \ tag dispatch-specializer ;
-
-: type-specializer ( quot dispatch# -- quot )
-    num-types \ type dispatch-specializer ;
-
-: make-specializer ( quot dispatch# spec -- quot )
-    {
-        { [ dup number eq? ] [ drop tag-specializer ] }
-        { [ dup object eq? ] [ drop type-specializer ] }
-        { [ dup \ * eq? ] [ 2drop ] }
-        { [ dup array? ] [ simple-specializer ] }
-        { [ t ] [ 1array simple-specializer ] }
-    } cond ;
-
-: specialized-def ( word -- quot )
-    dup word-def swap "specializer" word-prop [
-        [ length ] keep <reversed> [ make-specializer ] 2each
-    ] when* ;

core/optimizer/specializers/specializers-docs.factor

@@ -0,0 +1,26 @@
+IN: optimizer.specializers
+USING: help.markup help.syntax sequences words quotations ;
+
+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: 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." } ;

core/optimizer/specializers/specializers.factor

@@ -0,0 +1,41 @@
+! Copyright (C) 2006, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays generic hashtables kernel kernel.private math
+namespaces sequences vectors words strings layouts combinators
+combinators.private classes generic.standard assocs ;
+IN: optimizer.specializers
+
+: (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-subset
+    dup empty? [ drop [ t ] ] [
+        [ (make-specializer) ] { } assoc>map
+        unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
+    ] if ;
+
+: tag-specializer ( quot -- newquot )
+    [
+        [ dup tag ] %
+        num-tags get swap <array> ,
+        \ dispatch ,
+    ] [ ] make ;
+
+: specialized-def ( word -- quot )
+    dup word-def swap "specializer" word-prop [
+        dup { number } = [
+            drop tag-specializer
+        ] [
+            dup [ array? ] all? [ 1array ] unless [
+                [ make-specializer ] keep
+                [ declare ] curry pick append
+            ] { } map>assoc
+            alist>quot
+        ] if
+    ] when* ;
+
+: specialized-length ( specializer -- n )
+    dup [ array? ] all? [ first ] when length ;

extra/benchmark/recursive/recursive.factor

@@ -4,8 +4,6 @@ USING: math kernel hints prettyprint io ;
 : fib ( m -- n )
     dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
 
-! HINTS: fib { fixnum float } ;
-! 
 : ack ( m n -- x )
     over zero? [
         nip 1+
@@ -17,8 +15,6 @@ USING: math kernel hints prettyprint io ;
         ] if
     ] if ;
 
-! HINTS: ack fixnum fixnum ;
-
 : tak ( x y z -- t )
     pick pick swap < [
         [ rot 1- -rot tak ] 3keep
@@ -29,8 +25,6 @@ USING: math kernel hints prettyprint io ;
         2nip
     ] if ;
 
-! HINTS: tak { fixnum float } { fixnum float } { fixnum float } ;
-
 : recursive ( n -- )
     3 over ack . flush
     dup 27.0 + fib . flush

extra/math/vectors/vectors.factor

@@ -27,20 +27,20 @@ IN: math.vectors
 : set-axis ( u v axis -- w )
     dup length [ >r zero? pick pick ? r> swap nth ] 2map 2nip ;
 
-HINTS: vneg { float-array array } ;
-HINTS: norm-sq { float-array array } ;
-HINTS: norm { float-array array } ;
-HINTS: normalize { float-array array } ;
+HINTS: vneg { float-array } { array } ;
+HINTS: norm-sq { float-array } { array } ;
+HINTS: norm { float-array } { array } ;
+HINTS: normalize { float-array } { array } ;
 
-HINTS: n*v * { float-array array } ;
-HINTS: v*n { float-array array } * ;
-HINTS: n/v * { float-array array } ;
-HINTS: v/n { float-array array } * ;
+HINTS: n*v { object float-array } { object array } ;
+HINTS: v*n { float-array object } { array object } ;
+HINTS: n/v { object float-array } { array } ;
+HINTS: v/n { float-array object } { array object } ;
 
-HINTS: v+ { float-array array } { float-array array } ;
-HINTS: v- { float-array array } { float-array array } ;
-HINTS: v* { float-array array } { float-array array } ;
-HINTS: v/ { float-array array } { float-array array } ;
-HINTS: vmax { float-array array } { float-array array } ;
-HINTS: vmin { float-array array } { float-array array } ;
-HINTS: v. { float-array array } { float-array array } ;
+HINTS: v+ { float-array float-array } { array array } ;
+HINTS: v- { float-array float-array } { array array } ;
+HINTS: v* { float-array float-array } { array array } ;
+HINTS: v/ { float-array float-array } { array array } ;
+HINTS: vmax { float-array float-array } { array array } ;
+HINTS: vmin { float-array float-array } { array array } ;
+HINTS: v. { float-array float-array } { array array } ;