trans/tree.sml

   1 (* L3 Compiler
   2  * IR Trees
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  * Modified: Alex Vaynberg <alv@andrew.cmu.edu>
   5  * Modified: Frank Pfenning <fp@cs.cmu.edu>
   6  * Modified: Joshua Wise <jwise>
   7  * Modified: Chris Lu <czl>
   8  *)
   9
  10 signature TREE =
  11 sig
  12
  13   datatype binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
  14   datatype unop = NEG | BITNOT | BANG
  15
  16   type Blarg = int
  17
  18   datatype exp =
  19       CONST of Word32.word
  20     | TEMP of Temp.temp
  21     | ARG of Blarg * int (* I am j4cbo *)
  22     | BINOP of binop * exp * exp
  23     | UNOP of unop * exp
  24     | CALL of Ast.ident * (exp * int) list * int
  25     | MEMORY of exp
  26     | ALLOC of exp
  27   and stm =
  28       MOVE of exp * exp * int
  29     | RETURN of exp * int
  30     | EFFECT of exp * int
  31     | LABEL of Label.label
  32     | JUMPIFN of exp * Label.label
  33     | JUMP of Label.label
  34   and func =
  35       FUNCTION of Ast.ident * stm list
  36
  37   type program = func list
  38
  39   structure Print :
  40   sig
  41     val pp_exp : exp -> string
  42     val pp_stm : stm -> string
  43     val pp_program : program -> string
  44   end
  45 end
  46
  47 structure Tree :> TREE =
  48 struct
  49
  50   datatype binop = ADD | SUB | MUL | DIV | MOD | LSH | RSH | LOGOR | LOGAND | BITOR | BITAND | BITXOR | NEQ | EQ | LT | GT | LE | GE
  51   datatype unop = NEG | BITNOT | BANG
  52
  53   type Blarg = int
  54
  55   datatype exp =
  56       CONST of Word32.word
  57     | TEMP of Temp.temp
  58     | ARG of Blarg * int
  59     | BINOP of binop * exp * exp
  60     | UNOP of unop * exp
  61     | CALL of Ast.ident * (exp * int) list * int
  62     | MEMORY of exp
  63     | ALLOC of exp
  64   and stm =
  65       MOVE of exp * exp * int
  66     | RETURN of exp * int
  67     | EFFECT of exp * int
  68     | LABEL of Label.label
  69     | JUMPIFN of exp * Label.label
  70     | JUMP of Label.label
  71   and func =
  72       FUNCTION of Ast.ident * stm list
  73
  74   type program = func list
  75
  76   structure Print =
  77   struct
  78
  79     exception Aaaasssssss
  80
  81     fun pp_binop ADD = "+"
  82       | pp_binop SUB = "-"
  83       | pp_binop MUL = "*"
  84       | pp_binop DIV = "/"
  85       | pp_binop MOD = "%"
  86       | pp_binop LSH = "<<"
  87       | pp_binop RSH = ">>"
  88       | pp_binop LOGOR = "||"
  89       | pp_binop LOGAND = "&&"
  90       | pp_binop BITOR = "|"
  91       | pp_binop BITAND = "&"
  92       | pp_binop BITXOR = "^"
  93       | pp_binop NEQ = "!="
  94       | pp_binop EQ = "=="
  95       | pp_binop LE = "<="
  96       | pp_binop LT = "<"
  97       | pp_binop GE = ">="
  98       | pp_binop GT = ">"
  99
 100     fun pp_unop NEG = "-"
 101       | pp_unop BITNOT = "~"
 102       | pp_unop BANG = "!"
 103
 104     fun pp_exp (CONST(x)) = Word32Signed.toString x
 105       | pp_exp (TEMP(t)) = Temp.name t
 106       | pp_exp (ARG(n, sz)) = "arg#"^Int.toString n
 107       | pp_exp (BINOP (binop, e1, e2)) =
 108           "(" ^ pp_exp e1 ^ " " ^ pp_binop binop ^ " " ^ pp_exp e2 ^ ")"
 109       | pp_exp (UNOP (unop, e1)) =
 110           pp_unop unop ^ "(" ^ pp_exp e1 ^ ")"
 111       | pp_exp (CALL (f, l, sz)) =
 112           Symbol.name f ^ "(" ^ (String.concatWith ", " (List.map (fn (e, _) => pp_exp e) l)) ^ ")"
 113       | pp_exp (MEMORY exp) = "M[" ^ pp_exp exp ^ "]"
 114       | pp_exp (ALLOC(e)) = "NEW(" ^ pp_exp e ^ ")"
 115
 116     fun pp_stm (MOVE (e1,e2, sz)) =
 117           pp_exp e1 ^ "  <--  " ^ pp_exp e2
 118       | pp_stm (RETURN (e, sz)) =
 119           "return " ^ pp_exp e
 120       | pp_stm (EFFECT (e, sz)) = pp_exp e
 121       | pp_stm (LABEL l) =
 122           Label.name l ^ ":"
 123       | pp_stm (JUMP l) =
 124           "jump "^Label.name l
 125       | pp_stm (JUMPIFN (e, l)) =
 126           "jump "^Label.name l^" if! "^pp_exp e
 127
 128     fun pp_program (nil) = ""
 129       | pp_program (FUNCTION(id, stms)::funcs) =
 130           (Symbol.name id) ^
 131           "\n{\n" ^
 132           (foldr (fn (a,b) => (pp_stm a) ^ "\n" ^ b) "" stms) ^
 133           "}\n" ^
 134           pp_program funcs
 135   end
 136 end