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

SCM Repository

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

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

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

branches/vis12/src/compiler/c-util/tree-to-c-fn.sml revision 1958, Tue Jul 10 13:01:03 2012 UTC branches/vis12-cl/src/compiler/c-util/tree-to-c.sml revision 2402, Sat Jul 27 13:55:03 2013 UTC
# Line 6  Line 6 
6   * Translate TreeIL to the C version of CLang.   * Translate TreeIL to the C version of CLang.
7   *)   *)
8    
9  signature TREE_VAR_TO_C =  structure PseudoVars =
10    sig    struct
11      type env = CLang.typed_var TreeIL.Var.Map.map  (* TreeIL "variables" that are used to get the names needed to access the
12    (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)   * global and strand state variables.  These are just used as keys to lookup
13      val lvalueVar : env * TreeIL.var -> CLang.exp   * the C names in the environment, so their kind and type are irrelevant.
14    (* translate a variable that occurs in a r-value context *)   *)
15      val rvalueVar : env * TreeIL.var -> CLang.exp      local
16    (* translate a strand state variable that occurs in an l-value context *)        fun new name = TreeIL.Var.new (name, TreeIL.VK_Local, TreeIL.Ty.IntTy)
17      val lvalueStateVar : TreeIL.state_var -> CLang.exp      in
18    (* translate a strand state variable that occurs in a r-value context *)      val selfIn = new "$selfIn"
19      val rvalueStateVar : TreeIL.state_var -> CLang.exp      val selfOut = new "$selfOut"
20        val global = new "$global"
21        end (* local *)
22    end    end
23    
24  functor TreeToCFn (VarToC : TREE_VAR_TO_C) : sig  structure TreeToC : sig
25    
26      type env = CLang.typed_var TreeIL.Var.Map.map      type env = CLang.typed_var TreeIL.Var.Map.map
27    
28        val empty : env
29    
30      val trType : TreeIL.Ty.ty -> CLang.ty      val trType : TreeIL.Ty.ty -> CLang.ty
31    
32      val trBlock : env * TreeIL.block -> CLang.stm      val trBlock : env * TreeIL.block -> CLang.stm
# Line 33  Line 37 
37    
38      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
39    
40        val trAssign : env * CLang.exp * TreeIL.exp -> CLang.stm list
41    
42    (* vector indexing support.  Arguments are: vector, arity, index *)    (* vector indexing support.  Arguments are: vector, arity, index *)
43      val ivecIndex : CLang.exp * int * int -> CLang.exp      val ivecIndex : CLang.exp * int * int -> CLang.exp
44      val vecIndex : CLang.exp * int * int -> CLang.exp      val vecIndex : CLang.exp * int * int -> CLang.exp
# Line 49  Line 55 
55      datatype var = datatype CLang.typed_var      datatype var = datatype CLang.typed_var
56      type env = CLang.typed_var TreeIL.Var.Map.map      type env = CLang.typed_var TreeIL.Var.Map.map
57    
58        val empty = TreeIL.Var.Map.empty
59    
60      fun lookup (env, x) = (case V.Map.find (env, x)      fun lookup (env, x) = (case V.Map.find (env, x)
61             of SOME(V(_, x')) => x'             of SOME(V(_, x')) => x'
62              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
63            (* end case *))            (* end case *))
64    
65        local
66          fun global env = CL.mkVar(lookup(env, PseudoVars.global))
67          fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
68          fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
69        in
70      (* translate a variable that occurs in an l-value context (i.e., as the target of an assignment) *)
71        fun lvalueVar (env, x) = (case V.kind x
72               of IL.VK_Local => CL.mkVar(lookup(env, x))
73                | _ => CL.mkIndirect(global env, lookup(env, x))
74              (* end case *))
75    
76      (* translate a variable that occurs in an r-value context *)
77        fun rvalueVar (env, x) = (case V.kind x
78               of IL.VK_Local => CL.mkVar(lookup(env, x))
79                | _ => CL.mkIndirect(global env, lookup(env, x))
80              (* end case *))
81    
82      (* translate a strand state variable that occurs in an l-value context *)
83        fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, IL.StateVar.name x)
84    
85      (* translate a strand state variable that occurs in an r-value context *)
86        fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, IL.StateVar.name x)
87        end (* local *)
88    
89    (* integer literal expression *)    (* integer literal expression *)
90      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)      fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)
91    
# Line 174  Line 206 
206                    CL.mkSubscript(vecExp, ix)                    CL.mkSubscript(vecExp, ix)
207                  end                  end
208              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)              | (Op.Subscript(Ty.SeqTy(ty, n)), [v, ix]) => CL.mkSubscript(v, ix)
209                | (Op.Subscript(Ty.DynSeqTy ty), [v, ix]) => let
210                    val elemTy = trType ty
211                    in
212                      CL.mkUnOp (CL.%*,
213                        CL.mkCast(CL.T_Ptr elemTy,
214                          CL.mkApply("Diderot_DynSeqAddr", [CL.mkSizeof elemTy, v, ix])))
215                    end
216              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let              | (Op.Subscript(Ty.TensorTy[n]), [v, ix]) => let
217                  val unionTy = CL.T_Named(N.unionTy n)                  val unionTy = CL.T_Named(N.unionTy n)
218                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")                  val vecExp = CL.mkSelect(CL.mkCast(unionTy, v), "r")
# Line 223  Line 262 
262                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])                  CL.mkApply(N.toImageSpace(ImageInfo.dim info), [img, pos])
263              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
264                  CL.mkApply(N.toWorldSpace ty, [v, x])                  CL.mkApply(N.toWorldSpace ty, [v, x])
             | (Op.LoadImage info, [a]) =>  
                 raise Fail("impossible " ^ Op.toString rator)  
