(* high-to-mid.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * Translation from HighIL to MidIL representations.
 *)

structure HighToMid : sig

    val translate : HighIL.program -> MidIL.program

  end = struct

    structure SrcIL = HighIL
    structure SrcOp = HighOps
    structure VTbl = SrcIL.Var.Tbl
    structure DstIL = MidIL
    structure DstOp = MidOps

    type var_env = DstIL.var VTbl.hash_table

    fun rename (env : var_env, x) = (case VTbl.find env x
	   of SOME x' => x'
	    | NONE => let
		val x' = DstIL.Var.new (SrcIL.Var.name x)
		in
		  VTbl.insert env (x, x');
		  x'
		end
	  (* end case *))
    fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs

  (* expand the field Inside operator into a image-space test *)
    fun expandInside (env, result, pos, fld) = let
	  val pos = rename (env, pos)
	  val fld = (case SrcIL.Var.binding fld
		 of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
		  | _ => raise Fail "bogus field binding"
		(* end case *))
	  fun expand (FieldDef.CONV(_, img, _)) = let
		val imgPos = DstIL.Var.new "x"
		in [
		  (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
		  (result, DstIL.OP(DstOp.Inside img, [imgPos]))
		] end
	    | expand (FieldDef.NEG fld) = expand fld
	    | expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"
	  in
	    expand fld
	  end

    fun expandProbe (env, result, fld, pos) = let
	  val pos = rename (env, pos)
	  val fld = (case SrcIL.Var.binding fld
		 of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
		  | _ => raise Fail "bogus field binding"
		(* end case *))
	  in
	    Probe.expand (result, fld, pos)
	  end

    fun cvtTy SrcOp.BoolTy = DstOp.BoolTy
      | cvtTy SrcOp.StringTy = DstOp.StringTy
      | cvtTy SrcOp.IntTy = DstOp.IntTy
      | cvtTy (SrcOp.TensorTy[]) = DstOp.realTy
      | cvtTy (SrcOp.TensorTy[d]) = DstOp.VecTy d
      | cvtTy _ = raise Fail "unexpected higher-order tensor type"

    fun arity (SrcOp.TensorTy[]) = 1
      | arity (SrcOp.TensorTy[d]) = d
      | arity _ = raise Fail "arity"

    fun expandOp (env, y, rator, args) = let
	  fun assign rator' =
		[(y, DstIL.OP(rator', renameList(env, args)))]
	  in
	    case rator
	     of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
	      | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
	      | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
	      | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
	      | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
	      | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
	      | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
	      | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
	      | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
	      | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
	      | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
	      | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
	      | SrcOp.Cross => assign DstOp.Cross
	      | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
	      | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
	      | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
	      | SrcOp.CL => assign DstOp.CL
	      | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
	      | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
	      | SrcOp.Max => assign DstOp.Max
	      | SrcOp.Min => assign DstOp.Min
	      | SrcOp.Sin => assign DstOp.Sin
	      | SrcOp.Cos => assign DstOp.Cos
	      | SrcOp.Pow => assign DstOp.Pow
	      | SrcOp.Not => assign DstOp.Not
	      | SrcOp.IntToReal => assign DstOp.IntToReal
	      | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)
	      | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)
	      | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)
	      | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)
	      | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
	      | SrcOp.Inside => (case args
		   of [pos, fld] => expandInside(env, y, pos, fld)
		  (* end case *))
(* QUESTION: there is no MidIL equivalant, but these might be floating
 * around, which could cause invalid MidIL to be generated.
 *)
	      | SrcOp.Field fld => []
	      | SrcOp.Probe => (case args
		   of [fld, pos] => expandProbe(env, y, fld, pos)
		  (* end case *))
	      | SrcOp.Input s => assign (DstOp.Input s)
	      | SrcOp.InputWithDefault s => assign (DstOp.InputWithDefault s)
	      | _ => raise Fail("unexpected " ^ SrcOp.toString rator)
	    (* end case *)
	  end

    fun expand (env, (y, rhs)) = let
	  val y' = rename (env, y)
	  fun assign rhs = [(y', rhs)]
	  in
	    case rhs
	     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
	      | SrcIL.LIT lit => assign (DstIL.LIT lit)
	      | SrcIL.OP(rator, args) => expandOp (env, y', rator, args)
	      | SrcIL.CONS args => assign (DstIL.CONS(renameList(env, args)))
	    (* end case *)
	  end

    structure Trans =  TranslateFn (
      struct
	structure SrcIL = SrcIL
	structure DstIL = DstIL

	type var_env = var_env

	val rename = rename
	val expand = expand
      end)

    fun translate (SrcIL.Program{globals, globalInit, actors}) = let
	  val env = VTbl.mkTable (256, Fail "env")
	  fun transMethod (SrcIL.Method{name, stateIn, stateOut, body}) =
		DstIL.Method{
		    name = name,
		    stateIn = renameList (env, stateIn),
		    stateOut = renameList (env, stateOut),
		    body = Trans.translate (env, body)
		  }
	  fun transActor (SrcIL.Actor{name, params, state, stateInit, methods}) =
		DstIL.Actor{
		    name = name,
		    params = renameList (env, params),
		    state = renameList (env, state),
		    stateInit = Trans.translate (env, stateInit),
		    methods = List.map transMethod methods
		  }
	  in
	    DstIL.Program{
		globals = renameList (env, globals),
		globalInit = Trans.translate (env, globalInit),
		actors = List.map transActor actors
	      }
	  end

  end

<script type="text/javascript">//<![CDATA[
		function toggle_ffErrors() {
			var errorsblock = document.getElementById("ffErrorsBlock");
			var errorsgroup = document.getElementById("ffErrors");
			if (errorsblock.style.display == "none") {
				errorsblock.style.display = "block";
				errorsgroup.style.right = "10px";
			} else {
				errorsblock.style.display = "none";
				errorsgroup.style.right = "300px";
			}
		}
//]]></script>
<div id="ffErrors">
<a href="javascript:toggle_ffErrors();">Click to toggle</a>
<div id="ffErrorsBlock">
	<div class="error">does not end with &lt;/html&gt; tag</div>
	<div class="error">does not end with &lt;/body&gt; tag</div>
	<div class="info">The output has ended thus: it = Trans.translate (env, globalInit),
		actors = List.map transActor actors
	      }
	  end

  end</div>
</div></div>
</body></html>