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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1370, Wed Jun 22 21:11:20 2011 UTC revision 1640, Wed Nov 16 02:19:51 2011 UTC
# Line 1  Line 1 
1  (* tree-to-c.sml  (* tree-to-cl.sml
2   *   *
3   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Translate TreeIL to the C version of CLang.   * Translate TreeIL to the OpenCL version of CLang.
7   *)   *)
8    
9  structure TreeToCL : sig  structure TreeToCL : sig
# Line 14  Line 14 
14    
15      val trType : TreeIL.Ty.ty -> CLang.ty      val trType : TreeIL.Ty.ty -> CLang.ty
16    
17      val trBlock : env * (env * TreeIL.exp list * CLang.stm -> CLang.stm list) * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
18    
19      val trFragment : env * TreeIL.block -> env * CLang.stm list      val trFragment : env * TreeIL.block -> env * CLang.stm list
20    
# Line 46  Line 46 
46    (* integer literal expression *)    (* integer literal expression *)
47      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
48    
49      (* the type of an image-data pointer. *)
50        fun imageDataPtrTy rTy = CL.T_Qual("__global", CL.T_Ptr(CL.T_Num rTy))
51    
52    (* translate TreeIL types to CLang types *)    (* translate TreeIL types to CLang types *)
53      fun trType ty = (case ty      fun trType ty = (case ty
54             of Ty.BoolTy => CLang.T_Named "bool"             of Ty.BoolTy => CLang.T_Named "uint"
55              | Ty.StringTy => CL.charPtr              | Ty.StringTy => CL.charPtr
56              | Ty.IVecTy 1 => !RN.gIntTy              | Ty.IntTy => !RN.gIntTy
             | Ty.IVecTy n => CL.T_Named(RN.ivecTy n)  
57              | Ty.TensorTy[] => !RN.gRealTy              | Ty.TensorTy[] => !RN.gRealTy
58              | Ty.TensorTy[n] => CL.T_Named(RN.vecTy n)              | Ty.TensorTy[n] => CL.T_Named(RN.vecTy n)
59              | Ty.TensorTy[n, m] => CL.T_Named(RN.matTy(n,m))              | Ty.TensorTy[n, m] => CL.T_Named(RN.matTy(n,m))
60              | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => CL.T_Ptr(CL.T_Num rTy)              | Ty.SeqTy(Ty.IntTy, n) => CL.T_Named(RN.ivecTy n)
61  (* FIXME: concatenating "__global" is a hack.  Figure out a better way *)              | Ty.SeqTy(Ty.TensorTy[] , n) => CL.T_Named(RN.vecTy n)
62              | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Ptr(CL.T_Named("__global " ^ RN.imageTy dim))              | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => imageDataPtrTy rTy
63                | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Named(RN.imageTy dim)
64              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
65            (* end case *))            (* end case *))
66    
# Line 76  Line 79 
79      end (* local *)      end (* local *)
80    
81    (* translate IL basis functions *)    (* translate IL basis functions *)
82      local      fun trApply (f, args) = CL.mkApply(ILBasis.toString f, args)
       fun mkLookup suffix = let  
             val tbl = ILBasis.Tbl.mkTable (16, Fail "basis table")  
             fun ins f = ILBasis.Tbl.insert tbl (f, ILBasis.toString f ^ suffix)  
             in  
               List.app ins ILBasis.allFuns;  
               ILBasis.Tbl.lookup tbl  
             end  
       val fLookup = mkLookup "f"  
       val dLookup = mkLookup ""  
     in  
     fun trApply (f, args) = let  
           val f' = if !RN.doublePrecision then dLookup f else fLookup f  
           in  
             CL.mkApply(f', args)  
           end  
     end (* local *)  
83    
84    (* vector indexing support.  Arguments are: vector, index *)    (* vector indexing support.  Arguments are: vector, index *)
85      local      local
# Line 109  Line 96 
96    (* translate a variable use *)    (* translate a variable use *)
97      fun trVar (env, x) = (case V.kind x      fun trVar (env, x) = (case V.kind x
98             of IL.VK_Global => CL.mkIndirect(CL.E_Var RN.globalsVarName, lookup(env, x))             of IL.VK_Global => CL.mkIndirect(CL.E_Var RN.globalsVarName, lookup(env, x))
             | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfIn", lookup(env, x))  
99              | IL.VK_Local => CL.mkVar(lookup(env, x))              | IL.VK_Local => CL.mkVar(lookup(env, x))
100            (* end case *))            (* end case *))
101    
102      (* translate a state-variable use *)
103        fun trStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfIn", name)
104    
105        fun castArgs ty = List.map (fn e => CL.mkCast(ty, e))
106    
107    (* Translate a TreeIL operator application to a CLang expression *)    (* Translate a TreeIL operator application to a CLang expression *)
108      fun trOp (rator, args) = (case (rator, args)      fun trOp (rator, args) = (case (rator, args)
109             of (Op.Add ty, [a, b]) => CL.mkBinOp(a, CL.#+, b)             of (Op.Add ty, [a, b]) => CL.mkBinOp(a, CL.#+, b)
# Line 120  Line 111 
111              | (Op.Mul ty, [a, b]) => CL.mkBinOp(a, CL.#*, b)              | (Op.Mul ty, [a, b]) => CL.mkBinOp(a, CL.#*, b)
112              | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)              | (Op.Div ty, [a, b]) => CL.mkBinOp(a, CL.#/, b)
113              | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)              | (Op.Neg ty, [a]) => CL.mkUnOp(CL.%-, a)
114              | (Op.Abs(Ty.IVecTy 1), args) => CL.mkApply("abs", args)              | (Op.Abs(Ty.IntTy), args) => CL.mkApply("abs", args)
115              | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(RN.fabs, args)              | (Op.Abs(Ty.TensorTy[]), args) => CL.mkApply(RN.fabs, args)
116              | (Op.Abs(Ty.TensorTy[_]), args) => CL.mkApply(RN.fabs, args)              | (Op.Abs(Ty.TensorTy[_]), args) => CL.mkApply(RN.fabs, args)
117              | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])              | (Op.Abs ty, [a]) => raise Fail(concat["Abs<", Ty.toString ty, ">"])
# Line 131  Line 122 
122              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)              | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
123              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)              | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
124              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)              | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
125              | (Op.Max, args) => CL.mkApply(RN.max, args)              | (Op.Max, args) => CL.mkApply(RN.max, castArgs (!RN.gRealTy) args)
126              | (Op.Min, args) => CL.mkApply(RN.min, args)              | (Op.Min, args) => CL.mkApply(RN.min, castArgs (!RN.gRealTy) args)
127              | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(RN.clamp, [x, lo, hi])              | (Op.Clamp ty, [lo, hi, x]) => CL.mkApply(RN.clamp, [x, lo, hi])
128              | (Op.Lerp ty, args) => (case ty              | (Op.Lerp ty, args) => (case ty
129                   of Ty.TensorTy[] => CL.mkApply(RN.lerp, args)                   of Ty.TensorTy[] => CL.mkApply(RN.lerp, castArgs (!RN.gRealTy) args)
130                    | Ty.TensorTy[n] => CL.mkApply(RN.lerp, args)                    | Ty.TensorTy[n] => CL.mkApply(RN.lerp, castArgs (CL.T_Named(RN.vecTy n)) args)
131                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
132                          "lerp<", Ty.toString ty, "> not supported"                          "lerp<", Ty.toString ty, "> not supported"
133                        ])                        ])
# Line 155  Line 146 
146                    then CL.E_Apply(RN.mulMatMat(m,n,p), args)                    then CL.E_Apply(RN.mulMatMat(m,n,p), args)
147                    else raise Fail "unsupported matrix-matrix multiply"                    else raise Fail "unsupported matrix-matrix multiply"
148              | (Op.Cross, args) => CL.E_Apply(RN.cross, args)              | (Op.Cross, args) => CL.E_Apply(RN.cross, args)
             | (Op.Select(Ty.IVecTy n, i), [a]) => vecIndex (a, i)  
             | (Op.Select(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)  
149              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(RN.length, args)              | (Op.Norm(Ty.TensorTy[n]), args) => CL.E_Apply(RN.length, args)
150              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(RN.norm(m,n), args)              | (Op.Norm(Ty.TensorTy[m,n]), args) => CL.E_Apply(RN.norm(m,n), args)
151              | (Op.Normalize d, args) => CL.E_Apply(RN.normalize, args)              | (Op.Normalize d, args) => CL.E_Apply(RN.normalize, args)
             | (Op.Trace n, args) => CL.E_Apply(RN.trace n, args)  
152              | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)              | (Op.Scale(Ty.TensorTy[n]), [s, v]) => CL.mkBinOp(s, CL.#*, v)
             | (Op.CL, _) => raise Fail "CL unimplemented"  
153              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"              | (Op.PrincipleEvec ty, _) => raise Fail "PrincipleEvec unimplemented"
154              | (Op.Subscript(Ty.IVecTy n), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)              | (Op.Select(Ty.TupleTy tys, i), [a]) => raise Fail "Select unimplemented"
155              | (Op.Subscript(Ty.IVecTy n), [v, ix]) => let              | (Op.Index(Ty.SeqTy(Ty.IntTy, n), i), [a]) => vecIndex (a, i)
156                | (Op.Index(Ty.TensorTy[n], i), [a]) => vecIndex (a, i)
157                | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, CL.E_Int(ix, _)]) => vecIndex (v, Int.fromLarge ix)
158                | (Op.Subscript(Ty.SeqTy(Ty.IntTy, n)), [v, ix]) => let
159                  val unionTy = CL.T_Named(concat["union", Int.toString n, !RN.gIntSuffix, "_t"])                  val unionTy = CL.T_Named(concat["union", Int.toString n, !RN.gIntSuffix, "_t"])
160                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "i")
161                  in                  in
# Line 194  Line 184 
184              | (Op.Trunc d, args) => CL.mkApply("trunc", args)              | (Op.Trunc d, args) => CL.mkApply("trunc", args)
185              | (Op.IntToReal, [a]) => CL.mkCast(!RN.gRealTy, a)              | (Op.IntToReal, [a]) => CL.mkCast(!RN.gRealTy, a)
186              | (Op.RealToInt 1, [a]) => CL.mkCast(!RN.gIntTy, a)              | (Op.RealToInt 1, [a]) => CL.mkCast(!RN.gIntTy, a)
187              | (Op.RealToInt d, args) =>              | (Op.RealToInt d, args) => CL.mkApply(RN.vecftoi d, args)
                 CL.mkApply(RN.vecftoi d, args)  
