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 3465, Sun Nov 29 20:04:16 2015 UTC revision 4333, Mon Aug 1 12:55:39 2016 UTC
# Line 5  Line 5 
5   * COPYRIGHT (c) 2015 The University of Chicago   * COPYRIGHT (c) 2015 The University of Chicago
6   * All rights reserved.   * All rights reserved.
7   *   *
8   * Simplify the AST representation.   * Simplify the AST representation.  This phase involves the following transformations:
9     *
10     *      - types are simplified by removing meta variables (which will have been resolved)
11     *
12     *      - expressions are simplified to involve a single operation on variables
13     *
14     *      - global reductions are converted to MapReduce statements
15     *
16     *      - other comprehensions and reductions are converted to foreach loops
17     *
18     *      - unreachable code is pruned
19     *
20     *      - negation of literal integers and reals are constant folded
21   *)   *)
22    
23  structure Simplify : sig  structure Simplify : sig
# Line 19  Line 31 
31      structure STy = SimpleTypes      structure STy = SimpleTypes
32      structure Ty = Types      structure Ty = Types
33      structure VMap = Var.Map      structure VMap = Var.Map
34        structure II = ImageInfo
35    
36    (* convert a Types.ty to a SimpleTypes.ty *)    (* convert a Types.ty to a SimpleTypes.ty *)
37      fun cvtTy ty = (case ty      fun cvtTy ty = (case ty
# Line 31  Line 44 
44              | Ty.T_String => STy.T_String              | Ty.T_String => STy.T_String
45              | Ty.T_Sequence(ty, NONE) => STy.T_Sequence(cvtTy ty, NONE)              | Ty.T_Sequence(ty, NONE) => STy.T_Sequence(cvtTy ty, NONE)
46              | Ty.T_Sequence(ty, SOME dim) => STy.T_Sequence(cvtTy ty, SOME(TU.monoDim dim))              | Ty.T_Sequence(ty, SOME dim) => STy.T_Sequence(cvtTy ty, SOME(TU.monoDim dim))
47              | Ty.T_Named id => STy.T_Named id              | Ty.T_Strand id => STy.T_Strand id
48              | Ty.T_Kernel n => STy.T_Kernel(TU.monoDiff n)              | Ty.T_Kernel _ => STy.T_Kernel
49              | Ty.T_Tensor shape => STy.T_Tensor(TU.monoShape shape)              | Ty.T_Tensor shape => STy.T_Tensor(TU.monoShape shape)
50              | Ty.T_Image{dim, shape} => STy.T_Image{              | Ty.T_Image{dim, shape} =>
51                    dim = TU.monoDim dim,                  STy.T_Image(II.mkInfo(TU.monoDim dim, TU.monoShape shape))
                   shape = TU.monoShape shape  
                 }  
52              | Ty.T_Field{diff, dim, shape} => STy.T_Field{              | Ty.T_Field{diff, dim, shape} => STy.T_Field{
53                    diff = TU.monoDiff diff,                    diff = TU.monoDiff diff,
54                    dim = TU.monoDim dim,                    dim = TU.monoDim dim,
55                    shape = TU.monoShape shape                    shape = TU.monoShape shape
56                  }                  }
57              | Ty.T_Fun(tys1, ty2) => STy.T_Fun(List.map cvtTy tys1, cvtTy ty2)              | Ty.T_Fun(tys1, ty2) => raise Fail "unexpected T_Fun in Simplify"
58              | Ty.T_Error => raise Fail "unexpected T_Error in Simplify"              | Ty.T_Error => raise Fail "unexpected T_Error in Simplify"
59            (* end case *))            (* end case *))
60    
61      fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)      fun apiTypeOf x = let
62              fun cvtTy STy.T_Bool = APITypes.BoolTy
63                | cvtTy STy.T_Int = APITypes.IntTy
64                | cvtTy STy.T_String = APITypes.StringTy
65                | cvtTy (STy.T_Sequence(ty, len)) = APITypes.SeqTy(cvtTy ty, len)
66                | cvtTy (STy.T_Tensor shape) = APITypes.TensorTy shape
67                | cvtTy (STy.T_Image info) =
68                    APITypes.ImageTy(II.dim info, II.voxelShape info)
69                | cvtTy ty = raise Fail "bogus API type"
70              in
71                cvtTy (SimpleVar.typeOf x)
72              end
73    
74        fun newTemp (ty as STy.T_Image _) = SimpleVar.new ("img", SimpleVar.LocalVar, ty)
75          | newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)
76    
77      (* a property to map AST function variables to SimpleAST functions *)
78        local
79          fun cvt x = let
80                val Ty.T_Fun(paramTys, resTy) = Var.monoTypeOf x
81                in
82                  SimpleFunc.new (Var.nameOf x, cvtTy resTy, List.map cvtTy paramTys)
83                end
84        in
85        val {getFn = cvtFunc, ...} = Var.newProp cvt
86        end
87    
88    (* a property to map AST variables to SimpleAST variables *)    (* a property to map AST variables to SimpleAST variables *)
89      local      local
90        fun cvt x = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))        fun cvt x = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))
91          val {getFn, setFn, ...} = Var.newProp cvt
92      in      in
93      val {getFn = cvtVar, ...} = Var.newProp cvt      val cvtVar = getFn
94        fun newVarWithType (x, ty) = let
95              val x' = SimpleVar.new (Var.nameOf x, Var.kindOf x, ty)
96              in
97                setFn (x, x');
98                x'
99              end
100      end      end
101    
102      fun cvtVars xs = List.map cvtVar xs      fun cvtVars xs = List.map cvtVar xs
103    
104    (* 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 *)
105      fun mkBlock stms = S.Block(List.rev stms)      fun mkBlock stms = S.Block{props = PropList.newHolder(), code = List.rev stms}
   
     fun inputImage (errStrm, nrrd, dim, shape) = (  
           case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)  
            of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])  
             | SOME info => S.Proxy(nrrd, info)  
           (* end case *))  
   
     datatype 'a ctl_flow_info  
       = EXIT                    (* stm sequence always exits; no pruning so far *)  
       | PRUNE of 'a             (* stm sequence always exits at last stm in argument, which  
                                  * is either a block or stm list *)  
       | CONT                    (* stm sequence falls through *)  
       | EDIT of 'a              (* pruned code that has non-exiting paths *)  
   
     fun pruneUnreachableCode (blk as S.Block stms) = let  
           fun isExit S.S_Die = true  
             | isExit S.S_Stabilize = true  
             | isExit (S.S_Return _) = true  
             | isExit _ = false  
           fun pruneStms [] = CONT  
             | pruneStms [S.S_IfThenElse(x, blk1, blk2)] = (  
                 case pruneIf(x, blk1, blk2)  
                  of EXIT => EXIT  
                   | PRUNE stm => PRUNE[stm]  
                   | CONT => CONT  
                   | EDIT stm => EDIT[stm]  
                 (* end case *))  
             | pruneStms [stm] = if isExit stm then EXIT else CONT  
             | pruneStms ((stm as S.S_IfThenElse(x, blk1, blk2))::stms) = (  
                 case pruneIf(x, blk1, blk2)  
                  of EXIT => PRUNE[stm]  
                   | PRUNE stm => PRUNE[stm]  
                   | CONT => (case pruneStms stms  
                        of PRUNE stms => PRUNE(stm::stms)  
                         | EDIT stms => EDIT(stm::stms)  
                         | EXIT => EXIT (* different instances of ctl_flow_info *)  
                         | CONT => CONT  
                       (* end case *))  
                   | EDIT stm => (case pruneStms stms  
                        of PRUNE stms => PRUNE(stm::stms)  
                         | EDIT stms => EDIT(stm::stms)  
                         | _ => EDIT(stm::stms)  
                       (* end case *))  
                 (* end case *))  
             | pruneStms (stm::stms) = if isExit stm  
                 then PRUNE[stm]  
                 else (case pruneStms stms  
                    of PRUNE stms => PRUNE(stm::stms)  
                     | EDIT stms => EDIT(stm::stms)  
                     | info => info  
                   (* end case *))  
           and pruneIf (x, blk1, blk2) = (case (pruneBlk blk1, pruneBlk blk2)  
                  of (EXIT,       EXIT      ) => EXIT  
                   | (CONT,       CONT      ) => CONT  
                   | (CONT,       EXIT      ) => CONT  
                   | (EXIT,       CONT      ) => CONT  
                   | (CONT,       EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EDIT blk1,  CONT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (CONT,       PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (PRUNE blk1, CONT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EXIT,       EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EDIT blk1,  EXIT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EDIT blk1,  EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EDIT blk1,  PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (PRUNE blk1, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))  
                   | (EXIT,       PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))  
                   | (PRUNE blk1, EXIT      ) => PRUNE(S.S_IfThenElse(x, blk1, blk2))  
                   | (PRUNE blk1, PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))  
                 (* end case *))  
           and pruneBlk (S.Block stms) = (case pruneStms stms  
                  of PRUNE stms => PRUNE(S.Block stms)  
                   | EDIT stms => EDIT(S.Block stms)  
                   | EXIT => EXIT (* different instances of ctl_flow_info *)  
                   | CONT => CONT  
                 (* end case *))  
           in  
             case pruneBlk blk  
              of PRUNE blk => blk  
               | EDIT blk => blk  
               | _=> blk  
             (* end case *)  
           end  
