Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml
ViewVC logotype

View of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1301 - (download) (annotate)
Thu Jun 9 23:58:40 2011 UTC (8 years, 4 months ago) by jhr
Original Path: trunk/src/compiler/high-to-mid/high-to-mid.sml
File size: 9962 byte(s)
  Added support for hest-based command-line arguments to trunk.  Also switched
  output filename to prog.txt (from mip.txt)
(* high-to-mid.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.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 SrcTy = HighILTypes
    structure SrcOp = HighOps
    structure VTbl = SrcIL.Var.Tbl
    structure DstIL = MidIL
    structure DstTy = MidILTypes
    structure DstOp = MidOps

    type var_env = DstIL.var VTbl.hash_table

    fun getRHS x  = (case SrcIL.Var.binding x
	   of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (rator, args)
	    | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS x'
	    | vb => raise Fail(concat[
		  "expected rhs operator for ", SrcIL.Var.toString x,
		  "but found ", SrcIL.vbToString vb
		])
	  (* end case *))

    fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
      | cvtTy SrcTy.StringTy = DstTy.StringTy
      | cvtTy SrcTy.IntTy = DstTy.intTy
      | cvtTy (SrcTy.TensorTy dd) = DstTy.tensorTy dd
    (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
      | cvtTy SrcTy.KernelTy = DstTy.intTy
      | cvtTy SrcTy.FieldTy = DstTy.intTy
      | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)

    fun rename (env : var_env, x) = (case VTbl.find env x
	   of SOME x' => x'
	    | NONE => let
		val dstTy = (case SrcIL.Var.ty x
		       of SrcTy.ImageTy _ => (
			  (* for variables with image type, we need more detailed information
			   * about the image for the MidIL type.
			   *)
			    case getRHS x
			     of (SrcOp.LoadImage v, _) => DstTy.ImageTy v
			      | _ => raise Fail "bogus image variable"
			    (* end case *))
			| _ => cvtTy(SrcIL.Var.ty x)
		      (* end case *))
		val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
		in
		  VTbl.insert env (x, x');
		  x'
		end
	  (* end case *))
handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])

    fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs

  (* expand raising a real to an integer power.  When we know the exponent, we can inline
   * multiplications.
   *)
    fun expandPower (env, y, [x, n]) = let
	  fun getConst x = (case SrcIL.Var.binding x
		 of SrcIL.VB_RHS(SrcIL.VAR x') => getConst x'
		  | SrcIL.VB_RHS(SrcIL.LIT(Literal.Int n)) => SOME n
		  | vb => NONE
		(* end case *))
	  val x = rename(env, x)
	  fun pow () = let
		val t = DstIL.Var.new("n", DstTy.realTy)
		in [
		  (t, DstIL.OP(DstOp.IntToReal, [rename(env, n)])),
		  (y, DstIL.APPLY(ILBasis.pow, [x, t]))
		] end
	  in
	    case getConst n
	     of SOME 0 => [(y, DstIL.LIT(Literal.Float(FloatLit.one)))]
	      | SOME 1 => [(y, DstIL.VAR x)]
	      | SOME ~1 => let
		  val t = DstIL.Var.new("one", DstTy.realTy)
		  in [
		    (t, DstIL.LIT(Literal.Float(FloatLit.one))),
		    (y, DstIL.OP(DstOp.Div DstTy.realTy, [t, x]))
		  ] end
(* FIXME: expand into multiplications
	      | SOME n =>
*) | SOME _ => pow()
	      | NONE => pow()
	  end

  (* expand the field Inside operator into a image-space test *)
    fun expandInside (env, result, pos, fld) = (case getRHS fld
	   of (SrcOp.Field d, [img, h]) => (case (getRHS img, getRHS h)
		 of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, _), [])) => let
		      val pos = rename (env, pos)
		      val img = rename (env, img)
		      val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
		      val s = Kernel.support h
		      in [
			(imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
			(result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
		      ] end
		  | _ => raise Fail "bogus kernel binding"
		(* end case *))
	    | _ => raise Fail "bogus field binding"
	  (* end case *))

    fun expandProbe (env, result, fld, pos) = (case getRHS fld
	   of (SrcOp.Field _, [img, h]) => (case (getRHS img, getRHS h)
		 of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, k), _)) => Probe.expand {
			result = result,
			img = rename (env, img),
			v = v, h = h, k = k,
			pos = rename (env, pos)
		      }
		  | _ => raise Fail "bogus image/kernel binding"
		(* end case *))
	    | _ => raise Fail "bogus field binding"
	  (* end case *))

  (* expand the outer product of vectors v1 and v2, with dimensions d1 and d2 (resp.) *)
    fun expandOuter (env, y, d1, d2, v1, v2) = let
	  val rowTy = DstTy.tensorTy[d1]
	  val colTy = DstTy.tensorTy[d2]
	  fun mkVar (i, j) = DstIL.Var.new (concat["o_", Int.toString i, "_", Int.toString j], DstTy.realTy)
	  fun mkRowVar i = DstIL.Var.new ("r_" ^ Int.toString i, DstTy.TensorTy[d2])
	  fun rowLp (i, rowVars, code) = if (i < d1)
		then let
		  fun colLp (j, colVars, code) = if (j < d2)
			then let
			  val a = DstIL.Var.new("a", DstTy.realTy)
			  val b = DstIL.Var.new("b", DstTy.realTy)
			  val x = mkVar (i, j)
			  val code = (x, DstIL.OP(DstOp.Mul DstTy.realTy, [a, b]))
				:: (b, DstIL.OP(DstOp.Select(colTy, j), [v2]))
				:: (a, DstIL.OP(DstOp.Select(rowTy, i), [v1]))
				:: code
			  in
			    colLp (j+1, x::colVars, code)
			  end
			else let
			  val r = mkRowVar i
			  in
			    rowLp (i+1, r::rowVars,
			      (r, DstIL.CONS(rowTy, List.rev colVars)) :: code)
			  end
		  in
		    colLp (0, [], code)
		  end
		else List.rev ((y, DstIL.CONS(DstTy.TensorTy[d1,d2], List.rev rowVars)) :: code)
	  in
	    rowLp (0, [], [])
	  end

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

    fun expandOp (env, y, rator, args) = let
	  fun assign rator' =
		[(y, DstIL.OP(rator', renameList(env, args)))]
	  fun cvtToInt rator' = let
		val t = DstIL.Var.new ("t", DstTy.realTy)
		in [
		  (t, DstIL.OP(rator', renameList(env, args))),
		  (y, DstIL.OP(DstOp.RealToInt 1, [t]))
		] end
	  fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
	  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.Abs ty => assign (DstOp.Abs(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.Power => expandPower(env, y, args)
	      | SrcOp.Not => assign DstOp.Not
	      | SrcOp.Max => assign DstOp.Max
	      | SrcOp.Min => assign DstOp.Min
	      | SrcOp.Clamp ty => assign (DstOp.Clamp(cvtTy ty))
	      | SrcOp.Lerp ty => assign (DstOp.Lerp(cvtTy ty))
	      | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
	      | SrcOp.MulVecMat(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulVecMat(d1, d2))
	      | SrcOp.MulMatVec(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulMatVec(d1, d2))
	      | SrcOp.MulMatMat(SrcTy.TensorTy[d1, d2], SrcTy.TensorTy[d2', d3]) =>
		  assign (DstOp.MulMatMat(d1, d2, d3))
	      | SrcOp.Cross => assign DstOp.Cross
	      | SrcOp.Outer(SrcTy.TensorTy[d1, d2]) => let
		  val [v1, v2] = renameList(env, args)
		  in
		    expandOuter (env, y, d1, d2, v1, v2)
		  end
	      | SrcOp.Norm ty => assign (DstOp.Norm(cvtTy ty))
	      | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
	      | SrcOp.Scale ty => assign (DstOp.Scale(cvtTy ty))
	      | SrcOp.CL => assign DstOp.CL
	      | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
	      | SrcOp.Identity n => assign (DstOp.Identity n)
	      | SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))
	      | SrcOp.Trace(SrcTy.TensorTy[d, _]) => assign (DstOp.Trace d)
	      | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
	      | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
	      | SrcOp.IntToReal => assign DstOp.IntToReal
	      | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
	      | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
	      | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
	      | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
	      | SrcOp.Kernel _ => dummy()
	      | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
	      | SrcOp.Inside _ => (case args
		   of [pos, fld] => expandInside(env, y, pos, fld)
		  (* end case *))
	      | SrcOp.Probe _ => (case args
		   of [fld, pos] => expandProbe(env, y, fld, pos)
		  (* end case *))
	    (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
	      | SrcOp.Field _ => dummy()
	      | SrcOp.AddField => dummy()
	      | SrcOp.SubField => dummy()
	      | SrcOp.ScaleField => dummy()
	      | SrcOp.NegField => dummy()
	      | SrcOp.DiffField => dummy()
	      | SrcOp.Input(ty, s, desc) => assign (DstOp.Input(cvtTy ty, s, desc))
	      | SrcOp.InputWithDefault(ty, s, desc) =>
		  assign (DstOp.InputWithDefault(cvtTy ty, s, desc))
	      | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
	    (* end case *)
	  end

  (* expand a SrcIL assignment to a list of DstIL assignments *)
    fun expand (env, (y, rhs)) = let
	  fun assign rhs = [(rename (env, y), rhs)]
	  in
	    case rhs
	     of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
	      | SrcIL.LIT lit => assign (DstIL.LIT lit)
	      | SrcIL.OP(SrcOp.Field _, args) => []
	      | SrcIL.OP(rator, args) => expandOp (env, rename (env, y), rator, args)
	      | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, renameList(env, args)))
	      | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, 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 renameList = renameList
	val expand = DstIL.CFG.mkBlock o expand
      end)

    fun translate prog = let
	  val prog = Trans.translate prog
	  in
	    MidILCensus.init prog;
	    prog
	  end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0