265              | (Op.Inside(info, s), [pos, img]) =>              | (Op.Inside(info, s), [pos, img]) =>
266                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])                  CL.mkApply(N.inside(ImageInfo.dim info), [pos, img, intExp s])
267              | (Op.Input(ty, desc, name), []) =>              | (Op.LoadSeq(ty, nrrd), []) =>
268                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
269              | (Op.InputWithDefault(ty, desc, name), [a]) =>              | (Op.LoadImage(ty, nrrd, info), []) =>
270                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
271                | (Op.Input _, []) => raise Fail("impossible " ^ Op.toString rator)
272              | _ => raise Fail(concat[              | _ => raise Fail(concat[
273                    "unknown or incorrect operator ", Op.toString rator                    "unknown or incorrect operator ", Op.toString rator
274                  ])                  ])
275            (* end case *))            (* end case *))
276    
277      fun trExp (env, e) = (case e      fun trExp (env, e) = (case e
278             of IL.E_State x => VarToC.rvalueStateVar x             of IL.E_State x => rvalueStateVar (env, x)
279              | IL.E_Var x => VarToC.rvalueVar (env, x)              | IL.E_Var x => rvalueVar (env, x)
280              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !N.gIntTy)              | IL.E_Lit(Literal.Int n) => CL.mkIntTy(n, !N.gIntTy)
281              | IL.E_Lit(Literal.Bool b) => CL.mkBool b              | IL.E_Lit(Literal.Bool b) => CL.mkBool b
282              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)              | IL.E_Lit(Literal.Float f) => CL.mkFlt(f, !N.gRealTy)
# Line 384  Line 422 
422                        matIndex (m, CL.mkInt 2, CL.mkInt 2)                        matIndex (m, CL.mkInt 2, CL.mkInt 2)
423                      ])]                      ])]
424                  end                  end
425              | IL.E_Op(Op.Identity n, args) =>              | IL.E_Op(Op.Identity n, _) =>
426                  [CL.mkCall(N.identityMat n, [lhs])]                  [CL.mkCall(N.identityMat n, [lhs])]
427              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>              | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), _) =>
428                  [CL.mkCall(N.zeroMat(m,n), [lhs])]                  [CL.mkCall(N.zeroMat(m,n), [lhs])]
429                | IL.E_Op(Op.Transpose(m,n), args) =>
430                    [CL.mkCall(N.transposeMat(m,n), lhs :: trExps(env, args))]
431              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy(_::_::_)), args) =>              | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy(_::_::_)), args) =>
432                  [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]                  [CL.mkCall(N.toWorldSpace ty, lhs :: trExps(env, args))]
433              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>              | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
# Line 442  Line 482 
482                    doAssign (0, trExps(env, args))                    doAssign (0, trExps(env, args))
483                  end                  end
484              | IL.E_State x => (case IL.StateVar.ty x              | IL.E_State x => (case IL.StateVar.ty x
485                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueStateVar x])]                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueStateVar(env, x)])]
486                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, VarToC.rvalueStateVar x])]                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, rvalueStateVar(env, x)])]
487                    | _ => [CL.mkAssign(lhs, VarToC.rvalueStateVar x)]                    | _ => [CL.mkAssign(lhs, rvalueStateVar(env, x))]
488                  (* end case *))                  (* end case *))
489              | IL.E_Var x => (case IL.Var.ty x              | IL.E_Var x => (case IL.Var.ty x
490                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, VarToC.rvalueVar(env, x)])]                   of Ty.TensorTy[n,m] => [CL.mkCall(N.copyMat(n,m), [lhs, rvalueVar(env, x)])]
491                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, VarToC.rvalueVar(env, x)])]                    | Ty.TensorTy[n,m,l] => [CL.mkCall(N.copyTen3(n,m,l), [lhs, rvalueVar(env, x)])]
492                    | _ => [CL.mkAssign(lhs, VarToC.rvalueVar(env, x))]                    | _ => [CL.mkAssign(lhs, rvalueVar(env, x))]
493                  (* end case *))                  (* end case *))
494              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]              | _ => [CL.mkAssign(lhs, trExp(env, rhs))]
495            (* end case *))            (* end case *))
# Line 507  Line 547 
547            val env = trLocals (env, locals)            val env = trLocals (env, locals)
548            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
549                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
550                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadNrrd _ => [] (* FIXME *)
551                        val lhs = VarToC.lvalueVar (env, lhs)                    | IL.S_InputNrrd _ => [] (* FIXME *)
                       val imgTy = CL.T_Named(N.imageTy dim)  
                       val freeFn = N.freeImage dim  
                       in [  
                         CL.mkDecl(  
                           CL.T_Named N.statusTy, sts,  
                           SOME(CL.I_Exp(CL.E_Apply(freeFn, [  
                               CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),  
                               addrOf lhs  
                             ]))))  
                       ] end)  