106    
107    (* 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
108     * into more than one new statement).     * into more than one new statement).
109     *)     *)
110      fun simplifyBlock errStrm stm = mkBlock (simplifyStmt (errStrm, stm, []))      fun simplifyBlock (errStrm, stm) = mkBlock (simplifyStmt (errStrm, stm, []))
111    
112      (* convert the lhs variable of a var decl or assignment; if the rhs is a LoadImage,
113       * then we use the info from the proxy image to determine the type of the lhs
114       * variable.
115       *)
116        and cvtLHS (lhs, S.E_LoadImage(_, _, info)) = newVarWithType(lhs, STy.T_Image info)
117          | cvtLHS (lhs, _) = cvtVar lhs
118    
119    (* 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
120     * statements.  This function returns a reverse-order list of simplified statements.     * statements.  This function returns a reverse-order list of simplified statements.
# Line 167  Line 135 
135                  end                  end
136              | AST.S_Decl(x, SOME e) => let              | AST.S_Decl(x, SOME e) => let
137                  val (stms, e') = simplifyExp (errStrm, e, stms)                  val (stms, e') = simplifyExp (errStrm, e, stms)
138                  val x' = cvtVar x                  val x' = cvtLHS (x, e')
139                  in                  in
140                    S.S_Var(x', SOME e') :: stms                    S.S_Var(x', SOME e') :: stms
141                  end                  end
142    (* FIXME: we should also define a "boolean negate" operation on AST expressions so that we can
143     * handle both cases!
144     *)
145                | AST.S_IfThenElse(AST.E_Orelse(e1, e2), s1 as AST.S_Block[], s2) =>
146                    simplifyStmt (errStrm, AST.S_IfThenElse(e1, s1, AST.S_IfThenElse(e2, s1, s2)), stms)
147                | AST.S_IfThenElse(AST.E_Andalso(e1, e2), s1, s2 as AST.S_Block[]) =>
148                    simplifyStmt (errStrm, AST.S_IfThenElse(e1, AST.S_IfThenElse(e2, s1, s2), s2), stms)
149              | AST.S_IfThenElse(e, s1, s2) => let              | AST.S_IfThenElse(e, s1, s2) => let
150                  val (stms, x) = simplifyExpToVar (errStrm, e, stms)                  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
151                  val s1 = simplifyBlock errStrm s1                  val s1 = simplifyBlock (errStrm, s1)
152                  val s2 = simplifyBlock errStrm s2                  val s2 = simplifyBlock (errStrm, s2)
153                  in                  in
154                    S.S_IfThenElse(x, s1, s2) :: stms                    S.S_IfThenElse(x, s1, s2) :: stms
155                  end                  end
156              | AST.S_Foreach((x, e), body) => let              | AST.S_Foreach((x, e), body) => let
157                  val (stms, xs') = simplifyExpToVar (errStrm, e, stms)                  val (stms, xs') = simplifyExpToVar (errStrm, e, stms)
158                  val body' = simplifyBlock errStrm body                  val body' = simplifyBlock (errStrm, body)
159                  in                  in
160                    S.S_Foreach(cvtVar x, xs', body') :: stms                    S.S_Foreach(cvtVar x, xs', body') :: stms
161                  end                  end
162              | AST.S_Assign((x, _), e) => let              | AST.S_Assign((x, _), e) => let
163                  val (stms, e') = simplifyExp (errStrm, e, stms)                  val (stms, e') = simplifyExp (errStrm, e, stms)
164                    val x' = cvtLHS (x, e')
165                  in                  in
166                    S.S_Assign(cvtVar x, e') :: stms                    S.S_Assign(x', e') :: stms
167                  end                  end
168              | AST.S_New(name, args) => let              | AST.S_New(name, args) => let
169                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
# Line 210  Line 186 
186            (* end case *))            (* end case *))
187    
188      and simplifyExp (errStrm, exp, stms) = let      and simplifyExp (errStrm, exp, stms) = let
189              fun doBorderCtl (f, args) = let
190                    val (ctl, arg) = if Var.same(BasisVars.image_border, f)
191                            then (BorderCtl.Default(hd args), hd(tl args))
192                          else if Var.same(BasisVars.image_clamp, f)
193                            then (BorderCtl.Clamp, hd args)
194                          else if Var.same(BasisVars.image_mirror, f)
195                            then (BorderCtl.Mirror, hd args)
196                          else if Var.same(BasisVars.image_wrap, f)
197                            then (BorderCtl.Wrap, hd args)
198                            else raise Fail "impossible"
199                    in
200                      S.E_BorderCtl(ctl, arg)
201                    end
202            fun doPrimApply (f, tyArgs, args, ty) = let            fun doPrimApply (f, tyArgs, args, ty) = let
203                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
204                  in                  in
205                    case Var.kindOf f                    if Basis.isBorderCtl f
206                        then (stms, doBorderCtl (f, xs))
207                        else (case Var.kindOf f
208                     of Var.BasisVar => let                     of Var.BasisVar => let
209                          fun cvtTyArg (Types.TYPE tv) = S.TY(cvtTy(TU.resolve tv))                          fun cvtTyArg (Types.TYPE tv) = S.TY(cvtTy(TU.resolve tv))
210                            | cvtTyArg (Types.DIFF dv) = S.DIFF(TU.monoDiff(TU.resolveDiff dv))                            | cvtTyArg (Types.DIFF dv) = S.DIFF(TU.monoDiff(TU.resolveDiff dv))
# Line 224  Line 215 
215                            (stms, S.E_Prim(f, tyArgs, xs, cvtTy ty))                            (stms, S.E_Prim(f, tyArgs, xs, cvtTy ty))
216                          end                          end
217                      | _ => raise Fail "bogus prim application"                      | _ => raise Fail "bogus prim application"
218                    (* end case *)                        (* end case *))
219                  end                  end
220            in            in
221              case exp              case exp
# Line 239  Line 230 
230                      | _ => (stms, S.E_Var(cvtVar x))                      | _ => (stms, S.E_Var(cvtVar x))
231                    (* end case *))                    (* end case *))
232                | AST.E_Lit lit => (stms, S.E_Lit lit)                | AST.E_Lit lit => (stms, S.E_Lit lit)
233                  | AST.E_Kernel h => (stms, S.E_Kernel h)
234                | AST.E_Select(e, (fld, _)) => let                | AST.E_Select(e, (fld, _)) => let
235                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)
236                    in                    in
# Line 271  Line 263 
263                          if Basis.isReductionOp rator                          if Basis.isReductionOp rator
264                            then let                            then let
265                            (* parallel map-reduce *)                            (* parallel map-reduce *)
266                                val x' = cvtVar x
267                              val result = SimpleVar.new ("res", Var.LocalVar, cvtTy ty)                              val result = SimpleVar.new ("res", Var.LocalVar, cvtTy ty)
268                              val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e', [])                              val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e', [])
269                              val (func, args) = Util.makeFunction(                              val (func, args) = Util.makeFunction(
# Line 281  Line 274 
274                                      reductions = [rator],                                      reductions = [rator],
275                                      body = func,                                      body = func,
276                                      args = args,                                      args = args,
277                                      source = xs                                      source = [(x', xs)]
278                                    }                                    }
279                              in                              in
280                                (mapReduceStm :: stms, S.E_Var result)                                (mapReduceStm :: stms, S.E_Var result)
# Line 294  Line 287 
287                    val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)                    val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
288                    in                    in
289                      case Var.kindOf f                      case Var.kindOf f
290                       of Var.FunVar => (stms, S.E_Apply(cvtVar f, xs, cvtTy ty))                       of Var.FunVar => (stms, S.E_Apply(SimpleFunc.use(cvtFunc f), xs))
291                        | _ => raise Fail "bogus application"                        | _ => raise Fail "bogus application"
292                      (* end case *)                      (* end case *)
293                    end                    end
# Line 311  Line 304 
304                    in                    in
305                      (foreachStm :: initStm :: stms, S.E_Var acc)                      (foreachStm :: initStm :: stms, S.E_Var acc)
306                    end                    end
307                | AST.E_ParallelMap(e, x, xs, ty) => raise Fail "FIXME"                | AST.E_ParallelMap(e, x, xs, ty) => raise Fail "FIXME: ParallelMap"
308                | AST.E_Tensor(es, ty) => let                | AST.E_Tensor(es, ty) => let
309                    val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)                    val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
310                    in                    in
# Line 324  Line 317 
317                    end                    end
318                | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)                | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
319                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)
320                    fun f ([], ys, stms) = (stms, List.rev ys)                    fun f NONE = NONE
321                      | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)                      | f (SOME(AST.E_Lit(Literal.Int i))) = SOME(Int.fromLarge i)
322                      | f (SOME e::es, ys, stms) = let                      | f _ = raise Fail "expected integer literal in slice"
323                          val (stms, y) = simplifyExpToVar (errStrm, e, stms)                    val indices = List.map f indices
                         in  
                           f (es, SOME y::ys, stms)  
                         end  
                   val (stms, indices) = f (indices, [], stms)  
