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

SCM Repository

[diderot] Diff of /trunk/src/compiler/translate/translate.sml
ViewVC logotype

Diff of /trunk/src/compiler/translate/translate.sml

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

revision 168, Wed Jul 21 20:58:37 2010 UTC revision 200, Mon Aug 2 21:57:49 2010 UTC
# Line 3  Line 3 
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Translate AST code into the IL representation.   * Translate Simple-AST code into the IL representation.
7   *)   *)
8    
9  structure Translate : sig  structure Translate : sig
10    
11      val translate : AST.program -> ??      val translate : Simple.program -> HighIL.program
12    
13    end = struct    end = struct
14    
15        structure S = Simple
16      structure VMap = Var.Map      structure VMap = Var.Map
17        structure VSet = Var.Set
18      structure IL = HighIL      structure IL = HighIL
19    
20    (* expression translation *)      fun lookup env x = (case VMap.find (env, x)
21      fun cvtExpr (env, exp, kont) = let             of SOME x' => x'
22            fun cvt e = (case e              | NONE => raise Fail(concat[
23                   of AST.E_Var(x, tyArgs, ty) =>                    "no binding for ", Var.uniqueNameOf x, " in environment"
24                    | AST.E_Lit lit =>                  ])
                   | AST.E_Tuple es =>  
                   | AST.E_Apply(f, tyArgs, args, ty) =>  
                   | AST.E_Cons of expr list  
                   | AST.E_Cond(e1, e2, e3) =>  
25                  (* end case *))                  (* end case *))
26    
27      (* create a new instance of a variable *)
28        fun newVar x = IL.Var.new (Var.nameOf x)
29    
30      (* expression translation *)
31        fun cvtExp (env, lhs, exp) = (case exp
32               of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
33                | S.E_Lit lit => [(lhs, IL.LIT lit)]
34                | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
35                | S.E_Apply(f, tyArgs, args, ty) => let
36                    val args' = List.map (lookup env) args
37            in            in
38                      TranslateBasis.translate (lhs, f, tyArgs, args')
39            end            end
40                | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
41              (* end case *))
42    
43      and cvtStmt (env, stm) = (case stm    (* convert a Simple AST block to an IL statement.  We return the statement that represents the
44             of AST.S_Block of stmt list     * block, plus the environment mapping Simple AST variables to their current SSA representations
45              | AST.S_Decl of var_decl     * and the set of Simple AST variables that were assigned to in the block.
46              | AST.S_IfThenElse of expr * stmt * stmt     *)
47              | AST.S_Assign of var * expr      fun cvtBlock (env, S.Block stms) = let
48              | AST.S_New of Atom.atom * expr list            fun toBlock (env, assigned, [], assignments) =
49              | AST.S_Die                  (IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)
50              | AST.S_Stabilize              | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
51                    val x' = newVar x
52                    val stms = cvtExp(env, x', e)
53                    val assigned = VSet.add(assigned, x)
54                    val env = VMap.insert(env, x, x')
55                    in
56                      toBlock (env, assigned, rest, stms@assignments)
57                    end
58                | toBlock (env, assigned, stms, assignments) = let
59                    val (succ, env, assigned) = toStmt (env, assigned, stms)
60                    val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}
61                    in
62                      IL.addPred (succ, blk);
63                      (blk, env, assigned)
64                    end
65              and toStmt (env, assigned, []) =
66                    (IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)
67                | toStmt (env, assigned, stms as stm::rest) = (case stm
68                     of S.S_Assign _ => toBlock (env, assigned, stms, [])
69                      | S.S_IfThenElse(x, b1, b2) => let
70                          val x' = lookup env x
71                          val (s1, env1, assigned1) = cvtBlock(env, b1)
72                          val (s2, env2, assigned2) = cvtBlock(env, b2)
73                          val assigned = VSet.union(assigned1, assigned2)
74                          val (env, phis) = let
75                                fun mkPhi (x, (env, phis)) = let
76                                      val x1 = lookup env1 x
77                                      val x2 = lookup env2 x
78                                      val x' = newVar x
79                                      in
80                                        (VMap.insert(env, x, x'), (x', [x1, x2])::phis)
81                                      end
82                                in
83                                  VSet.foldl mkPhi (env, []) assigned
84                                end
85                          val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
86                          in
87                            case rest
88                             of [] => (stm, env, assigned)
89                              | _ => let
90                                  val (join, env, assigned) = toStmt (env, assigned, rest)
91                                  in
92                                    IL.addPred (join, stm);
93                                    IL.setSucc (stm, join);
94                                    (stm, env, assigned)
95                                  end
96                            (* end case *)
97                          end
98                      | S.S_New(name, xs) => let
99                          val xs' = List.map (lookup env) xs
100                          in
101                            case rest
102                             of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)
103                              | _ => let
104                                  val (succ, env, assigned) = toStmt (env, assigned, rest)
105                                  val stm = IL.mkNEW{actor=name, args=xs', succ=succ}
106                                  in
107                                    IL.addPred (succ, stm);
108                                    (stm, env, assigned)
109                                  end
110                          end
111                      | S.S_Die => (IL.mkDIE(), env, assigned)
112                      | S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)
113            (* end case *))            (* end case *))
114              in
115                toStmt (env, VSet.empty, stms)
116              end
117    
118        fun translate (S.Program{globals, globalInit, actors}) = let
119              val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)
120            (* get the SSA names for the globals and a reduced environment *)
121              val (env, globs) = let
122                    val lookup = lookup env
123                    fun cvtVar (x, (env, globs)) = let
124                          val x' = lookup x
125                          in
126                            (VMap.insert(env, x, x'), x'::globs)
127                          end
128                    val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
129                    in
130                      (env, List.rev globs)
131                    end
132              fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let
133                    val (env, params) = let
134                          fun cvtParam (x, (env, xs)) = let
135                                val x' = newVar x
136                                in
137                                  (VMap.insert(env, x, x'), x'::xs)
138                                end
139                          val (env, params) = List.foldl cvtParam (env, []) params
140                          in
141                            (env, List.rev params)
142                          end
143                    val (stateInit, env, _) = cvtBlock (env, stateInit)
144                    val state = List.map (lookup env) state
145                    fun cvtMethod (S.Method(name, blk)) = let
146                          val (body, _, _) = cvtBlock (env, blk)
147                          in
148                            IL.Method(name, body)
149                          end
150                    in
151                      IL.Actor{
152                          name = name,
153                          params = params,
154                          state = state,
155                          stateInit = stateInit,
156                          methods = List.map cvtMethod methods
157                        }
158                    end
159              in
160                IL.Program{
161                    globals = globs,
162                    globalInit = globalInit,
163                    actors = List.map cvtActor actors
164                  }
165              end
166    
167    end    end

Legend:
Removed from v.168  
changed lines
  Added in v.200

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