Add a new optimization

TODO.FACTOR.txt

@@ -1,15 +1,7 @@
 + 0.85:
 
-- words:
-  - S+left: reload
-  - S+right: inspect
-
-- links:
-  - same deal
-
 - pane output in UI should use less memory
 - signal 4 on datastack underflow on mac intel??
-- faster I/O
 - buffer-ptr should be an alien
 - fix this:
   [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 ] .
@@ -19,7 +11,6 @@
 - more compact relocation info
 - problem if major gc happens during relocation
   - in fact relocation should not cons at all
-- we need to optimize  [ dup array? [ array? ] [ array? ] if ]
 - better way of dealing with compiler errors
 - track individual method usages
 - variable width word wrap
@@ -42,6 +33,11 @@
 
 + ui:
 
+- words:
+  - S+left: reload
+  - S+right: inspect
+- links:
+  - same deal
 - if i do 10000 [ . ] each and then clear, the listener window is slow
 - dataflow UI needs various improvements:
   full-height nodes should really be full height

library/compiler/optimizer/call-optimizers.factor

@@ -43,10 +43,12 @@ math math-internals sequences words parser ;
     call>no-op dup
     dup node-children reverse swap set-node-children ;
 
+! An if following a not flips the two branches
 \ not {
     { [ dup node-successor #if? ] [ flip-branches ] }
 } define-optimizers
 
+! eq? on objects of disjoint types is always f
 : disjoint-eq? ( node -- ? )
     dup node-classes swap node-in-d
     [ swap ?hash ] map-with
@@ -61,12 +63,24 @@ math math-internals sequences words parser ;
     swap node-param "infer-effect" word-prop effect-out first
     eq? ;
 
+! >fixnum on a fixnum, etc is a no-op
 { >fixnum >bignum >float } [
     {
         { [ dup useless-coerce? ] [ call>no-op ] }
     } define-optimizers
 ] each
 
+! type applied to an object of a known type can be folded
+: known-type? ( node -- ? )
+    0 node-class# types length 1 number= ;
+
+: fold-known-type ( node -- node )
+    dup 0 node-class# types first 1array inline-literals ;
+
+\ type [
+    { [ dup known-type? ] [ fold-known-type ] }
+] define-optimizers
+
 ! Arithmetic identities
 SYMBOL: @