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

SCM Repository

[diderot] View of /branches/lamont/src/compiler/c-util/tree-to-c.sml
ViewVC logotype

View of /branches/lamont/src/compiler/c-util/tree-to-c.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3282 - (download) (annotate)
Tue Oct 13 19:46:34 2015 UTC (4 years, 3 months ago) by lamonts
File size: 50214 byte(s)
Fixed bug with dead strands appearing in query lists
(* tree-to-c.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Translate TreeIL to the C version of CLang.
 *)

structure PseudoVars =
  struct
(* TreeIL "variables" that are used to get the names needed to access the
 * global and strand state variables.  These are just used as keys to lookup
 * the C names in the environment, so their kind and type are irrelevant.
 *)
    local
      fun new name = TreeIL.Var.new (name, TreeIL.VK_Local, TreeIL.Ty.IntTy)
    in
    val world = new "$world"
    val global = new "$global"
    val selfIn = new "$selfIn"
    val globalNode = new "$node"
    val selfOut = new "$selfOut"
  (* these are really fields in the world structure, but we use a pseudo variable for them too *)
    val stateIn = new "$stateIn"
    val stateOut = new "$stateOut"
    end (* local *)
  end

structure TreeToC : sig

    type env = CLang.typed_var TreeIL.Var.Map.map

    val empty : env

    val trType : TreeIL.Ty.ty -> CLang.ty

    val trBlock : env * TreeIL.block -> CLang.stm

    val trReduce : env * TreeIL.block * TreeIL.block -> CLang.globalDefs option 
    
    val trFree : env * TreeIL.block -> CLang.stm

    val trFragment : env * TreeIL.block -> env * CLang.stm list

    val trExp : env * TreeIL.exp -> CLang.exp

    val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list

  (* vector indexing support.  Arguments are: vector, arity, index *)
    val ivecIndex : CLang.exp * int * int -> CLang.exp
    val vecIndex : CLang.exp * int * int -> CLang.exp

    val scope : TargetEnv.scope ref 

  end = struct

    structure CL = CLang
    structure N = CNames
    structure IL = TreeIL
    structure Op = IL.Op
    structure Ty = IL.Ty
    structure V = IL.Var
    structure RU = ReductionUtil 
    

    datatype var = datatype CLang.typed_var
    type env = CLang.typed_var TreeIL.Var.Map.map

    val empty = TreeIL.Var.Map.empty

    val scope = ref TargetEnv.NoScope

    fun lookup (env, x) = (case V.Map.find (env, x)
           of SOME(V(_, x')) => x'
            | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
          (* end case *))


    fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
    fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
    fun global env =  CL.mkVar(lookup(env, PseudoVars.global))
    fun world env = CL.mkVar(lookup(env, PseudoVars.world))

  (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
    fun lvalueVar (env, x) = (case V.kind x
           of IL.VK_Local => CL.mkVar(lookup(env, x))
            | _ => CL.mkIndirect(global env, lookup(env, x))
          (* end case *))

  (* translate a variable that occurs in an r-value context *)
    fun rvalueVar (env, x) = (case V.kind x
           of IL.VK_Local => CL.mkVar(lookup(env, x))
            | _ => CL.mkIndirect(global env, lookup(env, x))
          (* end case *))

  (* translate a strand state variable that occurs in an l-value context *)
    fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, IL.StateVar.name x)

  (* translate a strand state variable that occurs in an r-value context *)
    fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, IL.StateVar.name x)

  (* access to the output world strand state *)
    fun stateIn env = CL.mkIndirect(world env, lookup (env, PseudoVars.stateIn))
    fun stateOut env = CL.mkIndirect(world env, lookup (env, PseudoVars.stateOut))

  (* keep track of mean,variance,stdv*) 
  local 
      val stms = ref [] 
  in 
     fun insertReduction(r : CL.stm) = stms :=  r::(!stms)
     fun getReductionStms() = let 
             val stms' = !stms
        in 
            (stms := []; 
             stms')
        end  
  end (* local *) 

  (* integer literal expression *)
    fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)

    fun addrOf e = CL.mkUnOp(CL.%&, e)

  (* translate TreeIL types to CLang types *)
    val trType = CTyTranslate.toType

  (* generate new variables *)
    local
      val count = ref 0
      fun freshName prefix = let
            val n = !count
            in
              count := n+1;
              concat[prefix, "_", Int.toString n]
            end
    in
    fun tmpVar ty = freshName "tmp"
    fun freshVar prefix = freshName prefix
    end (* local *)

  (* translate IL basis functions *)
    local
      fun mkLookup suffix = let
            val tbl = MathFuns.Tbl.mkTable (16, Fail "basis table")
            fun ins f = MathFuns.Tbl.insert tbl (f, MathFuns.toString f ^ suffix)
            in
              List.app ins MathFuns.allFuns;
              MathFuns.Tbl.lookup tbl
            end
      val fLookup = mkLookup "f"
      val dLookup = mkLookup ""
    in
    fun trApply (f, args) = let
          val f' = if !N.doublePrecision then dLookup f else fLookup f
          in
            CL.mkApply(f', args)
          end
    end (* local *)

  (* vector indexing support.  Arguments are: vector, arity, index *)
    fun ivecIndex (v, n, ix) = let
          val e1 = CL.mkCast(CL.T_Named(N.iunionTy n), v)
          val e2 = CL.mkSelect(e1, "i")
          in
            CL.mkSubscript(e2, intExp ix)
          end

    fun vecIndex (v, n, ix) = let
          val e1 = CL.mkCast(CL.T_Named(N.unionTy n), v)
          val e2 = CL.mkSelect(e1, "r")
          in
            CL.mkSubscript(e2, intExp ix)
          end

  (* matrix indexing *)
    fun matIndex (m, ix, jx) =
          CL.mkSubscript(CL.mkSelect(CL.mkSubscript(m, ix), "r"), jx)

  (* Translate a TreeIL operator application to a CLang expression *)
    fun trOp (rator, args) = (case (rator, args)
           of (Op.Add ty, [a, b]) => CL.mkBinOp(a, CL.#+, b)
            | (Op.Sub ty, [a, b]) => CL.mkBinOp(a, CL.#-, b)
            | (Op.Mul ty, [a, b]) => CL.mkBinOp(a, CL.#*, b)
            | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)
            | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)
            | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)
            | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(N.fabs(), args)
            | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])
            | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
            | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
            | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
            | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
            | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
            | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
            | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
            | (Op.Max, args) => CL.mkApply(N.max(), args)
            | (Op.Min, args) => CL.mkApply(N.min(), args)
            | (Op.Clamp(Ty.TensorTy[]), args) => CL.mkApply(N.clamp 1, args)
            | (Op.Clamp(Ty.TensorTy[n]), args) => CL.mkApply(N.clamp n, args)
            | (Op.Lerp ty, args) => (case ty
                 of Ty.TensorTy[] => CL.mkApply(N.lerp 1, args)
                  | Ty.TensorTy[n] => CL.mkApply(N.lerp n, args)
                  | _ => raise Fail(concat[
                        "lerp<", Ty.toString ty, "> not supported"
                      ])
                (* end case *))
            | (Op.Dot d, args) => CL.E_Apply(N.dot d, args)
            | (Op.MulVecMat(m, n), args) =>
                if (1 < m) andalso (m <= 4) andalso (m = n)
                  then CL.E_Apply(N.mulVecMat(m,n), args)
                  else raise Fail "unsupported vector-matrix multiply"
            | (Op.MulMatVec(m, n), args) =>
                if (1 < m) andalso (m <= 4) andalso (m = n)
                  then CL.E_Apply(N.mulMatVec(m,n), args)
                  else raise Fail "unsupported matrix-vector multiply"
            | (Op.MulMatMat(m, n, p), args) =>
                if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
                  then CL.E_Apply(N.mulMatMat(m,n,p), args)
                  else raise Fail "unsupported matrix-matrix multiply"
            | (Op.ColonMul(Ty.TensorTy dd1, Ty.TensorTy dd2), args) =>
                CL.E_Apply(N.colonMul(dd1, dd2), args)
            | (Op.Cross, args) => CL.E_Apply(N.cross(), args)
            | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(N.length n, args)
            | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(N.normMat(m,n), args)
            | (Op.Norm(Ty.TensorTy[m,n,p]), args) => CL.E_Apply(N.normTen3(m,n,p), args)
            | (Op.Normalize d, args) => CL.E_Apply(N.normalize d, args)
            | (Op.Dist d, args) => CL.E_Apply(N.dist d, args)
            | (Op.Scale(Ty.TensorTy[n]), args) => CL.E_Apply(N.scale n, args)
            | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
            | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"
            | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => ivecIndex (a, n, i)
            | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, n, i)
            | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
                val unionTy = CL.T_Named(N.iunionTy n)
                val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
                in
                  CL.mkSubscript(vecExp, ix)
                end
            | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
            | (Op.Subscript(Ty.DynSeqTy ty), [v, ix]) => let
                val elemTy = trType ty
                in
                  CL.mkUnOp (CL.%*,
                    CL.mkCast(CL.T_Ptr elemTy,
                      CL.mkApply("Diderot_DynSeqAddr", [CL.mkSizeof elemTy, v, ix])))
                end
            | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
                val unionTy = CL.T_Named(N.unionTy n)
                val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
                in
                  CL.mkSubscript(vecExp, ix)
                end
            | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, jx]) => matIndex (m, ix, jx)
            | (Op.Subscript ty, t::(ixs as _::_)) =>
                raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
            | (Op.MkDynamic(ty, n), [seq]) => CL.mkApply("Diderot_DynSeqMk", [
                  CL.mkSizeof(trType ty), CL.mkInt(IntInf.fromInt n),
                  addrOf (CL.mkSubscript(seq, intExp 0))
                ])
            | (Op.Append ty, [seq, x]) => CL.mkApply("Diderot_DynSeqAppend", [
                  CL.mkSizeof(trType ty), seq, addrOf x
                ])
            | (Op.Prepend ty, [x, seq]) => CL.mkApply("Diderot_DynSeqPrepend", [
                  CL.mkSizeof(trType ty), addrOf x, seq
                ])
            | (Op.Concat ty, [seq1, seq2]) => CL.mkApply("Diderot_DynSeqConcat", [
                  CL.mkSizeof(trType ty), seq1, seq2
                ])
            | (Op.Length _, [seq]) => CL.mkApply("Diderot_DynSeqLength", [seq])
            | (Op.Ceiling d, args) => CL.mkApply(N.addTySuffix("ceil", d), args)
            | (Op.Floor d, args) => CL.mkApply(N.addTySuffix("floor", d), args)
            | (Op.Round d, args) => CL.mkApply(N.addTySuffix("round", d), args)
            | (Op.Trunc d, args) => CL.mkApply(N.addTySuffix("trunc", d), args)
            | (Op.IntToReal, [a]) => CL.mkCast(!N.gRealTy, a)
            | (Op.RealToInt 1, [a]) => CL.mkCast(!N.gIntTy, a)
            | (Op.RealToInt d, args) => CL.mkApply(N.vecftoi d, args)
            | (Op.ImageAddress info, [a]) => let
                val cTy = CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info))
                in
                  CL.mkCast(cTy, CL.mkIndirect(a, "data"))
                end
            | (Op.LoadVoxels(info, 1), [a]) => let
                val realTy as CL.T_Num rTy = !N.gRealTy
                val a = CL.E_UnOp(CL.%*, a)
                in
                  if (rTy = ImageInfo.sampleTy info)
                    then a
                    else CL.E_Cast(realTy, a)
                end
            | (Op.LoadVoxels _, [a]) =>
                raise Fail("impossible " ^ Op.toString rator)
            | (Op.PosToImgSpace info, [img, pos]) =>
                CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])
            | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
                CL.mkApply(N.toWorldSpace ty, [v, x])
            | (Op.Inside(info, s), [pos, img]) =>
                CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
            | (Op.LoadSeq(ty, nrrd), []) =>
                raise Fail("impossible " ^ Op.toString rator)
            | (Op.LoadImage(ty, nrrd, info), []) =>
                raise Fail("impossible " ^ Op.toString rator)
            | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
            | _ => raise Fail(concat[
                  "unknown or incorrect operator ", Op.toString rator
                ])
          (* end case *))

    fun trExp (env, e) = (case e
           of IL.E_State x => rvalueStateVar (env, x)
            | IL.E_Var x => rvalueVar (env, x)
            | IL.E_Selector(x, f) => CL.mkIndirect(trExp(env, x), Atom.toString f)
            | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !N.gIntTy)
            | IL.E_Lit(Literal.Bool b) => CL.mkBool b
            | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)
            | IL.E_Lit(Literal.String s) => CL.mkStr s
            | IL.E_Op(rator, args) => trOp (rator, trExps(env, args))
            | IL.E_Apply(f, args) => trApply(f, trExps(env, args))
            | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(N.mkVec n, trExps(env, args))
           (* | IL.E_Cons(Ty.SeqTy (ty,len), args) => SeqTy*) 
            | IL.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
          (* end case *))

    and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps

  (* translate an expression to a variable form; return the variable and the
   * (optional) declaration.
   *)
    fun expToVar (env, ty, name, exp) = (case trExp(env, exp)
           of x as CL.E_Var _ => (x, [])
            | exp => let
                val x = freshVar name
                in
                  (CL.mkVar x, [CL.mkDecl(ty, x, SOME(CL.I_Exp exp))])
                end
          (* end case *))

  fun isReduction(exp) = (case exp 
      of  IL.E_Op(Op.R_All _,_) => true
          | IL.E_Op(Op.R_Exists _,_) => true
          | IL.E_Op(Op.R_Max _,_) => true
          | IL.E_Op(Op.R_Min _,_) => true
          | IL.E_Op(Op.R_Sum _,_) =>  true
          | IL.E_Op(Op.R_Product _,_) => true
          | IL.E_Op(Op.R_Mean _,_) =>  true
          | _ => false 
     (* end case *))
  (* translate a print statement *)
    fun trPrint (env, tys, args) = let
        (* assemble the format string by analysing the types and argument expressions *)
          fun mkFmt (Ty.StringTy, IL.E_Lit(Literal.String s), (stms, fmt, args)) =
                (stms, s::fmt, args)
            | mkFmt (ty, exp, (stms, fmt, args)) = let
                fun mk (f, e) = (stms, f::fmt, e::args)
                in
                  case ty
                   of Ty.BoolTy => mk(
                        "%s",
                        CL.mkCond(trExp(env, exp), CL.mkStr "true", CL.mkStr "false"))
                    | Ty.StringTy => mk("%s", trExp(env, exp))
                    | Ty.IntTy => mk(!N.gIntFormat, trExp(env, exp))
                    | Ty.TensorTy[] => mk("%f", trExp(env, exp))
                    | Ty.TensorTy[n] => let
                        val (x, stm) = expToVar (env, trType ty, "vec", exp)
                        val elems = List.tabulate (n, fn i => vecIndex (x, n, i))
                        val (fmt, args) = mkSeqFmt (Ty.TensorTy[], elems, fmt, args)
                        in
                          (stm@stms, fmt, args)
                        end
