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

revision 2012, Mon Oct 8 14:27:53 2012 UTC revision 2140, Thu Feb 14 23:58:15 2013 UTC
# Line 14  Line 14 
14    
15      structure Ty = Types      structure Ty = Types
16      structure S = Simple      structure S = Simple
17        structure InP = Inputs
18    
19      local      local
20        val tempName = Atom.atom "_t"        val tempName = Atom.atom "_t"
# Line 27  Line 28 
28    (* convert an AST expression to an input initialization.  Note that the Diderot grammar    (* convert an AST expression to an input initialization.  Note that the Diderot grammar
29     * limits the forms of expression that we might encounter in this context.     * limits the forms of expression that we might encounter in this context.
30     *)     *)
31      fun expToInit exp = (case exp      fun expToInit (ty, exp) = (case exp
32             of AST.E_Lit(Literal.Int n) => Inputs.Int n             of AST.E_Lit(Literal.Int n) => InP.Int n
33              | AST.E_Lit(Literal.Float f) => Inputs.Real f              | AST.E_Lit(Literal.Float f) => InP.Real f
34              | AST.E_Lit(Literal.String s) => Inputs.String s              | AST.E_Lit(Literal.String s) => InP.String s
35              | AST.E_Lit(Bool b) => Inputs.Bool b              | AST.E_Lit(Literal.Bool b) => InP.Bool b
36              | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"              | AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"
37              | AST.E_Cons es => let              | AST.E_Cons es => let
38                  fun toReal (AST.E_Lit(Literal.Int n)) = FloatLit.fromInt n                  val shp = (case ty
39                    | toReal (AST.E_Lit(Literal.Float f)) = f                         of Ty.T_Tensor(Ty.Shape shp) => List.map (fn (Ty.DimConst d) => d) shp
40                    | toReal (AST.E_Coerce{e, ...}) = toReal e                          | _ => raise Fail "not tensor type"
                   | toReal _ = raise Fail "impossible"  
                 fun toTensor [e] = ??  
                   | toTensor (es as e1::_) = (case e1  
                        of AST.E_Cons _ => let  
                             val (shp, vs) = ??  
                             in  
                               (List.length es :: shp, List.concat vs)  
                             end  
                         | _ => ([List.length es], List.map toReal (e1::es))  
41                        (* end case *))                        (* end case *))
42                    fun flatten (AST.E_Lit(Literal.Int n), l) = FloatLit.fromInt n :: l
43                      | flatten (AST.E_Lit(Literal.Float f), l) = f :: l
44                      | flatten (AST.E_Coerce{e, ...}, l) = flatten(e, l)
45                      | flatten (AST.E_Cons es, l) = flattenList (es, l)
46                      | flatten _ = raise Fail "impossible"
47                    and flattenList ([], l) = l
48                      | flattenList (x::xs, l) = flatten(x, flattenList(xs, l))
49                  in                  in
50                    Inputs.Tensor(shp, Vector.fromList vs)                    InP.Tensor(shp, Vector.fromList(flattenList (es, [])))
51                  end                  end
52    (*
53              | AST.E_Seq es => ??              | AST.E_Seq es => ??
54              | AST.E_Coerce{srcTy, dstTy, e} => ??              | AST.E_Coerce{srcTy, dstTy, e} => ??
55    *)
56              | _ => raise Fail "impossible initialization expression"              | _ => raise Fail "impossible initialization expression"
57            (* end case *))            (* end case *))
58    
59        fun inputImage (nrrd, dim, shape) = let
60              val dim = TypeUtil.monoDim dim
61              val shp = TypeUtil.monoShape shape
62              in
63                case ImageInfo.fromNrrd(NrrdInfo.getInfo nrrd, dim, shp)
64                 of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])
65                  | SOME info => InP.Proxy(nrrd, info)
66                (* end case *)
67              end
68    
69      (* is the given statement's continuation the syntactically following statement? *)
70        fun contIsNext (AST.S_Block stms) = List.all contIsNext stms
71          | contIsNext AST.S_Die = false
72          | contIsNext AST.S_Stabilize = false
73          | contIsNext (AST.S_Return _) = false
74          | contIsNext _ = true
75    
76      fun simplifyProgram (AST.Program dcls) = let      fun simplifyProgram (AST.Program dcls) = let
77            val inputs = ref []            val inputs = ref []
78            val globals = ref []            val globals = ref []
79            val globalInit = ref []            val globalInit = ref []
80              val funcs = ref []
81            val initially = ref NONE            val initially = ref NONE
82            val strands = ref []            val strands = ref []
83            fun setInitially init = (case !initially            fun setInitially init = (case !initially
# Line 69  Line 88 
88            fun simplifyDecl dcl = (case dcl            fun simplifyDecl dcl = (case dcl
89                   of AST.D_Input(x, desc, NONE) => let                   of AST.D_Input(x, desc, NONE) => let
90                        val (ty, init) = (case Var.monoTypeOf x                        val (ty, init) = (case Var.monoTypeOf x
91                               of ty as Ty.T_Image{dim, shape} =>                               of ty as Ty.T_Image{dim, shape} => let
92                                    (ty, SOME(Inputs.Image(ImageInfo.fromNrrd(NrrdInfo.getInfo nrrd, ?, ?))))                                    val info = ImageInfo.mkInfo(TypeUtil.monoDim dim, TypeUtil.monoShape shape)
93                                      in
94                                        (ty, SOME(InP.Image info))
95                                      end
96                                | ty => (ty, NONE)                                | ty => (ty, NONE)
97                              (* end case *))                              (* end case *))
98                        val inp = Inputs.INP{                        val inp = InP.INP{
99                                ty = ty,                                ty = ty,
100                                name = Var.nameOf x,                                name = Var.nameOf x,
101                                desc = desc,                                desc = desc,
# Line 86  Line 108 
108                      (* load the nrrd proxy here *)                      (* load the nrrd proxy here *)
109                        val info = NrrdInfo.getInfo nrrd                        val info = NrrdInfo.getInfo nrrd
110                        val (ty, init) = (case Var.monoTypeOf x                        val (ty, init) = (case Var.monoTypeOf x
111                               of ty as Ty.T_DynSequence _ => (ty, Inputs.DynSeq nrrd)                               of ty as Ty.T_DynSequence _ => (ty, InP.DynSeq nrrd)
112                                | ty as Ty.T_Image{dim, shape} =>                                | ty as Ty.T_Image{dim, shape} => (ty, inputImage(nrrd, dim, shape))
                                   (ty, Inputs.Proxy(nrrd, ImageInfo.fromNrrd(NrrdInfo.getInfo nrrd, ?, ?)))  
113                                | _ => raise Fail "impossible"                                | _ => raise Fail "impossible"
114                              (* end case *))                              (* end case *))
115                        val inp = Inputs.INP{                        val inp = InP.INP{
116                                ty = ty,                                ty = ty,
117                                name = Var.nameOf x,                                name = Var.nameOf x,
118                                desc = desc,                                desc = desc,
# Line 101  Line 122 
122                          inputs := (x, inp) :: !inputs                          inputs := (x, inp) :: !inputs
123                        end                        end
124                    | AST.D_Input(x, desc, SOME e) => let                    | AST.D_Input(x, desc, SOME e) => let
125                        val inp = Inputs.INP{                        val ty = Var.monoTypeOf x
126                                ty = Var.monoTypeOf x,                        val inp = InP.INP{
127                                  ty = ty,
128                                name = Var.nameOf x,                                name = Var.nameOf x,
129                                desc = desc,                                desc = desc,
130                                init = SOME(expToInit e)                                init = SOME(expToInit(ty, e))
131                              }                              }
132                        in                        in
133                          inputs := (x, inp) :: !inputs                          inputs := (x, inp) :: !inputs
# Line 116  Line 138 
138                          globals := x :: !globals;                          globals := x :: !globals;
139                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)                          globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
140                        end                        end
141                      | AST.D_Func(f, params, body) =>
142                          funcs := S.Func{f=f, params=params, body=simplifyBlock body} :: !funcs
143                    | AST.D_Strand info => strands := simplifyStrand info :: !strands                    | AST.D_Strand info => strands := simplifyStrand info :: !strands
144                    | AST.D_InitialArray(creat, iters) =>                    | AST.D_InitialArray(creat, iters) =>
145                        setInitially (simplifyInit(true, creat, iters))                        setInitially (simplifyInit(true, creat, iters))
# Line 128  Line 152 
152                  inputs = List.rev(!inputs),                  inputs = List.rev(!inputs),
153                  globals = List.rev(!globals),                  globals = List.rev(!globals),
154                  globalInit = mkBlock (!globalInit),                  globalInit = mkBlock (!globalInit),
155                    funcs = List.rev(!funcs),
156                  init = (case !initially                  init = (case !initially
157  (* FIXME: the check for the initially block should really happen in typechecking *)  (* FIXME: the check for the initially block should really happen in typechecking *)
158                     of NONE => raise Fail "missing initially declaration"                     of NONE => raise Fail "missing initially declaration"
# Line 187  Line 212 
212    
213      and simplifyStmt (stm, stms) = (case stm      and simplifyStmt (stm, stms) = (case stm
214             of AST.S_Block body => let             of AST.S_Block body => let
215    (* FIXME: we should probably prune unreachable code in the typechecker and issue a warning! *)
216                  fun simplify ([], stms) = stms                  fun simplify ([], stms) = stms
217                    | simplify (stm::r, stms) = simplify (r, simplifyStmt (stm, stms))                    | simplify (stm::r, stms) = if contIsNext stm
218                          then simplify (r, simplifyStmt (stm, stms))
219                          else simplify (r, [])  (* prune unreachable statements *)
220                  in                  in
221                    simplify (body, stms)                    simplify (body, stms)
222                  end                  end
# Line 216  Line 244 
244                  end                  end
245              | AST.S_Die => S.S_Die :: stms              | AST.S_Die => S.S_Die :: stms
246              | AST.S_Stabilize => S.S_Stabilize :: stms              | AST.S_Stabilize => S.S_Stabilize :: stms
247                | AST.S_Return e => let
248                    val (stms, x) = simplifyExpToVar (e, stms)
249                    in
250                      S.S_Return x :: stms
251                    end
252              | AST.S_Print args => let              | AST.S_Print args => let
253                  val (stms, xs) = simplifyExpsToVars (args, stms)                  val (stms, xs) = simplifyExpsToVars (args, stms)
254                  in                  in
# Line 279  Line 312 
312                  in                  in
313                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)                    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
314                  end                  end
315              | AST.E_LoadNrrd _ => raise Fail "unexpected E_LoadNrrd" (* should be handled by simplifyDecl *)              | AST.E_LoadNrrd(_, nrrd, ty) => (case TypeUtil.prune ty
316                     of ty as Ty.T_DynSequence _ => (stms, S.E_LoadSeq(ty, nrrd))
317                      | ty as Ty.T_Image{dim, shape} => let
318                          val dim = TypeUtil.monoDim dim
319                          val shp = TypeUtil.monoShape shape
320                          in
321                            case ImageInfo.fromNrrd(NrrdInfo.getInfo nrrd, dim, shp)
322                             of NONE => raise Fail(concat[
323                                    "nrrd file \"", nrrd, "\" does not have expected type"
324                                  ])
325                              | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))
326                            (* end case *)
327                          end
328                      | _ => raise Fail "bogus type for E_LoadNrrd"
329                    (* end case *))
330              | AST.E_Coerce{srcTy, dstTy, e} => let              | AST.E_Coerce{srcTy, dstTy, e} => let
331                  val (stms, x) = simplifyExpToVar (e, stms)                  val (stms, x) = simplifyExpToVar (e, stms)
332                  val result = newTemp dstTy                  val result = newTemp dstTy

Legend:
Removed from v.2012  
changed lines
  Added in v.2140

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