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

Legend:
Removed from v.2488  
changed lines
  Added in v.2489

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