552                    | _ => []                    | _ => []
553                  (* end case *))                  (* end case *))
554            val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body            val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body
# Line 534  Line 564 
564      fun trStms (env, stms) = let      fun trStms (env, stms) = let
565            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
566                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
567                    | IL.S_Assign([x], exp) => trAssign (env, VarToC.lvalueVar (env, x), exp)                    | IL.S_Assign([x], exp) => trAssign (env, lvalueVar (env, x), exp)
568                    | IL.S_Assign(xs, exp) =>                    | IL.S_Assign(xs, exp) =>
569                        trMultiAssign (env, List.map (fn x => VarToC.lvalueVar (env, x)) xs, exp)                        trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp)
570                    | IL.S_IfThen(cond, thenBlk) =>                    | IL.S_IfThen(cond, thenBlk) =>
571                        [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]                        [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]
572                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
# Line 544  Line 574 
574                          trBlk(env, thenBlk),                          trBlk(env, thenBlk),
575                          trBlk(env, elseBlk))]                          trBlk(env, elseBlk))]
576                    | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)                    | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
577                    | IL.S_Save([x], exp) => trAssign (env, VarToC.lvalueStateVar x, exp)                    | IL.S_Save([x], exp) => trAssign (env, lvalueStateVar(env, x), exp)
578                    | IL.S_Save(xs, exp) =>                    | IL.S_Save(xs, exp) =>
579                        trMultiAssign (env, List.map VarToC.lvalueStateVar xs, exp)                        trMultiAssign (env, List.map (fn x => lvalueStateVar(env, x)) xs, exp)
580                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) =>
581                        val lhs = VarToC.lvalueVar (env, lhs)                        [GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)]
582                        val name = trExp(env, name)                    | IL.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
583                        val imgTy = CL.T_Named(N.imageTy dim)                        [GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.E_Str nrrd)]
                       val loadFn = N.loadImage dim  
                       in [  
                         CL.mkDecl(  
                           CL.T_Named N.statusTy, sts,  
                           SOME(CL.I_Exp(CL.E_Apply(loadFn, [  
                               CL.mkCast(CL.T_Ptr(CL.T_Named "WorldPrefix_t"), CL.mkVar "wrld"),  
                               name, addrOf lhs  
                             ]))))  
                       ] end)  
584                    | IL.S_Input(_, _, _, NONE) => []                    | IL.S_Input(_, _, _, NONE) => []
585                    | IL.S_Input(lhs, name, _, SOME dflt) => [                    | IL.S_Input(lhs, name, _, SOME dflt) => [
586                          CL.mkAssign(VarToC.lvalueVar(env, lhs), trExp(env, dflt))                          CL.mkAssign(lvalueVar(env, lhs), trExp(env, dflt))
587                        ]                        ]
588                      | IL.S_InputNrrd _ => []
589                    | IL.S_Exit args => []                    | IL.S_Exit args => []
590                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]                    | IL.S_Active => [CL.mkReturn(SOME(CL.mkVar N.kActive))]
591                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]                    | IL.S_Stabilize => [CL.mkReturn(SOME(CL.mkVar N.kStabilize))]

Legend:
Removed from v.1958  
changed lines
  Added in v.2402

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