324                    in                    in
325                      (stms, S.E_Slice(x, indices, cvtTy ty))                      (stms, S.E_Slice(x, indices, cvtTy ty))
326                    end                    end
# Line 349  Line 338 
338                    in                    in
339                      (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)                      (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
340                    end                    end
341                  | AST.E_Orelse(e1, e2) => simplifyExp (
342                      errStrm,
343                      AST.E_Cond(e1, AST.E_Lit(Literal.Bool true), e2, Ty.T_Bool),
344                      stms)
345                  | AST.E_Andalso(e1, e2) => simplifyExp (
346                      errStrm,
347                      AST.E_Cond(e1, e2, AST.E_Lit(Literal.Bool false), Ty.T_Bool),
348                      stms)
349                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty
350                     of ty as SimpleTypes.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))                     of ty as STy.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))
351                      | ty as SimpleTypes.T_Image{dim, shape} => (                      | ty as STy.T_Image info => let
352                          case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)                          val dim = II.dim info
353                           of NONE => raise Fail(concat[                          val shape = II.voxelShape info
354                            in
355                              case NrrdInfo.getInfo (errStrm, nrrd)
356                               of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)
357                                     of NONE => (
358                                          Error.error (errStrm, [
359                                  "nrrd file \"", nrrd, "\" does not have expected type"                                  "nrrd file \"", nrrd, "\" does not have expected type"
360                                ])                                          ]);
361                            | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))                                        (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
362                          (* end case *))                                    | SOME imgInfo =>
363                                          (stms, S.E_LoadImage(STy.T_Image imgInfo, nrrd, imgInfo))
364                                    (* end case *))
365                                | NONE => (
366                                    Error.warning (errStrm, [
367                                        "nrrd file \"", nrrd, "\" does not exist"
368                                      ]);
369                                    (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
370                              (* end case *)
371                            end
372                      | _ => raise Fail "bogus type for E_LoadNrrd"                      | _ => raise Fail "bogus type for E_LoadNrrd"
373                    (* end case *))                    (* end case *))
374                  | AST.E_Coerce{dstTy, e=AST.E_Lit(Literal.Int n), ...} => (case cvtTy dstTy
375                       of SimpleTypes.T_Tensor[] => (stms, S.E_Lit(Literal.Real(RealLit.fromInt n)))
376                        | _ => raise Fail "impossible: bad coercion"
377                      (* end case *))
378                | AST.E_Coerce{srcTy, dstTy, e} => let                | AST.E_Coerce{srcTy, dstTy, e} => let
379                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)                    val (stms, x) = simplifyExpToVar (errStrm, e, stms)
380                    val dstTy = cvtTy dstTy                    val dstTy = cvtTy dstTy
# Line 395  Line 410 
410              f (exps, [], stms)              f (exps, [], stms)
411            end            end
412    
413      fun simplifyStrand (errStrm, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let    (* simplify a block and then prune unreachable and dead code *)
414        fun simplifyAndPruneBlock errStrm blk =
415              DeadCode.eliminate (simplifyBlock (errStrm, blk))
416    
417        fun simplifyStrand (errStrm, strand) = let
418              val AST.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand
419            val params' = cvtVars params            val params' = cvtVars params
420            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)            fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
421              | simplifyState ((x, optE) :: r, xs, stms) = let              | simplifyState ((x, optE) :: r, xs, stms) = let
# Line 406  Line 426 
426                      | SOME e => let                      | SOME e => let
427                          val (stms, e') = simplifyExp (errStrm, e, stms)                          val (stms, e') = simplifyExp (errStrm, e, stms)
428                          in                          in
429                            simplifyState (r, x'::xs, S.S_Var(x', SOME e') :: stms)                            simplifyState (r, x'::xs, S.S_Assign(x', e') :: stms)
430                          end                          end
431                    (* end case *)                    (* end case *)
432                  end                  end
# Line 417  Line 437 
437                  params = params',                  params = params',
438                  state = xs,                  state = xs,
439                  stateInit = stm,                  stateInit = stm,
440                  initM = Option.map (simplifyBlock errStrm) initM,                  initM = Option.map (simplifyAndPruneBlock errStrm) initM,
441                  updateM = simplifyBlock errStrm updateM,                  updateM = simplifyAndPruneBlock errStrm updateM,
442                  stabilizeM = Option.map (simplifyBlock errStrm) stabilizeM                  stabilizeM = Option.map (simplifyAndPruneBlock errStrm) stabilizeM
443                }                }
444            end            end
445    
     fun simplifyCreate (errStrm, AST.C_Grid(dim, stm)) = S.C_Grid(dim, simplifyBlock errStrm stm)  
       | simplifyCreate (errStrm, AST.C_Collection stm) = S.C_Collection(simplifyBlock errStrm stm)  
   
