Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/simplify/inliner.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/simplify/inliner.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3451, Sat Nov 21 21:11:21 2015 UTC revision 3510, Fri Dec 18 16:37:24 2015 UTC
# Line 28  Line 28 
28                        then x                        then x
29                        else raise Fail("unknown variable " ^ V.uniqueNameOf x)                        else raise Fail("unknown variable " ^ V.uniqueNameOf x)
30                  (* end case *))                  (* end case *))
31            fun doBlock (env, isTop, S.Block stms) = let            fun doBlock (env, isTop, S.Block{props, code}) = let
32                  fun f (stm, (env, stms)) = let                  fun f (stm, (env, stms)) = let
33                          val (env, stm) = doStmt (env, isTop, stm)                          val (env, stm) = doStmt (env, isTop, stm)
34                          in                          in
35                            (env, stm::stms)                            (env, stm::stms)
36                          end                          end
37                  val (_, stms) = List.foldl f (env, []) stms                  val (_, stms) = List.foldl f (env, []) code
38                  in                  in
39                    S.Block(List.rev stms)                    S.Block{props = props, code = List.rev stms}
40                  end                  end
41            and doStmt (env, isTop, stm) = (case stm            and doStmt (env, isTop, stm) = (case stm
42                   of S.S_Var x => let                   of S.S_Var(x, optE) => let
43                        val x' = V.copy x                        val x' = V.copy(x, V.kindOf x)
44                          val optE' = Option.map (doExp env) optE
45                        in                        in
46                          (V.Map.insert(env, x, x'), S.S_Var x')                          (V.Map.insert(env, x, x'), S.S_Var(x', optE'))
47                        end                        end
48                    | S.S_Assign(x, e) => (case V.Map.find(env, x)                    | S.S_Assign(x, e) => (env, S.S_Assign(rename env x, doExp env e))
                        of SOME x' => (env, S.S_Assign(x', doExp env e))  
                         | NONE => let  
                             val x' = V.copy x  
                             in  
                               (V.Map.insert(env, x, x'), S.S_Assign(x', doExp env e))  
                             end  
                       (* end case *))  
49                    | S.S_IfThenElse(x, b1, b2) =>                    | S.S_IfThenElse(x, b1, b2) =>
50                        (env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2)))                        (env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2)))
51                      | S.S_Foreach(x, xs, blk) =>
52                          (env, S.S_Foreach(rename env x, rename env xs, doBlock(env, false, blk)))
53                    | S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs))                    | S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs))
54                      | S.S_Continue => (env, stm)
55                    | S.S_Die => (env, stm)                    | S.S_Die => (env, stm)
56                    | S.S_Stabilize => (env, stm)                    | S.S_Stabilize => (env, stm)
57                    | S.S_Return x => (                    | S.S_Return x => (
58                        if not isTop then needsLHSPreDecl := true else ();                        if not isTop then needsLHSPreDecl := true else ();
59                        (env, S.S_Assign(lhs, S.E_Var(rename env x))))                        (env, S.S_Assign(lhs, S.E_Var(rename env x))))
60                    | S.S_Print xs => (env, S.S_Print(List.map (rename env) xs))                    | S.S_Print xs => (env, S.S_Print(List.map (rename env) xs))
61                      | S.S_MapReduce _ => raise Fail "unexpected MapReduce in function"
62                  (* end case *))                  (* end case *))
63            and doExp env exp = (case exp            and doExp env exp = (case exp
64                   of S.E_Var x => S.E_Var(rename env x)                   of S.E_Var x => S.E_Var(rename env x)
65                      | S.E_Select(x, fld) => S.E_Select(rename env x, fld)
66                    | S.E_Lit _ => exp                    | S.E_Lit _ => exp
67                    | S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)                    | S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)
68                    | S.E_Prim(f, tys, xs, ty) =>                    | S.E_Prim(f, tys, xs, ty) =>
69                        S.E_Prim(f, tys, List.map (rename env) xs, ty)                        S.E_Prim(f, tys, List.map (rename env) xs, ty)
70                    | S.E_Cons(xs, ty) => S.E_Cons(List.map (rename env) xs, ty)                    | S.E_Tensor(xs, ty) => S.E_Tensor(List.map (rename env) xs, ty)
71                    | S.E_Seq(xs, ty) => S.E_Seq(List.map (rename env) xs, ty)                    | S.E_Seq(xs, ty) => S.E_Seq(List.map (rename env) xs, ty)
72                    | S.E_Slice(x, xs, ty) =>                    | S.E_Slice(x, xs, ty) =>
73                        S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)                        S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)
# Line 81  Line 80 
80            val env = ListPair.foldlEq            val env = ListPair.foldlEq
81                  (fn (x, x', env) => V.Map.insert(env, x, x'))                  (fn (x, x', env) => V.Map.insert(env, x, x'))
82                    V.Map.empty (params, args)                    V.Map.empty (params, args)
83            val blk as S.Block stms = doBlock (env, true, body)            val blk as S.Block{props, code} = doBlock (env, true, body)
84            in            in
85              if !needsLHSPreDecl              if !needsLHSPreDecl
86                then S.Block(S.S_Var lhs :: stms)                then S.Block{props = props, code = S.S_Var(lhs, NONE) :: code}
87                else blk                else blk
88            end            end
89    
90    (* inline expand user-function calls in a block *)    (* inline expand user-function calls in a block *)
91      fun expandBlock funcTbl = let      fun expandBlock funcTbl = let
92            val findFunc = V.Tbl.find funcTbl            val findFunc = V.Tbl.find funcTbl
93            fun expandBlk (S.Block stms) =            fun expandBlk (S.Block{props, code}) =
94                  S.Block(List.foldr expandStm [] stms)                  S.Block{props = props, code = List.foldr expandStm [] code}
95            and expandStm (stm, stms') = (case stm            and expandStm (stm, stms') = (case stm
96                   of S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f                   of S.S_Var(x, SOME(S.E_Apply(f, xs, _))) => (case findFunc f
97                           of NONE => stm :: stms'
98                            | SOME func => let
99                                val S.Block{code, ...} = beta(x, func, xs)
100                                in
101                                  code @ stms'
102                                end
103                          (* end case *))
104                      | S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f
105                         of NONE => stm :: stms'                         of NONE => stm :: stms'
106                          | SOME func => let                          | SOME func => let
107                              val S.Block stms = beta(x, func, xs)                              val S.Block{code, ...} = beta(x, func, xs)
108                              in                              in
109                                stms @ stms'                                code @ stms'
110                              end                              end
111                        (* end case *))                        (* end case *))
112                    | S.S_IfThenElse(x, b1, b2) =>                    | S.S_IfThenElse(x, b1, b2) =>
113                        S.S_IfThenElse(x, expandBlk b1, expandBlk b2) :: stms'                        S.S_IfThenElse(x, expandBlk b1, expandBlk b2) :: stms'
114                      | S.S_Foreach(x, xs, blk) =>
115                          S.S_Foreach(x, xs, expandBlk blk) :: stms'
116                    | _ => stm :: stms'                    | _ => stm :: stms'
117                  (* end case *))                  (* end case *))
118            in            in
# Line 135  Line 144 
144    
145      fun transform (prog as S.Program{funcs=[], ...}) = prog      fun transform (prog as S.Program{funcs=[], ...}) = prog
146        | transform prog = let        | transform prog = let
147            val S.Program{props, inputs, globals, funcs, init, strand, create, update} = prog            val S.Program{props, consts, inputs, constInit, globals, funcs, init, strand, create, update} = prog
148          (* a table that maps function names to their definitions *)          (* a table that maps function names to their definitions *)
149            val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")            val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")
150          (* first we inline expand the function bodies in definition order *)          (* first we inline expand the function bodies in definition order *)
# Line 144  Line 153 
153            in            in
154              S.Program{              S.Program{
155                  props = props,                  props = props,
156                    consts = consts,
157                  inputs = inputs,                  inputs = inputs,
158                    constInit = constInit,
159                  globals = globals,                  globals = globals,
160                  init = expandBlock init,                  init = expandBlock init,
161                  funcs = [],                  funcs = [],
162                  strand = expandStrand funcTbl strand,                  strand = expandStrand funcTbl strand,
163                  create = expandBlock create,                  create = (case create
164                       of S.Create{dim, code} => S.Create{dim = dim, code = expandBlock code}
165                      (* end case *)),
166                  update = Option.map expandBlock update                  update = Option.map expandBlock update
167                }                }
168            end            end

Legend:
Removed from v.3451  
changed lines
  Added in v.3510

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