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

SCM Repository

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

View of /trunk/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 364 - (download) (annotate)
Wed Sep 29 18:06:12 2010 UTC (9 years, 2 months ago) by jhr
File size: 4373 byte(s)
  Working on high to mid translation
(* 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 SrcIL.Var.Tbl.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 *))

  (* expand the field Inside operator into a image-space test *)
    fun expandInside (env, result, pos, fld) = let
	  val fld = (case fld
		 of 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 fld = (case fld
		 of SrcIL.OP(SrcOp.Field fld, []) => fld
		  | _ => raise Fail "bogus field binding"
		(* end case *))
	  in
	    Probe.expand (result, fld, pos)
	  end

    fun expandOp (env, y, rator, args) = let
	  fun assign rator' = [(y, DstIL.OP(rator', args))]
	  in
	    case rator
	     of SrcIL.Add ty => assign (DstIL.Add(cvtTy ty))
	      | SrcIL.Sub ty => assign (DstIL.Sub(cvtTy ty))
	      | SrcIL.Mul ty => assign (DstIL.Mul(cvtTy ty))
	      | SrcIL.Div ty => assign (DstIL.Div(cvtTy ty))
	      | SrcIL.Neg ty => assign (DstIL.Neg(cvtTy ty))
	      | SrcIL.LT ty => assign (DstIL.LT(cvtTy ty))
	      | SrcIL.LTE ty => assign (DstIL.LTE(cvtTy ty))
	      | SrcIL.EQ ty => assign (DstIL.EQ(cvtTy ty))
	      | SrcIL.NEQ ty => assign (DstIL.NEQ(cvtTy ty))
	      | SrcIL.GT ty => assign (DstIL.GT(cvtTy ty))
	      | SrcIL.GTE ty => assign (DstIL.GTE(cvtTy ty))
	      | SrcIL.Dot ty => assign (DstIL.Dot(cvtTy ty))
	      | SrcIL.Cross => assign (DstIL.Cross)
	      | SrcIL.Norm ty => assign (DstIL.Norm(cvtTy ty))
	      | SrcIL.Scale ty => assign (DstIL.Scale(cvtTy ty))
	      | SrcIL.InvScale ty => assign (DstIL.InvScale(cvtTy ty))
	      | SrcIL.CL => assign (DstIL.CL)
	      | SrcIL.PrincipleEvec ty => assign (DstIL.PrincipleEvec(cvtTy ty))
	      | SrcIL.Subscript ty => assign (DstIL.Subscript(cvtTy ty))
	      | SrcIL.Max => assign (DstIL.Max)
	      | SrcIL.Min => assign (DstIL.Min)
	      | SrcIL.Sin => assign (DstIL.Sin)
	      | SrcIL.Cos => assign (DstIL.Cos)
	      | SrcIL.Pow => assign (DstIL.Pow)
	      | SrcIL.Not => assign (DstIL.Not)
	      | SrcIL.IntToReal => assign (DstIL.IntToReal)
	      | SrcIL.TruncToInt => assign (DstIL.TruncToInt)
	      | SrcIL.RoundToInt => assign (DstIL.RoundToInt)
	      | SrcIL.CeilToInt => assign (DstIL.CeilToInt)
	      | SrcIL.FloorToInt => assign (DstIL.FloorToInt)
	      | SrcIL.LoadImage info => assign (DstIL.LoadImage info)
	      | SrcIL.Convolve => assign (DstIL.Convolve)
	      | SrcIL.Inside => expandInside(env, y, #1 args, #2 args)
	      | SrcIL.Probe => expandProbe(env, y, #1 args, #2 args)
	      | SrcIL.Input s => assign (DstIL.Input s)
	      | SrcIL.InputWithDefault => assign (DstIL.InputWithDefault s)
	      | _ => raise Fail("unexpected " ^ SrcIL.Op.toString rator)
	    (* end case *))

    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, List.map (fn x => rename(env, x)) args)
	      | SrcIL.CONS args =>
		  assign (DstIL.CONS(List.map (fn x => rename(env, x)) 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}) =
	  raise Fail "unimplemented"

  end

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