1 ! Copyright (C) 2009, 2011 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs fry functors generic.parser
4 kernel lexer namespaces parser sequences slots words sets
5 compiler.cfg.def-use compiler.cfg.instructions
6 compiler.cfg.instructions.syntax ;
7 IN: compiler.cfg.renaming.functor
9 ! Like compiler.cfg.def-use, but for changing operands
11 : slot-change-quot ( slots quot -- quot' )
12 '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
15 FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
17 rename-insn-defs DEFINES ${NAME}-insn-defs
18 rename-insn-uses DEFINES ${NAME}-insn-uses
19 rename-insn-temps DEFINES ${NAME}-insn-temps
23 GENERIC: rename-insn-defs ( insn -- )
24 GENERIC: rename-insn-uses ( insn -- )
25 GENERIC: rename-insn-temps ( insn -- )
27 M: insn rename-insn-defs drop ;
28 M: insn rename-insn-uses drop ;
29 M: insn rename-insn-temps drop ;
31 ! Instructions with unusual operands
33 ! Special rename-insn-defs methods
34 M: ##parallel-copy rename-insn-defs
35 [ [ first2 [ DEF-QUOT ] dip 2array ] map ] change-values ;
37 M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
39 M: alien-call-insn rename-insn-defs
40 [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
43 M: ##callback-inputs rename-insn-defs
44 [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
45 [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
48 ! Special rename-insn-uses methods
49 M: ##parallel-copy rename-insn-uses
50 [ [ first2 USE-QUOT 2array ] map ] change-values ;
52 M: ##phi rename-insn-uses
53 [ USE-QUOT assoc-map ] change-inputs drop ;
55 M: alien-call-insn rename-insn-uses
56 [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
57 [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
60 M: ##alien-indirect rename-insn-uses
61 USE-QUOT change-src call-next-method ;
63 M: ##callback-outputs rename-insn-uses
64 [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
67 ! Generate methods for everything else
68 insn-classes get special-vreg-insns diff [ insn-def-slots empty? not ] filter [
69 [ \ rename-insn-defs create-method-in ]
70 [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
74 insn-classes get special-vreg-insns diff [ insn-use-slots empty? not ] filter [
75 [ \ rename-insn-uses create-method-in ]
76 [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
80 insn-classes get [ insn-temp-slots empty? not ] filter [
81 [ \ rename-insn-temps create-method-in ]
82 [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
88 SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;