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

SCM Repository

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

Diff of /branches/vis12/src/compiler/simplify/simplify.sml

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

trunk/src/compiler/simplify/simplify.sml revision 395, Thu Oct 14 16:52:15 2010 UTC branches/vis12/src/compiler/simplify/simplify.sml revision 1993, Fri Sep 28 14:51:23 2012 UTC
# Line 1  Line 1 
1  (* simplify.sml  (* simplify.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Simplify the AST representation.   * Simplify the AST representation.
# Line 8  Line 8 
8    
9  structure Simplify : sig  structure Simplify : sig
10    
11      val transform : AST.program -> Simple.program      val transform : Error.err_stream * AST.program -> Simple.program
12    
13    end = struct    end = struct
14    
# Line 27  Line 27 
27      fun simplifyProgram (AST.Program dcls) = let      fun simplifyProgram (AST.Program dcls) = let
28            val globals = ref []            val globals = ref []
29            val globalInit = ref []            val globalInit = ref []
30            val actors = ref []            val initially = ref NONE
31              val strands = ref []
32              fun setInitially init = (case !initially
33                     of NONE => initially := SOME init
34    (* FIXME: the check for multiple initially decls should happen in type checking *)
35                      | SOME _ => raise Fail "multiple initially declarations"
36                    (* end case *))
37            fun simplifyDecl dcl = (case dcl            fun simplifyDecl dcl = (case dcl
38                   of AST.D_Input(x, NONE) => let                   of AST.D_Input(x, desc, NONE) => let
39                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, NONE)                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, desc, NONE)
40                        in                        in
41                          globals := x :: !globals;                          globals := x :: !globals;
42                          globalInit := S.S_Assign(x, e') :: !globalInit                          globalInit := S.S_Assign(x, e') :: !globalInit
43                        end                        end
44                    | AST.D_Input(x, SOME e) => let                    | AST.D_Input(x, desc, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))) => let
45                        (* load the nrrd prox here *)
46                          val info = NrrdInfo.getInfo nrrd
47                          val stm = (case TypeUtil.pruneHead ty
48                                 of Ty.T_DynSequence _ => (* FIXME *) raise Fail "unimplemented"
49                                  | Ty.T_Image _ => (* FIXME *) raise Fail "unimplemented"
50                                  | _ => raise Fail "impossible"
51                                (* end case *))
52                          in
53                            globals := x :: !globals;
54                            globalInit := stm :: !globalInit
55                          end
56                      | AST.D_Input(x, desc, SOME e) => let
57                        val (stms, x') = simplifyExpToVar (e, [])                        val (stms, x') = simplifyExpToVar (e, [])
58                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, SOME x')                        val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, desc, SOME x')
59                        in                        in
60                          globals := x :: !globals;                          globals := x :: !globals;
61                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
# Line 48  Line 66 
66                          globals := x :: !globals;                          globals := x :: !globals;
67                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
68                        end                        end
69                    | AST.D_Actor info => actors := simplifyActor info :: !actors                    | AST.D_Strand info => strands := simplifyStrand info :: !strands
70                    | AST.D_InitialArray(e, iters) => () (* FIXME *)                    | AST.D_InitialArray(creat, iters) =>
71                    | AST.D_InitialCollection(e, iters) => () (* FIXME *)                        setInitially (simplifyInit(true, creat, iters))
72                      | AST.D_InitialCollection(creat, iters) =>
73                          setInitially (simplifyInit(false, creat, iters))
74                  (* end case *))                  (* end case *))
75            in            in
76              List.app simplifyDecl dcls;              List.app simplifyDecl dcls;
77              S.Program{              S.Program{
78                  globals = List.rev(!globals),                  globals = List.rev(!globals),
79                  globalInit = mkBlock (!globalInit),                  globalInit = mkBlock (!globalInit),
80                  actors = List.rev(!actors)                  init = (case !initially
81    (* FIXME: the check for the initially block should really happen in typechecking *)
82                       of NONE => raise Fail "missing initially declaration"
83                        | SOME blk => blk
84                      (* end case *)),
85                    strands = List.rev(!strands)
86                }                }
87            end            end
88    
89      and simplifyActor {name, params, state, methods} = let      and simplifyInit (isArray, AST.C_Create(strand, exps), iters) = let
90              val (stms, xs) = simplifyExpsToVars (exps, [])
91              val creat = S.C_Create{
92                      argInit = mkBlock stms,
93                      name = strand,
94                      args = xs
95                    }
96              fun simplifyIter (AST.I_Range(x, e1, e2), (iters, stms)) = let
97                    val (stms, lo) = simplifyExpToVar (e1, stms)
98                    val (stms, hi) = simplifyExpToVar (e2, stms)
99                    in
100                      ({param=x, lo=lo, hi=hi}::iters, stms)
101                    end
102              val (iters, stms) = List.foldl simplifyIter ([], []) iters
103              in
104                S.Initially{
105                    isArray = isArray,
106                    rangeInit = mkBlock stms,
107                    iters = List.rev iters,
108                    create = creat
109                  }
110              end
111    
112        and simplifyStrand {name, params, state, methods} = let
113            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
114              | simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let              | simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let
115                  val (stms, e') = simplifyExp (e, stms)                  val (stms, e') = simplifyExp (e, stms)
# Line 70  Line 118 
118                  end                  end
119            val (xs, stm) = simplifyState (state, [], [])            val (xs, stm) = simplifyState (state, [], [])
120            in            in
121              S.Actor{              S.Strand{
122                  name = name,                  name = name,
123                  params = params,                  params = params,
124                  state = xs, stateInit = stm,                  state = xs, stateInit = stm,
# Line 81  Line 129 
129      and simplifyMethod (AST.M_Method(name, body)) =      and simplifyMethod (AST.M_Method(name, body)) =
130            S.Method(name, simplifyBlock body)            S.Method(name, simplifyBlock body)
131    
132    (* simplify a statement into a single statement (i.e., a block if it expands into more    (* simplify a statement into a single statement (i.e., a block if it expands
133     * than one new statement.     * into more than one new statement).
134     *)     *)
135      and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))      and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))
136    
# Line 117  Line 165 
165                  end                  end
166              | AST.S_Die => S.S_Die :: stms              | AST.S_Die => S.S_Die :: stms
167              | AST.S_Stabilize => S.S_Stabilize :: stms              | AST.S_Stabilize => S.S_Stabilize :: stms
168                | AST.S_Print args => let
169                    val (stms, xs) = simplifyExpsToVars (args, stms)
170                    in
171                      S.S_Print xs :: stms
172                    end
173            (* end case *))            (* end case *))
174    
175      and simplifyExp (exp, stms) = (      and simplifyExp (exp, stms) = (
# Line 143  Line 196 
196                  in                  in
197                    (stms, S.E_Cons xs)                    (stms, S.E_Cons xs)
198                  end                  end
199              | AST.E_Slice(e, indices) => let (* tensor slicing *)              | AST.E_Seq es => let
200                    val (stms, xs) = simplifyExpsToVars (es, stms)
201                    in
202                      (stms, S.E_Seq xs)
203                    end
204                | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
205                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (e, stms)
206                    fun f ([], ys, stms) = (stms, List.rev ys)
207                      | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)
208                      | f (SOME e::es, ys, stms) = let
209                          val (stms, y) = simplifyExpToVar (e, stms)
210                          in
211                            f (es, SOME y::ys, stms)
212                          end
213                    val (stms, indices) = f (indices, [], stms)
214                  in                  in
215                    raise Fail "FIXME"                    (stms, S.E_Slice(x, indices, ty))
216                  end                  end
217              | AST.E_Cond(e1, e2, e3) => let              | AST.E_Cond(e1, e2, e3, ty) => let
218                (* a conditional expression gets turned into an if-then-else statememt *)                (* a conditional expression gets turned into an if-then-else statememt *)
219                  val result = newTemp Ty.T_Bool                  val result = newTemp ty
220                  val (stms, x) = simplifyExpToVar (e1, stms)                  val (stms, x) = simplifyExpToVar (e1, S.S_Var result :: stms)
221                  fun simplifyBranch e = let                  fun simplifyBranch e = let
222                        val (stms, e) = simplifyExp (e, [])                        val (stms, e) = simplifyExp (e, [])
223                        in                        in
224                          mkBlock (S.S_Assign(result, e)::stms)                          mkBlock (S.S_Assign(result, e)::stms)
225                        end                        end
226                  val s1 = simplifyBranch e1                  val s1 = simplifyBranch e2
227                  val s2 = simplifyBranch e2                  val s2 = simplifyBranch e3
228                  in                  in
229                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
230                  end                  end
231                | AST.E_Coerce{srcTy, dstTy, e} => let
232                    val (stms, x) = simplifyExpToVar (e, stms)
233                    val result = newTemp dstTy
234                    in
235                      (S.S_Assign(result, S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=x})::stms, S.E_Var result)
236                    end
237            (* end case *))            (* end case *))
238    
239      and simplifyExpToVar (exp, stms) = let      and simplifyExpToVar (exp, stms) = let
# Line 188  Line 260 
260              f (exps, [], stms)              f (exps, [], stms)
261            end            end
262    
263      fun transform ast = let      fun transform (errStrm, ast) = let
264            val simple = simplifyProgram ast            val simple = simplifyProgram ast
265            val _ = SimplePP.output (Log.logFile(), simple)       (* DEBUG *)            val _ = SimplePP.output (Log.logFile(), simple)       (* DEBUG *)
266    (*
267            val simple = Lift.transform simple            val simple = Lift.transform simple
268                    handle Eval.Error msg => (Error.error(errStrm, msg); simple)
269    *)
270            in            in
271              simple              simple
272            end            end

Legend:
Removed from v.395  
changed lines
  Added in v.1993

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