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

SCM Repository

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

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

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

revision 2377, Mon Jun 3 19:41:56 2013 UTC revision 2604, Fri Apr 25 18:23:44 2014 UTC
# Line 13  Line 13 
13    end = struct    end = struct
14    
15      structure S = Simple      structure S = Simple
16      structure V = Var      structure V = SimpleVar
17    
18    (* beta reduce the application "lhs = f(args)" by creating a fresh copy of f's body    (* beta reduce the application "lhs = f(args)" by creating a fresh copy of f's body
19     * while mapping the parameters to arguments.     * while mapping the parameters to arguments.
20     *)     *)
21      fun beta (lhs, S.Func{f, params, body}, args) = let      fun beta (lhs, S.Func{f, params, body}, args) = let
22              val needsLHSPreDecl = ref false (* set to true if the lhs needs to be declared before the body *)
23            fun rename env x = (case V.Map.find(env, x)            fun rename env x = (case V.Map.find(env, x)
24                   of SOME x' => x'                   of SOME x' => x'
25                    | NONE => if Var.isGlobal x                    | NONE => if SimpleVar.isGlobal x
26                        then x                        then x
27                        else raise Fail("unknown variable " ^ V.uniqueNameOf x)                        else raise Fail("unknown variable " ^ V.uniqueNameOf x)
28                  (* end case *))                  (* end case *))
29            fun doBlock (env, S.Block stms) = let            fun doBlock (env, isTop, S.Block stms) = let
30                  fun f (stm, (env, stms)) = let                  fun f (stm, (env, stms)) = let
31                          val (env, stm) = doStmt (env, stm)                          val (env, stm) = doStmt (env, isTop, stm)
32                          in                          in
33                            (env, stm::stms)                            (env, stm::stms)
34                          end                          end
# Line 35  Line 36 
36                  in                  in
37                    S.Block(List.rev stms)                    S.Block(List.rev stms)
38                  end                  end
39            and doStmt (env, stm) = (case stm            and doStmt (env, isTop, stm) = (case stm
40                   of S.S_Var x => let                   of S.S_Var x => let
41                        val x' = V.copy x                        val x' = V.copy x
42                        in                        in
# Line 50  Line 51 
51                              end                              end
52                        (* end case *))                        (* end case *))
53                    | S.S_IfThenElse(x, b1, b2) =>                    | S.S_IfThenElse(x, b1, b2) =>
54                        (env, S.S_IfThenElse(rename env x, doBlock(env, b1), doBlock(env, b2)))                        (env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2)))
55                    | 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))
56                    | S.S_Die => (env, stm)                    | S.S_Die => (env, stm)
57                    | S.S_Stabilize => (env, stm)                    | S.S_Stabilize => (env, stm)
58                    | S.S_Return x => (env, S.S_Assign(lhs, S.E_Var(rename env x)))                    | S.S_Return x => (
59                          if not isTop then needsLHSPreDecl := true else ();
60                          (env, S.S_Assign(lhs, S.E_Var(rename env x))))
61                    | 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))
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_Lit _ => exp                    | S.E_Lit _ => exp
66                    | S.E_Tuple xs => S.E_Tuple(List.map (rename env) xs)                    | S.E_Tuple xs => S.E_Tuple(List.map (rename env) xs)
67                    | S.E_Apply(f, tys, xs, ty) =>                    | S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)
68                        S.E_Apply(f, tys, List.map (rename env) xs, ty)                    | S.E_Prim(f, tys, xs, ty) =>
69                          S.E_Prim(f, tys, List.map (rename env) xs, ty)
70                    | S.E_Cons xs => S.E_Cons(List.map (rename env) xs)                    | S.E_Cons xs => S.E_Cons(List.map (rename env) xs)
71                    | S.E_Slice(x, xs, ty) =>                    | S.E_Slice(x, xs, ty) =>
72                        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)
73                    | S.E_Coerce{srcTy, dstTy, x} =>                    | S.E_Coerce{srcTy, dstTy, x} =>
74                        S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}                        S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}
75                      | S.E_Input(_, _, _, NONE) => exp
76                      | S.E_Input(ty, name, desc, SOME x) =>
77                          S.E_Input(ty, name, desc, SOME(rename env x))
78                    | S.E_LoadImage _ => exp                    | S.E_LoadImage _ => exp
79                  (* end case *))                  (* end case *))
80          (* build the initial environment by mapping parameters to arguments *)          (* build the initial environment by mapping parameters to arguments *)
81            val env = ListPair.foldlEq            val env = ListPair.foldlEq
82                  (fn (x, x', env) => V.Map.insert(env, x, x'))                  (fn (x, x', env) => V.Map.insert(env, x, x'))
83                    V.Map.empty (params, args)                    V.Map.empty (params, args)
84              val blk as S.Block stms = doBlock (env, true, body)
85            in            in
86              doBlock (env, body)              if !needsLHSPreDecl
87                  then S.Block(S.S_Var lhs :: stms)
88                  else blk
89            end            end
90    
91    (* inline expand user-function calls in a block *)    (* inline expand user-function calls in a block *)
# Line 84  Line 94 
94            fun expandBlk (S.Block stms) =            fun expandBlk (S.Block stms) =
95                  S.Block(List.foldr expandStm [] stms)                  S.Block(List.foldr expandStm [] stms)
96            and expandStm (stm, stms') = (case stm            and expandStm (stm, stms') = (case stm
97                   of S.S_Assign(x, S.E_Apply(f, [], xs, _)) => (case findFunc f                   of S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f
98                         of NONE => stm :: stms'                         of NONE => stm :: stms'
99                          | SOME func => let                          | SOME func => let
100                              val S.Block stms = beta(x, func, xs)                              val S.Block stms = beta(x, func, xs)
# Line 102  Line 112 
112    
113      fun expandFunc funcTbl (S.Func{f, params, body}) = let      fun expandFunc funcTbl (S.Func{f, params, body}) = let
114            val body' = expandBlock funcTbl body            val body' = expandBlock funcTbl body
115              val func' = S.Func{f=f, params=params, body=body'}
116            in            in
117              V.Tbl.insert funcTbl (f, S.Func{f=f, params=params, body=body'})              V.Tbl.insert funcTbl (f, func')
118            end            end
119    
120      fun expandStrand funcTbl = let      fun expandStrand funcTbl = let

Legend:
Removed from v.2377  
changed lines
  Added in v.2604

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