188  (* FIXME: need type info *)  (* FIXME: need type info *)
189              | (Op.ImageAddress(ImageInfo.ImgInfo{ty=(_,rTy), ...}), [a]) => let              | (Op.ImageAddress(ImageInfo.ImgInfo{ty=(_,rTy), ...}), [a as CL.E_Indirect(_,field)]) => let
190                  val cTy = CL.T_Ptr(CL.T_Num rTy)                  val cTy = imageDataPtrTy rTy
191                  in                  in
192                    CL.mkCast(cTy, CL.mkIndirect(a, "data"))                    CL.mkCast(cTy,
193                        CL.mkSelect(CL.mkVar RN.globalImageDataName, RN.imageDataName field))
194                  end                  end
195              | (Op.LoadVoxels(info, 1), [a]) => let              | (Op.LoadVoxels(info, 1), [a]) => let
196                  val realTy as CL.T_Num rTy = !RN.gRealTy                  val realTy as CL.T_Num rTy = !RN.gRealTy
# Line 213  Line 203 
203              | (Op.LoadVoxels _, [a]) =>              | (Op.LoadVoxels _, [a]) =>
204                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
205              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>
206                  CL.mkApply(RN.toImageSpace dim, [img, pos])                  CL.mkApply(RN.toImageSpace dim, [CL.mkUnOp(CL.%&,img), pos])
207              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
208                  CL.mkApply(RN.toWorldSpace ty, [v, x])                  CL.mkApply(RN.toWorldSpace ty, [CL.mkUnOp(CL.%&,v), x])
209              | (Op.LoadImage info, [a]) =>              | (Op.LoadImage info, [a]) =>
210                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
211              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>
212                  CL.mkApply(RN.inside dim, [pos, img, intExp s])                  CL.mkApply(RN.inside dim, [pos, CL.mkUnOp(CL.%&,img), intExp s])
213              | (Op.Input(ty, name, desc), []) =>              | (Op.Input(ty, name, desc), []) =>
214                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
215              | (Op.InputWithDefault(ty, name, desc), [a]) =>              | (Op.InputWithDefault(ty, name, desc), [a]) =>
# Line 230  Line 220 
220            (* end case *))            (* end case *))
221    
222      fun trExp (env, e) = (case e      fun trExp (env, e) = (case e
223             of IL.E_Var x => trVar (env, x)             of IL.E_State x => trStateVar x
224                | IL.E_Var x => trVar (env, x)
225              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !RN.gIntTy)              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !RN.gIntTy)
226              | IL.E_Lit(Literal.Bool b) => CL.mkBool b              | IL.E_Lit(Literal.Bool b) => CL.mkBool b
227              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !RN.gRealTy)              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !RN.gRealTy)
# Line 243  Line 234 
234    
235      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
236    
237      fun trAssign (env, lhs, rhs) = let      fun trLHSVar (env, lhs) = (case V.kind lhs
238            val lhs = (case V.kind lhs             of IL.VK_Global => CL.mkIndirect(CL.mkVar RN.globalsVarName, lookup(env, lhs))
                  of IL.VK_Global => CL.mkIndirect(CL.E_Var (RN.globalsVarName),lookup(env, lhs))  
                   | IL.VK_State strand => CL.mkIndirect(CL.mkVar "selfOut", lookup(env, lhs))  
239                    | IL.VK_Local => CL.mkVar(lookup(env, lhs))                    | IL.VK_Local => CL.mkVar(lookup(env, lhs))
240                  (* end case *))                  (* end case *))
241            in  
242        fun trLHSStateVar (IL.SV{name, ...}) = CL.mkIndirect(CL.mkVar "selfOut", name)
243    
244        fun trSet (env, lhs, rhs) = (
245            (* certain rhs forms, such as those that return a matrix,            (* certain rhs forms, such as those that return a matrix,
246             * require a function call instead of an assignment             * require a function call instead of an assignment
247             *)             *)
# Line 268  Line 260 
260                    [CL.mkCall(RN.identityMat n, [lhs])]                    [CL.mkCall(RN.identityMat n, [lhs])]
261                | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>                | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
262                    [CL.mkCall(RN.zeroMat(m,n), [lhs])]                    [CL.mkCall(RN.zeroMat(m,n), [lhs])]
263                | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), args) =>              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), [img,src]) =>
264                    [CL.mkCall(RN.toWorldSpace ty, lhs :: trExps(env, args))]                  [CL.mkCall(RN.toWorldSpace ty, lhs :: [CL.mkUnOp(CL.%&,trExp(env, img)),trExp(env, src)] )]
265                | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>                | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
266                    if (n > 1)                    if (n > 1)
267                      then let                      then let
# Line 283  Line 275 
275                                if needsCast then CL.mkCast(!RN.gRealTy, e) else e                                if needsCast then CL.mkCast(!RN.gRealTy, e) else e
276                              end                              end
277                        in [                        in [
278                          CL.mkDecl(CL.T_Ptr(CL.T_Num rTy), vp, SOME(CL.I_Exp(trExp(env, a)))),                        CL.mkDecl(imageDataPtrTy rTy, vp, SOME(CL.I_Exp(trExp(env, a)))),
279                          CL.mkAssign(lhs,                          CL.mkAssign(lhs,
280                            CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))                            CL.mkApply(RN.mkVec n, List.tabulate (n, mkLoad)))
281                        ] end                        ] end
# Line 302  Line 294 
294                      | _ => [CL.mkAssign(lhs, trVar(env, x))]                      | _ => [CL.mkAssign(lhs, trVar(env, x))]
295                    (* end case *))                    (* end case *))
296                | _ => [CL.mkAssign(lhs, trExp(env, rhs))]                | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
297              (* end case *)            (* end case *))
298            end  
299        fun trAssign (env, lhs, rhs) = trSet (env, trLHSVar (env, lhs), rhs)
300    
301      fun trLocals (env : env, locals) =      fun trLocals (env : env, locals) =
302            List.foldl            List.foldl
# Line 320  Line 313 
313                CL.mkCall("exit", [intExp 1]))]                CL.mkCall("exit", [intExp 1]))]
314            end            end
315    
316      fun trStms (env, saveState, stms) = let      fun trStms (env, stms) = let
317            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
318                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
319                    | IL.S_Assign(x, exp) => trAssign (env, x, exp)                | IL.S_Assign([x], exp) => trAssign (env, x, exp)
320                    | IL.S_IfThen(cond, thenBlk) =>                    | IL.S_IfThen(cond, thenBlk) =>
321                        [CL.mkIfThen(trExp(env, cond), trBlk(env, saveState, thenBlk))]                    [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]
322                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
323                        [CL.mkIfThenElse(trExp(env, cond),                        [CL.mkIfThenElse(trExp(env, cond),
324                          trBlk(env, saveState, thenBlk),                      trBlk(env, thenBlk),
325                          trBlk(env, saveState, elseBlk))]                      trBlk(env, elseBlk))]
326                    | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)                    | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
327                  | IL.S_Save([x], exp) => trSet (env, trLHSStateVar x, exp)
328  (* FIXME: I think that S_LoadImage should never happen in OpenCL code [jhr] *)  (* FIXME: I think that S_LoadImage should never happen in OpenCL code [jhr] *)
329                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
330                        val lhs = lookup(env, lhs)                        val lhs = lookup(env, lhs)
# Line 346  Line 340 
340                    | IL.S_Input(lhs, name, desc, optDflt) => checkSts (fn sts => let                    | IL.S_Input(lhs, name, desc, optDflt) => checkSts (fn sts => let
341                        val inputFn = RN.input(V.ty lhs)                        val inputFn = RN.input(V.ty lhs)
342                        val lhs = lookup(env, lhs)                        val lhs = lookup(env, lhs)
                       val lhs = CL.E_Var lhs  
343                        val (initCode, hasDflt) = (case optDflt                        val (initCode, hasDflt) = (case optDflt
344                               of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)                       of SOME e => ([CL.mkAssign(CL.E_Var lhs, trExp(env, e))], true)
345                                | NONE => ([], false)                                | NONE => ([], false)
346                              (* end case *))                              (* end case *))
347                        val code = [                        val code = [
348                              CL.mkDecl(                              CL.mkDecl(
349                                CL.T_Named RN.statusTy, sts,                                CL.T_Named RN.statusTy, sts,
350                                SOME(CL.I_Exp(CL.E_Apply(inputFn, [                                SOME(CL.I_Exp(CL.E_Apply(inputFn, [
351                                    CL.E_Str name, CL.mkUnOp(CL.%&, lhs), CL.mkBool hasDflt                          CL.E_Str name, CL.mkUnOp(CL.%&, CL.mkIndirect(CL.mkVar (RN.globalsVarName), lhs)), CL.mkBool hasDflt
352                                  ]))))                                  ]))))
353                              ]                              ]
354                        in                        in
355                          initCode @ code                          initCode @ code
356                        end)                        end)
357                    | IL.S_Exit args =>                | IL.S_Exit args => [CL.mkReturn NONE]
358                        saveState (env, args, CL.mkReturn NONE)                | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar RN.kActive))]
359                    | IL.S_Active args =>                | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar RN.kStabilize))]
                       saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kActive)))  
                   | IL.S_Stabilize args =>  
                       saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)))  
