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 4426, Wed Aug 17 20:00:23 2016 UTC revision 4441, Sun Aug 21 15:55:21 2016 UTC
# Line 34  Line 34 
34      structure II = ImageInfo      structure II = ImageInfo
35      structure BV = BasisVars      structure BV = BasisVars
36    
37      (* environment for mapping small global constants to AST expressions *)
38        type const_env = AST.expr VMap.map
39    
40    (* context for simplification *)    (* context for simplification *)
41      type context = {errStrm : Error.err_stream, gEnv : GlobalEnv.t}      datatype context = Cxt of {
42            errStrm : Error.err_stream,
43            gEnv : GlobalEnv.t,
44            cEnv : const_env
45          }
46    
47        fun getNrrdInfo (Cxt{errStrm, ...}, nrrd) = NrrdInfo.getInfo (errStrm, nrrd)
48    
49        fun findStrand (Cxt{gEnv, ...}, s) = GlobalEnv.findStrand(gEnv, s)
50    
51        fun insertConst (Cxt{errStrm, gEnv, cEnv}, x, e) = Cxt{
52                errStrm = errStrm, gEnv = gEnv, cEnv = VMap.insert(cEnv, x, e)
53              }
54    
55        fun findConst (Cxt{cEnv, ...}, x) = VMap.find(cEnv, x)
56    
57      fun error ({errStrm, gEnv}, msg) = Error.error (errStrm, msg)      fun error (Cxt{errStrm, ...}, msg) = Error.error (errStrm, msg)
58      fun warning ({errStrm, gEnv}, msg) = Error.warning (errStrm, msg)      fun warning (Cxt{errStrm, ...}, msg) = Error.warning (errStrm, msg)
59    
60      (* error message for when a nrrd image file is incompatible with the declared image type *)
61        fun badImageNrrd (cxt, nrrdFile, nrrdInfo, expectedDim, expectedShp) = let
62              val NrrdInfo.NrrdInfo{dim, nElems, ...} = nrrdInfo
63              val expectedNumElems = List.foldl (op * ) 1 expectedShp
64              val prefix = String.concat[
65                      "image file \"", nrrdFile, "\"  is incompatible with expected type image(",
66                      Int.toString expectedDim, ")[",
67                      String.concatWithMap "," Int.toString expectedShp, "]"
68                    ]
69              in
70                case (dim = expectedDim, nElems = expectedNumElems)
71                 of (false, true) => error (cxt, [
72                        prefix, "; its dimension is ", Int.toString dim
73                      ])
74                  | (true, false) => error (cxt, [
75                        prefix, "; it has ", Int.toString nElems, " sample per voxel"
76                      ])
77                  | _ =>  error (cxt, [
78                        prefix, ";  its dimension is ", Int.toString dim, " and it has ",
79                        Int.toString nElems, " sample per voxel"
80                      ])
81                (* end case *)
82              end
83    
84    (* convert a Types.ty to a SimpleTypes.ty *)    (* convert a Types.ty to a SimpleTypes.ty *)
85      fun cvtTy ty = (case ty      fun cvtTy ty = (case ty
# Line 137  Line 178 
178     * 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
179     * code.     * code.
180     *)     *)
181      and simplifyStmt (cxt, stm, stms) : S.stmt list = (case stm      and simplifyStmt (cxt : context, stm, stms) : S.stmt list = (case stm
182             of AST.S_Block body => let             of AST.S_Block body => let
183                  fun simplify ([], stms) = stms                  fun simplify ([], stms) = stms
184                    | simplify (stm::r, stms) = simplify (r, simplifyStmt (cxt, stm, stms))                    | simplify (stm::r, stms) = simplify (r, simplifyStmt (cxt, stm, stms))
# Line 229  Line 270 
270                      (* get the strand type for the query *)                      (* get the strand type for the query *)
271                        val tyArgs as [S.TY(STy.T_Strand strand)] = List.map cvtTyArg tyArgs                        val tyArgs as [S.TY(STy.T_Strand strand)] = List.map cvtTyArg tyArgs
272                      (* get the strand environment for the strand *)                      (* get the strand environment for the strand *)
273                        val SOME sEnv = GlobalEnv.findStrand(#gEnv cxt, strand)                        val SOME sEnv = findStrand(cxt, strand)
274                        fun result (query, pos) =                        fun result (query, pos) =
275                              (stms, S.E_Prim(query, tyArgs, cvtVar pos::xs, cvtTy ty))                              (stms, S.E_Prim(query, tyArgs, cvtVar pos::xs, cvtTy ty))
276                        in                        in
# Line 260  Line 301 
301                          in                          in
302                            (stm::stms, S.E_Var x')                            (stm::stms, S.E_Var x')
303                          end                          end
304                        | Var.ConstVar => (case findConst(cxt, x)
305                             of SOME e => let
306                                  val (stms, x') = simplifyExpToVar (cxt, e, stms)
307                                  in
308                                    (stms, S.E_Var x')
309                                  end
310                              | NONE => (stms, S.E_Var(cvtVar x))
311                            (* end case *))
312                      | _ => (stms, S.E_Var(cvtVar x))                      | _ => (stms, S.E_Var(cvtVar x))
313                    (* end case *))                    (* end case *))
314                | AST.E_Lit lit => (stms, S.E_Lit lit)                | AST.E_Lit lit => (stms, S.E_Lit lit)
# Line 395  Line 444 
444                          val dim = II.dim info                          val dim = II.dim info
445                          val shape = II.voxelShape info                          val shape = II.voxelShape info
446                          in                          in
447                            case NrrdInfo.getInfo (#errStrm cxt, nrrd)                            case getNrrdInfo (cxt, nrrd)
448                             of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)                             of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)
449                                   of NONE => (                                   of NONE => (
450                                        error (cxt, [                                        badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);
                                           "nrrd file \"", nrrd, "\" does not have expected type"  
                                         ]);  
451                                        (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))                                        (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
452                                    | SOME imgInfo =>                                    | SOME imgInfo =>
453                                        (stms, S.E_LoadImage(STy.T_Image imgInfo, nrrd, imgInfo))                                        (stms, S.E_LoadImage(STy.T_Image imgInfo, nrrd, imgInfo))
454                                  (* end case *))                                  (* end case *))
455                              | NONE => (                              | NONE => (
456                                  warning (cxt, [                                  error (cxt, [
457                                      "nrrd file \"", nrrd, "\" does not exist"                                      "proxy-image file \"", nrrd, "\" does not exist"
458                                    ]);                                    ]);
459                                  (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))                                  (stms, S.E_LoadImage(ty, nrrd, II.mkInfo(dim, shape))))
460                            (* end case *)                            (* end case *)
# Line 545  Line 592 
592            val AST.Program{            val AST.Program{
593                    props, const_dcls, input_dcls, globals, globInit, strand, create, init, update                    props, const_dcls, input_dcls, globals, globInit, strand, create, init, update
594                  } = prog                  } = prog
           val cxt = {errStrm = errStrm, gEnv = gEnv}  
595            val consts' = ref[]            val consts' = ref[]
596            val constInit = ref[]            val constInit = ref[]
597            val inputs' = ref[]            val inputs' = ref[]
598            val globals' = ref[]            val globals' = ref[]
599            val globalInit = ref[]            val globalInit = ref[]
600            val funcs = ref[]            val funcs = ref[]
601            fun simplifyConstDcl (x, SOME e) = let          (* simplify the constant dcls: the small constants will be added to the context
602             * while the large constants will be added to the const' list.
603             *)
604              val cxt = let
605                    val cxt = Cxt{errStrm = errStrm, gEnv = gEnv, cEnv = VMap.empty}
606                    fun simplifyConstDcl ((x, SOME e), cxt) = if Util.isSmallExp e
607                          then insertConst (cxt, x, e)
608                          else let
609                  val (stms, e') = simplifyExp (cxt, e, [])                  val (stms, e') = simplifyExp (cxt, e, [])
610                  val x' = cvtVar x                  val x' = cvtVar x
611                  in                  in
612                    consts' := x' :: !consts';                    consts' := x' :: !consts';
613                    constInit := S.S_Assign(x', e') :: (stms @ !constInit)                            constInit := S.S_Assign(x', e') :: (stms @ !constInit);
614                              cxt
615                            end
616                      | simplifyConstDcl _ = raise Fail "impossble"
617                    in
618                      List.foldl simplifyConstDcl cxt const_dcls
619                  end                  end
620            fun simplifyInputDcl ((x, NONE), desc) = let            fun simplifyInputDcl ((x, NONE), desc) = let
621                  val x' = cvtVar x                  val x' = cvtVar x
622                  val init = (case SimpleVar.typeOf x'                  val init = (case SimpleVar.typeOf x'
623                         of STy.T_Image info => S.Image info                         of STy.T_Image info => (
624                                warning(cxt, [
625                                    "assuming a sample type of ", RawTypes.toString(II.sampleTy info),
626                                    " for '", SimpleVar.nameOf x',
627                                    "'; specify a proxy-image file to override the default sample type"
628                                  ]);
629                                S.Image info)
630                          | _ => S.NoDefault                          | _ => S.NoDefault
631                        (* end case *))                        (* end case *))
632                  val inp = S.INP{                  val inp = S.INP{
# Line 582  Line 646 
646                              val dim = TU.monoDim dim                              val dim = TU.monoDim dim
647                              val shape = TU.monoShape shape                              val shape = TU.monoShape shape
648                              in                              in
649                                case NrrdInfo.getInfo (#errStrm cxt, nrrd)                                case getNrrdInfo (cxt, nrrd)
650                                 of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)                                 of SOME nrrdInfo => (case II.fromNrrd(nrrdInfo, dim, shape)
651                                       of NONE => (                                       of NONE => (
652                                            error (cxt, [                                            badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);
                                               "proxy input file \"", nrrd,  
                                               "\" does not have expected type"  
                                             ]);  
653                                            (cvtVar x, S.Image(II.mkInfo(dim, shape))))                                            (cvtVar x, S.Image(II.mkInfo(dim, shape))))
654                                        | SOME info =>                                        | SOME info =>
655                                            (newVarWithType(x, STy.T_Image info), S.Proxy(nrrd, info))                                            (newVarWithType(x, STy.T_Image info), S.Proxy(nrrd, info))
656                                      (* end case *))                                      (* end case *))
657                                  | NONE => (                                  | NONE => (
658                                      warning (cxt, [                                      error (cxt, [
659                                          "proxy input file \"", nrrd, "\" does not exist"                                          "proxy-image file \"", nrrd, "\" does not exist"
660                                        ]);                                        ]);
661                                      (cvtVar x, S.Image(II.mkInfo(dim, shape))))                                      (cvtVar x, S.Image(II.mkInfo(dim, shape))))
662                                (* end case *)                                (* end case *)
# Line 642  Line 703 
703                    funcs := S.Func{f=f', params=params', body=body'} :: !funcs                    funcs := S.Func{f=f', params=params', body=body'} :: !funcs
704                  end                  end
705            val () = (            val () = (
                 List.app simplifyConstDcl const_dcls;  
706                  List.app simplifyInputDcl input_dcls;                  List.app simplifyInputDcl input_dcls;
707                  List.app simplifyGlobalDcl globals)                  List.app simplifyGlobalDcl globals)
708          (* make the global-initialization block *)          (* make the global-initialization block *)

Legend:
Removed from v.4426  
changed lines
  Added in v.4441

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