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 2800 - (download) (annotate)
Thu Nov 6 17:34:24 2014 UTC (4 years, 9 months ago) by jhr
File size: 14401 byte(s)
  working on globals
(* 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 SrcSV = SrcIL.StateVar
    structure VTbl = SrcIL.Var.Tbl
    structure DstIL = MidIL
    structure DstTy = MidILTypes
    structure DstOp = MidOps
    structure InP = Inputs

    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'
	    | SrcIL.VB_RHS(SrcIL.GLOBAL x') => getRHS(SrcIL.GlobalVar.binding x')
            | vb => raise Fail(concat[
                  "expected rhs operator for ", SrcIL.Var.toString x,
                  " but found ", SrcIL.vbToString vb
                ])
          (* end case *))

    fun getRHSImage x = (case getRHS x
           of (SrcOp.LoadImage(SrcTy.ImageTy v, _), _) => v
            | (SrcOp.Input(InP.INP{init=SOME(InP.Proxy(_, v)), ...}), _) => v
            | (SrcOp.Input(InP.INP{init=SOME(InP.Image v), ...}), _) => v
            | _ => raise Fail "bogus image variable"
          (* 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
      | cvtTy (SrcTy.TupleTy tys) = DstTy.TupleTy(List.map cvtTy tys)
      | cvtTy (SrcTy.SeqTy(ty, n)) = DstTy.SeqTy(cvtTy ty, n)
      | cvtTy (SrcTy.DynSeqTy ty) = DstTy.DynSeqTy(cvtTy ty)
    (* 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 (SrcTy.ImageTy info) = DstTy.ImageTy info
      | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)

  (* instantiate the translation environment *)
    structure Env = TranslateEnvFn (
      struct
        structure SrcIL = SrcIL
        structure DstIL = DstIL
	val cvtTy = cvtTy
      end)

  (* 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 = Env.rename(env, x)
          fun pow () = let
                val t = DstIL.Var.new("n", DstTy.realTy)
                in [
                  (t, DstIL.OP(DstOp.IntToReal, [Env.rename(env, n)])),
                  (y, DstIL.APPLY(MathFuns.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
              | SOME 2 => [(y, DstIL.OP(DstOp.Mul DstTy.realTy, [x, x]))]
(* FIXME: expand into multiplications; ~2 ==> sqrt
              | 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(SrcTy.TensorTy[d], _), [img, h]) => (case (getRHSImage img, getRHS h)
                 of (v, (SrcOp.Kernel(h, _), [])) => let
                      val pos = Env.rename (env, pos)
                      val img = Env.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 (getRHSImage img, getRHS h)
                 of (v, (SrcOp.Kernel(h, k), _)) => Probe.expand {
                        result = result,
                        img = Env.rename (env, img),
                        v = v, h = h, k = k,
                        pos = Env.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.Index(colTy, j), [v2]))
                                :: (a, DstIL.OP(DstOp.Index(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', Env.renameList(env, args)))]
          fun cvtToInt rator' = let
                val t = DstIL.Var.new ("t", DstTy.realTy)
                in [
                  (t, DstIL.OP(rator', Env.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.MulVecTen3(SrcTy.TensorTy[d1, d2, d3]) => assign(DstOp.MulVecTen3(d1, d2, d3))
              | SrcOp.MulTen3Vec(SrcTy.TensorTy[d1, d2, d3]) => assign(DstOp.MulTen3Vec(d1, d2, d3))
              | SrcOp.ColonMul(ty1, ty2) => assign(DstOp.ColonMul(cvtTy ty1, cvtTy ty2))
              | SrcOp.Cross => assign DstOp.Cross
              | SrcOp.Outer(SrcTy.TensorTy[d1, d2]) => let
                  val [v1, v2] = Env.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.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.Transpose(d1, d2) => assign (DstOp.Transpose(d1, d2))
              | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
              | SrcOp.TensorSub(ty as SrcTy.TensorTy _) => assign (DstOp.Subscript(cvtTy ty))
              | SrcOp.Select(ty as SrcTy.TupleTy _, i) => assign (DstOp.Select(cvtTy ty, i))
              | SrcOp.SeqSub ty => assign (DstOp.Subscript(cvtTy ty))
              | SrcOp.MkDynamic(ty, n) => assign (DstOp.MkDynamic(cvtTy ty, n))
              | SrcOp.Append ty => assign (DstOp.Append(cvtTy ty))
              | SrcOp.Prepend ty => assign (DstOp.Prepend(cvtTy ty))
              | SrcOp.Concat ty => assign (DstOp.Concat(cvtTy ty))
              | SrcOp.Length ty => assign (DstOp.Length(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.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.OffsetField => dummy()
              | SrcOp.LoadSeq(ty, nrrd) => assign (DstOp.LoadSeq(cvtTy ty, nrrd))
              | SrcOp.LoadImage(ty, nrrd) =>
                  assign (DstOp.LoadImage(cvtTy ty, nrrd))
              | SrcOp.Input inp => (case Inputs.imageInfo inp
                   of SOME info => let
                        val Inputs.INP{name, desc, init, ...} = inp
                        in
                          assign (DstOp.Input(Inputs.INP{
                              ty = DstTy.ImageTy info,
                              name = name, desc = desc,
                              init = init
                            }))
                        end
                    | _ => assign (DstOp.Input(Inputs.map cvtTy inp))
                  (* end case *))
              | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
            (* end case *)
          end
handle ex => (print(concat["error converting ", SrcOp.toString rator, "\n"]); raise ex)

  (* expand a SrcIL assignment to a list of DstIL assignments *)
    fun expand (env, (y, rhs)) = let
          fun assign rhs = [DstIL.ASSGN(Env.rename (env, y), rhs)]
          in
            case rhs
             of SrcIL.GLOBAL x => assign (DstIL.GLOBAL(Env.renameGV(env, x)))
	      | SrcIL.STATE x => assign (DstIL.STATE(Env.renameSV(env, x)))
              | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
              | SrcIL.LIT lit => assign (DstIL.LIT lit)
              | SrcIL.OP(rator, args) =>
                  List.map DstIL.ASSGN (expandOp (env, Env.rename (env, y), rator, args))
              | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, Env.renameList(env, args)))
              | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, Env.renameList(env, args)))
            (* end case *)
          end

  (* expand a SrcIL multi-assignment to a DstIL CFG *)
    fun mexpand (env, (ys, rator, xs)) = let
          val ys' = Env.renameList(env, ys)
          val rator' = (case rator
                 of SrcOp.Eigen2x2 => DstOp.EigenVecs2x2
                  | SrcOp.Eigen3x3 => DstOp.EigenVecs3x3
                  | SrcOp.Print tys => DstOp.Print(List.map cvtTy tys)
                  | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
                (* end case *))
          val xs' = Env.renameList(env, xs)
          val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
          in
            DstIL.CFG{entry=nd, exit=nd}
          end

    structure Trans =  TranslateFn (
      struct
        open Env
        val expand = DstIL.CFG.mkBlock o expand
        val mexpand = mexpand
      end)

    structure Promote = PromoteFn (DstIL)

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

  end

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