360                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar RN.kDie))]                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar RN.kDie))]
361                  (* end case *))                  (* end case *))
362            in            in
363              List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms              List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
364            end            end
365    
366      and trBlk (env, saveState, IL.Block{locals, body}) = let      and trBlk (env, IL.Block{locals, body}) = let
367            val env = trLocals (env, locals)            val env = trLocals (env, locals)
368            val stms = trStms (env, saveState, body)            val stms = trStms (env, body)
369            fun mkDecl (x, stms) = (case V.Map.find (env, x)            fun mkDecl (x, stms) = (case V.Map.find (env, x)
370                   of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms                   of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
371                    | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])                    | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
# Line 387  Line 377 
377    
378      fun trFragment (env, IL.Block{locals, body}) = let      fun trFragment (env, IL.Block{locals, body}) = let
379            val env = trLocals (env, locals)            val env = trLocals (env, locals)
380            val stms = trStms (env, fn _ => raise Fail "exit in fragment", body)            val stms = trStms (env, body)
381            fun mkDecl (x, stms) = (case V.Map.find (env, x)            fun mkDecl (x, stms) = (case V.Map.find (env, x)
382                   of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms                   of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
383                    | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])                    | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])

Legend:
Removed from v.1370  
changed lines
  Added in v.1640

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