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

SCM Repository

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

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

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

revision 3455, Mon Nov 23 13:54:15 2015 UTC revision 3456, Mon Nov 23 15:49:56 2015 UTC
# Line 44  Line 44 
44                    shape = TU.monoShape shape                    shape = TU.monoShape shape
45                  }                  }
46              | Ty.T_Fun(tys1, ty2) => STy.T_Fun(List.map cvtTy tys1, cvtTy ty2)              | Ty.T_Fun(tys1, ty2) => STy.T_Fun(List.map cvtTy tys1, cvtTy ty2)
47                | Ty.T_Error => raise Fail "unexpected T_Error in Simplify"
48            (* end case *))            (* end case *))
49    
50      fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)      fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)
51    
52      datatype env = E of {    (* a property to map AST variables to SimpleAST variables *)
53          errStrm : Error.err_stream,      local
54          vMap : SimpleVar.t VMap.map        fun cvt x = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))
       }  
   
     fun newEnv errStrm = E{errStrm=errStrm, vMap=VMap.empty}  
   
     fun errStream (E{errStrm, ...}) = errStrm  
   
   (* convert an AST variable to a Simple variable *)  
     fun cvtVar (E{errStrm, vMap}, x) = let  
           val x' = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))  
55            in            in
56              (x', E{errStrm=errStrm, vMap=VMap.insert(vMap, x, x')})      val {getFn = cvtVar, ...} = Var.newProp cvt
57            end            end
58    
59      fun cvtVars (env, xs) = List.foldr      fun cvtVars xs = List.map cvtVar xs
           (fn (x, (xs, env)) => let  
             val (x', env) = cvtVar(env, x)  
             in  
               (x'::xs, env)  
             end) ([], env) xs  
   
     fun lookupVar (E{vMap, ...}, x) = (case VMap.find (vMap, x)  
            of SOME x' => x'  
             | NONE => raise Fail(concat["lookupVar(", Var.uniqueNameOf x, ")"])  
           (* end case *))  
60    
61    (* 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 *)
62      fun mkBlock stms = S.Block(List.rev stms)      fun mkBlock stms = S.Block(List.rev stms)
63    
64      fun inputImage (env, nrrd, dim, shape) = (      fun inputImage (errStrm, nrrd, dim, shape) = (
65            case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStream env, nrrd), dim, shape)            case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
66             of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])             of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])
67              | SOME info => S.Proxy(nrrd, info)              | SOME info => S.Proxy(nrrd, info)
68            (* end case *))            (* end case *))
# Line 164  Line 146 
146    (* 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
147     * into more than one new statement).     * into more than one new statement).
148     *)     *)
149      fun simplifyBlock env stm = mkBlock (#1 (simplifyStmt (env, stm, [])))      fun simplifyBlock errStrm stm = mkBlock (simplifyStmt (errStrm, stm, []))
150    
151    (* 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
152     * statements.  This function returns a reverse-order list of simplified statements.     * statements.  This function returns a reverse-order list of simplified statements.
153     * 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
154     * code.     * code.
155     *)     *)
156      and simplifyStmt (env, stm, stms) = (case stm      and simplifyStmt (errStrm, stm, stms) : S.stmt list = (case stm
157             of AST.S_Block body => let             of AST.S_Block body => let
158                  fun simplify (_, [], stms) = stms                  fun simplify ([], stms) = stms
159                    | simplify (env', stm::r, stms) = let                    | simplify (stm::r, stms) = simplify (r, simplifyStmt (errStrm, stm, stms))
                       val (stms, env') = simplifyStmt (env', stm, stms)  
                       in  
                         simplify (env', r, stms)  
                       end  
160                  in                  in
161                    (simplify (env, body, stms), env)                    simplify (body, stms)
162                  end                  end
163              | AST.S_Decl(x, NONE) => let              | AST.S_Decl(x, NONE) => let
164                  val (x', env) = cvtVar(env, x)                  val x' = cvtVar x
165                  in                  in
166  (* QUESTION: where do we declare x? *)  (* QUESTION: where do we declare x? *)
167                    (stms, env)                    stms
168                  end                  end
169              | AST.S_Decl(x, SOME e) => let              | AST.S_Decl(x, SOME e) => let
170                  val (stms, e') = simplifyExp (env, e, stms)                  val (stms, e') = simplifyExp (errStrm, e, stms)
171                  val (x', env) = cvtVar(env, x)                  val x' = cvtVar x
172                  in                  in
173                    (S.S_Assign(x', e') :: stms, env)                    S.S_Assign(x', e') :: stms
174                  end                  end
175              | AST.S_IfThenElse(e, s1, s2) => let              | AST.S_IfThenElse(e, s1, s2) => let
176                  val (stms, x) = simplifyExpToVar (env, e, stms)                  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
177                  val s1 = simplifyBlock env s1                  val s1 = simplifyBlock errStrm s1
178                  val s2 = simplifyBlock env s2                  val s2 = simplifyBlock errStrm s2
179                  in                  in
180                    (S.S_IfThenElse(x, s1, s2) :: stms, env)                    S.S_IfThenElse(x, s1, s2) :: stms
181                    end
182                | AST.S_Foreach((x, e), body) => let
183                    val (stms, xs') = simplifyExpToVar (errStrm, e, stms)
184                    val body' = simplifyBlock errStrm body
185                    in
186                      S.S_Foreach(cvtVar x, xs', body') :: stms
187                  end                  end
188              | AST.S_Assign((x, _), e) => let              | AST.S_Assign((x, _), e) => let
189                  val (stms, e') = simplifyExp (env, e, stms)                  val (stms, e') = simplifyExp (errStrm, e, stms)
190                  in                  in
191                    (S.S_Assign(lookupVar(env, x), e') :: stms, env)                    S.S_Assign(cvtVar x, e') :: stms
192                  end                  end
193              | AST.S_New(name, args) => let              | AST.S_New(name, args) => let
194                  val (stms, xs) = simplifyExpsToVars (env, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
195                  in                  in
196                    (S.S_New(name, xs) :: stms, env)                    S.S_New(name, xs) :: stms
197                  end                  end
198              | AST.S_Continue => (S.S_Continue :: stms, env)              | AST.S_Continue => S.S_Continue :: stms
199              | AST.S_Die => (S.S_Die :: stms, env)              | AST.S_Die => S.S_Die :: stms
200              | AST.S_Stabilize => (S.S_Stabilize :: stms, env)              | AST.S_Stabilize => S.S_Stabilize :: stms
201              | AST.S_Return e => let              | AST.S_Return e => let
202                  val (stms, x) = simplifyExpToVar (env, e, stms)                  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
203                  in                  in
204                    (S.S_Return x :: stms, env)                    S.S_Return x :: stms
205                  end                  end
206              | AST.S_Print args => let              | AST.S_Print args => let
207                  val (stms, xs) = simplifyExpsToVars (env, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
208                  in                  in
209                    (S.S_Print xs :: stms, env)                    S.S_Print xs :: stms
210                  end                  end
211            (* end case *))            (* end case *))
212    
213      and simplifyExp (env, exp, stms) = let      and simplifyExp (errStrm, exp, stms) = let
214            fun doPrimApply (f, tyArgs, args, ty) = let            fun doPrimApply (f, tyArgs, args, ty) = let
215                  val (stms, xs) = simplifyExpsToVars (env, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
216                  in                  in
217                    case Var.kindOf f                    case Var.kindOf f
218                     of Var.BasisVar => let                     of Var.BasisVar => let
# Line 253  Line 237 
237                          in                          in
238                            (stm::stms, S.E_Var x')                            (stm::stms, S.E_Var x')
239                          end                          end
240                      | _ => (stms, S.E_Var(lookupVar(env, x)))                      | _ => (stms, S.E_Var(cvtVar x))
241                    (* end case *))                    (* end case *))
242                | AST.E_Lit lit => (stms, S.E_Lit lit)                | AST.E_Lit lit => (stms, S.E_Lit lit)
243                  | AST.E_Select(e, (fld, _)) => let
244                      val (stms, x) = simplifyExpToVar (errStrm, e, stms)
245                      in
246                        (stms, S.E_Select(x, cvtVar fld))
247                      end
248                | AST.E_Prim(rator, tyArgs, args as [AST.E_Lit(Literal.Int n)], ty) =>                | AST.E_Prim(rator, tyArgs, args as [AST.E_Lit(Literal.Int n)], ty) =>
249                  (* constant-fold negation of integer literals *)                  (* constant-fold negation of integer literals *)
250                    if Var.same(BasisVars.neg_i, rator)                    if Var.same(BasisVars.neg_i, rator)
# Line 268  Line 257 
257                      else doPrimApply (rator, tyArgs, args, ty)                      else doPrimApply (rator, tyArgs, args, ty)
258                | AST.E_Prim(f, tyArgs, args, ty) => doPrimApply (f, tyArgs, args, ty)                | AST.E_Prim(f, tyArgs, args, ty) => doPrimApply (f, tyArgs, args, ty)
259                | AST.E_Apply((f, _), args, ty) => let                | AST.E_Apply((f, _), args, ty) => let
260                    val (stms, xs) = simplifyExpsToVars (env, args, stms)                    val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
261                    in                    in
262                      case Var.kindOf f                      case Var.kindOf f
263                       of Var.FunVar => (stms, S.E_Apply(lookupVar(env, f), xs, cvtTy ty))                       of Var.FunVar => (stms, S.E_Apply(cvtVar f, xs, cvtTy ty))
264                        | _ => raise Fail "bogus application"                        | _ => raise Fail "bogus application"
265                      (* end case *)                      (* end case *)
266                    end                    end
267                  | AST.E_Comprehension(e, (x, e'), ty) => raise Fail "FIXME"
268                | AST.E_Tensor(es, ty) => let                | AST.E_Tensor(es, ty) => let
269                    val (stms, xs) = simplifyExpsToVars (env, es, stms)                    val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
270                    in                    in
271                      (stms, S.E_Tensor(xs, cvtTy ty))                      (stms, S.E_Tensor(xs, cvtTy ty))
272                    end                    end
273                | AST.E_Seq(es, ty) => let                | AST.E_Seq(es, ty) => let
274                    val (stms, xs) = simplifyExpsToVars (env, es, stms)                    val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
275                    in                    in
276                      (stms, S.E_Seq(xs, cvtTy ty))                      (stms, S.E_Seq(xs, cvtTy ty))
277                    end                    end
278                | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)                | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
279                    val (stms, x) = simplifyExpToVar (env, e, stms)                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)
280                    fun f ([], ys, stms) = (stms, List.rev ys)                    fun f ([], ys, stms) = (stms, List.rev ys)
281                      | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)                      | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)
282                      | f (SOME e::es, ys, stms) = let                      | f (SOME e::es, ys, stms) = let
283                          val (stms, y) = simplifyExpToVar (env, e, stms)                          val (stms, y) = simplifyExpToVar (errStrm, e, stms)
284                          in                          in
285                            f (es, SOME y::ys, stms)                            f (es, SOME y::ys, stms)
286                          end                          end
# Line 301  Line 291 
291                | AST.E_Cond(e1, e2, e3, ty) => let                | AST.E_Cond(e1, e2, e3, ty) => let
292                  (* a conditional expression gets turned into an if-then-else statememt *)                  (* a conditional expression gets turned into an if-then-else statememt *)
293                    val result = newTemp(cvtTy ty)                    val result = newTemp(cvtTy ty)
294                    val (stms, x) = simplifyExpToVar (env, e1, S.S_Var result :: stms)                    val (stms, x) = simplifyExpToVar (errStrm, e1, S.S_Var result :: stms)
295                    fun simplifyBranch e = let                    fun simplifyBranch e = let
296                          val (stms, e) = simplifyExp (env, e, [])                          val (stms, e) = simplifyExp (errStrm, e, [])
297                          in                          in
298                            mkBlock (S.S_Assign(result, e)::stms)                            mkBlock (S.S_Assign(result, e)::stms)
299                          end                          end
# Line 315  Line 305 
305                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty
306                     of ty as SimpleTypes.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))                     of ty as SimpleTypes.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))
307                      | ty as SimpleTypes.T_Image{dim, shape} => (                      | ty as SimpleTypes.T_Image{dim, shape} => (
308                          case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStream env, nrrd), dim, shape)                          case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
309                           of NONE => raise Fail(concat[                           of NONE => raise Fail(concat[
310                                  "nrrd file \"", nrrd, "\" does not have expected type"                                  "nrrd file \"", nrrd, "\" does not have expected type"
311                                ])                                ])
# Line 324  Line 314 
314                      | _ => raise Fail "bogus type for E_LoadNrrd"                      | _ => raise Fail "bogus type for E_LoadNrrd"
315                    (* end case *))                    (* end case *))
316                | AST.E_Coerce{srcTy, dstTy, e} => let                | AST.E_Coerce{srcTy, dstTy, e} => let
317                    val (stms, x) = simplifyExpToVar (env, e, stms)                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)
318                    val dstTy = cvtTy dstTy                    val dstTy = cvtTy dstTy
319                    val result = newTemp dstTy                    val result = newTemp dstTy
320                    val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = dstTy, x = x}                    val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = dstTy, x = x}
# Line 334  Line 324 
324              (* end case *)              (* end case *)
325            end            end
326    
327      and simplifyExpToVar (env, exp, stms) = let      and simplifyExpToVar (errStrm, exp, stms) = let
328            val (stms, e) = simplifyExp (env, exp, stms)            val (stms, e) = simplifyExp (errStrm, exp, stms)
329            in            in
330              case e              case e
331               of S.E_Var x => (stms, x)               of S.E_Var x => (stms, x)
# Line 347  Line 337 
337              (* end case *)              (* end case *)
338            end            end
339    
340      and simplifyExpsToVars (env, exps, stms) = let      and simplifyExpsToVars (errStrm, exps, stms) = let
341            fun f ([], xs, stms) = (stms, List.rev xs)            fun f ([], xs, stms) = (stms, List.rev xs)
342              | f (e::es, xs, stms) = let              | f (e::es, xs, stms) = let
343                  val (stms, x) = simplifyExpToVar (env, e, stms)                  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
344                  in                  in
345                    f (es, x::xs, stms)                    f (es, x::xs, stms)
346                  end                  end
# Line 358  Line 348 
348              f (exps, [], stms)              f (exps, [], stms)
349            end            end
350    
351      fun simplifyStrand (env, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let      fun simplifyStrand (errStrm, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let
352            val (params', env) = cvtVars (env, params)            val params' = cvtVars params
353            fun simplifyState (env, [], xs, stms) = (List.rev xs, mkBlock stms, env)            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
354              | simplifyState (env, (x, optE) :: r, xs, stms) = let              | simplifyState ((x, optE) :: r, xs, stms) = let
355                  val (x', env') = cvtVar(env, x)                  val x' = cvtVar x
356                  in                  in
357                    case optE                    case optE
358                     of NONE => simplifyState (env', r, x'::xs, stms)                     of NONE => simplifyState (r, x'::xs, stms)
359                      | SOME e => let                      | SOME e => let
360                          val (stms, e') = simplifyExp (env, e, stms)                          val (stms, e') = simplifyExp (errStrm, e, stms)
361                          in                          in
362                            simplifyState (env', r, x'::xs, S.S_Assign(x', e') :: stms)                            simplifyState (r, x'::xs, S.S_Assign(x', e') :: stms)
363                          end                          end
364                    (* end case *)                    (* end case *)
365                  end                  end
366            val (xs, stm, env) = simplifyState (env, state, [], [])            val (xs, stm) = simplifyState (state, [], [])
367            in            in
368              S.Strand{              S.Strand{
369                  name = name,                  name = name,
370                  params = params',                  params = params',
371                  state = xs, stateInit = stm,                  state = xs,
372                  initM = Option.map (simplifyBlock env) initM,                  stateInit = stm,
373                  updateM = simplifyBlock env updateM,                  initM = Option.map (simplifyBlock errStrm) initM,
374                  stabilizeM = Option.map (simplifyBlock env) stabilizeM                  updateM = simplifyBlock errStrm updateM,
375                    stabilizeM = Option.map (simplifyBlock errStrm) stabilizeM
376                }                }
377            end            end
378    
379        fun simplifyCreate (errStrm, AST.C_Grid(dim, stm)) = S.C_Grid(dim, simplifyBlock errStrm stm)
380          | simplifyCreate (errStrm, AST.C_Collection stm) = S.C_Collection(simplifyBlock errStrm stm)
381    
382      fun transform (errStrm, prog) = let      fun transform (errStrm, prog) = let
383            val AST.Program{            val AST.Program{
384                    props, const_dcls, input_dcls, globals, init, strand, create, update                    props, const_dcls, input_dcls, globals, init, strand, create, update
385                  } = prog                  } = prog
386              val consts' = ref[]
387              val constInit = ref[]
388            val inputs' = ref[]            val inputs' = ref[]
389            val globals' = ref[]            val globals' = ref[]
390            val globalInit = ref[]            val globalInit = ref[]
391            val funcs = ref[]            val funcs = ref[]
392            fun simplifyConstDcl ((x, SOME e), env) = ??            fun simplifyConstDcl (x, SOME e) = let
393            fun simplifyInputDcl (((x, optE), desc), env) = ??                  val (stms, e') = simplifyExp (errStrm, e, [])
394            fun simplifyGlobalDcl (AST.D_Var(x, optE), env) = let                  val x' = cvtVar x
395                  val (x', env) = cvtVar(env, x)                  in
396                  in                    consts' := x' :: !consts';
397                    case optE                    constInit := S.S_Assign(x', e') :: (stms @ !constInit)
398                      of NONE => (globals' := x' :: !globals'; env)                  end
399                       | SOME e => let            fun simplifyInputDcl ((x, NONE), desc) = let
400                           val (stms, e') = simplifyExp (env, e, [])                  val x' = cvtVar x
401                           in                  val init = (case SimpleVar.typeOf x'
402                             globals' := x' :: !globals';                         of SimpleTypes.T_Image{dim, shape} => let
                            globalInit := S.S_Assign(x', e') :: (stms @ !globalInit);  
                            env  
                          end  
                   (* end case *)  
                 end  
             | simplifyGlobalDcl (AST.D_Func(f, params, body), env) = let  
                 val (f', env) = cvtVar(env, f)  
                 val (params', env) = cvtVars (env, params)  
                 val body' = pruneUnreachableCode (simplifyBlock env body)  
                 in  
                   funcs := S.Func{f=f', params=params', body=body'} :: !funcs;  
                   env  
                 end  
   
 (*  
                  of AST.D_Input(x, desc, NONE) => let  
                       val (x', env) = cvtVar(env, x)  
                       val (ty, init) = (case SimpleVar.typeOf x'  
                              of ty as SimpleTypes.T_Image{dim, shape} => let  
403                                    val info = ImageInfo.mkInfo(dim, shape)                                    val info = ImageInfo.mkInfo(dim, shape)
404                                    in                                    in
405                                      (ty, SOME(S.Image info))                                S.Image info
406                                    end                                    end
407                                | ty => (ty, NONE)                          | _ => S.NoDefault
408                              (* end case *))                              (* end case *))
409                        val inp = S.INP{                        val inp = S.INP{
410                                ty = ty,                          var = x',
                               name = SimpleVar.nameOf x',  
411                                desc = desc,                                desc = desc,
412                                init = init                                init = init
413                              }                              }
414                        in                        in
415                          inputs := (x', inp) :: !inputs;                    inputs' := inp :: !inputs'
                         env  
416                        end                        end
417                    | AST.D_Input(x, desc, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))) => let              | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let
418                        val (x', env) = cvtVar(env, x)                  val x' = cvtVar x
419                      (* load the nrrd proxy here *)                      (* load the nrrd proxy here *)
420                        val info = NrrdInfo.getInfo nrrd                  val info = NrrdInfo.getInfo (errStrm, nrrd)
421                        val (ty, init) = (case SimpleVar.typeOf x'                  val init = (case SimpleVar.typeOf x'
422                               of ty as SimpleTypes.T_Seq(_, NONE) => (ty, S.DynSeq nrrd)                         of SimpleTypes.T_Sequence(_, NONE) => S.LoadSeq nrrd
423                                | ty as SimpleTypes.T_Image{dim, shape} =>                          | SimpleTypes.T_Image{dim, shape} => inputImage(errStrm, nrrd, dim, shape)
                                   (ty, inputImage(env, nrrd, dim, shape))  
424                                | _ => raise Fail "impossible"                                | _ => raise Fail "impossible"
425                              (* end case *))                              (* end case *))
426                        val inp = S.INP{                        val inp = S.INP{
427                                ty = ty,                          var = x',
                               name = SimpleVar.nameOf x',  
428                                desc = desc,                                desc = desc,
429                                init = SOME init                          init = init
430                              }                              }
431                        in                        in
432                          inputs := (x', inp) :: !inputs;                    inputs' := inp :: !inputs'
                         env  
433                        end                        end
434                    | AST.D_Input(x, desc, SOME e) => let              | simplifyInputDcl ((x, SOME e), desc) = let
435                        val (x', env) = cvtVar(env, x)                  val x' = cvtVar x
436                        val (stms, e') = simplifyExp (env, e, [])                  val (stms, e') = simplifyExp (errStrm, e, [])
437                        val inp = S.INP{                        val inp = S.INP{
438                                ty = SimpleVar.typeOf x',                          var = x',
                               name = SimpleVar.nameOf x',  
439                                desc = desc,                                desc = desc,
440                                init = NONE                          init = S.ConstExpr
441                              }                              }
442                        in                        in
443                          inputs := (x', inp) :: !inputs;                    inputs' := inp :: !inputs';
444                          inputInit := S.S_Assign(x', e') :: (stms @ !inputInit);                    constInit := S.S_Assign(x', e') :: (stms @ !constInit)
445                          env                  end
446              fun simplifyGlobalDcl (AST.D_Var(x, optE)) = let
447                    val x' = cvtVar x
448                    in
449                      case optE
450                        of NONE => globals' := x' :: !globals'
451                         | SOME e => let
452                             val (stms, e') = simplifyExp (errStrm, e, [])
453                             in
454                               globals' := x' :: !globals';
455                               globalInit := S.S_Assign(x', e') :: (stms @ !globalInit)
456                             end
457                      (* end case *)
458                    end
459                | simplifyGlobalDcl (AST.D_Func(f, params, body)) = let
460                    val f' = cvtVar f
461                    val params' = cvtVars params
462                    val body' = pruneUnreachableCode (simplifyBlock errStrm body)
463                    in
464                      funcs := S.Func{f=f', params=params', body=body'} :: !funcs
465                        end                        end
 *)  
           val env = newEnv errStrm  
           val env = List.foldl simplifyConstDcl env const_dcls  
           val env = List.foldl simplifyInputDcl env input_dcls  
           val env = List.foldl simplifyGlobalDcl env globals  
466            in            in
467                List.app simplifyConstDcl const_dcls;
468                List.app simplifyInputDcl input_dcls;
469                List.app simplifyGlobalDcl globals;
470              S.Program{              S.Program{
471                  props = props,                  props = props,
472                    consts = List.rev(!consts'),
473                  inputs = List.rev(!inputs'),                  inputs = List.rev(!inputs'),
474                    constInit = mkBlock (!constInit),
475                  globals = List.rev(!globals'),                  globals = List.rev(!globals'),
476                  init = mkBlock (!globalInit),                  init = mkBlock (!globalInit),
477                  funcs = List.rev(!funcs),                  funcs = List.rev(!funcs),
478                  strand = simplifyStrand (env, strand),                  strand = simplifyStrand (errStrm, strand),
479                  create = ??,                  create = simplifyCreate (errStrm, create),
480                  update =  ??                  update = Option.map (simplifyBlock errStrm) update
481                }                }
482            end            end
483    

Legend:
Removed from v.3455  
changed lines
  Added in v.3456

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