(*
                    | Ty.TensorTy[n, m] => 
*)
                    | Ty.SeqTy(elemTy, n) =>  let
                        val (x, stm) = expToVar (env, trType ty, "vec", exp)
                        val elems = List.tabulate (n, fn i => ivecIndex (x, n, i))
                        val (fmt, args) = mkSeqFmt (elemTy, elems, fmt, args)
                        in
                          (stm@stms, fmt, args)
                        end
                    | _ => raise Fail(concat["TreeToC.trPrint(", Ty.toString ty, ")"])
                  (* end case *)
                end
          and mkElemFmt (elemTy, elem, (fmt, args)) = (case elemTy
                 of Ty.BoolTy =>
                      ("%s"::fmt, CL.mkCond(elem, CL.mkStr "true", CL.mkStr "false")::args)
                  | Ty.StringTy => ("%s"::fmt, elem::args)
                  | Ty.IntTy => (!N.gIntFormat::fmt, elem::args)
                  | Ty.TensorTy[] => ("%f"::fmt, elem::args)
                  | Ty.TensorTy[n] => let
                      val elems = List.tabulate (n, fn i => vecIndex (elem, n, i))
                      in
                        mkSeqFmt (Ty.TensorTy[], elems, fmt, args)
                      end
(*
                  | Ty.TensorTy[n, m] => 
*)
                  | Ty.SeqTy(elemTy, n) =>  let
                      val elems = List.tabulate (n, fn i => ivecIndex (elem, n, i))
                      in
                        mkSeqFmt (elemTy, elems, fmt, args)
                      end
                  | _ => raise Fail(concat["TreeToC.mkElemFmt(", Ty.toString elemTy, ")"])
                (* end case *))
          and mkSeqFmt (elemTy, elems, fmt, args) = let
                fun mk (elem, acc) = mkFmt(elemTy, elem, acc)
                val (seqFmt, args) =
                      List.foldr
                        (fn (elem, acc) => mkElemFmt(elemTy, elem, acc))
                          ([], args) elems
                in
                  ("<" :: String.concatWith "," seqFmt :: ">" :: fmt, args)
                end
          val (stms, fmt, args) = ListPair.foldr mkFmt ([], [], []) (tys, args)
          val stm = CL.mkCall("fprintf", CL.mkVar "stderr" :: CL.mkStr(String.concat fmt) :: args)
          in
            List.rev (stm :: stms)
          end

    fun trAssign (env, lhs, rhs) = (
        (* certain rhs forms, such as those that return a matrix,
         * require a function call instead of an assignment
         *)
          case rhs
           of IL.E_Op(Op.Add(Ty.TensorTy[m,n]), args) =>
                [CL.mkCall(N.addMat(m,n),  lhs :: trExps(env, args))]
            | IL.E_Op(Op.Sub(Ty.TensorTy[m,n]), args) =>
                [CL.mkCall(N.subMat(m,n),  lhs :: trExps(env, args))]
            | IL.E_Op(Op.Neg(Ty.TensorTy[m,n]), args) =>
                [CL.mkCall(N.scaleMat(m,n),  lhs :: intExp ~1 :: trExps(env, args))]
            | IL.E_Op(Op.Scale(Ty.TensorTy[m,n]), args) =>
                [CL.mkCall(N.scaleMat(m,n),  lhs :: trExps(env, args))]
            | IL.E_Op(Op.MulMatMat(m,n,p), args) =>
                [CL.mkCall(N.mulMatMat(m,n,p), lhs :: trExps(env, args))]
            | IL.E_Op(Op.SphereQuery _, args) => let 
                val [pos,radius] = trExps(env, args)
                in [
                  CL.mkAssign(
                    lhs,
                    CL.mkApply(N.sphereQuery, [
                        world env, 
                        pos,
                        selfIn env,
                        CL.mkVar N.queryPoolName,
                        radius
                      ]))
                ] end
            | IL.E_Op(Op.MulVecTen3(m, n, p), args) =>
                if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
                  then [CL.mkCall(N.mulVecTen3(m,n,p), lhs :: trExps(env, args))]
                  else raise Fail "unsupported vector-tensor multiply"
            | IL.E_Op(Op.MulTen3Vec(m, n, p), args)  =>
                if (1 < m) andalso (m <= 4) andalso (m = n) andalso (n = p)
                  then [CL.mkCall(N.mulTen3Vec(m,n,p), lhs :: trExps(env, args))]
                  else raise Fail "unsupported tensor-vector multiply"
            | IL.E_Op(Op.ColonMul(Ty.TensorTy dd1, Ty.TensorTy dd2), args) =>
                if (length dd1 + length dd2 > 5)
                  then [CL.mkCall(N.colonMul(dd1, dd2), lhs :: trExps(env, args))]
                  else [CL.mkAssign(lhs, trExp(env, rhs))]
            | IL.E_Op(Op.EigenVals2x2, [m]) => let
                val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
                in
                  stms @ [CL.mkCall(N.evals2x2, [
                      lhs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1)
                    ])]
                end
            | IL.E_Op(Op.EigenVals3x3, [m]) => let
                val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
                in
                  stms @ [CL.mkCall(N.evals3x3, [
                      lhs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 0, CL.mkInt 2),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 2),
                      matIndex (m, CL.mkInt 2, CL.mkInt 2)
                    ])]
                end
           (* | IL.E_Op(Op.R_Variance ty , [arg0,arg1,sx,setVar,meanVar]) => let 
                val seqVar = trExp(env,setVar)
                val elemVar = trExp(env,sx)   
                val iterVarName = freshVar "tmp" 
                val dynSeqSize = CL.mkIndirect(seqVar,"nElems")
                val elemVar = let
		                             val elemTy = trType ty
		                         in
		                                   CL.mkAssign(elemVar,CL.mkUnOp (CL.%*,
		                                     CL.mkCast(CL.T_Ptr elemTy,
		                                        CL.mkApply("Diderot_DynSeqAddr", 
                                                      [CL.mkSizeof elemTy, trExp(env,setVar), CL.mkVar  iterVarName]))))
                                end 
                val diff =CL.mkBinOp(trExp(env,arg1), 
                                                   CL.#-, 
                                                   trExp(env,meanVar))
                val assignReduction = CL.S_Exp(CL.mkAssignOp(lhs,CL.+=,CL.mkBinOp(diff,CL.#*,diff)))
                val divAssign = CL.S_Exp(CL.mkAssignOp(lhs,CL./=,CL.mkIndirect(seqVar,"nElems")))
                val forBlock = CL.mkFor([(CL.uint32, iterVarName, CL.mkInt(0))],
                                  CL.mkBinOp(CL.mkVar(iterVarName), CL.#<, dynSeqSize),
                                  [CL.mkPostOp(CL.mkVar(iterVarName), CL.^++)],
                                  CL.mkBlock([elemVar,assignReduction]))
		in [
		  CL.mkAssign(lhs, trExp(env, arg0)),
		  forBlock,
		  divAssign
		] end*) 
            | IL.E_Op(Op.Identity n, args) =>
                [CL.mkCall(N.identityMat n, [lhs])]
            | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
                [CL.mkCall(N.zeroMat(m,n), [lhs])]
            | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy(_::_::_)), args) =>
                [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]
            | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
                if (n > 1)
                  then let
                    val stride = ImageInfo.stride info
                    val rTy = ImageInfo.sampleTy info
                    val vp = freshVar "vp"
                    val needsCast = (CL.T_Num rTy <> !N.gRealTy)
                    fun mkLoad i = let
                          val e = CL.mkSubscript(CL.mkVar vp, intExp(i*stride))
                          in
                            if needsCast then CL.mkCast(!N.gRealTy, e) else e
                          end
                    in [
                      CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), vp, SOME(CL.I_Exp(trExp(env, a)))),
                      CL.mkAssign(lhs,
                        CL.mkApply(N.mkVec n, List.tabulate (n, mkLoad)))
                    ] end
                else [CL.mkAssign(lhs, trExp(env, rhs))]
            | IL.E_Cons(Ty.TensorTy[n,m], args) => let
              (* matrices are represented as arrays of union<d><ty>_t vectors *)
                fun doRows (_, []) = []
                  | doRows (i, e::es) =
                      CL.mkAssign(CL.mkSelect(CL.mkSubscript(lhs, intExp i), "v"), e)
                        :: doRows (i+1, es)
                in
                  doRows (0, trExps(env, args))
                end
            | IL.E_Cons(Ty.TensorTy[n,m,l], args) => let
              (* 3rd-order tensors are represented as 2D arrays of union<d><ty>_t vectors *)
                fun lp1 (i, [], code) = code
                  | lp1 (i, e::es, code) = let
                      val lhs_i = CL.mkSubscript(lhs, intExp i)
                      fun lp2 j = if (j < m)
                            then CL.mkAssign(
                                CL.mkSelect(CL.mkSubscript(lhs_i, intExp j), "v"),
                                CL.mkSelect(CL.mkSubscript (e, intExp j), "v")
                              ) :: lp2(j+1)
                            else code
                      in
                        lp1 (i+1, es, lp2 0)
                      end
                in
                  lp1 (0, trExps(env, args), [])
                end
            | IL.E_Cons(Ty.SeqTy(ty, n), args) => let
                fun doAssign (_, []) = []
                  | doAssign (i, arg::args) =
                      CL.mkAssign(CL.mkSubscript(lhs, intExp i), arg) :: doAssign(i+1, args)
                in
                  doAssign (0, trExps(env, args))
                end
            | IL.E_State x => (case IL.StateVar.ty x
                 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueStateVar(env, x)])]
                  | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, rvalueStateVar(env, x)])]
                  | _ => [CL.mkAssign(lhs, rvalueStateVar(env, x))]
                (* end case *))
            | IL.E_Var x => (case IL.Var.ty x
                 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueVar(env, x)])]
                  | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, rvalueVar(env, x)])]
                  | _ => [CL.mkAssign(lhs, rvalueVar(env, x))]
                (* end case *))
            | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
          (* end case *))

    fun trMultiAssign (env, lhs, IL.E_Op(rator, args)) = (case (lhs, rator, args)
           of ([vals, vecs], Op.EigenVecs2x2, [m]) => let
                val (m, stms) = expToVar (env, CL.T_Named(N.matTy(2,2)), "m", m)
                in
                  stms @ [CL.mkCall(N.evecs2x2, [
                      vals, vecs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1)
                    ])]
                end
            | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
                val (m, stms) = expToVar (env, CL.T_Named(N.matTy(3,3)), "m", m)
                in
                  stms @ [CL.mkCall(N.evecs3x3, [
                      vals, vecs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 0, CL.mkInt 2),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 2),
                      matIndex (m, CL.mkInt 2, CL.mkInt 2)
                    ])]
                end
            | ([], Op.Print tys, args) => trPrint (env, tys, args)
            | _ => raise Fail "bogus multi-assignment"
          (* end case *))
      | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"

   fun rIdentity r = case r 
     of "all" => CL.E_Bool(true)
      | "exists" => CL.E_Bool(false)
      | "min" => CL.mkFlt(FloatLit.posInf,CL.float)
      | "max" => CL.mkFlt(FloatLit.negInf,CL.float)
      | "product" => CL.mkFlt(FloatLit.fromInt 1,CL.float)
      | "sum" => CL.mkFlt(FloatLit.fromInt 0,CL.float)
      | "mean" => CL.mkFlt(FloatLit.fromInt 0,CL.float)
      | _ => raise Fail(concat["Could not find reduction kind but found:",r])

    fun trReduction (env, lhs, rhs) = let 
      val lhs' = CL.mkIndirect(CL.mkVar "node",lookup(env,lhs))
      val globallhs = lvalueVar (env, lhs)
      fun assignReduction (lhs,env,v,kind,rStm) = let 
        val kind = trExp(env,kind)
        val v' = trExp(env,v) 
        val cond = (case kind
           of CL.E_Str("all") => CL.mkBinOp(CL.mkBinOp(CL.mkSubscript(CL.mkVar("status"),CL.mkVar(N.reduceIterVar)), CL.#==, CL.mkVar(N.kActive)), 
                 CL.#||, CL.mkBinOp(CL.mkSubscript(CL.mkVar("status"),CL.mkVar(N.reduceIterVar)), CL.#==, CL.mkVar(N.kStable))) 
           | CL.E_Str("active") => CL.mkBinOp(CL.mkSubscript(CL.mkVar("status"),CL.mkVar(N.reduceIterVar)), CL.#==, CL.mkVar(N.kActive))
           | CL.E_Str("stable") => CL.mkBinOp(CL.mkSubscript(CL.mkVar("status"),CL.mkVar(N.reduceIterVar)), CL.#==, CL.mkVar(N.kStable))
           (* end case *))
        in 
            [CL.mkIfThen(cond,CL.mkBlock[rStm])]
        end
      in  ( case rhs
           of IL.E_Op(Op.R_All ty,[rExpr,v,kind]) => let 
               val rStm = CL.S_Exp(CL.mkAssignOp(lhs',CL.&=, CL.mkGrp(trExp(env,rExpr))))
               in 
                  assignReduction(lhs',env,v,kind,rStm) 
               end
            | IL.E_Op(Op.R_Exists ty,[rExpr,v,kind]) => let 
               val rStm = CL.S_Exp(CL.mkAssignOp(lhs',CL.|=, CL.mkGrp(trExp(env,rExpr))))
               in 
                  assignReduction(lhs',env,v,kind,rStm) 
               end 
            | IL.E_Op(Op.R_Max ty,[rExpr,v,kind]) => let 
               val rStm = CL.mkAssign(lhs',CL.mkApply((N.max ()),[lhs',trExp(env,rExpr)]))
               in 
                   assignReduction(lhs',env,v,kind,rStm) 
               end 
            | IL.E_Op(Op.R_Min ty,[rExpr,v,kind]) => let 
               val rStm = CL.mkAssign(lhs',CL.mkApply((N.min ()),[lhs',trExp(env,rExpr)]))
               in 
                  assignReduction(lhs',env,v,kind,rStm) 
               end 
            | IL.E_Op(Op.R_Sum ty,[rExpr,v,kind]) => let 
               val rStm = CL.S_Exp(CL.mkAssignOp(lhs',CL.+=, trExp(env,rExpr)))
               in 
                  assignReduction(lhs',env,v,kind,rStm) 
               end 
            | IL.E_Op(Op.R_Product ty,[rExpr,v,kind]) => let 
               val rStm = CL.S_Exp(CL.mkAssignOp(lhs',CL.*=, trExp(env,rExpr)))
               in 
                  assignReduction(lhs',env,v,kind,rStm) 
               end 
            | IL.E_Op(Op.R_Mean ty,[rExpr,v,kind]) => let 
              val rStm = CL.S_Exp(CL.mkAssignOp(lhs',CL.+=, trExp(env,rExpr))) 
              val denominator = (case trExp(env,kind)
                  of CL.E_Str("all") => CL.mkGrp(CL.mkBinOp(CL.mkVar "numActive", 
                                                CL.#+ ,CL.mkVar "numStable"))
              | CL.E_Str("active") => CL.mkVar "numActive"
              | CL.E_Str("stable")  =>CL.mkVar "numStable"
                (* end case *))
               in 
                  (insertReduction(CL.S_Exp(CL.mkAssignOp(globallhs,CL./=,denominator))); 
                  assignReduction(lhs',env,v,kind,rStm)) 
               end 
            | _ => trAssign (env, lvalueVar (env, lhs), rhs)
            (* end case *))
      end 
    fun trLocals (env : env, locals) = 
          List.foldl
            (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))
              env locals

  (* generate code to check the status of runtime-system calls; this code assumes that
   * we are in a function with a boolean return type
   *)
    fun checkSts mkDecl = let
          val sts = freshVar "sts"
          in
            mkDecl sts @
            [CL.mkIfThen(
              CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
              CL.mkReturn(SOME(CL.mkVar "true")))]
          end

  (* given the global initialization code, generate code to free the storage that is heap
   * allocated for globals.
   *)
    fun trFree (env, IL.Block{locals, body}) = let
          val env = trLocals (env, locals)
          fun trStmt (env, stm) = (case stm
                 of IL.S_Comment text => [CL.mkComment text]
                  | IL.S_LoadNrrd _ => [] (* FIXME *)
                  | IL.S_InputNrrd _ => [] (* FIXME *)
                  | _ => []
                (* end case *))
          val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body
          fun mkDecl (x, stms) = (case V.Map.find (env, x)
                 of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
                  | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
                (* end case *))
          val stms = List.foldr mkDecl stms locals
          in
            CL.mkBlock stms
          end

    fun trStms (env, stms) =  List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
    
    and  trStmt (env, stm) = (case stm
         of IL.S_Comment text => [CL.mkComment text]
          | IL.S_Assign([x], exp) => if isReduction(exp)
            then trReduction (env, x, exp)
            else trAssign (env, lvalueVar (env, x), exp)
          | IL.S_Assign(xs, exp) =>
              trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp)
          | IL.S_IfThen(cond, thenBlk) =>
              [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]
          | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
              [CL.mkIfThenElse(trExp(env, cond),
                trBlk(env, thenBlk),
                trBlk(env, elseBlk))]
          | IL.S_Foreach(cond, block, _) => trForeach(env, cond, block)
          | IL.S_New (strand,args) => let
    (* FIXME: the translation of "new" should probably be target-dependent or else abstracted into a constructor function *)
              val sStrand = Atom.toString strand
    (* allocate the strand from the pool *)
              val newStrandIdxName = freshVar "idx"
              val allocStrandStm = CL.mkDeclInit(CL.int32, newStrandIdxName,
                    CL.mkApply(N.allocNewStrand sStrand, [world env]))
    (* memcpy statment to copy the outstate to the instate *) 
    val memcpyStm = CL.mkCall("memcpy", [CL.mkSubscript(stateIn env,CL.mkVar newStrandIdxName), 
    									 CL.mkSubscript(stateOut env,CL.mkVar newStrandIdxName), 
    									 CL.mkVar "wrld->strandDesc[0].stateSzb"]) 
    (* initialize the strand *)
      val initStmSingleState = CL.mkCall(N.strandInit sStrand,
        global env
        :: CL.mkUnOp(CL.%&, CL.mkSubscript(stateOut env, CL.mkVar newStrandIdxName))
        :: trExps(env, args))
       val initStmDualState = CL.mkCall(N.strandInit sStrand,
        global env
        :: CL.mkSubscript(stateOut env, CL.mkVar newStrandIdxName)
        :: trExps(env, args))
        val initStms = [ CL.S_Verbatim(["#ifdef DIDEROT_DUAL_STATE"]),
        				 initStmDualState,
        				 memcpyStm,
        			     CL.S_Verbatim(["#else"]),
        			     initStmSingleState, 
        			     CL.S_Verbatim(["#endif"])
        				]
              in 
    			allocStrandStm::initStms
              end 
          | IL.S_Save([x], exp) => trAssign (env, lvalueStateVar(env, x), exp)
          | IL.S_Save(xs, exp) =>
              trMultiAssign (env, List.map (fn x => lvalueStateVar(env, x)) xs, exp)
          | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) =>
              [GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)]
          | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
              [GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.E_Str nrrd)]
          | IL.S_Input(_, _, _, NONE) => []
          | IL.S_Input(lhs, name, _, SOME dflt) => [
                CL.mkAssign(lvalueVar(env, lhs), trExp(env, dflt))
              ]
          | IL.S_InputNrrd _ => []
          | IL.S_Exit args => []
          | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
          | IL.S_Stabilize => let
              val stms' = case !scope 
                of TargetEnv.GlobalScope => [CL.mkAssign(CL.mkVar("StabalizeAllStrands"), CL.mkBool(true))]
                 | _ => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
          in
            stms' 
          end  
          | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]
        (* end case *))
            
    and trForeach (env, cond, b as IL.Block{locals, body}) = let 
          val foreachStms = trBlk(env,b)
          val condVar = trExp(env, cond)
          val iterVarName = freshVar "tmp" 
          val dynSeqSize = CL.mkIndirect(condVar, "nElems")
          in [
            CL.mkFor(
              [(CL.uint32, iterVarName, CL.mkInt 0)],
              CL.mkBinOp(CL.mkVar iterVarName, CL.#<, dynSeqSize),
              [CL.mkPostOp(CL.mkVar iterVarName, CL.^++)],
              foreachStms)
          ] end 

    and trBlk (env, IL.Block{locals, body}) = let
          val env = trLocals (env, locals)
          val stms = trStms (env, body)
          fun mkDecl (x, stms) = (case V.Map.find (env, x)
                 of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
                  | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
                (* end case *))
          val stms = List.foldr mkDecl stms locals
          in
            CL.mkBlock stms
          end

    fun trGlobal(env,(glocals,rlocals),gbody,pbs,rIdentities) = let 
        (* Generates call statements to the Reduction function based on the phase *)
        fun genPhaseCallStms(phaseNum) = let 
            val barrierVarInit = CL.mkUnOp(CL.%&,CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld","sched"),"barrier"))
            val barrierVar = CL.mkUnOp(CL.%&,CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld","globSched"),"barrier"))
          in 
            if phaseNum = 0  
            then [CL.mkCall(N.globalReduceStartFn,[CL.mkVar "wrld", CL.mkVar "workerId"]), 
                  CL.S_Verbatim(["#endif"]),
                  CL.mkCall(N.globalReduceBroadcastFn,[barrierVarInit]), 
                  CL.S_Verbatim(["#ifdef DIDEROT_TARGET_PARALLEL"]),
                  CL.mkAssign(CL.mkIndirect(global env,"phase"),CL.mkInt phaseNum)]
            else 
                  [CL.mkCall(N.globalReduceStartFn,[CL.mkVar "wrld", CL.mkVar "workerId"]), 
                   CL.S_Verbatim(["#endif "]),
                   CL.mkCall(N.globalReduceBroadcastFn,[barrierVar]), 
                   CL.S_Verbatim(["#ifdef DIDEROT_TARGET_PARALLEL"]),
                   CL.mkAssign(CL.mkIndirect(global env,"phase"),CL.mkInt phaseNum)]
          end 
        (* Inserts the phase calls into the global function's statements (i.e. we need to figure out where in the global 
           function to perform our phase reductions) *)
        fun insertPhases(stms,[],_) = trStms(env,stms)
          | insertPhases([],pbs,phaseNum) = let 
                 val(stms,_) = List.foldr(fn ((pStms,_,_),(stms,phaseNum)) => 
                              (genPhaseCallStms(phaseNum) @stms,phaseNum + 1)) ([],phaseNum) pbs 
                in 
                    List.rev(stms) 
                end  
          | insertPhases(stm::stms,(pStms,fr,globals)::pbs,phaseNum) = (case stm
                (* Check to see if the expression contains a global reduction variable if so 
                   we need to perform a reduction phase *)
                of IL.S_Assign([x], exp) => if RU.find(x,exp,globals) 
                    then
                        let
                            val updatePhase = CL.mkAssign(CL.mkIndirect(global env,"phase"),CL.mkInt phaseNum)
                            val reduceCall = CL.mkCall(N.globalReduceStartFn,[CL.mkVar "wrld", CL.mkVar "workerId"])
                            val stms' = trStmt(env,stm)
                        in
                            ((List.rev(genPhaseCallStms(phaseNum)))@stms')@ insertPhases(stms,pbs,phaseNum + 1)
                        end
                    else trStmt(env,stm) @ insertPhases(stms,(pStms,fr,globals)::pbs,phaseNum)
                 |  _ => trStmt(env,stm) @ insertPhases(stms,(pStms,fr,globals)::pbs,phaseNum)
                (* end case*))
        (* Generates the statements for the global node assignments 
           e.g.  wrld->gNode.reduceVar "OP" node->reduceVar , where "OP" = += | &= | *= | etc..
           *)
        fun nodeAssigns((_,_,globals),(stms,phase)) = let 
            fun parNodelValue(field) = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "gNode"),field) 
            val aStms = List.foldr (fn ((x,rkind),stms) => RU.rToAssignStm(parNodelValue(V.name x), CL.mkIndirect(CL.mkVar "node", V.name x),rkind)::stms) [] globals
          in 
            (CL.mkIfThen(CL.mkBinOp(CL.mkVar "phase", CL.#==, CL.mkInt phase),CL.mkBlock(aStms))::stms, phase  + 1)
          end
        
        fun convertGlobals((_,_,globals),vars) = (List.map (fn ((x,kind)) => (trType(V.ty x),V.name x)) globals) @ vars 
      
        fun finalReductions((_,fReduction,_),stms) = case (fReduction) 
                of SOME(x) => x::stms 
                 | NONE => stms 
                        
        fun mkDecl (x, stms) = (case V.Map.find (env, x)
            of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
             | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
        (* end case *))
        val finalReduceExtras = [CL.S_Verbatim(["#ifdef DIDEROT_TARGET_PARALLEL"]),
                                CL.mkDecl(CL.uint32, "numActive", SOME(CL.I_Exp(CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld","sched"), "numActive")))),
                                CL.mkDecl(CL.uint32, "numStable", SOME(CL.I_Exp(CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld","sched"), "numStable")))),
                                 CL.S_Verbatim(["#else"]), 
                                 CL.mkDecl(CL.uint32, "numActive", SOME(CL.I_Exp(CL.mkIndirect(CL.mkVar "wrld","numActive")))),
                                 CL.mkDecl(CL.uint32, "numStable", SOME(CL.I_Exp(CL.mkIndirect(CL.mkVar "wrld","numStable")))),
                                 CL.S_Verbatim(["#endif"])]
          
          (*  Inserts the phase calls into the global block *)
          val gstms = List.foldr mkDecl (insertPhases(gbody,pbs,0)) glocals
          (* combines all the reduction phase blocks into a single list *)
          val rstms = List.foldr mkDecl (List.foldr (fn ((pStm,_,_),stms) => pStm::stms) [] pbs) rlocals
         (* Combines all the world-node to node assignments from their phase blocks into a single list *)
          val (astms,_) = List.foldl nodeAssigns ([],0) pbs 
         (* Combines all the final assignment from their phase blocks into a single list *) 
          val fstms  = List.foldr finalReductions [] pbs 
          val globalList = List.foldl  convertGlobals [] pbs 
        in 
            SOME(CL.GBlock { 
                gBlock = CL.mkBlock gstms,
                rBlock = CL.mkBlock rstms,
                aBlock = CL.mkBlock astms,
                fBlock = CL.mkBlock (finalReduceExtras @ fstms),
                rIdentBlock = CL.mkBlock(rIdentities), 
                reduceGlobals = globalList
            })
        end  

    fun trReduce (env, IL.Block gb,IL.ReduceBlock b) = case (#locals b) 
          of [] => let (* No Global Reduce *)
               val gBlock = trBlk(env,IL.Block gb)
             in
               (case gBlock 
               of CL.S_Block([]) => NONE 
                |  _ => SOME(CL.GBlock { 
                  gBlock = gBlock,
                  rBlock = CL.mkBlock ([]),
                  aBlock = CL.mkBlock ([]),
                  fBlock = CL.mkBlock ([]),
                  rIdentBlock = CL.mkBlock ([]), 
                  reduceGlobals = []
                }) 
              (*end case *))
             end 
           | _  => let
               (* Retrieve the local variables for the global function and reduction function *)
               val (locals,body) = (#locals b, #body b)
               val (glocals,gbody) = (#locals gb, #body gb)
               val env = trLocals (env, glocals)
               (* Find the type of the Strand for a program *)
               val strandVar = List.find (fn (x) => case (V.ty x)  
                                            of Ty.StrandSeqTy(_) => true 
                                             | _ => false) locals

               val tStrandty = (case strandVar
                                of SOME x' => V.ty x'
                                | NONE => raise Fail(concat["trReduce no strand type found"]))
               (* Create a new Variable that will be a "pointer" to a strand *)
               val reduceVar = IL.Var.new(N.reduceStrand,IL.VK_Local,tStrandty)
               val locals = reduceVar::locals
               val env = trLocals (env,locals)
               (* Keeps track of all the variables that are assigned to be a reduction expression *)
               val globalReduceVars = ref [] 
               (* Converts a global variable into a global node variable *)
               fun parNodelValue(field) = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld","gNode"),field) 

               (* Parse through a phase block *)
               fun trPhaseBlock(IL.PBlock{iStms,lStms,rStms,globals},prevLocalStms,phase) = let 
                   (* Resigns a variable that has a strand type to point to our previously created reduction variable (i.e., reduceVar)
                      e.g.:  Readuction l_t_3 = 0 =>  Reduction l_t_3 = reduceVar 
                    *) 
                   fun reassingReduceStm x = case x 
                       of IL.S_Assign([x], IL.E_Lit e) => (case (List.find (fn x' => (IL.Var.name x) = (IL.Var.name x')) locals)
                           of SOME _ => (IL.S_Assign([x],IL.E_Var reduceVar))
                           | NONE =>IL.S_Assign([x], IL.E_Lit e) 
                           (* end case *)) 
                        | stmt => stmt  
                  (* Add the local statements from the previous phase to this current phase. Variables can be shared through phases *)
                   val lStms' = prevLocalStms @ trStms (env, List.map reassingReduceStm lStms)
                   val _ =  globalReduceVars :=  (!globalReduceVars) @ globals
                   val stmts = lStms' @ trStms (env, rStms)
                   (* The following code produces the for loop and assigned the reduceVar to a strand in the strand array. It also creates
                       the if statement for this particular phase *) 
                   val iterVarName = CL.mkVar N.reduceIterVar
                   val size = CL.mkIndirect(CL.mkVar "wrld", "numStrands") 
                   val iterStrandStms = [
                       CL.S_Verbatim(["#ifdef DIDEROT_DUAL_STATE"]),
			               CL.mkAssign(CL.mkVar N.reduceStrand,
			               CL.mkSubscript(CL.mkVar "state", CL.mkVar N.reduceIterVar)),
                       CL.S_Verbatim(["#else"]), 
			               CL.mkAssign(CL.mkVar N.reduceStrand,
			               CL.mkUnOp(CL.%&, CL.mkSubscript(CL.mkVar "state", CL.mkVar N.reduceIterVar))), 
                       CL.S_Verbatim(["#endif"])]
                   val loop = CL.mkFor(
                       [(CL.uint32, N.reduceIterVar, CL.mkVar "start")],
                       CL.mkBinOp(iterVarName, CL.#<, CL.mkVar "end"),
                       [CL.mkPostOp(iterVarName, CL.^++)],
                       CL.mkBlock(iterStrandStms @ stmts))
                  val phaseIf = CL.mkIfThen(CL.mkBinOp(CL.mkVar "phase", CL.#==, CL.mkInt phase),CL.mkBlock([loop]))  
                  (* The following code handles situtations where a reduction is embedded inside other expressions. Once the reduction is computed 
                      it could be used further inside an expression. 
                      e.g.: gSum = (sum{....} + 4) + 10  
                  *)
                  val finalAssigns = List.foldr (fn ((x,rkind),stms) => CL.mkAssign(CL.mkIndirect(CL.mkVar "glob", V.name x),parNodelValue(V.name x))::stms) [] globals
                  val finalReduction = case ( finalAssigns @ getReductionStms()) 
                            of [] => NONE 
                             | stms => SOME(CL.mkIfThen(CL.mkBinOp(CL.mkVar "phase", CL.#==, CL.mkInt phase),CL.mkBlock(stms))) 
                in
                    (lStms', (phaseIf,finalReduction,globals))
                end
                (* Parses through the phase blocks and generates the code for the phase *)
                val (_,pbs,_) =  List.foldl (fn(pBlock,(prevStms,stms,phase)) => let 
                                               val (prevLocalStms',stm) = trPhaseBlock(pBlock,prevStms,phase)
                                               in
                                                   (prevLocalStms', stm::stms,phase+1)
                                               end) ([],[],0) body
                (* Initializes the reduction variables that are inside a reduction node to their identity expressions *)
                fun initNode(x,kind,stms) = let 
                    val rIdentExp = rIdentity(kind)
                  in 
                    CL.mkAssign(CL.mkIndirect(CL.mkVar "node", V.name x),rIdentExp)::stms 
                  end 
                                               
                 val rIdentities = List.foldr (fn((x,kind),stms)=>initNode(x,kind,stms)) [] (!globalReduceVars)
              in 
                   trGlobal(env,(glocals,locals),gbody,List.rev(pbs),rIdentities)
              end

    fun trFragment (env, IL.Block{locals, body}) = let
          val env = trLocals (env, locals)
          val stms = trStms (env, body)
          fun mkDecl (x, stms) = (case V.Map.find (env, x)
                 of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
                  | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
                (* end case *))
          val stms = List.foldr mkDecl stms locals
          in
            (env, stms)
          end

    val trBlock = trBlk

  end

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