basis/compiler/cfg/renaming/functor/functor.factor

   1 ! Copyright (C) 2009, 2010 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
   8
   9 : slot-change-quot ( slots quot -- quot' )
  10     '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
  11     [ drop ] append ;
  12
  13 FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
  14
  15 rename-insn-defs DEFINES ${NAME}-insn-defs
  16 rename-insn-uses DEFINES ${NAME}-insn-uses
  17 rename-insn-temps DEFINES ${NAME}-insn-temps
  18
  19 WHERE
  20
  21 GENERIC: rename-insn-defs ( insn -- )
  22
  23 M: insn rename-insn-defs drop ;
  24
  25 insn-classes get special-vreg-insns diff [ insn-def-slots empty? not ] filter [
  26     [ \ rename-insn-defs create-method-in ]
  27     [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
  28     define
  29 ] each
  30
  31 M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
  32
  33 M: alien-call-insn rename-insn-defs
  34     [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs drop ;
  35
  36 M: ##callback-inputs rename-insn-defs
  37     [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
  38     [ [ first3 DEF-QUOT 2dip 3array ] map ] change-stack-outputs
  39     drop ;
  40
  41 GENERIC: rename-insn-uses ( insn -- )
  42
  43 M: insn rename-insn-uses drop ;
  44
  45 insn-classes get special-vreg-insns diff [ insn-use-slots empty? not ] filter [
  46     [ \ rename-insn-uses create-method-in ]
  47     [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
  48     define
  49 ] each
  50
  51 M: alien-call-insn rename-insn-uses
  52     [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
  53     [ [ first3 USE-QUOT 2dip 3array ] map ] change-stack-inputs
  54     drop ;
  55
  56 M: ##alien-indirect rename-insn-uses
  57     USE-QUOT change-src call-next-method ;
  58
  59 M: ##callback-outputs rename-insn-uses
  60     [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs drop ;
  61
  62 M: ##phi rename-insn-uses
  63     [ USE-QUOT assoc-map ] change-inputs drop ;
  64
  65 GENERIC: rename-insn-temps ( insn -- )
  66
  67 M: insn rename-insn-temps drop ;
  68
  69 insn-classes get [ insn-temp-slots empty? not ] filter [
  70     [ \ rename-insn-temps create-method-in ]
  71     [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
  72     define
  73 ] each
  74
  75 ;FUNCTOR
  76
  77 SYNTAX: RENAMING: scan scan-object scan-object scan-object define-renaming ;