Compiler speedups

basis/bootstrap/compiler/compiler.factor

@@ -94,6 +94,7 @@ nl
 {
     memq? split harvest sift cut cut-slice start index clone
     set-at reverse push-all class number>string string>number
+    like clone-like
 } compile-unoptimized
 
 "." write flush

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -26,10 +26,9 @@ SYMBOL: spill-temps
     2dup = [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
 
 : compute-mappings ( bb to -- mappings )
-    [
-        dup live-in keys
-        [ resolve-value-data-flow ] with with each
-    ] { } make ;
+    dup live-in dup assoc-empty? [ 3drop f ] [
+        [ keys [ resolve-value-data-flow ] with with each ] { } make
+    ] if ;
 
 : memory->register ( from to -- )
     swap [ first2 ] [ first n>> ] bi* _reload ;

basis/compiler/cfg/stacks/finalize/finalize.factor

@@ -30,8 +30,12 @@ ERROR: bad-peek dst loc ;
     [ dup n>> 0 < [ 2drop ] [ ##replace ] if ] each-insertion ;
 
 : visit-edge ( from to -- )
-    2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
-    [ 2drop ] [ <simple-block> insert-basic-block ] if-empty ;
+    ! If both blocks are subroutine calls, don't bother
+    ! computing anything.
+    2dup [ kill-block? ] both? [ 2drop ] [
+        2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
+        [ 2drop ] [ <simple-block> insert-basic-block ] if-empty
+    ] if ;
 
 : visit-block ( bb -- )
     [ predecessors>> ] keep '[ _ visit-edge ] each ;

basis/compiler/cfg/two-operand/two-operand.factor

@@ -93,8 +93,10 @@ M: ##not convert-two-operand*
 
 M: insn convert-two-operand* , ;
 
-: (convert-two-operand) ( cfg -- cfg' )
-    [ [ convert-two-operand* ] each ] V{ } make ;
+: (convert-two-operand) ( insns -- insns' )
+    dup first kill-vreg-insn? [
+        [ [ convert-two-operand* ] each ] V{ } make
+    ] unless ;
 
 : convert-two-operand ( cfg -- cfg' )
     two-operand? [ [ (convert-two-operand) ] local-optimization ] when ;

core/make/make.factor

@@ -8,7 +8,7 @@ SYMBOL: building
 : make ( quot exemplar -- seq )
     [
         [
-            1024 swap new-resizable [
+            100 swap new-resizable [
                 building set call
             ] keep
         ] keep like