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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2667 - (download) (annotate)
Thu Jun 5 18:54:12 2014 UTC (5 years, 3 months ago) by cchiw
File size: 9716 byte(s)
changed inlcude
(* mid-to-low.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Translation from MidIL to LowIL representations.
 *)

structure MidToLow : sig

    val translate : MidIL.program -> LowIL.program

  end = struct

    structure SrcIL = MidIL
    structure SrcOp = MidOps
    structure SrcSV = SrcIL.StateVar
    structure SrcTy = MidILTypes
    structure VTbl = SrcIL.Var.Tbl
    structure DstIL = LowIL
    structure DstTy = LowILTypes
    structure DstOp = LowOps
    structure E=Ein
    structure P=Printer
    structure X=checkEin
    structure S1=step1


 
  (* instantiate the translation environment *)
    local
      type var_env = DstIL.var VTbl.hash_table
      type state_var_env = DstIL.state_var SrcSV.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, SrcIL.Var.ty x)
                  in
                    VTbl.insert env (x, x');
                    x'
                  end
            (* end case *))

        fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
               of SOME x' => x'
                | NONE => let
                    val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, SrcSV.ty x)
                    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 (* local *)



    fun mkDot(n, args)= let
        val DTy=DstTy.TensorTy [n]
        val RTy=DstTy.TensorTy []
        val a=DstIL.Var.new("prod" ,DTy)
        val b=DstIL.Var.new("sum" ,RTy)
        val code= [(a, DstIL.OP(DstOp.prodVec n,args@args)),
            (b, DstIL.OP(DstOp.sumVec n, [a]))]
        in
            (code,b)
        end


    fun mkN(n, args)= let
        val (code, b)=mkDot(n, args)
        val norm=DstIL.OP(DstOp.Sqrt,[b])
        in
            (code,norm)
        end


    fun expandOp (env, y, rator, args) = let
	  val args' = Env.renameList (env, args)
	  fun assign rator' = [(y, DstIL.OP(rator', args'))]
     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 ty)
	      | SrcOp.LT ty => assign (DstOp.LT ty)
	      | SrcOp.LTE ty => assign (DstOp.LTE ty)
	      | SrcOp.EQ ty => assign (DstOp.EQ ty)
	      | SrcOp.NEQ ty => assign (DstOp.NEQ ty)
	      | SrcOp.GT ty => assign (DstOp.GT ty)
	      | SrcOp.GTE ty => assign (DstOp.GTE ty)
	      | SrcOp.Not => assign (DstOp.Not)
	      | SrcOp.Max => assign (DstOp.Max)
	      | SrcOp.Min => assign (DstOp.Min)
	      | SrcOp.Clamp ty => assign (DstOp.Clamp ty)
	      | SrcOp.Lerp ty => assign (DstOp.Lerp ty)

                (*replace norm of vectors and length functions*)
              | SrcOp.Norm(SrcTy.TensorTy [n]) =>let
                    val (code,norm)=mkN(n, args')
                in
                        code@[(y,norm)]
                end

            (*untested. How should we index matrices?*)
            | SrcOp.Norm(SrcTy.TensorTy [i,j]) =>let
                val argTy=SrcTy.TensorTy [i,j]
                val rstTy=DstTy.TensorTy [i]
                


                
                fun sortCol(0,code,SOME var) =let
                    val norm=DstIL.OP(DstOp.Sqrt,[var])
                    in
                        code@[(y,norm)]
                    end
                  |sortCol(m,code,NONE)= let
                    val n=m-1
                    val ix=DstTy.indexTy [n]
                    val b=DstIL.Var.new("indexed" ,rstTy)
                    val opp= DstIL.OP(DstOp.IndexTensor(0,rstTy,ix,argTy),args')
                    val (code',d)=mkDot(i, [b])
                    in
                        sortCol(n, [(b,opp)]@code'@code, SOME d)
                    end
                |sortCol(m,code,SOME var)= let
                    val n=m-1
                    val ix=DstTy.indexTy [n]
                    val b=DstIL.Var.new("indexed" ,rstTy)
                    val opp=DstIL.OP(DstOp.IndexTensor(0,rstTy,ix,argTy),args')
                    val (code',d)=mkDot(i, [b])
                    val c=DstIL.Var.new("add" ,DstTy.TensorTy [])
                    val add=DstIL.OP(DstOp.addSca,[d,var])
                    in
                        sortCol(n, [(b,opp)]@code'@[(c,add)]@code, SOME c)
                    end
                in
                     sortCol(i,[],NONE)
                end

               | SrcOp.Norm ty => assign (DstOp.Norm ty)
             | SrcOp.Normalize n =>let
                val (code,norm)=mkN(n, args')
                val Sca=DstTy.TensorTy []
                val a=DstIL.Var.new("sqrt" ,Sca)
                val b=DstIL.Var.new("Int" ,Sca)
                val c=DstIL.Var.new("div" ,Sca)
                    
                in code@ [(a, norm),
                    (b, DstIL.LIT(Literal.Int 1)),
                    (c ,DstIL.OP(DstOp.divSca,[b,a])),
                    (y, DstIL.OP(DstOp.prodScaV n,[c]@args'))]
                end

(*	      | SrcOp.Normalize d => assign (DstOp.Normalize d)*)
	      | SrcOp.Zero ty => assign (DstOp.Zero ty)
	      | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec ty)
          | SrcOp.EigenVals2x2 => assign (DstOp.EigenVals2x2)
          | SrcOp.EigenVals3x3 => assign (DstOp.EigenVals3x3)
          | SrcOp.Select(ty as SrcTy.TupleTy tys, i) => assign (DstOp.Select(ty, i))
          | SrcOp.Index(ty, i) => assign (DstOp.Index(ty, i))
          | SrcOp.Subscript ty => assign (DstOp.Subscript ty)
	      | SrcOp.Ceiling d => assign (DstOp.Ceiling d)
	      | SrcOp.Floor d => assign (DstOp.Floor d)
	      | SrcOp.Round d => assign (DstOp.Round d)
	      | SrcOp.Trunc d => assign (DstOp.Trunc d)
	      | SrcOp.IntToReal => assign (DstOp.IntToReal)
	      | SrcOp.RealToInt d => assign (DstOp.RealToInt d)
	
	      | SrcOp.LoadVoxels(rty, d) => assign (DstOp.LoadVoxels(rty, d))
          | SrcOp.Kernel h =>  assign(DstOp.Kernel h)
          | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
	      | SrcOp.Inside info => assign (DstOp.Inside info)
       
            (*Input problems *)
	      (*| SrcOp.Input(ty, s, desc) => assign (DstOp.Input(ty, s, desc))
	      | SrcOp.InputWithDefault(ty, s, desc) =>assign (DstOp.InputWithDefault(ty, s, desc))
       *)
          | SrcOp.Transform V=> assign (DstOp.Transform V)
          | SrcOp.Translate V=> assign(DstOp.Translate V)
	      | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
	    (* end case *)
	  end
       
            
       val testing=1
      
    fun expandEinOp (env, y, e, args) = let
        val einargs=Env.renameList(env, args)
        val _ =(case testing
            of 0 => 1
            | _  => (print(String.concat(["\n\n new ein \n", DstIL.Var.toString(y),"=",P.printerE(e)]@(List.map (fn e=> (DstIL.Var.toString(e)^",")) einargs)@["\n ** pre gen**"]));1)
            (*end case*))
      
        val _ = X.checkEIN(e)

        val (_,code)=S1.genfn(e,einargs,args)
        val DstIL.ASSGN (a1,A)=List.hd(List.rev(code))
        val c=DstIL.ASSGN (y,A)
        in code@[c]
        end

       
	handle ex => (print(concat["error converting  \n"]); raise ex)
	              

  (* expand a SrcIL assignment to a DstIL CFG *)
    fun expand (env, (y, rhs)) = let
	  val y' = Env.rename (env, y)

	  fun assign rhs = [DstIL.ASSGN(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, y', rator, args)))
	      | SrcIL.APPLY(f, args) => assign (DstIL.APPLY(f, Env.renameList(env, args)))
	      | SrcIL.CONS(ty, args) => assign (DstIL.CONS(ty, Env.renameList(env, args)))
          | SrcIL.EINAPP(rator, args) => let
             val _  = (case testing
                of 0  => 1
                | _  => (print(String.concat["\n ------------------------last name",SrcIL.Var.toString(y)]);1)
                (*end case *))
            in
                expandEinOp (env, Env.rename (env, y), rator, args)
            end
		 (* 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.EigenVecs2x2 => DstOp.EigenVecs2x2
                  | SrcOp.EigenVecs3x3 => DstOp.EigenVecs3x3
                  | SrcOp.Print tys => DstOp.Print 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
	    LowILCensus.init prog;
	    prog
	  end

  end

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