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

   1 ! Copyright (C) 2009, 2011 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs compiler.cfg.def-use
   4 compiler.cfg.instructions compiler.cfg.instructions.syntax fry
   5 functors generic.parser kernel lexer namespaces parser sequences
   6 sets slots words ;
   7 IN: compiler.cfg.renaming.functor
   8
   9 ! Like compiler.cfg.def-use, but for changing operands
  10
  11 : slot-change-quot ( slots quot -- quot' )
  12     '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
  13     [ drop ] append ;
  14
  15 <FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
  16
  17 rename-insn-defs DEFINES ${NAME}-insn-defs
  18 rename-insn-uses DEFINES ${NAME}-insn-uses
  19 rename-insn-temps DEFINES ${NAME}-insn-temps
  20
  21 WHERE
  22
  23 GENERIC: rename-insn-defs ( insn -- )
  24 GENERIC: rename-insn-uses ( insn -- )
  25 GENERIC: rename-insn-temps ( insn -- )
  26
  27 M: insn rename-insn-defs drop ;
  28 M: insn rename-insn-uses drop ;
  29 M: insn rename-insn-temps drop ;
  30
  31 ! Instructions with unusual operands
  32
  33 ! Special rename-insn-defs methods
  34 M: ##parallel-copy rename-insn-defs
  35     [ [ first2 DEF-QUOT dip 2array ] map ] change-values drop ;
  36
  37 M: ##phi rename-insn-defs DEF-QUOT change-dst drop ;
  38
  39 M: alien-call-insn rename-insn-defs
  40     [ [ first3 DEF-QUOT 2dip 3array ] map ] change-reg-outputs
  41     drop ;
  42
  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
  46     drop ;
  47
  48 ! Special rename-insn-uses methods
  49 M: ##parallel-copy rename-insn-uses
  50     [ [ first2 USE-QUOT call 2array ] map ] change-values drop ;
  51
  52 M: ##phi rename-insn-uses
  53     [ USE-QUOT assoc-map ] change-inputs drop ;
  54
  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
  58     drop ;
  59
  60 M: ##alien-indirect rename-insn-uses
  61     USE-QUOT change-src call-next-method ;
  62
  63 M: ##callback-outputs rename-insn-uses
  64     [ [ first3 USE-QUOT 2dip 3array ] map ] change-reg-inputs
  65     drop ;
  66
  67 ! Generate methods for everything else
  68 insn-classes get special-vreg-insns diff [ insn-def-slots empty? ] reject [
  69     [ \ rename-insn-defs create-method-in ]
  70     [ insn-def-slots [ name>> ] map DEF-QUOT slot-change-quot ] bi
  71     define
  72 ] each
  73
  74 insn-classes get special-vreg-insns diff [ insn-use-slots empty? ] reject [
  75     [ \ rename-insn-uses create-method-in ]
  76     [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
  77     define
  78 ] each
  79
  80 insn-classes get [ insn-temp-slots empty? ] reject [
  81     [ \ rename-insn-temps create-method-in ]
  82     [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
  83     define
  84 ] each
  85
  86 ;FUNCTOR>
  87
  88 SYNTAX: RENAMING: scan-token scan-object scan-object scan-object define-renaming ;