trans/treeutils.sml

   1 signature TREEUTILS =
   2 sig
   3   val effect : Tree.exp -> bool
   4   val effect_stm : Tree.stm -> bool
   5
   6   structure Print :
   7   sig
   8     val pp_exp : Tree.exp -> string
   9     val pp_stm : Tree.stm -> string
  10     val pp_program : Tree.program -> string
  11   end
  12 end
  13
  14 structure TreeUtils :> TREEUTILS =
  15 struct
  16   structure T = Tree
  17
  18   (* effect : T.exp -> bool
  19    * true iff the given expression has an effect.
  20    *)
  21   fun effect (T.CONST _) = false
  22     | effect (T.TEMP _) = false
  23     | effect (T.ARG _) = false
  24     | effect (T.BINOP(T.DIV, _, _)) = true
  25     | effect (T.BINOP(T.MOD, _, _)) = true
  26     | effect (T.CALL _) = true
  27     | effect (T.BINOP(_, a, b)) = (effect a) orelse (effect b)
  28     | effect (T.UNOP (_, a)) = effect a
  29     | effect (T.MEMORY _) = true
  30     | effect (T.ALLOC _) = true
  31     | effect (T.STRING _) = false
  32     | effect (T.COND (a, b, c)) = (effect a) orelse (effect b) orelse (effect c)
  33     | effect (T.STMVAR (sl, e)) = true (* Has to be, to be safe <--- jwise is an assclown, he was too lazy to write a effect_stm *)
  34     | effect (T.NULLPTR) = false
  35
  36   fun effect_stm (T.MOVE (e1,e2)) = effect e1 orelse effect e2
  37     | effect_stm (T.RETURN (e1)) = effect e1
  38     | effect_stm (T.EFFECT e) = effect e
  39     | effect_stm (T.JUMPIFN (e,_)) = effect e
  40     | effect_stm _ = false
  41
  42   structure Print =
  43   struct
  44     exception Aaaasssssss
  45
  46     fun pp_binop T.ADD = "+"
  47       | pp_binop T.SUB = "-"
  48       | pp_binop T.MUL = "*"
  49       | pp_binop T.DIV = "/"
  50       | pp_binop T.MOD = "%"
  51       | pp_binop T.LSH = "<<"
  52       | pp_binop T.RSH = ">>"
  53       | pp_binop T.LOGOR = "||"
  54       | pp_binop T.LOGAND = "&&"
  55       | pp_binop T.BITOR = "|"
  56       | pp_binop T.BITAND = "&"
  57       | pp_binop T.BITXOR = "^"
  58       | pp_binop T.NEQ = "!="
  59       | pp_binop T.EQ = "=="
  60       | pp_binop T.LE = "<="
  61       | pp_binop T.LT = "<"
  62       | pp_binop T.GE = ">="
  63       | pp_binop T.GT = ">"
  64       | pp_binop T.BE = "[BE]"
  65
  66     fun pp_unop T.NEG = "-"
  67       | pp_unop T.BITNOT = "~"
  68       | pp_unop T.BANG = "!"
  69
  70     fun pp_exp (T.CONST(x)) = Word32Signed.toString x
  71       | pp_exp (T.TEMP(t)) = Temp.name t
  72       | pp_exp (T.ARG(n)) = "arg#"^Int.toString n
  73       | pp_exp (T.BINOP (binop, e1, e2)) =
  74           "(" ^ pp_exp e1 ^ " " ^ pp_binop binop ^ " " ^ pp_exp e2 ^ ")"
  75       | pp_exp (T.UNOP (unop, e1)) =
  76           pp_unop unop ^ "(" ^ pp_exp e1 ^ ")"
  77       | pp_exp (T.CALL (f, l)) =
  78           Symbol.name f ^ "(" ^ (String.concatWith ", " (List.map (fn e => pp_exp e) l)) ^ ")"
  79       | pp_exp (T.MEMORY (exp)) = "M[" ^ pp_exp exp ^ "]"
  80       | pp_exp (T.ALLOC(e)) = "NEW(" ^ pp_exp e ^ ")"
  81       | pp_exp (T.STRING(s)) = "STRING(" ^ (Stringref.name s) ^ ")"
  82       | pp_exp (T.COND(c,e1,e2)) = "(" ^ pp_exp c ^ ") ? (" ^ pp_exp e1 ^ ") : (" ^ pp_exp e2 ^ ")"
  83       | pp_exp (T.STMVAR(sl,v)) = "({" ^ (foldr (fn (st,s) => (pp_stm st) ^ "; " ^ s) "" sl) ^ (pp_exp v) ^ "})"
  84       | pp_exp (T.NULLPTR) = "NULL"
  85
  86     and pp_stm (T.MOVE (e1,e2)) =
  87           pp_exp e1 ^ "  <--  " ^ pp_exp e2
  88       | pp_stm (T.RETURN (e)) =
  89           "return " ^ pp_exp e
  90       | pp_stm (T.EFFECT e) = pp_exp e
  91       | pp_stm (T.LABEL l) =
  92           Label.name l ^ ":"
  93       | pp_stm (T.JUMP l) =
  94           "jump "^Label.name l
  95       | pp_stm (T.JUMPIFN (e, l)) =
  96           "jump "^Label.name l^" if! "^pp_exp e
  97
  98     fun pp_program (nil) = ""
  99       | pp_program (T.FUNCTION(id, stms)::funcs) =
 100           (Symbol.name id) ^
 101           "\n{\n" ^
 102           (foldr (fn (a,b) => (pp_stm a) ^ "\n" ^ b) "" stms) ^
 103           "}\n" ^
 104           pp_program funcs
 105   end
 106 end