446      fun transform (errStrm, prog) = let      fun transform (errStrm, prog) = let
447            val AST.Program{            val AST.Program{
448                    props, const_dcls, input_dcls, globals, init, strand, create, update                    props, const_dcls, input_dcls, globals, globInit, strand, create, init, update
449                  } = prog                  } = prog
450            val consts' = ref[]            val consts' = ref[]
451            val constInit = ref[]            val constInit = ref[]
# Line 446  Line 463 
463            fun simplifyInputDcl ((x, NONE), desc) = let            fun simplifyInputDcl ((x, NONE), desc) = let
464                  val x' = cvtVar x                  val x' = cvtVar x
465                  val init = (case SimpleVar.typeOf x'                  val init = (case SimpleVar.typeOf x'
466                         of SimpleTypes.T_Image{dim, shape} => let                         of STy.T_Image info => S.Image info
                             val info = ImageInfo.mkInfo(dim, shape)  
                             in  
                               S.Image info  
                             end  
467                          | _ => S.NoDefault                          | _ => S.NoDefault
468                        (* end case *))                        (* end case *))
469                  val inp = S.INP{                  val inp = S.INP{
470                          var = x',                          var = x',
471                            name = Var.nameOf x,
472                            ty =  apiTypeOf x',
473                          desc = desc,                          desc = desc,
474                          init = init                          init = init
475                        }                        }
# Line 462  Line 477 
477                    inputs' := inp :: !inputs'                    inputs' := inp :: !inputs'
478                  end                  end
479              | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let              | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let
480                  val x' = cvtVar x                  val (x', init) = (case Var.monoTypeOf x
481                (* load the nrrd proxy here *)                         of Ty.T_Sequence(_, NONE) => (cvtVar x, S.LoadSeq nrrd)
482                  val info = NrrdInfo.getInfo (errStrm, nrrd)                          | Ty.T_Image{dim, shape} => let
483                  val init = (case SimpleVar.typeOf x'                              val dim = TU.monoDim dim
484                         of SimpleTypes.T_Sequence(_, NONE) => S.LoadSeq nrrd                              val shape = TU.monoShape shape
485                          | SimpleTypes.T_Image{dim, shape} => inputImage(errStrm, nrrd, dim, shape)                              in
486                                  case NrrdInfo.getInfo (errStrm, nrrd)
487                                   of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)
488                                         of NONE => (
489                                              Error.error (errStrm, [
490                                                  "proxy nrrd file \"", nrrd,
491                                                  "\" does not have expected type"
492                                                ]);
493                                              (cvtVar x, S.Image(II.mkInfo(dim, shape))))
494                                          | SOME info =>
495                                              (newVarWithType(x, STy.T_Image info), S.Proxy(nrrd, info))
496                                        (* end case *))
497                                    | NONE => (
498                                        Error.warning (errStrm, [
499                                            "proxy nrrd file \"", nrrd, "\" does not exist"
500                                          ]);
501                                        (cvtVar x, S.Image(II.mkInfo(dim, shape))))
502                                  (* end case *)
503                                end
504                          | _ => raise Fail "impossible"                          | _ => raise Fail "impossible"
505                        (* end case *))                        (* end case *))
506                  val inp = S.INP{                  val inp = S.INP{
507                          var = x',                          var = x',
508                            name = Var.nameOf x,
509                            ty = apiTypeOf x',
510                          desc = desc,                          desc = desc,
511                          init = init                          init = init
512                        }                        }
# Line 483  Line 518 
518                  val (stms, e') = simplifyExp (errStrm, e, [])                  val (stms, e') = simplifyExp (errStrm, e, [])
519                  val inp = S.INP{                  val inp = S.INP{
520                          var = x',                          var = x',
521                            name = Var.nameOf x,
522                            ty = apiTypeOf x',
523                          desc = desc,                          desc = desc,
524                          init = S.ConstExpr                          init = S.ConstExpr
525                        }                        }
# Line 490  Line 527 
527                    inputs' := inp :: !inputs';                    inputs' := inp :: !inputs';
528                    constInit := S.S_Assign(x', e') :: (stms @ !constInit)                    constInit := S.S_Assign(x', e') :: (stms @ !constInit)
529                  end                  end
530            fun simplifyGlobalDcl (AST.D_Var(x, optE)) = let            fun simplifyGlobalDcl (AST.D_Var(x, NONE)) = globals' := cvtVar x :: !globals'
531                  val x' = cvtVar x              | simplifyGlobalDcl (AST.D_Var(x, SOME e)) = let
                 in  
                   case optE  
                     of NONE => globals' := x' :: !globals'  
                      | SOME e => let  
