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 2a9d8d4911449dd6da3b95429c32df8d985e1099..2f2d348b725d3f9bb05f76efa7a044e2df4461e9 100644 (file)
--- a/basis/compiler/cfg/renaming/functor/functor.factor
+++ b/basis/compiler/cfg/renaming/functor/functor.factor
@@ -1,116 +1,88 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: functors assocs kernel accessors compiler.cfg.instructions
-lexer parser ;
+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
 
-FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT -- )
+! Like compiler.cfg.def-use, but for changing operands
+
+: slot-change-quot ( slots quot -- quot' )
+    '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
+    [ drop ] append ;
+
+FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
 
 rename-insn-defs DEFINES ${NAME}-insn-defs
 rename-insn-uses DEFINES ${NAME}-insn-uses
+rename-insn-temps DEFINES ${NAME}-insn-temps
 
 WHERE
 
 GENERIC: rename-insn-defs ( insn -- )
-
-M: ##flushable rename-insn-defs
-    DEF-QUOT change-dst
-    drop ;
-
-M: ##fixnum-overflow rename-insn-defs
-    DEF-QUOT change-dst
-    drop ;
-
-M: _fixnum-overflow rename-insn-defs
-    DEF-QUOT change-dst
-    drop ;
-
-M: insn rename-insn-defs drop ;
-
 GENERIC: rename-insn-uses ( insn -- )
+GENERIC: rename-insn-temps ( insn -- )
 
-M: ##effect rename-insn-uses
-    USE-QUOT change-src
-    drop ;
-
-M: ##unary rename-insn-uses
-    USE-QUOT change-src
-    drop ;
-
-M: ##binary rename-insn-uses
-    USE-QUOT change-src1
-    USE-QUOT change-src2
-    drop ;
-
-M: ##binary-imm rename-insn-uses
-    USE-QUOT change-src1
-    drop ;
-
-M: ##slot rename-insn-uses
-    USE-QUOT change-obj
-    USE-QUOT change-slot
-    drop ;
+M: insn rename-insn-defs drop ;
+M: insn rename-insn-uses drop ;
+M: insn rename-insn-temps drop ;
 
-M: ##slot-imm rename-insn-uses
-    USE-QUOT change-obj
-    drop ;
+! Instructions with unusual operands
 
-M: ##set-slot rename-insn-uses
-    dup call-next-method
-    USE-QUOT change-obj
-    USE-QUOT change-slot
-    drop ;
+! Special rename-insn-defs methods
+M: ##parallel-copy rename-insn-defs
+    [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
 
-M: ##string-nth rename-insn-uses
-    USE-QUOT change-obj
-    USE-QUOT change-index
-    drop ;
+M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
 
-M: ##set-string-nth-fast rename-insn-uses
-    dup call-next-method
-    USE-QUOT change-obj
-    USE-QUOT change-index
+M: alien-call-insn rename-insn-defs
+    [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
     drop ;
 
-M: ##set-slot-imm rename-insn-uses
-    dup call-next-method
-    USE-QUOT change-obj
+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 ;
 
-M: ##alien-getter rename-insn-uses
-    dup call-next-method
-    USE-QUOT change-src
-    drop ;
+! Special rename-insn-uses methods
+M: ##parallel-copy rename-insn-uses
+    [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
 
-M: ##alien-setter rename-insn-uses
-    dup call-next-method
-    USE-QUOT change-value
-    drop ;
+M: ##phi rename-insn-uses
+    [ USE-QUOT assoc-map ] change-inputs drop ;
 
-M: ##conditional-branch rename-insn-uses
-    USE-QUOT change-src1
-    USE-QUOT change-src2
+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: ##compare-imm-branch rename-insn-uses
-    USE-QUOT change-src1
-    drop ;
+M: ##alien-indirect rename-insn-uses
+    USE-QUOT change-src call-next-method ;
 
-M: ##dispatch rename-insn-uses
-    USE-QUOT change-src
+M: ##callback-outputs rename-insn-uses
+    [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
     drop ;
 
-M: ##fixnum-overflow rename-insn-uses
-    USE-QUOT change-src1
-    USE-QUOT change-src2
-    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-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
+    define
+] each
 
-M: ##phi rename-insn-uses
-    [ USE-QUOT assoc-map ] change-inputs
-    drop ;
+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: insn rename-insn-uses drop ;
+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
+] each
 
 ;FUNCTOR
 
-SYNTAX: RENAMING: scan scan-object scan-object define-renaming ;
\ No newline at end of file
+SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;