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

SCM Repository

[diderot] View of /branches/vis12-cl/src/compiler/cl-target/tree-to-cl.sml
ViewVC logotype

View of /branches/vis12-cl/src/compiler/cl-target/tree-to-cl.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3159 - (download) (annotate)
Sat Mar 28 09:40:50 2015 UTC (4 years, 1 month ago) by jhr
File size: 20706 byte(s)
  bug fixes for images in OpenCL target
(* tree-to-cl.sml
 *
 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Translate TreeIL to the OpenCL version of CLang.
 *)

structure TreeToCL : sig

    datatype var = V of (CLang.ty * CLang.var)

    type env = var TreeIL.Var.Map.map

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

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

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

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

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

  end = struct

    structure CL = CLang
    structure N = OCLNames
    structure IL = TreeIL
    structure Op = IL.Op
    structure Ty = IL.Ty
    structure V = IL.Var

    datatype var = datatype CLang.typed_var

    type env = var TreeIL.Var.Map.map

    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 *))

    local
      fun global env = CL.mkVar(lookup(env, PseudoVars.global))
      fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
      fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
    in
  (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
    fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))

  (* translate a variable that occurs in an r-value context *)
    fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))

  (* translate a global variable *)
    fun lvalueGlobalVar (env, x) = CL.mkIndirect(global env, IL.GlobalVar.name x)
    val rvalueGlobalVar = lvalueGlobalVar

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

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

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

  (* 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 *)
    fun trApply (f, args) = CL.mkApply(MathFuns.toString f, args)

  (* vector indexing support.  Arguments are: vector, index *)
    local
      val fields = Vector.fromList [
              "s0", "s1", "s2", "s3",
              "s4", "s5", "s6", "s7",
              "s8", "s9", "sa", "sb",
              "sc", "sd", "se", "sf"
            ]
    in
    fun vecIndex (v, ix) = CL.mkSelect(v, Vector.sub(fields, ix))
    end

    fun unionTy n = CL.T_Named(concat["union", Int.toString n, !CNames.gRealSuffix, "_t"])

  (* matrix indexing *)
    fun matIndex (m, ix, jx) = CL.mkSelect(CL.mkSubscript(m, ix), concat["s",jx])

  (* translate a state-variable use *)
    fun trStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfIn", name)

    fun castArgs ty = List.map (fn e => CL.mkCast(ty, e))

  (* 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.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, castArgs (!N.gRealTy) args)
            | (Op.Min, args) => CL.mkApply(N.min, castArgs (!N.gRealTy) args)
            | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(N.clamp, [x, lo, hi])
            | (Op.Lerp ty, args) => (case ty
                 of Ty.TensorTy[] => CL.mkApply(N.lerp, castArgs (!N.gRealTy) args)
                  | Ty.TensorTy[n] => CL.mkApply(N.lerp, castArgs (N.vecTy n) args)
                  | _ => raise Fail(concat[
                    "lerp<", Ty.toString ty, "> not supported"
                      ])
                (* end case *))
            | (Op.Dot d, args) => CL.mkApply(N.dot, args)
            | (Op.MulVecMat(m, n), args) =>
                if (1 < m) andalso (m < 4) andalso (m = n)
                  then CL.mkApply(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.mkApply(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.mkApply(N.mulMatMat(m,n,p), args)
                  else raise Fail "unsupported matrix-matrix multiply"
            | (Op.Cross, args) => CL.mkApply(N.cross, args)
            | (Op.Norm(Ty.TensorTy[n]), args) => CL.mkApply(N.length, args)
            | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.mkApply(N.normMat(m,n), args)
            | (Op.Normalize d, args) => CL.mkApply(N.normalize, args)
            | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)
            | (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]) => vecIndex (a, i)
            | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)
            | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
            | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
                val vecExp = CL.mkSelect(CL.mkCast(unionTy n, v), "i")
                in
                  CL.mkSubscript(vecExp, ix)
                end
            | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
            | (Op.Subscript(Ty.TensorTy[n]), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
            | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
                val vecExp = CL.mkSelect(CL.mkCast(unionTy n, v), "r")
                in
                  CL.mkSubscript(vecExp, ix)
                end
            | (Op.Subscript(Ty.TensorTy[_,_]), [m, ix, CL.E_Int(jx, _)]) =>
                vecIndex(CL.mkSubscript(m, ix), Int.fromLarge jx)
            | (Op.Subscript(Ty.TensorTy[_,n]), [m, ix, jx]) => let
                val vecExp = CL.mkSelect(CL.mkCast(unionTy n, CL.mkSubscript(m, ix)), "r")
                in
                  CL.mkSubscript(vecExp, jx)
                end
            | (Op.Subscript ty, t::(ixs as _::_)) =>
                raise Fail(concat["Subscript<", Ty.toString ty, "> unsupported"])
            | (Op.Ceiling d, args) => CL.mkApply("ceil", args)
            | (Op.Floor d, args) => CL.mkApply("floor", args)
            | (Op.Round d, args) => CL.mkApply("round", args)
            | (Op.Trunc d, args) => CL.mkApply("trunc", 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_Qual("__global", CL.T_Ptr(CL.T_Num(ImageInfo.sampleTy info)))
                in
                  CL.mkCast(cTy, CL.mkSelect(a, "data"))
                end
            | (Op.LoadVoxels(info, 1), [a]) => let
                val realTy as CL.T_Num rTy = !N.gRealTy
                val a = CL.mkUnOp(CL.%*, a)
                in
                  if (rTy = ImageInfo.sampleTy info)
                    then a
                    else CL.mkCast(realTy, a)
                end
            | (Op.LoadVoxels _, [a]) =>
                raise Fail("impossible " ^ Op.toString rator)
            | (Op.PosToImgSpace info, [img, pos]) =>
                CL.mkApply(N.toImageSpace(ImageInfo.dim info), [CL.mkUnOp(CL.%&, img), pos])
            | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
                CL.mkApply(N.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])
            | (Op.Inside(info, s), [pos, img]) =>
                CL.mkApply(N.inside(ImageInfo.dim info), [pos, CL.mkUnOp(CL.%&, img), intExp s])
            | (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_Global x => rvalueGlobalVar (env, x)
            | IL.E_State x => rvalueStateVar (env, x)
            | IL.E_Var x => rvalueVar (env, x)
            | 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[3], args) => CL.mkApply("VEC3", trExps(env, args))
            | IL.E_Cons(Ty.TensorTy[n], args) => CL.mkVec(N.vecTy n, trExps(env, args))
            | 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.mkDeclInit(ty, x, exp)])
                end
          (* end case *))
   
    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.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[_,_]), [img,src]) =>
                [CL.mkCall(N.toWorldSpace ty, lhs :: [CL.mkUnOp(CL.%&,trExp(env, img)),trExp(env, src)] )]
            | 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
		    val voxs = if (n = 3)
			  then CL.mkApply("VEC3", List.tabulate (n, mkLoad))
			  else CL.mkVec(N.vecTy n, List.tabulate (n, mkLoad))
                    in [
                      CL.mkDeclInit(CLTyTranslate.imageDataPtrTy info, vp, trExp(env, a)),
                      CL.mkAssign(lhs, voxs)
                    ] end
                else [CL.mkAssign(lhs, trExp(env, rhs))]
            | IL.E_Op(Op.EigenVals2x2, [m]) => let
                val (m, stms) = expToVar (env, N.matTy(2,2), "m", m)
                in
                  stms @ [CL.mkCall(N.evals2x2, [
                      CL.mkUnOp(CL.%&,lhs),
                      matIndex (m, CL.mkInt 0,  "0"),
                      matIndex (m, CL.mkInt 0, "1"),
                      matIndex (m, CL.mkInt 1, "1")
                    ])]
                end
            | IL.E_Op(Op.EigenVals3x3, [m]) => let
                val (m, stms) = expToVar (env, N.matTy(3,3), "m", m)
                in
                  stms @ [CL.mkCall(N.evals3x3, [
                      CL.mkUnOp(CL.%&,lhs),
                      matIndex (m, CL.mkInt 0, "0"),
                      matIndex (m, CL.mkInt 0, "1"),
                      matIndex (m, CL.mkInt 0, "2"),
                      matIndex (m, CL.mkInt 1, "1"),
                      matIndex (m, CL.mkInt 1, "2"),
                      matIndex (m, CL.mkInt 2, "2")
                    ])]
                end
            
            | 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.mkSubscript(lhs, intExp i), e)
                        :: doRows (i+1, es)
                in
                  doRows (0, trExps(env, args))
                end
            | IL.E_Var x => (case IL.Var.ty x
                 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueVar(env, x)])]
                  | _ => [CL.mkAssign(lhs, rvalueVar(env, x))]
                (* end case *))
	    | IL.E_Global x => (case IL.GlobalVar.ty x
                 of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueGlobalVar (env, x)])]
		  | Ty.ImageTy info => let
		      fun mkLHS fld = CL.mkSelect(lhs, fld)
		      fun mkLHS' (fld, i) = CL.mkSubscript(mkLHS fld, CL.mkInt i)
		      val rhs = rvalueGlobalVar (env, x)
		      fun mkRHS fld = CL.mkSelect(rhs, fld)
		      fun mkRHS' (fld, i) = CL.mkSubscript(mkRHS fld, CL.mkInt i)
		      val dataStm = CL.mkAssign(mkLHS "data", mkRHS "data")
		      in
			case ImageInfo.dim info
			 of 1 => [
				CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
				CL.mkAssign(mkLHS "s", mkRHS "s"),
				CL.mkAssign(mkLHS "t", mkRHS "t"),
				dataStm
			      ]
			  | 2 => [
				CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
				CL.mkAssign(mkLHS' ("size", 1), mkRHS' ("size", 1)),
				CL.mkAssign(mkLHS' ("w2i", 0), mkRHS' ("w2i", 0)),
				CL.mkAssign(mkLHS' ("w2i", 1), mkRHS' ("w2i", 1)),
				CL.mkAssign(mkLHS "tVec", mkRHS "tVec"),
				CL.mkAssign(mkLHS' ("w2iT", 0), mkRHS' ("w2iT", 0)),
				CL.mkAssign(mkLHS' ("w2iT", 1), mkRHS' ("w2iT", 1)),
				dataStm
			      ]
			  | 3 => [
				CL.mkAssign(mkLHS' ("size", 0), mkRHS' ("size", 0)),
				CL.mkAssign(mkLHS' ("size", 1), mkRHS' ("size", 1)),
				CL.mkAssign(mkLHS' ("size", 2), mkRHS' ("size", 2)),
				CL.mkAssign(mkLHS' ("w2i", 0), mkRHS' ("w2i", 0)),
				CL.mkAssign(mkLHS' ("w2i", 1), mkRHS' ("w2i", 1)),
				CL.mkAssign(mkLHS' ("w2i", 2), mkRHS' ("w2i", 2)),
				CL.mkAssign(mkLHS "tVec", mkRHS "tVec"),
				CL.mkAssign(mkLHS' ("w2iT", 0), mkRHS' ("w2iT", 0)),
				CL.mkAssign(mkLHS' ("w2iT", 1), mkRHS' ("w2iT", 1)),
				CL.mkAssign(mkLHS' ("w2iT", 2), mkRHS' ("w2iT", 2)),
				dataStm
			      ]
			  | _ => raise Fail "image with dimension > 3"
			(* end case *)
		      end
                  | _ => [CL.mkAssign(lhs, rvalueGlobalVar (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, N.matTy(2,2), "m", m)
                in
                  stms @ [CL.mkCall(N.evecs2x2, [
                      CL.mkUnOp(CL.%&,vals), vecs,
                      matIndex (m, CL.mkInt 0, "0"),
                      matIndex (m, CL.mkInt 0, "1"),
                      matIndex (m, CL.mkInt 1, "1")
                    ])]
                end
            | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
                val (m, stms) = expToVar (env, N.matTy(3,3), "m", m)
                in
                  stms @ [CL.mkCall(N.evecs3x3, [
                      CL.mkUnOp(CL.%&,vals), vecs,
                      matIndex (m, CL.mkInt 0, "0"),
                      matIndex (m, CL.mkInt 0, "1"),
                      matIndex (m, CL.mkInt 0, "2"),
                      matIndex (m, CL.mkInt 1, "1"),
                      matIndex (m, CL.mkInt 1, "2"),
                      matIndex (m, CL.mkInt 2, "2")
                    ])]
                end
            | _ => raise Fail "bogus multi-assignment"
          (* end case *))
      | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
      
    fun trLocals (env : env, locals) = 
          List.foldl
            (fn (x, env) => V.Map.insert(env, x, V(CLTyTranslate.toGPUType(V.ty x), V.name x)))
              env locals

    fun trStms (env, stms) = let
          fun trStmt (env, stm) = (case stm
		 of IL.S_Comment text => [CL.mkComment text]
		  | IL.S_Assign([x], exp) => trAssign (env, lvalueVar (env, x), exp)
		  | IL.S_Assign(xs, exp) =>
			  trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp)
                  | IL.S_GAssign(x, exp) => trAssign (env, lvalueGlobalVar (env, x), 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_New _ => raise Fail "new not supported yet" (* FIXME *)
		  | 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 _ => raise Fail "impossible S_LoadNrrd in OpenCL"
		  | IL.S_Input _ => raise Fail "impossible S_Input in OpenCL"
		  | IL.S_InputNrrd _ => raise Fail "impossible S_InputNrrd in OpenCL"
                  | IL.S_Exit args => []
		  | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
		  | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]
		  | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar N.kDie))]
		(* end case *))
          in
            List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
          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 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