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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3686 - (download) (annotate)
Fri Feb 26 16:01:37 2016 UTC (4 years, 7 months ago) by cchiw
File size: 9025 byte(s)
added einsurface
(* 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 EtLow = EinToLowSet
    structure LowToS = LowToString

    val testing = 0
    fun testp c=(case testing
        of 0 => 1
        | _  => (print(String.concat(c));1)
        (*end case*))
    val cleanflag=false
  (* 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 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)
        | SrcOp.Sqrt=>assign DstOp.Sqrt
        | 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.Kernel h => assign(DstOp.Kernel h)
        | SrcOp.Inside info => assign (DstOp.Inside info)
        | SrcOp.LoadImage(ty, nrrd, info) => assign (DstOp.LoadImage(ty, nrrd, info))
        | SrcOp.Input inp => assign (DstOp.Input inp)
        (*| SrcOp.Norm ty => assign (DstOp.Norm ty)*)
        | SrcOp.Normalize d => assign (DstOp.Normalize d)
        | 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


    fun cleanup code =let
        val tbl0= lowSet.LowSet.empty
        fun getSet([],done,_,cnt)=(done,cnt)
          | getSet( DstIL.ASSGN(lhs,rhs)::es,done,opset,cnt)=let
            val (opset,var) = lowSet.filter(opset,(lhs,rhs))
            in  (case var
                of NONE => getSet(es,done@[DstIL.ASSGN(lhs,rhs)], opset,cnt)
                | SOME v=> (("replacing"^DstIL.Var.toString(lhs));getSet(es,done@[DstIL.ASSGN(lhs,DstIL.VAR v)], opset,cnt+1))
                (*end case*))
            end
          | getSet (e1::es, done, opset,cnt)=getSet(es,done@[e1],opset,cnt)

        val _=testp["creating set"]
        val (code,cnt)=getSet(code, [],tbl0,0)
        val _ = testp[" post creating set"]
        val n=length(code)

        val _ = if (cnt> 5)
            then  testp["\n Length: ",Int.toString n," Replaced: ", Int.toString cnt,"\n"]
            else   testp[]

        val _ = testp["DONE"]
        in code end

 fun getUse (LowIL.V{useCnt, ...}) =Int.toString(!useCnt)
    fun expandEinOp(env, y, e, args) = let
        val einargs=Env.renameList(env, args)

val _ =  ["\n",DstTy.toString(DstIL.Var.ty y)]

        val _ = print(String.concat["\n\n***************************\n",DstTy.toString(DstIL.Var.ty y), "-",DstIL.Var.toString(y),"(",getUse(y),")"])
        val _ = print(String.concat["=",P.printerE(e)])
        val _ =print(String.concat(List.map (fn e=> (DstIL.Var.toString(e)^"("^getUse(e)^"),")) einargs))

        (*val _=checkEin.checkEIN e*)

        fun incUse (LowIL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
        val _= List.map incUse einargs;

        val code = Curent.scan(y,e,einargs)
        val n=length(code)
(*
        val _ = testp["\n\tcnt(",Int.toString(n),")\n"]
        val _=List.map (fn LowIL.ASSGN(lhs,rhs)=>testp["\n",LowIL.Var.toString(lhs),"(", getUse(lhs),")"]) code
        val _=List.map (fn e=> ( LowToString.toStringAll(DstTy.realTy,e))) code
*)
        in
            code
        end
	handle ex => (print(concat["error converting  \n",P.printerE(e)]); raise ex)
(*
    fun expandEinOp5(env, y, rhs) = let

        val pieces = handleEin.expandEinOp rhs

        val newbies= List.map  (fn (SrcIL.ASSGN(y,SrcIL.EINAPP(ein1,arg1)))=> expandEinOp(env, Env.rename(env,y),ein1,arg1)) pieces
        val flatcode= List.foldr op@ [] newbies
        val _ = testp["\ncreated:",Int.toString(length newbies),"flatcode:",Int.toString(length flatcode)]
        val flatcode= (case cleanflag
            of true =>  let
                        val flatcode =cleanup flatcode
                        val _ = (String.concat["\ncleancode:",Int.toString(length flatcode)])
                        in flatcode end
            | _ =>flatcode
            (*end case*))
        in flatcode end
*)

  (* expand a SrcIL assignment to a DstIL CFG *)
    fun expand (env, (y, rhs)) = let
      (*val _=testp["\nAttempting var",SrcIL.Var.toString y,"\n"]*)
      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) => expandEinOp (env, Env.rename (env, y), rator, args)
(*
          | SrcIL.EINAPP(rator, args) => expandEinOp5 (env, y, (y,rhs))
*)
          (* 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 _ ="pre translate"
	  val prog = Trans.translate prog
      val _ ="post translate"
	  in
	    LowILCensus.init prog;
	    prog
	  end

  end

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