Optimizer fixes

TODO.FACTOR.txt

@@ -85,6 +85,7 @@
 
 + compiler/ffi:
 
+- we need to optimize  [ dup array? [ array? ] [ array? ] if ]
 - mac intel: struct returns from objc methods
 - fix compiled gc check
   - there was a performance hit, investigate

library/bootstrap/boot-stage2.factor

@@ -57,11 +57,14 @@ parser sequences sequences-internals words ;
         "x11" get [
             "/library/ui/x11/load.factor" run-resource
         ] when
-    ] when
+        
+        ! We only do this if we are compiled, otherwise it takes
+        ! too long.
 
-    "Building online help search index..." print flush
+        "Building online help search index..." print flush
-    H{ } clone parent-graph set-global xref-help
+        H{ } clone parent-graph set-global xref-help
-    H{ } clone term-index set-global index-help
+        H{ } clone term-index set-global index-help
+    ] when
 
     [
         boot
@@ -86,6 +89,6 @@ parser sequences sequences-internals words ;
     "Now, you can run ./f factor.image" print flush
 
     "factor.image" resource-path save-image
-] [ print-error listener ] recover
+] [ print-error :c ] recover
 
 0 exit

library/bootstrap/primitives.factor

@@ -372,7 +372,7 @@ num-types f <array> builtins set
         f
     } {
         2
-        fixnum
+        object
         { "string-hashcode" "kernel-internals" }
         { "set-string-hashcode" "kernel-internals" }
     }

library/compiler/inference/dataflow.factor

@@ -268,3 +268,18 @@ DEFER: (map-nodes)
     #! Mutates nodes.
     node-stack get 1 head-slice* swap add
     [ >r 2dup r> node-successor (subst-values) ] each 2drop ;
+
+: node-literal? ( node value -- ? )
+    dup value?
+    [ 2drop t ] [ swap node-literals ?hash* nip ] if ;
+
+: node-literal ( node value -- obj )
+    dup value?
+    [ nip value-literal ] [ swap node-literals ?hash ] if ;
+
+: node-class ( node value -- class )
+    dup value? [
+        nip value-literal class
+    ] [
+        swap node-classes ?hash [ object ] unless*
+    ] if ;

library/compiler/optimizer/call-optimizers.factor

@@ -23,7 +23,7 @@ math math-internals sequences words ;
     ] if ;
 
 : literal-in-d ( #call -- inputs )
-    dup node-in-d [ node-value-literal ] map-with ;
+    dup node-in-d [ node-literal ] map-with ;
 
 : partial-eval ( #call -- node )
     dup literal-in-d over node-param

library/compiler/optimizer/class-infer.factor

@@ -155,8 +155,7 @@ DEFER: (infer-classes)
     ] 2each ;
 
 : merge-value-class ( # nodes -- class )
-    [ tuck node-in-d ?nth node-class ] map-with
+    [ swap node-class# ] map-with null [ class-or ] reduce ;
-    null [ class-or ] reduce ;
 
 : annotate-merge ( nodes values -- )
     dup length
@@ -165,7 +164,7 @@ DEFER: (infer-classes)
 
 : merge-children ( node -- )
     dup node-successor dup #merge? [
-        node-out-d
+        node-out-d <reversed>
         >r node-children [ last-node ] map r>
         annotate-merge
     ] [

library/compiler/optimizer/inline-methods.factor

@@ -19,7 +19,8 @@ words ;
 : dispatch# ( #call -- n )
     node-param "combination" word-prop first ;
 
-: dispatching-class ( node -- seq ) dup dispatch# node-class# ;
+: dispatching-class ( node -- class )
+    dup dispatch# node-class# ;
 
 : already-inlined? ( node -- ? )
     #! Was this node inlined from definition of 'word'?

library/compiler/optimizer/optimizer.factor

@@ -79,21 +79,6 @@ M: #return optimize-node* ( node -- node/t )
     set-node-successor ;
 
 ! Constant branch folding
-: node-literal? ( node value -- ? )
-    dup value?
-    [ 2drop t ] [ swap node-literals ?hash* nip ] if ;
-
-: node-literal ( node value -- obj )
-    dup value?
-    [ nip value-literal ] [ swap node-literals ?hash ] if ;
-
-: node-class ( node value -- class )
-    dup value? [
-        nip value-literal class
-    ] [
-        swap node-classes ?hash [ object ] unless*
-    ] if ;
-
 : fold-branch ( node branch# -- node )
     over drop-inputs >r
     >r dup node-successor r> rot node-children nth

library/generic/classes.factor

@@ -92,7 +92,7 @@ SYMBOL: class<cache
 : types* ( class -- hash ) types [ type>class dup ] map>hash ;
 
 : (class-or) ( class class -- class )
-    [ flatten-class ] 2apply hash-union lookup-union ;
+    [ types* ] 2apply hash-union lookup-union ;
 
 : class-or ( class class -- class )
     {
@@ -102,7 +102,7 @@ SYMBOL: class<cache
     } cond ;
 
 : (class-and) ( class class -- class )
-    [ flatten-class ] 2apply hash-intersect lookup-union ;
+    [ types* ] 2apply hash-intersect lookup-union ;
 
 : class-and ( class class -- class )
     {

library/generic/classes.facts

@@ -91,6 +91,10 @@ HELP: lookup-union "( classes -- class )"
 { $values { "classes" "a hashtable where keys are classes and values equal keys" } { "class" "a class word" } }
 { $description "Outputs a class that is the union of the given classes. If no precise match is found, outputs " { $link object } ", even if the given set is not an exhaustive cover all classes." } ;
 
+HELP: types* "( class -- classes )"
+{ $values { "class" "a class word" } { "classes" "a hashtable where keys are classes and values equal keys" } }
+{ $description "Outputs a sequence of builtin classes whose instances can possibly be instances of the given class." } ;
+
 HELP: class-or "( class1 class2 -- class )"
 { $values { "class1" "a class word" } { "class2" "a class word" } { "class" "a class word" } }
 { $description "Outputs a class whose instances are instances of either one of the two input classes. If the union is non-empty but no class with those members is defined, outputs " { $link object } "." } ;

library/generic/math-combination.factor

@@ -7,7 +7,15 @@ math namespaces sequences words ;
 ! Math combination for generic dyadic upgrading arithmetic.
 
 : math-class? ( object -- ? )
-    dup word? [ number bootstrap-word class< ] [ drop f ] if ;
+    dup word? [
+        dup null bootstrap-word eq? [
+            drop f
+        ] [
+            number bootstrap-word class<
+        ] if
+    ] [
+        drop f
+    ] if ;
 
 : math-class-compare ( class class -- n )
     [