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 4192, Tue Jul 12 22:13:25 2016 UTC revision 4193, Wed Jul 13 02:54:21 2016 UTC
# Line 31  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 46  Line 47 
47              | Ty.T_Strand id => STy.T_Strand id              | Ty.T_Strand id => STy.T_Strand id
48              | Ty.T_Kernel n => STy.T_Kernel(TU.monoDiff n)              | Ty.T_Kernel n => STy.T_Kernel(TU.monoDiff n)
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,
# Line 65  Line 64 
64              | cvtTy STy.T_String = APITypes.StringTy              | cvtTy STy.T_String = APITypes.StringTy
65              | cvtTy (STy.T_Sequence(ty, len)) = APITypes.SeqTy(cvtTy ty, len)              | cvtTy (STy.T_Sequence(ty, len)) = APITypes.SeqTy(cvtTy ty, len)
66              | cvtTy (STy.T_Tensor shape) = APITypes.TensorTy shape              | cvtTy (STy.T_Tensor shape) = APITypes.TensorTy shape
67              | cvtTy (STy.T_Image{dim, shape}) = APITypes.ImageTy(dim, shape)              | cvtTy (STy.T_Image info) =
68                    APITypes.ImageTy(II.dim info, II.voxelShape info)
69              | cvtTy ty = raise Fail "bogus API type"              | cvtTy ty = raise Fail "bogus API type"
70            in            in
71              cvtTy (SimpleVar.typeOf x)              cvtTy (SimpleVar.typeOf x)
# Line 88  Line 88 
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
# Line 102  Line 109 
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.
121     * 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
# Line 121  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
# Line 140  Line 154 
154                  end                  end
155              | AST.S_Assign((x, _), e) => let              | AST.S_Assign((x, _), e) => let
156                  val (stms, e') = simplifyExp (errStrm, e, stms)                  val (stms, e') = simplifyExp (errStrm, e, stms)
157                    val x' = cvtLHS (x, e')
158                  in                  in
159                    S.S_Assign(cvtVar x, e') :: stms                    S.S_Assign(x', e') :: stms
160                  end                  end
161              | AST.S_New(name, args) => let              | AST.S_New(name, args) => let
162                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)                  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
# Line 302  Line 317 
317                    end                    end
318                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty                | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty
319                     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))
320                      | ty as SimpleTypes.T_Image{dim, shape} => (                      | ty as SimpleTypes.T_Image info => let
321                            val dim = II.dim info
322                            val shape = II.voxelShape info
323                            in
324                          case NrrdInfo.getInfo (errStrm, nrrd)                          case NrrdInfo.getInfo (errStrm, nrrd)
325                           of SOME info => (case ImageInfo.fromNrrd(info, dim, shape)                             of SOME info' => (case II.fromNrrd(info', dim, shape)
326                                 of NONE => (                                 of NONE => (
327                                      Error.error (errStrm, [                                      Error.error (errStrm, [
328                                          "nrrd file \"", nrrd, "\" does not have expected type"                                          "nrrd file \"", nrrd, "\" does not have expected type"
329                                        ]);                                        ]);
330                                      (stms, S.E_LoadImage(ty, nrrd, ImageInfo.mkInfo(dim, shape))))                                        (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
331                                  | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))                                  | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))
332                                (* end case *))                                (* end case *))
333                            | NONE => (                            | NONE => (
334                                Error.warning (errStrm, [                                Error.warning (errStrm, [
335                                    "nrrd file \"", nrrd, "\" does not exist"                                    "nrrd file \"", nrrd, "\" does not exist"
336                                  ]);                                  ]);
337                                (stms, S.E_LoadImage(ty, nrrd, ImageInfo.mkInfo(dim, shape))))                                  (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
338                          (* end case *))                            (* end case *)
339                            end
340                      | _ => raise Fail "bogus type for E_LoadNrrd"                      | _ => raise Fail "bogus type for E_LoadNrrd"
341                    (* end case *))                    (* end case *))
342                | AST.E_Coerce{dstTy, e=AST.E_Lit(Literal.Int n), ...} => (case cvtTy dstTy                | AST.E_Coerce{dstTy, e=AST.E_Lit(Literal.Int n), ...} => (case cvtTy dstTy
# Line 412  Line 431 
431            fun simplifyInputDcl ((x, NONE), desc) = let            fun simplifyInputDcl ((x, NONE), desc) = let
432                  val x' = cvtVar x                  val x' = cvtVar x
433                  val init = (case SimpleVar.typeOf x'                  val init = (case SimpleVar.typeOf x'
434                         of STy.T_Image{dim, shape} => let                         of STy.T_Image info => S.Image info
                             val info = ImageInfo.mkInfo(dim, shape)  
                             in  
                               S.Image info  
                             end  
435                          | _ => S.NoDefault                          | _ => S.NoDefault
436                        (* end case *))                        (* end case *))
437                  val inp = S.INP{                  val inp = S.INP{
# Line 430  Line 445 
445                    inputs' := inp :: !inputs'                    inputs' := inp :: !inputs'
446                  end                  end
447              | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let              | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let
448                  val x' = cvtVar x                  val (x', init) = (case Var.monoTypeOf x
449                  val init = (case SimpleVar.typeOf x'                         of Ty.T_Sequence(_, NONE) => (cvtVar x, S.LoadSeq nrrd)
450                         of SimpleTypes.T_Sequence(_, NONE) => S.LoadSeq nrrd                          | Ty.T_Image{dim, shape} => let
451                          | SimpleTypes.T_Image{dim, shape} => (                              val dim = TU.monoDim dim
452                                val shape = TU.monoShape shape
453                                in
454                              case NrrdInfo.getInfo (errStrm, nrrd)                              case NrrdInfo.getInfo (errStrm, nrrd)
455                               of SOME info => (case ImageInfo.fromNrrd(info, dim, shape)                                 of SOME info => (case II.fromNrrd(info, dim, shape)
456                                     of NONE => (                                     of NONE => (
457                                          Error.error (errStrm, [                                          Error.error (errStrm, [
458                                              "proxy nrrd file \"", nrrd,                                              "proxy nrrd file \"", nrrd,
459                                              "\" does not have expected type"                                              "\" does not have expected type"
460                                            ]);                                            ]);
461                                          S.Image(ImageInfo.mkInfo(dim, shape)))                                            (cvtVar x, S.Image(II.mkInfo(dim, shape))))
462                                      | SOME info => S.Proxy(nrrd, info)                                        | SOME info =>
463                                              (newVarWithType(x, STy.T_Image info), S.Proxy(nrrd, info))
464                                    (* end case *))                                    (* end case *))
465                                | NONE => (                                | NONE => (
466                                    Error.warning (errStrm, [                                    Error.warning (errStrm, [
467                                        "proxy nrrd file \"", nrrd, "\" does not exist"                                        "proxy nrrd file \"", nrrd, "\" does not exist"
468                                      ]);                                      ]);
469                                    S.Image(ImageInfo.mkInfo(dim, shape)))                                      (cvtVar x, S.Image(II.mkInfo(dim, shape))))
470                              (* end case *))                                (* end case *)
471                                end
472                          | _ => raise Fail "impossible"                          | _ => raise Fail "impossible"
473                        (* end case *))                        (* end case *))
474                  val inp = S.INP{                  val inp = S.INP{

Legend:
Removed from v.4192  
changed lines
  Added in v.4193

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