optimize/stupidfunc.sml

   1 structure StupidFunctionElim :> OPTIMIZATION =
   2 struct
   3   structure T = Tree
   4   structure TU = TreeUtils
   5
   6   datatype rval = Any | Const of Word32.word
   7
   8   fun stmhit NONE _ = NONE
   9     | stmhit _ (T.JUMPIFN _) = NONE
  10     | stmhit (SOME(Any)) (T.RETURN (T.CONST n, s)) = SOME(Const(n))
  11     | stmhit (SOME(Const(n))) (T.RETURN (T.CONST n',s)) = if n' = n then SOME(Const(n)) else NONE
  12     | stmhit _ (T.RETURN _) = NONE
  13     | stmhit opt s = if TU.effect_stm s then NONE else opt
  14
  15   fun stupid (T.FUNCTION (id, fl)) = (foldr (fn (a,b) => stmhit b a) (SOME(Any)) fl, id)
  16
  17   fun findstupids prog = foldr (fn ((SOME(Const(n)),id),b) => Symbol.bind b (id, SOME(n))
  18                                  | ((SOME(Any), id),b) => raise ErrorMsg.InternalError "wtf, this function no return"
  19                                  | ((NONE, id),b) => Symbol.bind b (id, NONE))
  20                                Symbol.empty
  21                                (List.map stupid prog)
  22
  23   fun ds_exp t (T.CALL(id, l, s)) =
  24         let
  25           val effecting = List.mapPartial (fn (a,_) => if TU.effect a then SOME(ds_exp t a) else NONE) l
  26         in
  27           (case Symbol.look' t id
  28             of SOME(n) => T.STMVAR(List.map T.EFFECT effecting, T.CONST n)
  29             |  NONE => T.CALL(id, List.map (fn (a,i) => (ds_exp t a, i)) l, s))
  30           handle Option => T.CALL(id, List.map (fn (a,i) => (ds_exp t a, i)) l, s)
  31         end
  32     | ds_exp t (T.BINOP(oper, e1, e2)) = T.BINOP(oper, ds_exp t e1, ds_exp t e2)
  33     | ds_exp t (T.UNOP(oper, e)) = T.UNOP(oper, ds_exp t e)
  34     | ds_exp t (T.MEMORY (e,s)) = T.MEMORY (ds_exp t e, s)
  35     | ds_exp t (T.COND (c, e1, e2)) = T.COND (ds_exp t c, ds_exp t e1, ds_exp t e2)
  36     | ds_exp t (T.ALLOC e) = T.ALLOC (ds_exp t e)
  37     | ds_exp t (T.STMVAR (sl, e)) = T.STMVAR (List.map (ds_stm t) sl, ds_exp t e)
  38     | ds_exp t a = a
  39
  40   and ds_stm t (T.MOVE (e1, e2)) = T.MOVE (ds_exp t e1, ds_exp t e2)
  41     | ds_stm t (T.RETURN (e, s)) = T.RETURN (ds_exp t e, s)
  42     | ds_stm t (T.EFFECT e) = T.EFFECT (ds_exp t e)
  43     | ds_stm t (a as T.LABEL _) = a
  44     | ds_stm t (T.JUMPIFN (e, l)) = T.JUMPIFN (ds_exp t e, l)
  45     | ds_stm t (a as T.JUMP _) = a
  46
  47   fun diestupids prog =
  48     let
  49       val stupids = findstupids prog
  50       fun kill (T.FUNCTION (id, sl)) = T.FUNCTION (id, List.map (ds_stm stupids) sl)
  51     in
  52       List.map kill prog
  53     end
  54
  55   val optimizer = { shortname = "stupidfn",
  56                     description = "Turns stupid functions with constant return and no side effect into constant",
  57                     func = Optimizer.IRPROG diestupids }
  58 end