compiler.cfg.representations: add peephole optimizations for integer comparisons

basis/compiler/cfg/representations/peephole/peephole.factor

@@ -104,8 +104,14 @@ M: ##load-reference optimize-insn
         [ 2drop int-rep ##copy here ]
     } cond ;
 
+: inert-tag-imm? ( insn -- ? )
+    src1>> rep-of tagged-rep? ;
+
 : inert-tag/untag-imm? ( insn -- ? )
-    [ dst>> ] [ src1>> ] bi [ rep-of tagged-rep? ] both? ;
+    {
+        [ dst>> rep-of tagged-rep? ]
+        [ inert-tag-imm? ]
+    } 1&& ;
 
 M: ##shl-imm optimize-insn
     {
@@ -169,13 +175,15 @@ M: ##sar-imm optimize-insn
 !
 ! so if all inputs and outputs of ##X or ##X-imm are tagged,
 ! don't have to insert any conversions
-: inert-tag/untag? ( insn -- ? )
+: inert-tag? ( insn -- ? )
     {
-        [ dst>> rep-of tagged-rep? ]
         [ src1>> rep-of tagged-rep? ]
         [ src2>> rep-of tagged-rep? ]
     } 1&& ;
 
+: inert-tag/untag? ( insn -- ? )
+    { [ dst>> rep-of tagged-rep? ] [ inert-tag? ] } 1&& ;
+
 M: inert-tag-untag-insn optimize-insn
     {
         { [ dup inert-tag/untag? ] [ unchanged ] }
@@ -183,16 +191,44 @@ M: inert-tag-untag-insn optimize-insn
     } cond ;
 
 ! -imm variant of above
+: >tagged-imm ( insn -- )
+    [ tag-fixnum ] change-src2 unchanged ; inline
+
 M: inert-tag-untag-imm-insn optimize-insn
     {
-        { [ dup inert-tag/untag-imm? ] [ [ tag-fixnum ] change-src2 unchanged ] }
+        { [ dup inert-tag/untag-imm? ] [ >tagged-imm ] }
         [ call-next-method ]
     } cond ;
 
 M: ##mul-imm optimize-insn
     {
         { [ dup inert-tag/untag-imm? ] [ unchanged ] }
-        { [ dup dst>> rep-of tagged-rep? ] [ [ tag-fixnum ] change-src2 unchanged ] }
+        { [ dup dst>> rep-of tagged-rep? ] [ >tagged-imm ] }
+        [ call-next-method ]
+    } cond ;
+
+! Similar optimization for comparison operators
+M: ##compare-integer-imm optimize-insn
+    {
+        { [ dup inert-tag-imm? ] [ >tagged-imm ] }
+        [ call-next-method ]
+    } cond ;
+
+M: ##compare-integer-imm-branch optimize-insn
+    {
+        { [ dup inert-tag-imm? ] [ >tagged-imm ] }
+        [ call-next-method ]
+    } cond ;
+
+M: ##compare-integer optimize-insn
+    {
+        { [ dup inert-tag? ] [ unchanged ] }
+        [ call-next-method ]
+    } cond ;
+
+M: ##compare-integer-branch optimize-insn
+    {
+        { [ dup inert-tag? ] [ unchanged ] }
         [ call-next-method ]
     } cond ;
 

basis/compiler/cfg/representations/representations-tests.factor

@@ -605,6 +605,51 @@ cpu x86.32? [
     } test-peephole
 ] unit-test
 
+! Tag/untag elimination for ##compare-integer
+[
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer f 2 0 1 cc= }
+        T{ ##replace f 2 D 0 }
+    }
+] [
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer f 2 0 1 cc= }
+        T{ ##replace f 2 D 0 }
+    } test-peephole
+] unit-test
+
+[
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer-branch f 0 1 cc= }
+    }
+] [
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer-branch f 0 1 cc= }
+    } test-peephole
+] unit-test
+
+[
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer-imm-branch f 0 $[ 10 tag-fixnum ] cc= }
+    }
+] [
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##compare-integer-imm-branch f 0 10 cc= }
+    } test-peephole
+] unit-test
+
 ! Tag/untag elimination for ##neg
 [
     V{

basis/compiler/cfg/representations/selection/selection.factor

@@ -113,17 +113,21 @@ UNION: inert-tag-untag-imm-insn
 
 GENERIC: has-peephole-opts? ( insn -- ? )
 
-M: insn                     has-peephole-opts? drop f ;
+M: insn has-peephole-opts? drop f ;
-M: ##load-integer           has-peephole-opts? drop t ;
+M: ##load-integer has-peephole-opts? drop t ;
-M: ##load-reference         has-peephole-opts? drop t ;
+M: ##load-reference has-peephole-opts? drop t ;
-M: inert-tag-untag-insn     has-peephole-opts? drop t ;
+M: ##neg has-peephole-opts? drop t ;
+M: ##not has-peephole-opts? drop t ;
+M: inert-tag-untag-insn has-peephole-opts? drop t ;
 M: inert-tag-untag-imm-insn has-peephole-opts? drop t ;
-M: ##mul-imm                has-peephole-opts? drop t ;
+M: ##mul-imm has-peephole-opts? drop t ;
-M: ##shl-imm                has-peephole-opts? drop t ;
+M: ##shl-imm has-peephole-opts? drop t ;
-M: ##shr-imm                has-peephole-opts? drop t ;
+M: ##shr-imm has-peephole-opts? drop t ;
-M: ##sar-imm                has-peephole-opts? drop t ;
+M: ##sar-imm has-peephole-opts? drop t ;
-M: ##neg                    has-peephole-opts? drop t ;
+M: ##compare-integer-imm has-peephole-opts? drop t ;
-M: ##not                    has-peephole-opts? drop t ;
+M: ##compare-integer has-peephole-opts? drop t ;
+M: ##compare-integer-imm-branch has-peephole-opts? drop t ;
+M: ##compare-integer-branch has-peephole-opts? drop t ;
 
 GENERIC: compute-insn-costs ( insn -- )