]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.cfg: don't generate useless methods in instruction meta-programming. reduces...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 3 Nov 2009 02:11:29 +0000 (20:11 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 3 Nov 2009 02:11:29 +0000 (20:11 -0600)
basis/compiler/cfg/def-use/def-use.factor
basis/compiler/cfg/intrinsics/intrinsics.factor
basis/compiler/cfg/renaming/functor/functor.factor
basis/compiler/cfg/representations/preferred/preferred.factor

index 825ff71b9be76aff6c7aa397a7e2bf62ff44f2ea..54cff2ccaa7aeb3bcac9c5321b223c3e57f601f8 100644 (file)
@@ -11,6 +11,10 @@ GENERIC: defs-vreg ( insn -- vreg/f )
 GENERIC: temp-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
+M: insn defs-vreg drop f ;
+M: insn temp-vregs drop { } ;
+M: insn uses-vregs drop { } ;
+
 M: ##phi uses-vregs inputs>> values ;
 
 <PRIVATE
@@ -24,19 +28,25 @@ M: ##phi uses-vregs inputs>> values ;
     } case ;
 
 : define-defs-vreg-method ( insn -- )
-    [ \ defs-vreg create-method ]
-    [ insn-def-slot [ name>> reader-word 1quotation ] [ [ drop f ] ] if* ] bi
-    define ;
+    dup insn-def-slot dup [
+        [ \ defs-vreg create-method ]
+        [ name>> reader-word 1quotation ] bi*
+        define
+    ] [ 2drop ] if ;
 
 : define-uses-vregs-method ( insn -- )
-    [ \ uses-vregs create-method ]
-    [ insn-use-slots [ name>> ] map slot-array-quot ] bi
-    define ;
+    dup insn-use-slots [ drop ] [
+        [ \ uses-vregs create-method ]
+        [ [ name>> ] map slot-array-quot ] bi*
+        define
+    ] if-empty ;
 
 : define-temp-vregs-method ( insn -- )
-    [ \ temp-vregs create-method ]
-    [ insn-temp-slots [ name>> ] map slot-array-quot ] bi
-    define ;
+    dup insn-temp-slots [ drop ] [
+        [ \ temp-vregs create-method ]
+        [ [ name>> ] map slot-array-quot ] bi*
+        define
+    ] if-empty ;
 
 PRIVATE>
 
index a03f04f182aed195b4dc95ec5c454614e7f4799f..e8933d38fc52422c6d813d0c708be7b0f2c7663f 100644 (file)
@@ -59,7 +59,7 @@ IN: compiler.cfg.intrinsics
     { byte-arrays:<byte-array> [ emit-<byte-array> ] }
     { byte-arrays:(byte-array) [ emit-(byte-array) ] }
     { kernel:<wrapper> [ emit-simple-allot ] }
-    { alien:<displaced-alien> [ emit-<displaced-alien> ] }
+    { alien:<displaced-alien> [ emit-<displaced-alien> ] }
     { alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
     { alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
     { alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
index 2af68e9175214ca03218cc6ea599a917f2c30b5d..261aab6c54ee996e67ad9dd8aa07b661370aff02 100644 (file)
@@ -20,15 +20,19 @@ WHERE
 
 GENERIC: rename-insn-defs ( insn -- )
 
-insn-classes get [
+M: insn rename-insn-defs drop ;
+
+insn-classes get [ insn-def-slot ] filter [
     [ \ rename-insn-defs create-method-in ]
-    [ insn-def-slot dup [ name>> 1array ] when DEF-QUOT slot-change-quot ] bi
+    [ insn-def-slot name>> 1array DEF-QUOT slot-change-quot ] bi
     define
 ] each
 
 GENERIC: rename-insn-uses ( insn -- )
 
-insn-classes get { ##phi } diff [
+M: insn rename-insn-uses drop ;
+
+insn-classes get { ##phi } diff [ insn-use-slots empty? not ] filter [
     [ \ rename-insn-uses create-method-in ]
     [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
     define
@@ -39,7 +43,9 @@ M: ##phi rename-insn-uses
 
 GENERIC: rename-insn-temps ( insn -- )
 
-insn-classes get [
+M: insn rename-insn-temps drop ;
+
+insn-classes get [ insn-temp-slots empty? not ] filter [
     [ \ rename-insn-temps create-method-in ]
     [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
     define
index 1e07e56b356df45e5e3cac5692a91b2fe91db1c1..726521cfe1922b4fbfda67de04f296f05f8b319e 100644 (file)
@@ -11,6 +11,10 @@ GENERIC: defs-vreg-rep ( insn -- rep/f )
 GENERIC: temp-vreg-reps ( insn -- reps )
 GENERIC: uses-vreg-reps ( insn -- reps )
 
+M: insn defs-vreg-rep drop f ;
+M: insn temp-vreg-reps drop { } ;
+M: insn uses-vreg-reps drop { } ;
+
 <PRIVATE
 
 : rep-getter-quot ( rep -- quot )
@@ -21,9 +25,11 @@ GENERIC: uses-vreg-reps ( insn -- reps )
     } case ;
 
 : define-defs-vreg-rep-method ( insn -- )
-    [ \ defs-vreg-rep create-method ]
-    [ insn-def-slot [ rep>> rep-getter-quot ] [ [ drop f ] ] if* ]
-    bi define ;
+    dup insn-def-slot dup [
+        [ \ defs-vreg-rep create-method ]
+        [ rep>> rep-getter-quot ]
+        bi* define
+    ] [ 2drop ] if ;
 
 : reps-getter-quot ( reps -- quot )
     dup [ rep>> { f scalar-rep } member-eq? not ] all? [
@@ -38,14 +44,18 @@ GENERIC: uses-vreg-reps ( insn -- reps )
     ] if ;
 
 : define-uses-vreg-reps-method ( insn -- )
-    [ \ uses-vreg-reps create-method ]
-    [ insn-use-slots reps-getter-quot ]
-    bi define ;
+    dup insn-use-slots [ drop ] [
+        [ \ uses-vreg-reps create-method ]
+        [ reps-getter-quot ]
+        bi* define
+    ] if-empty ;
 
 : define-temp-vreg-reps-method ( insn -- )
-    [ \ temp-vreg-reps create-method ]
-    [ insn-temp-slots reps-getter-quot ]
-    bi define ;
+    dup insn-temp-slots [ drop ] [
+        [ \ temp-vreg-reps create-method ]
+        [ reps-getter-quot ]
+        bi* define
+    ] if-empty ;
 
 PRIVATE>