(* simplify.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * Simplify the AST representation.
 *)

structure Simplify : sig

    val transform : AST.program -> Simple.program

  end = struct

    structure Ty = Types
    structure S = Simple

    local
      val tempName = Atom.atom "_t"
    in
    fun newTemp ty = Var.new (tempName, AST.LocalVar, ty)
    end

  (* make a block out of a list of statements that are in reverse order *)
    fun mkBlock stms = let
	  fun flatten [] = []
	    | flatten (S.S_Block stms :: r) = stms @ flatten r
	    | flatten (stm :: r) = stm :: flatten r
	  in
	    S.S_Block(flatten (List.rev stms))
	  end

    fun transform (AST.Program dcls) = let
	  val globals = ref []
	  val globalInit = ref []
	  val actors = ref []
	  fun simplifyDecl dcl = (case dcl
		 of AST.D_Input(x, NONE) => globals := x :: !globals
		  | AST.D_Input(x, SOME e) => let
		      val (stms, e') = simplifyExp (e, [])
		      in
(* FIXME: note that we should add code to check for the input value overriding the default value *)
			globals := x :: !globals;
			globalInit := S.S_Assign(x, e') :: (stms @ !globalInit) 
		      end
		  | AST.D_Var(AST.VD_Decl(x, e)) => let
		      val (stms, e') = simplifyExp (e, [])
		      in
			globals := x :: !globals;
			globalInit := S.S_Assign(x, e') :: (stms @ !globalInit) 
		      end
		  | AST.D_Actor info => actors := simplifyActor info :: !actors
		  | AST.D_InitialArray(e, iters) => () (* FIXME *)
		  | AST.D_InitialCollection(e, iters) => () (* FIXME *)
		(* end case *))
	  in
	    List.app simplifyDecl dcls;
	    S.Prog{
		globals = List.rev(!globals),
		globalInit = mkBlock (!globalInit),
		actors = List.rev(!actors)
	      }
	  end

    and simplifyActor {name, params, state, methods} = let
	  fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
	    | simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let
		val (stms, e') = simplifyExp (e, stms)
		in
		  simplifyState (r, x::xs, S.S_Assign(x, e') :: stms)
		end
	  val (xs, stm) = simplifyState (state, [], [])
	  in
	    S.Actor{
		params = params,
		state = xs, stateInit = stm,
		methods = List.map simplifyMethod methods
	      }
	  end

    and simplifyMethod (AST.M_Method(name, body)) =
	  S.M_Method(name, simplifyBlock body)

  (* simplify a statement into a single statement (i.e., a block if it expands into more
   * than one new statement.
   *)
    and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))

    and simplifyStmt (stm, stms) = (case stm
	   of AST.S_Block body => let
		fun simplify ([], stms) = stms
		  | simplify (stm::r, stms) = simplify (r, simplifyStmt (stm, stms))
		in
		  simplify (body, stms)
		end
	    | AST.S_Decl(AST.VD_Decl(x, e)) => let
		val (stms, e') = simplifyExp (e, stms)
		in
		  S.S_Assign(x, e') :: stms
		end
	    | AST.S_IfThenElse(e, s1, s2) => let
		val (stms, x) = simplifyExpToVar (e, stms)
		val s1 = simplifyBlock s1
		val s2 = simplifyBlock s2
		in
		  S.S_IfThenElse(x, s1, s2) :: stms
		end
	    | AST.S_Assign(x, e) => let
		val (stms, e') = simplifyExp (e, stms)
		in
		  S.S_Assign(x, e') :: stms
		end
	    | AST.S_New(name, args) => let
		val (stms, xs) = simplifyExpsToVars (args, stms)
		in
		  S.S_New(name, xs) :: stms
		end
	    | AST.S_Die => S.S_Die :: stms
	    | AST.S_Stabilize => S.S_Stabilize :: stms
	  (* end case *))

    and simplifyExp (exp, stms) = (
	  case exp
	   of AST.E_Var x => (stms, S.E_Var x)
	    | AST.E_Lit lit => (stms, S.E_Lit lit)
	    | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"
	    | AST.E_Apply(f, tyArgs, args, ty) => let
		val (stms, xs) = simplifyExpsToVars (args, stms)
		in
		  (stms, S.E_Apply(f, tyArgs, xs, ty))
		end
	    | AST.E_Cons es => let
		val (stms, xs) = simplifyExpsToVars (es, stms)
		in
		  (stms, S.E_Cons xs)
		end
	    | AST.E_Cond(e1, e2, e3) => let
	      (* a conditional expression gets turned into an if-then-else statememt *)
		val result = newTemp Ty.T_Bool
		val (stms, x) = simplifyExpToVar (e1, stms)
		fun simplifyBranch e = let
		      val (stms, e) = simplifyExp (e, [])
		      in
			mkBlock (S.S_Assign(result, e)::stms)
		      end
		val s1 = simplifyBranch e1
		val s2 = simplifyBranch e2
		in
		  (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
		end
	  (* end case *))

    and simplifyExpToVar (exp, stms) = let
	  val (stms, e) = simplifyExp (exp, stms)
	  in
	    case e
	     of S.E_Var x => (stms, x)
	      | _ => let
		  val x = newTemp (S.typeOf e)
		  in
		    (S.S_Assign(x, e)::stms, x)
		  end
	    (* end case *)
	  end

    and simplifyExpsToVars (exps, stms) = let
	  fun f ([], xs, stms) = (stms, List.rev xs)
	    | f (e::es, xs, stms) = let
		val (stms, x) = simplifyExpToVar (e, stms)
		in
		  f (es, x::xs, stms)
		end
	  in
	    f (exps, [], stms)
	  end

  end