532                           val (stms, e') = simplifyExp (errStrm, e, [])                           val (stms, e') = simplifyExp (errStrm, e, [])
533                    val x' = cvtLHS (x, e')
534                           in                           in
535                             globals' := x' :: !globals';                             globals' := x' :: !globals';
536                             globalInit := S.S_Assign(x', e') :: (stms @ !globalInit)                             globalInit := S.S_Assign(x', e') :: (stms @ !globalInit)
537                           end                           end
                   (* end case *)  
                 end  
538              | simplifyGlobalDcl (AST.D_Func(f, params, body)) = let              | simplifyGlobalDcl (AST.D_Func(f, params, body)) = let
539                  val f' = cvtVar f                  val f' = cvtFunc f
540                  val params' = cvtVars params                  val params' = cvtVars params
541                  val body' = pruneUnreachableCode (simplifyBlock errStrm body)                  val body' = simplifyAndPruneBlock errStrm body
542                  in                  in
543                    funcs := S.Func{f=f', params=params', body=body'} :: !funcs                    funcs := S.Func{f=f', params=params', body=body'} :: !funcs
544                  end                  end
545            in            val () = (
546              List.app simplifyConstDcl const_dcls;              List.app simplifyConstDcl const_dcls;
547              List.app simplifyInputDcl input_dcls;              List.app simplifyInputDcl input_dcls;
548              List.app simplifyGlobalDcl globals;                  List.app simplifyGlobalDcl globals)
549            (* make the global-initialization block *)
550              val globInit = (case globInit
551                     of SOME stm => mkBlock (simplifyStmt (errStrm, stm, !globalInit))
552                      | NONE => mkBlock (!globalInit)
553                    (* end case *))
554            (* if the globInit block is non-empty, record the fact in the property list *)
555              val props = (case globInit
556                     of S.Block{code=[], ...} => props
557                      | _ => Properties.GlobalInit :: props
558                    (* end case *))
559              in
560              S.Program{              S.Program{
561                  props = props,                  props = props,
562                  consts = List.rev(!consts'),                  consts = List.rev(!consts'),
563                  inputs = List.rev(!inputs'),                  inputs = List.rev(!inputs'),
564                  constInit = mkBlock (!constInit),                  constInit = mkBlock (!constInit),
565                  globals = List.rev(!globals'),                  globals = List.rev(!globals'),
566                  init = mkBlock (!globalInit),                  globInit = globInit,
567                  funcs = List.rev(!funcs),                  funcs = List.rev(!funcs),
568                  strand = simplifyStrand (errStrm, strand),                  strand = simplifyStrand (errStrm, strand),
569                  create = simplifyCreate (errStrm, create),                  create = Create.map (simplifyAndPruneBlock errStrm) create,
570                  update = Option.map (simplifyBlock errStrm) update                  init = Option.map (simplifyAndPruneBlock errStrm) init,
571                    update = Option.map (simplifyAndPruneBlock errStrm) update
572                }                }
573            end            end
574    

Legend:
Removed from v.3465  
changed lines
  Added in v.4333

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