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

SCM Repository

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

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

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

revision 3872, Wed May 18 13:08:16 2016 UTC revision 3873, Wed May 18 13:38:23 2016 UTC
# Line 11  Line 11 
11    
12  structure TreeToCxx : sig  structure TreeToCxx : sig
13    
     type env = CLang.typed_var TreeVar.Map.map  
   
     val empty : env  
   
14      val trType : TreeTypes.t -> CLang.ty      val trType : TreeTypes.t -> CLang.ty
15    
16      val trBlock : env * TreeIR.block -> CLang.stm      val trBlock : CodeGenEnv.t * TreeIR.block -> CLang.stm
17    
18      val trExp : env * TreeIR.exp -> CLang.exp      val trExp : CodeGenEnv.t * TreeIR.exp -> CLang.exp
19    
20    (* 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)
21     * and the (optional) declaration.     * and the (optional) declaration.
22     *)     *)
23      val expToVar : env * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list      val expToVar : CodeGenEnv.t * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list
24    
25      val trAssign : env * CLang.exp * TreeIR.exp -> CLang.stm list      val trAssign : CodeGenEnv.t * CLang.exp * TreeIR.exp -> CLang.stm list
26    
27    end = struct    end = struct
28    
# Line 35  Line 31 
31      structure Op = TreeOps      structure Op = TreeOps
32      structure Ty = TreeTypes      structure Ty = TreeTypes
33      structure V = TreeVar      structure V = TreeVar
34      structure VMap = V.Map      structure Env = CodeGenEnv
35    
36      datatype var = datatype CL.typed_var      datatype var = datatype CL.typed_var
     type env = CLang.typed_var VMap.map  
37    
     val empty = VMap.empty  
   
     fun lookup (env, x) = (case VMap.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  
38    (* translate a local variable that occurs in an l-value context *)    (* translate a local variable that occurs in an l-value context *)
39      fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))      fun lvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
40    (* translate a variable that occurs in an r-value context *)    (* translate a variable that occurs in an r-value context *)
41      fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))      fun rvalueVar (env, x) = CL.mkVar(Env.lookup(env, x))
42    
43    (* translate a global variable that occurs in an l-value context *)    (* translate a global variable that occurs in an l-value context *)
44      fun lvalueGlobalVar (env, x) = CL.mkIndirect(global env, TreeGlobalVar.name x)      fun lvalueGlobalVar (env, x) = CL.mkIndirect(Env.global env, TreeGlobalVar.name x)
45    (* translate a global variable that occurs in an r-value context *)    (* translate a global variable that occurs in an r-value context *)
46      val rvalueGlobalVar = lvalueGlobalVar      val rvalueGlobalVar = lvalueGlobalVar
47    
48    (* translate a strand state variable that occurs in an l-value context *)    (* translate a strand state variable that occurs in an l-value context *)
49      fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, TreeStateVar.name x)      fun lvalueStateVar (env, x) = CL.mkIndirect(Env.selfOut env, TreeStateVar.name x)
50    (* translate a strand state variable that occurs in an r-value context *)    (* translate a strand state variable that occurs in an r-value context *)
51      fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, TreeStateVar.name x)      fun rvalueStateVar (env, x) = CL.mkIndirect(Env.selfIn env, TreeStateVar.name x)
     end (* local *)  
52    
53    (* generate new variables *)    (* generate new variables *)
54      local      local
# Line 205  Line 187 
187    
188      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
189    
190    (* QUESTION: not sure that we need this function? *)
191      fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)      fun trExpToVar (env, ty, name, exp) = (case trExp (env, exp)
192             of e as CL.E_Var _ => (e, [])             of e as CL.E_Var _ => (e, [])
193              | e => let              | e => let
# Line 212  Line 195 
195                  in                  in
196                    (CL.mkVar x, pCL.mkDeclInit(ty, x, e))                    (CL.mkVar x, pCL.mkDeclInit(ty, x, e))
197                  end                  end
198              (* end case *))
199    
200      fun trRHS mkStm (env, rhs) = (case rhs      fun trRHS mkStm (env, rhs) = (case rhs
201             of IR.E_Op(??, args) => ???             of IR.E_Op(??, args) => ???
# Line 229  Line 213 
213      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)
214             of ([vals, vecs], Op.EigenVecs2x2, [m]) =>             of ([vals, vecs], Op.EigenVecs2x2, [m]) =>
215                  mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])                  mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
216              | ([vals, vecs], Op.EigenVecs3x3, [m]) => let              | ([vals, vecs], Op.EigenVecs3x3, [m]) =>
217                  mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])                  mkDiderotCall("eigenvecs", [trExp (env, exp), vals, vecs])
218              | _ => raise Fail "bogus multi-assignment"              | _ => raise Fail "bogus multi-assignment"
219            (* end case *))            (* end case *))
220        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"        | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"
221    
     fun trLocals (env : env, locals) =  
           List.foldl  
             (fn (x, env) => VMap.insert(env, x, V(trType(V.ty x), V.name x)))  
               env locals  
   
222      fun trStms (env, stms : TreeIR.stm list) = let      fun trStms (env, stms : TreeIR.stm list) = let
223            fun trStm (stm, (env, stms : CL.stm list)) = (case stm            fun trStm (stm, (env, stms : CL.stm list)) = (case stm
224                   of IR.S_Comment text => (env, CL.mkComment text :: stms)                   of IR.S_Comment text => (env, CL.mkComment text :: stms)
225                    | IR.S_Assign(true, x, exp) => let                    | IR.S_Assign(true, x, exp) => let
226                        val (env, stm) = trDecl (env, ??, lookup (env, x), exp)                        val (env, stm) = trDecl (env, ??, Env.lookup (env, x), exp)
227                        in                        in
228                          (env, stm::stms)                          (env, stm::stms)
229                        end                        end
# Line 296  Line 275 
275            end            end
276    
277      and trBlock (env, IR.Block{locals, body}) = let      and trBlock (env, IR.Block{locals, body}) = let
278            val env = trLocals (env, !locals)            fun trLocal (x, (env, dcls)) = let
279            val stms = trStms (env, body)                  val x' = V.name x
280            fun mkDecl (x, stms) = (case VMap.find (env, x)                  in
281                   of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms                    (Env.insert(env, x, x'), CL.mkDecl(ty, x', NONE) :: dcls)
282                    | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])                  end
283                  (* end case *))            val (env, dcls) = List.foldl trLocal (env, []) (!locals)
           val stms = List.foldr mkDecl stms (!locals)  
284            in            in
285              CL.mkBlock stms              CL.mkBlock (dcls @ trStms (env, body))
286            end            end
287    
288    end    end

Legend:
Removed from v.3872  
changed lines
  Added in v.3873

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