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 4433, Fri Aug 19 15:12:41 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 *)    (* error message for when a nrrd image file is incompatible with the declared image type *)
61      fun badImageNrrd (cxt, nrrdFile, nrrdInfo, expectedDim, expectedShp) = let      fun badImageNrrd (cxt, nrrdFile, nrrdInfo, expectedDim, expectedShp) = let
# Line 161  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 253  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 284  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 419  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                                        badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);                                        badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);
# Line 567  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
# Line 610  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                                            badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);                                            badImageNrrd (cxt, nrrd, nrrdInfo, dim, shape);
# Line 667  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.4433  
changed lines
  Added in v.4441

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