Minor performance improvements in optimizer

library/bootstrap/boot-stage2.factor

@@ -4,7 +4,7 @@ USING: compiler generic help io io-internals kernel
 kernel-internals lists math memory namespaces optimizer parser
 sequences sequences-internals words ;
 
-"Cross-referencing..." print
+"Cross-referencing..." print flush
 H{ } clone crossref set-global xref-words
 H{ } clone help-graph set-global xref-articles
 
@@ -13,8 +13,8 @@ H{ } clone help-graph set-global xref-articles
         unix? [
             "/library/unix/load.factor" run-resource
         ] when
-
     ] when
+
     windows? [
         "/library/windows/load.factor" run-resource
     ] when

library/compiler/compiler.factor

@@ -5,9 +5,7 @@ USING: errors hashtables inference io kernel lists math
 namespaces optimizer prettyprint sequences test words ;
 
 : (compile) ( word -- )
-    [
+    dup specialized-def dataflow optimize generate ;
-        [ dup specialized-def dataflow optimize generate ] keep
-    ] benchmark nip "compile-time" set-word-prop ;
 
 : inform-compile ( word -- ) "Compiling " write . flush ;
 

library/compiler/optimizer/call-optimizers.factor

@@ -36,17 +36,17 @@ math math-internals sequences words ;
     [ with-datastack ] catch
     [ 3drop t ] [ inline-literals ] if ;
 
-: flip-subst ( not -- )
+: call>no-op ( not -- )
     #! Note: cloning the vectors, since subst-values will modify
     #! them.
     [ node-in-d clone ] keep
     [ node-out-d clone ] keep
-    subst-values ;
+    [ subst-values ] keep node-successor ;
 
 : flip-branches ( not -- #if )
     #! If a not is followed by an #if, flip branches and
     #! remove the not.
-    dup flip-subst node-successor dup
+    call>no-op dup
     dup node-children reverse swap set-node-children ;
 
 \ not {
@@ -66,9 +66,6 @@ math math-internals sequences words ;
     dup 0 node-class#
     swap node-param "infer-effect" word-prop second first eq? ;
 
-: call>no-op ( node -- node )
-    [ ] dataflow [ subst-node ] keep ;
-
 { >fixnum >bignum >float } [
     {
         { [ dup useless-coerce? ] [ call>no-op ] }

library/compiler/optimizer/class-infer.factor

@@ -1,5 +1,5 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer
 USING: arrays generic hashtables inference kernel
 kernel-internals math namespaces sequences words ;
@@ -166,10 +166,20 @@ DEFER: (infer-classes)
         node-successor (infer-classes)
     ] when* ;
 
-: infer-classes ( node -- )
+: ?<hashtable> [ H{ } clone ] unless* ;
+
+: infer-classes-with ( node classes literals -- )
     [
-        H{ } clone value-classes set
+        ?<hashtable> value-literals set
-        H{ } clone value-literals set
+        ?<hashtable> value-classes set
         H{ } clone ties set
         (infer-classes)
     ] with-scope ;
+
+: infer-classes ( node -- )
+    f f infer-classes-with ;
+
+: infer-classes/node ( existing node -- )
+    #! Infer classes, using the existing node's class info as a
+    #! starting point.
+    over node-classes rot node-literals infer-classes-with ;

library/compiler/optimizer/inline-methods.factor

@@ -2,31 +2,49 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer
 USING: arrays generic hashtables inference kernel
-kernel-internals lists math namespaces sequences words ;
+kernel-internals lists math namespaces prettyprint sequences
+words ;
 
 ! Some utilities for splicing in dataflow IR subtrees
 : post-inline ( #return/#values #call/#merge -- )
-    dup [
     [
-            >r node-in-d r> node-out-d
+        >r node-in-d r> node-out-d 2array unify-lengths first2
-            2array unify-lengths first2
+    ] keep subst-values ;
-        ] keep subst-values
+
+: ?hash-union ( hash/f hash -- hash )
+    over [ hash-union ] [ nip ] if ;
+
+: add-node-literals ( hash node -- )
+    [ node-literals ?hash-union ] keep set-node-literals ;
+
+: add-node-classes ( hash node -- )
+    [ node-classes ?hash-union ] keep set-node-classes ;
+
+: (subst-classes) ( literals classes node -- )
+    dup [
+        3dup [ add-node-classes ] keep add-node-literals
+        node-successor (subst-classes)
     ] [
-        2drop
+        3drop
     ] if ;
 
+: subst-classes ( #return/#values #call/#merge -- )
+    >r dup node-literals swap node-classes r> (subst-classes) ;
+
 : subst-node ( old new -- )
     #! The last node of 'new' becomes 'old', then values are
     #! substituted. A subsequent optimizer phase kills the
     #! last node of 'new' and the first node of 'old'.
-    last-node 2dup swap post-inline set-node-successor ;
+    last-node 2dup swap 2dup post-inline subst-classes
+    set-node-successor ;
 
 : (inline-method) ( #call quot -- node )
     dup t eq? [
         2drop t
     ] [
         over node-in-d dataflow-with
-        [ >r node-param r> remember-node ] 2keep
+        2dup infer-classes/node
+        over node-param over remember-node
         [ subst-node ] keep
     ] if ;
 

library/compiler/optimizer/optimizer.factor

@@ -9,7 +9,7 @@ SYMBOL: optimizer-changed
 GENERIC: optimize-node* ( node -- node/t )
 
 : keep-optimizing ( node -- node ? )
-    dup optimize-node* dup t =
+    dup optimize-node* dup t eq?
     [ drop f ] [ nip keep-optimizing t or ] if ;
 
 : optimize-node ( node -- node )