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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml

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

branches/vis15/src/compiler/c-util/tree-to-cxx.sml revision 3886, Fri May 20 15:10:11 2016 UTC branches/vis15/src/compiler/cxx-util/tree-to-cxx.sml revision 3917, Sat May 28 16:41:39 2016 UTC
# Line 24  Line 24 
24    
25      val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list      val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
26    
27      (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
28        val errorMsgAdd : CLang.exp -> CLang.stm
29    
30        val trParam : CodeGenEnv.t -> TreeIR.var -> CLang.param
31    
32    end = struct    end = struct
33    
34      structure CL = CLang      structure CL = CLang
# Line 39  Line 44 
44              | Ty.IntTy => Env.intTy env              | Ty.IntTy => Env.intTy env
45              | (Ty.VecTy(1, 1)) => Env.realTy env              | (Ty.VecTy(1, 1)) => Env.realTy env
46              | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)              | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)
47                | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"
48              | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))              | (Ty.TensorTy dd) => CL.T_Array(Env.realTy env, SOME(List.foldl Int.* 1 dd))
49              | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])              | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])
50              | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)              | (Ty.SeqTy(t, SOME n)) => CL.T_Array(trType(env, t), SOME n)
# Line 81  Line 87 
87    (* integer literal expression *)    (* integer literal expression *)
88      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
89    
90        val zero = CL.mkInt 0
91    
92      fun addrOf e = CL.mkUnOp(CL.%&, e)      fun addrOf e = CL.mkUnOp(CL.%&, e)
93    
94    (* make an application of a function from the "std" namespace *)    (* make an application of a function from the "std" namespace *)
# Line 202  Line 210 
210              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)              | IR.E_Lit(Literal.Real f) => CL.mkFlt(f, Env.realTy env)
211              | IR.E_Lit(Literal.String s) => CL.mkStr s              | IR.E_Lit(Literal.String s) => CL.mkStr s
212              | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))              | IR.E_Op(rator, args) => trOp (env, rator, trExps(env, args))
213              | IR.E_Vec(d, args) => ??              | IR.E_Vec(w, pw, args) => let
214              | IR.E_Cons(args, Ty.TensorTy shape) => ??                  val args = trExps (env, args)
215              | IR.E_Seq(args, ty) => ??                  val args = if (w < pw) then args @ List.tabulate(pw-w, fn _ => zero) else args
216              | IR.E_Pack(layout, args) => ??                  in
217              | IR.E_VLoad(layout, e, i) => ??                    CL.mkVec(CL.T_Named("vec" ^ Int.toString pw), args)
218                    end
219                | IR.E_Cons(args, Ty.TensorTy shape) => raise Fail "unexpected E_Cons"
220                | IR.E_Seq(args, ty) => raise Fail "unexpected E_Seq"
221                | IR.E_Pack(layout, args) => raise Fail "unexpected E_Pack"
222    (* FIXME: check if e is aligned and use "vload_aligned" in that case *)
223                | IR.E_VLoad(layout, e, i) =>
224                    CL.mkTemplateApply("vload",
225                      [trType(env, Ty.nthVec(layout, i))],
226                      [CL.mkBinOp(trExp(env, e), CL.#+, intExp(Ty.offsetOf(layout, i)))])
227                | _ => raise Fail "trExp"
228            (* end case *))            (* end case *))
229    
230      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
# Line 215  Line 233 
233      fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)      fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
234             of e as CL.E_Var _ => (e, [])             of e as CL.E_Var _ => (e, [])
235              | e => let              | e => let
236                  val x = freshName name                  val x = freshVar name
237                  in                  in
238                    (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])                    (CL.mkVar x, [CL.mkDeclInit(ty, x, e)])
239                  end                  end
240            (* end case *))            (* end case *))
241    
242      fun trRHS mkStm (env, rhs) = (case rhs      fun trAssign (env, lhs, rhs) = let
243             of IR.E_Op(??, args) => ???            fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))
244              | IR.E_Cons(args, Ty.TensorTy shape) => ??            in
245              | IR.E_Seq(args, ty) => ??              case rhs
246              | _ => mkStm (trExp (env, rhs)) (* generic case *)               of IR.E_Pack(_, args) => [CL.mkCall ("vpack", List.map (fn e => trExp(env, e)) args)]
247            (* end case *))                | IR.E_Cons(args, _) => List.mapi trArg args
248                  | IR.E_Seq(args, _) => List.mapi trArg args
249      fun trAssign (env, lhs, rhs) =                | _ => [CL.mkAssign(lhs, trExp (env, rhs))]
250            trRHS (fn rhs => CL.mkAssign(lhs, rhs)) (env, rhs)              (* end case *)
251              end
252      fun trDecl (env, ty, lhs, rhs) =  
253            trRHS (fn rhs => CL.mkDeclInit(ty, lhs, rhs)) (env, rhs)      fun trDecl (env, ty, lhs, rhs) = let
254              fun trArgs args = CL.mkDecl(
255                    ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
256              in
257                case rhs
258                 of IR.E_Cons(args, _) => trArgs args
259                  | IR.E_Seq(args, _) => trArgs args
260                  | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs))
261                (* end case *)
262              end
263    
264      fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)      fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
265             of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>             of ([vals, vecs], Op.EigenVecs2x2, [exp]) =>
# Line 247  Line 274 
274            fun trStm (stm, (env, stms : CL.stm list)) = (case stm            fun trStm (stm, (env, stms : CL.stm list)) = (case stm
275                   of IR.S_Comment text => (env, CL.mkComment text :: stms)                   of IR.S_Comment text => (env, CL.mkComment text :: stms)
276                    | IR.S_Assign(true, x, exp) => let                    | IR.S_Assign(true, x, exp) => let
277                        val (env, stm) = trDecl (env, ??, Env.lookup (env, x), exp)                        val ty = trType (env, V.ty x)
278                          val x' = V.name x
279                          val env = Env.insert (env, x, x')
280                        in                        in
281                          (env, stm::stms)                          (env, trDecl (env, ty, x', exp) :: stms)
282                        end                        end
283                    | IR.S_Assign(false, x, exp) => let                    | IR.S_Assign(false, x, exp) => let
284                        val (env, stm) = trAssign (env, lvalueVar (env, x), exp)                        val stms' = trAssign (env, lvalueVar (env, x), exp)
285                        in                        in
286                          (env, stm::stms)                          (env, stms' @ stms)
287                        end                        end
288                    | IR.S_MAssign(xs, exp) =>                    | IR.S_MAssign(xs, exp) =>
289                        (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)                        (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
290                    | IR.S_GAssign(x, exp) =>                    | IR.S_GAssign(x, exp) =>
291                        (env, trAssign (env, lvalueGlobalVar (env, x), exp) :: stms)                        (env, trAssign (env, lvalueGlobalVar (env, x), exp) @ stms)
292                    | IR.S_IfThen(cond, thenBlk) =>                    | IR.S_IfThen(cond, thenBlk) =>
293                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)                        (env, CL.mkIfThen(trExp(env, cond), trBlock(env, thenBlk)) :: stms)
294                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let                    | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
# Line 272  Line 301 
301                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let
302                        val x' = V.name x                        val x' = V.name x
303                        val env' = Env.insert (env, x, x')                        val env' = Env.insert (env, x, x')
304                          val (hi', hiInit) = if CodeGenUtil.isSimple hi
305                                then (trExp(env, hi), [])
306                                else let
307                                  val hi' = freshVar "hi"
308                                  in
309                                    (CL.mkVar hi', [CL.mkDeclInit(CL.int32, hi', trExp(env, hi))])
310                                  end
311                        val loop = CL.mkFor(                        val loop = CL.mkFor(
312                              [(CL.int32, x', lo')],                              [(CL.int32, x', trExp(env, lo))],
313                              CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),                              CL.mkBinOp(CL.mkVar x', CL.#<=, hi'),
314                              [CL.mkUnOp(CL.%++, CL.mkVar x')],                              [CL.mkUnOp(CL.%++, CL.mkVar x')],
315                              trBlock (env', blk))                              trBlock (env', blk))
316                        in                        in
317                          (env, loop :: stms)                          (env, hiInit @ loop :: stms)
318                        end                        end
319                    | IR.S_Foreach(x, e, blk) => ??                    | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
320                    | IR.S_New(strand, args) => ??                    | IR.S_New(strand, args) => raise Fail "New"
321                    | IR.S_Save(x, exp) => trAssign (env, lvalueStateVar(env, x), exp)                    | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp))
322                    | IR.S_LoadNrrd(lhs, nrrd) => let                    | IR.S_LoadNrrd(lhs, ty, nrrd) => let
323                        val stm = (case V.ty lhs                        val stm = (case ty
324                               of Ty.SeqTy(ty, NONE) =>                               of APITypes.SeqTy(ty, NONE) =>
325                                    GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)                                    GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)
326                                | Ty.ImageTy info =>                                | APITypes.ImageTy _ =>
327                                    GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.mkStr nrrd)                                    GenLoadNrrd.loadImage (lvalueVar (env, lhs), CL.mkStr nrrd)
328                                  | _ => raise Fail(concat[
329                                        "bogus type ", APITypes.toString ty, " for LoadNrrd"
330                                      ])
331                              (* end case *))                              (* end case *))
332                        in                        in
333                          (env, stm :: stms)                          (env, stm :: stms)
# Line 326  Line 365 
365              CL.mkBlock (dcls @ trStms (env, body))              CL.mkBlock (dcls @ trStms (env, body))
366            end            end
367    
368        fun errorMsgAdd msg =
369              CL.mkCall("biffMsgAdd", [CL.mkIndirect(CL.mkVar "wrld", "_errors"), msg])
370    
371        fun trParam env x = let
372              val x' = V.name x
373              in
374                Env.insert (env, x, x');
375                CL.PARAM([], trType(env, V.ty x), x')
376              end
377    
378    end    end

Legend:
Removed from v.3886  
changed lines
  Added in v.3917

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