use reject instead of [ ... not ] filter.

[factor.git] / basis / compiler / cfg / renaming / functor / functor.factor

diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor
index 2af68e9175214ca03218cc6ea599a917f2c30b5d..2f2d348b725d3f9bb05f76efa7a044e2df4461e9 100644 (file)
--- a/basis/compiler/cfg/renaming/functor/functor.factor
+++ b/basis/compiler/cfg/renaming/functor/functor.factor
@@ -1,11 +1,13 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs fry functors generic.parser
-kernel lexer namespaces parser sequences slots words sets
-compiler.cfg.def-use compiler.cfg.instructions
-compiler.cfg.instructions.syntax ;
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.instructions.syntax fry
+functors generic.parser kernel lexer namespaces parser sequences
+sets slots words ;
 IN: compiler.cfg.renaming.functor
 
+! Like compiler.cfg.def-use, but for changing operands
+
 : slot-change-quot ( slots quot -- quot' )
     '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
     [ drop ] append ;
@@ -19,27 +21,63 @@ rename-insn-temps DEFINES ${NAME}-insn-temps
 WHERE
 
 GENERIC: rename-insn-defs ( insn -- )
+GENERIC: rename-insn-uses ( insn -- )
+GENERIC: rename-insn-temps ( insn -- )
+
+M: insn rename-insn-defs drop ;
+M: insn rename-insn-uses drop ;
+M: insn rename-insn-temps drop ;
+
+! Instructions with unusual operands
+
+! Special rename-insn-defs methods
+M: ##parallel-copy rename-insn-defs
+    [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
 
-insn-classes get [
+M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
+
+M: alien-call-insn rename-insn-defs
+    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+    drop ;
+
+M: ##callback-inputs rename-insn-defs
+    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
+    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
+    drop ;
+
+! Special rename-insn-uses methods
+M: ##parallel-copy rename-insn-uses
+    [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
+
+M: ##phi rename-insn-uses
+    [ USE-QUOT assoc-map ] change-inputs drop ;
+
+M: alien-call-insn rename-insn-uses
+    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+    [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
+    drop ;
+
+M: ##alien-indirect rename-insn-uses
+    USE-QUOT change-src call-next-method ;
+
+M: ##callback-outputs rename-insn-uses
+    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
+    drop ;
+
+! Generate methods for everything else
+insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
     [ \ rename-insn-defs create-method-in ]
-    [ insn-def-slot dup [ name>> 1array ] when DEF-QUOT slot-change-quot ] bi
+    [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
     define
 ] each
 
-GENERIC: rename-insn-uses ( insn -- )
-
-insn-classes get { ##phi } diff [
+insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
     [ \ rename-insn-uses create-method-in ]
     [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
     define
 ] each
 
-M: ##phi rename-insn-uses
-    [ USE-QUOT assoc-map ] change-inputs drop ;
-
-GENERIC: rename-insn-temps ( insn -- )
-
-insn-classes get [
+insn-classes get [ insn-temp-slots empty? ] reject [
     [ \ rename-insn-temps create-method-in ]
     [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
     define
@@ -47,4 +85,4 @@ insn-classes get [
 
 ;FUNCTOR
 
-SYNTAX: RENAMING: scan scan-object scan-object scan-object define-renaming ;
\ No newline at end of file
+SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;