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

revision 3922, Wed Jun 1 17:02:34 2016 UTC revision 3963, Mon Jun 13 17:49:00 2016 UTC
# Line 15  Line 15 
15    
16      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17    
18        val trWithLocals : CodeGenEnv.t * TreeVar.t list * (CodeGenEnv.t -> CLang.stm list) -> CLang.stm
19    
20        val trStms : CodeGenEnv.t * TreeIR.stm list -> CodeGenEnv.t * CLang.stm list
21    
22      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
23    
24    (* translate an expression to a variable form; return the variable (as an expression)    (* translate an expression to a variable form; return the variable (as an expression)
# Line 25  Line 29 
29      val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list      val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
30    
31    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)    (* generate code to register an error message (require that a world pointer "wrld" is in scope) *)
32      val errorMsgAdd : CLang.exp -> CLang.stm      val errorMsgAdd : CodeGenEnv.t * CLang.exp -> CLang.stm
33    
34      val trParam : CodeGenEnv.t -> TreeIR.var -> CLang.param      val trParam : CodeGenEnv.t * TreeIR.var -> CodeGenEnv.t * CLang.param
35    
36    end = struct    end = struct
37    
# Line 45  Line 49 
49              | Ty.IntTy => Env.intTy env              | Ty.IntTy => Env.intTy env
50              | (Ty.VecTy(1, 1)) => Env.realTy env              | (Ty.VecTy(1, 1)) => Env.realTy env
51              | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)              | (Ty.VecTy(d, _)) => CL.T_Named("vec" ^ Int.toString d)
             | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"  
52              | (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))
53                | (Ty.TensorRefTy _) => CL.constPtrTy(Env.realTy env)
54                | (Ty.TupleTy tys) => raise Fail "FIXME: TupleTy"
55              | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])              | (Ty.SeqTy(t, NONE)) => CL.T_Template("diderot::dynseq", [trType(env, t)])
56              | (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)
57              | (Ty.ImageTy info) =>              | (Ty.ImageTy info) =>
# Line 62  Line 67 
67      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
68    
69    (* translate a global variable that occurs in an l-value context *)    (* translate a global variable that occurs in an l-value context *)
70      fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.name x)      fun lvalueGlobalVar (env, x) = CL.mkIndirect(CL.mkVar(Env.global env), TreeGlobalVar.qname x)
71    (* translate a global variable that occurs in an r-value context *)    (* translate a global variable that occurs in an r-value context *)
72      val rvalueGlobalVar = lvalueGlobalVar      val rvalueGlobalVar = lvalueGlobalVar
73    
74    (* translate a strand state variable that occurs in an l-value context *)    (* translate a strand state variable that occurs in an l-value context *)
75      fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.name x)      fun lvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfOut env), TreeStateVar.qname x)
76    (* translate a strand state variable that occurs in an r-value context *)    (* translate a strand state variable that occurs in an r-value context *)
77      fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.name x)      fun rvalueStateVar (env, x) = CL.mkIndirect(CL.mkVar(Env.selfIn env), TreeStateVar.qname x)
78    
79        fun worldVar env = CL.mkVar(Env.world env)
80    
81    (* generate new variables *)    (* generate new variables *)
82      local      val freshVar = CodeGenUtil.freshVar
       val count = ref 0  
       fun freshName prefix = let  
             val n = !count  
             in  
               count := n+1;  
               concat[prefix, "_", Int.toString n]  
             end  
     in  
     fun tmpVar () = freshName "tmp"  
     fun freshVar prefix = freshName prefix  
     end (* local *)  
83    
84    (* integer literal expression *)    (* integer literal expression *)
85      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
# Line 143  Line 139 
139              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])              | (Op.VFloor d, [a]) => CL.mkApply("vfloor", [a])
140              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])              | (Op.VRound d, [a]) => CL.mkApply("vround", [a])
141              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])              | (Op.VTrunc d, [a]) => CL.mkApply("vtrunc", [a])
142              | (Op.VToInt d, [a]) => CL.mkApply("vtoi", [a])              | (Op.TensorIndex(Ty.TensorRefTy(_::dd), idxs), [a]) => let
             | (Op.TensorIndex(Ty.TensorTy(_::dd), idxs), [a]) => let  
