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

SCM Repository

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

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

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

revision 2475, Sat Oct 12 17:45:57 2013 UTC revision 2476, Mon Oct 14 09:36:13 2013 UTC
# Line 12  Line 12 
12    
13    end = struct    end = struct
14    
15      structure Ty = Types      structure TU = TypeUtil
16      structure S = Simple      structure S = Simple
17        structure VMap = Var.Map
18    
19    (* the SimpleAST and AST currently use the same type representation, but      val cvtTy = SimpleTypes.simplify
20     * we prune out meta variables.  
21     *)      fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)
     val cvtTy = TypeUtil.prune  
22    
23      local    (* convert an AST variable to a Simple variable *)
24        val tempName = Atom.atom "_t"      fun cvtVar (env, x as Var.V{name, kind, ty=([], ty), ...}) = let
25              val x' = SimpleVar.new (name, kind, cvtTy ty)
26      in      in
27      fun newTemp ty = Var.new (tempName, AST.LocalVar, cvtTy ty)              (x', VMap.insert(env, x, x'))
28      end      end
29    
30        fun cvtVars (env, xs) = List.foldr
31              (fn (x, (xs, env)) => let
32                val (x', env) = cvtVar(env, x)
33                in
34                  (x'::xs, env)
35                end) ([], env) xs
36    
37        fun lookupVar (env, x) = (case VMap.find (env, x)
38               of SOME x' => x'
39                | NONE => raise Fail(concat["lookupVar(", Var.uniqueNameOf x, ")"])
40              (* end case *))
41    
42    (* make a block out of a list of statements that are in reverse order *)    (* make a block out of a list of statements that are in reverse order *)
43      fun mkBlock stms = S.Block(List.rev stms)      fun mkBlock stms = S.Block(List.rev stms)
44    
# Line 48  Line 61 
61  (* FIXME: the check for multiple initially decls should happen in type checking *)  (* FIXME: the check for multiple initially decls should happen in type checking *)
62                    | SOME _ => raise Fail "multiple initially declarations"                    | SOME _ => raise Fail "multiple initially declarations"
63                  (* end case *))                  (* end case *))
64            fun simplifyDecl dcl = (case dcl            fun simplifyDecl (dcl, env) = (case dcl
65                   of AST.D_Input(x, desc, NONE) => let                   of AST.D_Input(x, desc, NONE) => let
66                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, desc, NONE)                        val (x', env) = cvtVar(env, x)
67                          val e' = S.E_Input(SimpleVar.typeOf x', SimpleVar.nameOf x', desc, NONE)
68                        in                        in
69                          globals := x :: !globals;                          globals := x' :: !globals;
70                          globalInit := S.S_Assign(x, e') :: !globalInit                          globalInit := S.S_Assign(x', e') :: !globalInit;
71                            env
72                        end                        end
73                    | AST.D_Input(x, desc, SOME e) => let                    | AST.D_Input(x, desc, SOME e) => let
74                        val (stms, x') = simplifyExpToVar (e, [])                        val (x', env) = cvtVar(env, x)
75                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, desc, SOME x')                        val (stms, x'') = simplifyExpToVar (env, e, [])
76                        in                        val e' = S.E_Input(SimpleVar.typeOf x', SimpleVar.nameOf x', desc, SOME x'')
77                          globals := x :: !globals;                        in
78                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)                          globals := x' :: !globals;
79                            globalInit := S.S_Assign(x', e') :: (stms @ !globalInit);
80                            env
81                        end                        end
82                    | AST.D_Var(AST.VD_Decl(x, e)) => let                    | AST.D_Var(AST.VD_Decl(x, e)) => let
83                        val (stms, e') = simplifyExp (e, [])                        val (x', env) = cvtVar(env, x)
84                          val (stms, e') = simplifyExp (env, e, [])
85                        in                        in
86                          globals := x :: !globals;                          globals := x' :: !globals;
87                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)                          globalInit := S.S_Assign(x', e') :: (stms @ !globalInit);
88                        end                          env
89                    | AST.D_Func(f, params, body) =>                        end
90                        funcs := S.Func{f=f, params=params, body=simplifyBlock body} :: !funcs                    | AST.D_Func(f, params, body) => let
91                    | AST.D_Strand info => strands := simplifyStrand info :: !strands                        val (f', env) = cvtVar(env, f)
92                    | AST.D_InitialArray(creat, iters) =>                        val (params', env) = cvtVars (env, params)
93                        setInitially (simplifyInit(true, creat, iters))                        val body' = simplifyBlock(env, body)
94                    | AST.D_InitialCollection(creat, iters) =>                        in
95                        setInitially (simplifyInit(false, creat, iters))                          funcs := S.Func{f=f', params=params', body=body'} :: !funcs;
96                            env
97                          end
98                      | AST.D_Strand info => (
99                          strands := simplifyStrand(env, info) :: !strands;
100                          env)
101                      | AST.D_InitialArray(creat, iters) => (
102                          setInitially (simplifyInit(env, true, creat, iters));
103                          env)
104                      | AST.D_InitialCollection(creat, iters) => (
105                          setInitially (simplifyInit(env, false, creat, iters));
106                          env)
107                  (* end case *))                  (* end case *))
108              val env = List.foldl simplifyDecl VMap.empty dcls
109            in            in
             List.app simplifyDecl dcls;  
110              S.Program{              S.Program{
111                  globals = List.rev(!globals),                  globals = List.rev(!globals),
112                  globalInit = mkBlock (!globalInit),                  globalInit = mkBlock (!globalInit),
# Line 91  Line 120 
120                }                }
121            end            end
122    
123      and simplifyInit (isArray, AST.C_Create(strand, exps), iters) = let      and simplifyInit (env, isArray, AST.C_Create(strand, exps), iters) = let
124            val (stms, xs) = simplifyExpsToVars (exps, [])            fun simplifyIter (AST.I_Range(x, e1, e2), (env, iters, stms)) = let
125                    val (stms, lo) = simplifyExpToVar (env, e1, stms)
126                    val (stms, hi) = simplifyExpToVar (env, e2, stms)
127                    val (x', env) = cvtVar (env, x)
128                    in
129                      (env, {param=x', lo=lo, hi=hi}::iters, stms)
130                    end
131              val (env, iters, iterStms) = List.foldl simplifyIter (env, [], []) iters
132              val (stms, xs) = simplifyExpsToVars (env, exps, [])
133            val creat = S.C_Create{            val creat = S.C_Create{
134                    argInit = mkBlock stms,                    argInit = mkBlock stms,
135                    name = strand,                    name = strand,
136                    args = xs                    args = xs
137                  }                  }
           fun simplifyIter (AST.I_Range(x, e1, e2), (iters, stms)) = let  
                 val (stms, lo) = simplifyExpToVar (e1, stms)  
                 val (stms, hi) = simplifyExpToVar (e2, stms)  
                 in  
                   ({param=x, lo=lo, hi=hi}::iters, stms)  
                 end  
           val (iters, stms) = List.foldl simplifyIter ([], []) iters  
138            in            in
139              S.Initially{              S.Initially{
140                  isArray = isArray,                  isArray = isArray,
141                  rangeInit = mkBlock stms,                  rangeInit = mkBlock iterStms,
142                  iters = List.rev iters,                  iters = List.rev iters,
143                  create = creat                  create = creat
144                }                }
145            end            end
146    
147      and simplifyStrand (AST.Strand{name, params, state, methods}) = let      and simplifyStrand (env, AST.Strand{name, params, state, methods}) = let
148            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)            val (params', env) = cvtVars (env, params)
149              | simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let            fun simplifyState (env, [], xs, stms) = (List.rev xs, mkBlock stms, env)
150                  val (stms, e') = simplifyExp (e, stms)              | simplifyState (env, AST.VD_Decl(x, e) :: r, xs, stms) = let
151                    val (stms, e') = simplifyExp (env, e, stms)
152                    val (x', env) = cvtVar(env, x)
153                  in                  in
154                    simplifyState (r, x::xs, S.S_Assign(x, e') :: stms)                    simplifyState (env, r, x'::xs, S.S_Assign(x', e') :: stms)
155                  end                  end
156            val (xs, stm) = simplifyState (state, [], [])            val (xs, stm, env) = simplifyState (env, state, [], [])
157            in            in
158              S.Strand{              S.Strand{
159                  name = name,                  name = name,
160                  params = params,                  params = params',
161                  state = xs, stateInit = stm,                  state = xs, stateInit = stm,
162                  methods = List.map simplifyMethod methods                  methods = List.map (simplifyMethod env) methods
163                }                }
164            end            end
165    
166      and simplifyMethod (AST.M_Method(name, body)) =      and simplifyMethod env (AST.M_Method(name, body)) =
167            S.Method(name, simplifyBlock body)            S.Method(name, simplifyBlock(env, body))
168    
169    (* simplify a statement into a single statement (i.e., a block if it expands    (* simplify a statement into a single statement (i.e., a block if it expands
170     * into more than one new statement).     * into more than one new statement).
171     *)     *)
172      and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))      and simplifyBlock (env, stm) = mkBlock (#1 (simplifyStmt (env, stm, [])))
173    
174    (* simplify the statement stm where stms is a reverse-order list of preceeding simplified    (* simplify the statement stm where stms is a reverse-order list of preceeding simplified
175     * statements.  This function returns a reverse-order list of simplified statements.     * statements.  This function returns a reverse-order list of simplified statements.
176     * Note that error reporting is done in the typechecker, but it does not prune unreachable     * Note that error reporting is done in the typechecker, but it does not prune unreachable
177     * code.     * code.
178     *)     *)
179      and simplifyStmt (stm, stms) = (case stm      and simplifyStmt (env, stm, stms) = (case stm
180             of AST.S_Block body => let             of AST.S_Block body => let
181                  fun simplify ([], stms) = stms                  fun simplify (_, [], stms) = stms
182                    | simplify (stm::r, stms) = if contIsNext stm                    | simplify (env', stm::r, stms) = let
183                        then simplify (r, simplifyStmt (stm, stms))                        val (stms, env') = simplifyStmt (env', stm, stms)
184                        else simplifyStmt (stm, stms)  (* prune unreachable statements *)                        in
185                            if contIsNext stm
186                              then simplify (env', r, stms)
187                              else stms  (* prune the unreachable statements "r" *)
188                          end
189                  in                  in
190                    simplify (body, stms)                    (simplify (env, body, stms), env)
191                  end                  end
192              | AST.S_Decl(AST.VD_Decl(x, e)) => let              | AST.S_Decl(AST.VD_Decl(x, e)) => let
193                  val (stms, e') = simplifyExp (e, stms)                  val (stms, e') = simplifyExp (env, e, stms)
194                    val (x', env) = cvtVar(env, x)
195                  in                  in
196                    S.S_Assign(x, e') :: stms                    (S.S_Assign(x', e') :: stms, env)
197                  end                  end
198              | AST.S_IfThenElse(e, s1, s2) => let              | AST.S_IfThenElse(e, s1, s2) => let
199                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (env, e, stms)
200                  val s1 = simplifyBlock s1                  val s1 = simplifyBlock (env, s1)
201                  val s2 = simplifyBlock s2                  val s2 = simplifyBlock (env, s2)
202                  in                  in
203                    S.S_IfThenElse(x, s1, s2) :: stms                    (S.S_IfThenElse(x, s1, s2) :: stms, env)
204                  end                  end
205              | AST.S_Assign(x, e) => let              | AST.S_Assign(x, e) => let
206                  val (stms, e') = simplifyExp (e, stms)                  val (stms, e') = simplifyExp (env, e, stms)
207                  in                  in
208                    S.S_Assign(x, e') :: stms                    (S.S_Assign(lookupVar(env, x), e') :: stms, env)
209                  end                  end
210              | AST.S_New(name, args) => let              | AST.S_New(name, args) => let
211                  val (stms, xs) = simplifyExpsToVars (args, stms)                  val (stms, xs) = simplifyExpsToVars (env, args, stms)
212                  in                  in
213                    S.S_New(name, xs) :: stms                    (S.S_New(name, xs) :: stms, env)
214                  end                  end
215              | AST.S_Die => S.S_Die :: stms              | AST.S_Die => (S.S_Die :: stms, env)
216              | AST.S_Stabilize => S.S_Stabilize :: stms              | AST.S_Stabilize => (S.S_Stabilize :: stms, env)
217              | AST.S_Return e => let              | AST.S_Return e => let
218                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (env, e, stms)
219                  in                  in
220                    S.S_Return x :: stms                    (S.S_Return x :: stms, env)
221                  end                  end
222              | AST.S_Print args => let              | AST.S_Print args => let
223                  val (stms, xs) = simplifyExpsToVars (args, stms)                  val (stms, xs) = simplifyExpsToVars (env, args, stms)
224                  in                  in
225                    S.S_Print xs :: stms                    (S.S_Print xs :: stms, env)
226                  end                  end
227            (* end case *))            (* end case *))
228    
229      and simplifyExp (exp, stms) = (      and simplifyExp (env, exp, stms) = (
230            case exp            case exp
231             of AST.E_Var x => (case Var.kindOf x             of AST.E_Var x => (case Var.kindOf x
232                   of Var.BasisVar => let                   of Var.BasisVar => let
233                        val ty = Var.monoTypeOf x                        val ty = cvtTy(Var.monoTypeOf x)
234                        val x' = newTemp ty                        val x' = newTemp ty
235                        val stm = S.S_Assign(x', S.E_Apply(x, [], [], ty))                        val stm = S.S_Assign(x', S.E_Prim(x, [], [], ty))
236                        in                        in
237                          (stm::stms, S.E_Var x')                          (stm::stms, S.E_Var x')
238                        end                        end
239                    | _ => (stms, S.E_Var x)                    | _ => (stms, S.E_Var(lookupVar(env, x)))
240                  (* end case *))                  (* end case *))
241              | AST.E_Lit lit => (stms, S.E_Lit lit)              | AST.E_Lit lit => (stms, S.E_Lit lit)
242              | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"              | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"
243              | AST.E_Apply(f, tyArgs, args, ty) => let              | AST.E_Apply(f, tyArgs, args, ty) => let
244                  val (stms, xs) = simplifyExpsToVars (args, stms)                  val (stms, xs) = simplifyExpsToVars (env, args, stms)
245                    in
246                      case Var.kindOf f
247                       of S.FunVar => (stms, S.E_Apply(lookupVar(env, f), xs, cvtTy ty))
248                        | S.BasisVar => let
249                            fun cvtTyArg (Types.TYPE tv) = S.TY(cvtTy(TU.resolve tv))
250                              | cvtTyArg (Types.DIFF dv) = S.DIFF(TU.monoDiff(TU.resolveDiff dv))
251                              | cvtTyArg (Types.SHAPE sv) = S.SHAPE(TU.monoShape(TU.resolveShape sv))
252                              | cvtTyArg (Types.DIM dv) = S.DIM(TU.monoDim(TU.resolveDim dv))
253                            val tyArgs = List.map cvtTyArg tyArgs
254                  in                  in
255                    (stms, S.E_Apply(f, tyArgs, xs, ty))                            (stms, S.E_Prim(f, tyArgs, xs, cvtTy ty))
256                            end
257                        | _ => raise Fail "bogus application"
258                      (* end case *)
259                  end                  end
260              | AST.E_Cons es => let              | AST.E_Cons es => let
261                  val (stms, xs) = simplifyExpsToVars (es, stms)                  val (stms, xs) = simplifyExpsToVars (env, es, stms)
262                  in                  in
263                    (stms, S.E_Cons xs)                    (stms, S.E_Cons xs)
264                  end                  end
265              | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)              | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
266                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (env, e, stms)
267                  fun f ([], ys, stms) = (stms, List.rev ys)                  fun f ([], ys, stms) = (stms, List.rev ys)
268                    | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)                    | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)
269                    | f (SOME e::es, ys, stms) = let                    | f (SOME e::es, ys, stms) = let
270                        val (stms, y) = simplifyExpToVar (e, stms)                        val (stms, y) = simplifyExpToVar (env, e, stms)
271                        in                        in
272                          f (es, SOME y::ys, stms)                          f (es, SOME y::ys, stms)
273                        end                        end
274                  val (stms, indices) = f (indices, [], stms)                  val (stms, indices) = f (indices, [], stms)
275                  in                  in
276                    (stms, S.E_Slice(x, indices, ty))                    (stms, S.E_Slice(x, indices, cvtTy ty))
277                  end                  end
278              | AST.E_Cond(e1, e2, e3, ty) => let              | AST.E_Cond(e1, e2, e3, ty) => let
279                (* a conditional expression gets turned into an if-then-else statememt *)                (* a conditional expression gets turned into an if-then-else statememt *)
280                  val result = newTemp ty                  val result = newTemp(cvtTy ty)
281                  val (stms, x) = simplifyExpToVar (e1, S.S_Var result :: stms)                  val (stms, x) = simplifyExpToVar (env, e1, S.S_Var result :: stms)
282                  fun simplifyBranch e = let                  fun simplifyBranch e = let
283                        val (stms, e) = simplifyExp (e, [])                        val (stms, e) = simplifyExp (env, e, [])
284                        in                        in
285                          mkBlock (S.S_Assign(result, e)::stms)                          mkBlock (S.S_Assign(result, e)::stms)
286                        end                        end
# Line 241  Line 290 
290                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
291                  end                  end
292              | AST.E_Coerce{srcTy, dstTy, e} => let              | AST.E_Coerce{srcTy, dstTy, e} => let
293                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (env, e, stms)
294                    val dstTy = cvtTy dstTy
295                  val result = newTemp dstTy                  val result = newTemp dstTy
296                  val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = cvtTy dstTy, x = x}                  val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = dstTy, x = x}
297                  in                  in
298                    (S.S_Assign(result, rhs)::stms, S.E_Var result)                    (S.S_Assign(result, rhs)::stms, S.E_Var result)
299                  end                  end
300            (* end case *))            (* end case *))
301    
302      and simplifyExpToVar (exp, stms) = let      and simplifyExpToVar (env, exp, stms) = let
303            val (stms, e) = simplifyExp (exp, stms)            val (stms, e) = simplifyExp (env, exp, stms)
304            in            in
305              case e              case e
306               of S.E_Var x => (stms, x)               of S.E_Var x => (stms, x)
# Line 262  Line 312 
312              (* end case *)              (* end case *)
313            end            end
314    
315      and simplifyExpsToVars (exps, stms) = let      and simplifyExpsToVars (env, exps, stms) = let
316            fun f ([], xs, stms) = (stms, List.rev xs)            fun f ([], xs, stms) = (stms, List.rev xs)
317              | f (e::es, xs, stms) = let              | f (e::es, xs, stms) = let
318                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (env, e, stms)
319                  in                  in
320                    f (es, x::xs, stms)                    f (es, x::xs, stms)
321                  end                  end

Legend:
Removed from v.2475  
changed lines
  Added in v.2476

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