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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2525 - (download) (annotate)
Tue Jan 21 19:14:22 2014 UTC (5 years, 6 months ago) by cchiw
File size: 13420 byte(s)
eintypes->mid-iltypes
(* 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 Expand=Expand
    structure P=Printer
    structure shift=shiftHtM
    structure split= splitHtM

   datatype peanut=    O of  SrcOp.rator | E of Ein.ein |Nope

    fun printEin e=print(P.printerE(e))

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




        (*created so a fail isn't returned. see rename function *)
        fun getRHS2 x  = (case SrcIL.Var.binding x
            of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (O rator, args)
            | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS2 x'
            | SrcIL.VB_RHS(SrcIL.EINAPP(rator, args)) => (E rator,args)
            | _=>(print "yyy";(Nope, []))
        (* 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)
    (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
      | cvtTy SrcTy.KernelTy = DstTy.KernelTy
      | cvtTy SrcTy.FieldTy = DstTy.intTy
      | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)

  (* instantiate the translation environment *)
    local
      type var_env = DstIL.var VTbl.hash_table
      type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table

        (*********************FIX*********************)

        fun rename (env : var_env, x) =

           (* case getRHS2(x)
            of (E e,ea)=>(print(P.printerE e);DstIL.Var.new("l",DstTy.BoolTy))
            |_=> *)

                case VTbl.find env x
                of SOME x' =>( x')
                | NONE => let
                   (* val g= print "\n  in rename-none\n"*)
                    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 (O (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
                    
        handle Fail msg => raise Fail(concat["rename(_, ",  SrcIL.Var.toString x, "): ", msg])

      fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
             of SOME x' => x'
              | NONE => let
                  val dstTy = cvtTy (SrcSV.ty x)
                  val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, dstTy)
                  in
                    SrcSV.Tbl.insert env (x, x');
                    x'
                  end
            (* end case *))
    in
    structure Env = TranslateEnvFn (
      struct
        structure SrcIL = SrcIL
        structure DstIL = DstIL
        type var_env = var_env
        type state_var_env = state_var_env
        val rename = rename
        val renameSV = renameSV
      end)
    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.IDiv , [t, x]))
                  ] end
              | SOME 2 => [(y, DstIL.OP(DstOp.IMul , [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 (O(SrcOp.Field d), [img, h]) => (case (getRHS img, getRHS h)
                 of (O(SrcOp.LoadImage v), _), (O (SrcOp.Kernel(h, _)), [])) => let
                      val pos = Env.rename (env, pos)
                      val img = Env.rename (env, img)

                            (**********FIXME**)
                      val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
                      val s = Kernel.support h
						(*PostoImageSpace*)
                      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 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.IAdd  => assign (DstOp.IAdd)
              | SrcOp.ISub  => assign (DstOp.ISub)
              | SrcOp.IMul  => assign (DstOp.IMul)
              | SrcOp.IDiv  => assign (DstOp.IDiv)
              | SrcOp.INeg  => assign (DstOp.INeg)
              | 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.Norm ty => assign (DstOp.Norm(cvtTy ty))
              | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
 
              | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
        
              (*| SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))*)
              | 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.Select(ty as SrcTy.SeqTy _, i) => assign (DstOp.Index(cvtTy ty, i))
              | SrcOp.SeqSub(ty as SrcTy.SeqTy _) => 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 h => assign (DstOp.Kernel h)
              | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
              (*| SrcOp.Inside _ =>
                (case args
                   of [pos, fld] => expandInside(env, y, pos, fld)
                  (* end case *))*)
            (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
              | 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
handle ex => (print(concat["error converting ", SrcOp.toString rator, "\n"]); raise ex)


(*Expand then split *)
fun setEinAp e=let
    val (y,rator,args)=e
    val a= print(String.concat["\n \t \t ",split.printA e])
    in
        (y, DstIL.EINAPP(rator,  args))
    end


  fun expandEinOp (env, y, rator, args) = let
        val einargs=Env.renameList(env, args)

        val g=print "\n -----------------------------------------------\n\n  New One \n\n"
        val a= print(String.concat["\n","previous  ", split.printAA(y,rator,args),"\n now",split.printA (y,rator,einargs),"\n"])
        val (change,rator', args',code)= Expand.expandEinOp(rator,args,einargs)
        val z=(case change
            of 1 => (print "\n Expanded ===>\n")
            |_=> print " ")
        val ll=print (Int.toString(length(code)))
   

        val (change,newbie)=split.splitein(y,rator',args')
        in (case change
            of 0 => (
                    print(String.concat["\n Returning \n  ", split.printA(y,rator',args')]);
                    [(y, DstIL.EINAPP(rator',  args'))])
            | _=> let 
                    val x=print"\n \t $plit \n"
                
                    in (List.map setEinAp newbie)@code
                    end
            (*end case*))

  
        end 

  (* expand a SrcIL assignment to a list of DstIL assignments *)
    fun expand (env, (y, rhs)) = let    
       (* val x=print"\n newbie\n"*)
        (*
        val v=( case SrcIL.Var.binding y
            of   SrcIL.VB_RHS(SrcIL.EINAPP(rator, args))  => print(String.concat[P.printerE rator ,"\n\n"])
            |_=>print "")
*)
          fun assign rhs = [DstIL.ASSGN(Env.rename (env, y), rhs)]

          in 
            case rhs
                of 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))))
              | SrcIL.EINAPP(rator, args) =>                List.map (fn (y,rator)=> DstIL.ASSGN(y,rator))
                (expandEinOp (env, Env.rename (env, y), rator, 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)

    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