143                (* dimensions/indices are slowest to fastest *)                (* dimensions/indices are slowest to fastest *)
144                  fun index ([], [i], acc) = acc + i                  fun index ([], [i], acc) = acc + i
145                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
146                  in                  in
147                    CL.mkSubscript(a, intExp(index (dd, idxs, 0)))                    CL.mkSubscript(a, intExp(index (dd, idxs, 0)))
148                  end                  end
149              | (Op.ProjectLast(Ty.TensorTy(_::dd), idxs), [a]) => let              | (Op.ProjectLast(Ty.TensorRefTy(_::dd), idxs), [a]) => let
150                (* dimensions/indices are slowest to fastest *)                (* dimensions/indices are slowest to fastest *)
151                  fun index ([], [], acc) = acc                  fun index ([], [], acc) = acc
152                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))                    | index (d::dd, i::ii, acc) = index (dd, ii, d * (acc + i))
# Line 193  Line 188 
188              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])              | (Op.BaseAddress info, [img]) => CL.mkDispatch(img, "base_addr", [])
189              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>              | (Op.ControlIndex(info, ctl, d), [img, idx]) =>
190                  CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])                  CL.mkDispatch(img, IndexCtl.toString ctl, [intExp d, idx])
191                | (Op.LoadVoxel info, [addr, offp]) => let
192                    val voxel = CL.mkSubscript(addr, offp)
193                    in
194                      if RawTypes.same(ImageInfo.sampleTy info, Env.rawRealTy env)
195                        then voxel
196                        else CL.mkStaticCast(Env.realTy env, voxel)
197                    end
198              | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])              | (Op.Inside(info, s), [pos, img]) => CL.mkDispatch(img, "inside", [pos, intExp s])
199              | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])              | (Op.ImageDim(info, i), [img]) => CL.mkDispatch(img, "size", [intExp i])
200              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)              | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, args)
# Line 234  Line 236 
236                  end                  end
237            (* end case *))            (* end case *))
238    
239    (* FIXME: trAssign and trDecl do the same analysis of the rhs; we should factor that out *)
240      fun trAssign (env, lhs, rhs) = let      fun trAssign (env, lhs, rhs) = let
241            fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))            fun trArg (i, arg) = CL.mkAssign(CL.mkSubscript(lhs, intExp i), trExp (env, arg))
242            in            in
243              case rhs              case rhs
244               of IR.E_Pack(_, args) => [CL.mkCall ("vpack", List.map (fn e => trExp(env, e)) args)]               of IR.E_Op(Op.VToInt _, [a]) => [CL.mkCall ("vtoi", [lhs, trExp(env, a)])]
245                  | IR.E_Op(Op.TensorCopy shp, [a]) =>
246                      [CL.mkCall (RN.tensorCopy shp, [lhs, trExp(env, a)])]
247                  | IR.E_Pack({wid, ...}, args) =>
248                      [CL.mkCall (RN.vpack wid, lhs :: List.map (fn e => trExp(env, e)) args)]
249                | IR.E_Cons(args, _) => List.mapi trArg args                | IR.E_Cons(args, _) => List.mapi trArg args
250                | IR.E_Seq(args, _) => List.mapi trArg args                | IR.E_Seq(args, _) => List.mapi trArg args
251                | _ => [CL.mkAssign(lhs, trExp (env, rhs))]                | _ => [CL.mkAssign(lhs, trExp (env, rhs))]
# Line 250  Line 257 
257                  ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))                  ty, lhs, SOME(CL.I_Exps(List.map (fn arg => CL.I_Exp(trExp (env, arg))) args)))
258            in            in
259              case rhs              case rhs
260               of IR.E_Cons(args, _) => trArgs args               of IR.E_Op(Op.VToInt _, [a]) => [ (* NOTE: reverse order! *)
261                | IR.E_Seq(args, _) => trArgs args                      CL.mkCall ("vtoi", [CL.mkVar lhs, trExp(env, a)]),
262                | _ => CL.mkDeclInit(ty, lhs, trExp (env, rhs))                      CL.mkDecl(ty, lhs, NONE)
263                      ]
264                  | IR.E_Op(Op.TensorCopy shp, [a]) => [ (* NOTE: reverse order! *)
265                        CL.mkCall (RN.tensorCopy shp, [CL.mkVar lhs, trExp(env, a)]),
266                        CL.mkDecl(ty, lhs, NONE)
267                      ]
268                  | IR.E_Cons(args, _) => [trArgs args]
269                  | IR.E_Seq(args, _) => [trArgs args]
270                  | _ => [CL.mkDeclInit(ty, lhs, trExp (env, rhs))]
271              (* end case *)              (* end case *)
272            end            end
273    
# Line 266  Line 281 
281        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
282    
283      fun trPrintStm (outS, tys, args) = let      fun trPrintStm (outS, tys, args) = let
284            fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::end")            fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::flush")
285              | mkExp (lhs, ty::tys, e::es) = let              | mkExp (lhs, ty::tys, e::es) = let
286                (* if necessary, wrap the argument so that the correct "<<" instance is used *)                (* if necessary, wrap the argument so that the correct "<<" instance is used *)
287                  val e = (case ty                  val e = (case ty
# Line 289  Line 304 
304                        val x' = V.name x                        val x' = V.name x
305                        val env = Env.insert (env, x, x')                        val env = Env.insert (env, x, x')
306                        in                        in
307                          (env, trDecl (env, ty, x', exp) :: stms)                          (env, trDecl (env, ty, x', exp) @ stms)
308                        end                        end
309                    | IR.S_Assign(false, x, exp) => let                    | IR.S_Assign(false, x, exp) => let
310                        val stms' = trAssign (env, lvalueVar (env, x), exp)                        val stms' = trAssign (env, lvalueVar (env, x), exp)
# Line 309  Line 324 
324                        in                        in
325                          (env, stm :: stms)                          (env, stm :: stms)
326                        end                        end
327                    | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => let                    | IR.S_For(x, lo, hi, blk) => let
328                        val x' = V.name x                        val x' = V.name x
329                        val env' = Env.insert (env, x, x')                        val env' = Env.insert (env, x, x')
330                        val (hi', hiInit) = if CodeGenUtil.isSimple hi                        val (hi', hiInit) = if CodeGenUtil.isSimple hi
# Line 328  Line 343 
343                          (env, hiInit @ loop :: stms)                          (env, hiInit @ loop :: stms)
344                        end                        end
345                    | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"                    | IR.S_Foreach(x, e, blk) => raise Fail "Foreach"
346                    | IR.S_New(strand, args) => raise Fail "New"                    | IR.S_New(strand, args) => let
347                          val args = List.map (fn e => trExp(env, e)) args
348                          val stm = CL.mkCall(
349                                Atom.toString strand ^ "_new",
350                                worldVar env :: args)
351                          in
352                            (env, stm :: stms)
353                          end
354                    | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp) @ stms)                    | IR.S_Save(x, exp) => (env, trAssign (env, lvalueStateVar(env, x), exp) @ stms)
355                    | IR.S_LoadNrrd(lhs, ty, nrrd) => let                    | IR.S_LoadNrrd(lhs, ty, nrrd) => let
356                        val stm = (case ty                        val stm = (case ty
# Line 347  Line 369 
369                    | IR.S_Input(gv, name, _, SOME dflt) =>                    | IR.S_Input(gv, name, _, SOME dflt) =>
370                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)                        (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
371                    | IR.S_InputNrrd _ => (env, stms)                    | IR.S_InputNrrd _ => (env, stms)
372                    | IR.S_Exit => (env, stms)                    | IR.S_Exit => (env, List.revAppend(Env.handleExit env, stms))
373                    | IR.S_Print(tys, args) => let                    | IR.S_Print(tys, args) => let
374                        val args = List.map (fn e => trExp(env, e)) args                        val args = List.map (fn e => trExp(env, e)) args
375                        val stm = trPrintStm (                        val stm = trPrintStm (
376                              CL.mkIndirect(CL.mkVar "wrld", "_output"),                              CL.mkIndirectDispatch(worldVar env, "output", []),
377                              tys, args)                              tys, args)
378                        in                        in
379                          (env, stm::stms)                          (env, stm::stms)
# Line 360  Line 382 
382                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)                    | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kStabilize")) :: stms)
383                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)                    | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar "diderot::kDie")) :: stms)
384                  (* end case *))                  (* end case *))
385              val (env, stms) = List.foldl trStm (env, []) stms
386            in            in
387              List.rev (#2 (List.foldl trStm (env, []) stms))              (env, List.rev stms)
388            end            end
389    
390      and trBlock (env, IR.Block{locals, body}) = let      and trBlock (env, IR.Block{locals, body}) = let
# Line 372  Line 395 
395                    (Env.insert(env, x, x'), dcl :: dcls)                    (Env.insert(env, x, x'), dcl :: dcls)
396                  end                  end
397            val (env, dcls) = List.foldl trLocal (env, []) (!locals)            val (env, dcls) = List.foldl trLocal (env, []) (!locals)
398              val (_, stms) = trStms (env, body)
399              in
400                CL.mkBlock (dcls @ stms)
401              end
402    
403        and trWithLocals (env, locals, trBody) = let
404              fun trLocal (x, (env, dcls)) = let
405                    val x' = V.name x
406                    val dcl = CL.mkDecl(trType(env, V.ty x), x', NONE)
407                    in
408                      (Env.insert(env, x, x'), dcl :: dcls)
409                    end
410              val (env, dcls) = List.foldl trLocal (env, []) locals
411            in            in
412              CL.mkBlock (dcls @ trStms (env, body))              CL.mkBlock (dcls @ trBody env)
413            end            end
414    
415      fun errorMsgAdd msg =      fun errorMsgAdd (env, msg) =
416            CL.mkCall("biffMsgAdd", [CL.mkIndirect(CL.mkVar "wrld", "_errors"), msg])            CL.mkCall("biffMsgAdd", [CL.mkIndirect(worldVar env, "_errors"), msg])
417    
418      fun trParam env x = let      fun trParam (env, x)= let
419            val x' = V.name x            val x' = V.name x
420            in            in
421              Env.insert (env, x, x');              (Env.insert (env, x, x'), CL.PARAM([], trType(env, V.ty x), x'))
             CL.PARAM([], trType(env, V.ty x), x')  
422            end            end
423    
424    end    end

Legend:
Removed from v.3922  
changed lines
  Added in v.3963

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