Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/opt/split.sml
[smlnj] / sml / trunk / src / compiler / FLINT / opt / split.sml  
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/opt/split.sml

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

revision 422, Sun Sep 5 22:49:38 1999 UTC revision 423, Mon Sep 6 02:32:11 1999 UTC
# Line 12  Line 12 
12    
13  local  local
14      structure F  = FLINT      structure F  = FLINT
15      structure S  = IntSetF      structure S  = IntBinarySet
16      structure M  = IntmapF      structure M  = IntBinaryMap
17      structure O  = Option      structure O  = Option
18      structure OU = OptUtils      structure OU = OptUtils
19      structure FU = FlintUtil      structure FU = FlintUtil
# Line 33  Line 33 
33  val mklv = LambdaVar.mkLvar  val mklv = LambdaVar.mkLvar
34  val cplv = LambdaVar.dupLvar  val cplv = LambdaVar.dupLvar
35    
36  fun addv (s,F.VAR lv) = S.add(lv, s)  fun addv (s,F.VAR lv) = S.add(s, lv)
37    | addv (s,_) = s    | addv (s,_) = s
38  fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs  fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs
39  fun rmvs (s,lvs) = foldl S.rmv s lvs  fun rmvs (s,lvs) = foldl (fn (l,s) => S.delete(s, l)) s lvs
40    
41  exception Unknown  exception Unknown
42    
# Line 67  Line 67 
67      let      let
68          (* non-side effecting binds are copied to leI if exported *)          (* non-side effecting binds are copied to leI if exported *)
69          fun let1 (le,lewrap,lv,vs,effect) =          fun let1 (le,lewrap,lv,vs,effect) =
70              let val (leE,leI,fvI,leRet) = sexp (S.add(lv, env)) le              let val (leE,leI,fvI,leRet) = sexp (S.add(env, lv)) le
71                  val leE = lewrap o leE                  val leE = lewrap o leE
72              in if effect orelse not (S.member fvI lv)              in if effect orelse not (S.member(fvI, lv))
73                 then (leE, leI, fvI, leRet)                 then (leE, leI, fvI, leRet)
74                 else (leE, lewrap leI, addvs(S.rmv(lv, fvI), vs), leRet)                 else (leE, lewrap leI, addvs(S.delete(fvI, lv), vs), leRet)
75              end              end
76    
77      in case lexp      in case lexp
# Line 109  Line 109 
109             let1(le, fn e => F.SWITCH(v, ac, [(dc, e)], NONE), lv, [v], false)             let1(le, fn e => F.SWITCH(v, ac, [(dc, e)], NONE), lv, [v], false)
110    
111           | F.LET (lvs,body,le) =>           | F.LET (lvs,body,le) =>
112             let val (leE,leI,fvI,leRet) = sexp (S.union(S.make lvs, env)) le             let val (leE,leI,fvI,leRet) = sexp (S.union(S.addList(S.empty, lvs), env)) le
113             in (fn e => F.LET(lvs, body, leE e), leI, fvI, leRet)             in (fn e => F.LET(lvs, body, leE e), leI, fvI, leRet)
114             end             end
115    
# Line 130  Line 130 
130   * - (mutually) recursive:  don't bother   * - (mutually) recursive:  don't bother
131   * - non-inlinable non-recursive:  split recursively *)   * - non-inlinable non-recursive:  split recursively *)
132  and sfix env (fdecs,le) =  and sfix env (fdecs,le) =
133      let val nenv = S.union(S.make(map #2 fdecs), env)      let val nenv = S.union(S.addList(S.empty, map #2 fdecs), env)
134          val (leE,leI,fvI,leRet) = sexp nenv le          val (leE,leI,fvI,leRet) = sexp nenv le
135          val nleE = fn e => F.FIX(fdecs, leE e)          val nleE = fn e => F.FIX(fdecs, leE e)
136      in case fdecs      in case fdecs
137          of [({inline=inl as (F.IH_ALWAYS | F.IH_MAYBE _),...},f,args,body)] =>          of [({inline=inl as (F.IH_ALWAYS | F.IH_MAYBE _),...},f,args,body)] =>
138             let val min = case inl of F.IH_MAYBE(n,_) => n | _ => 0             let val min = case inl of F.IH_MAYBE(n,_) => n | _ => 0
139             in if not(S.member fvI f) orelse min > !CTRL.splitThreshold             in if not(S.member(fvI, f)) orelse min > !CTRL.splitThreshold
140                then (nleE, leI, fvI, leRet)                then (nleE, leI, fvI, leRet)
141                else (nleE, F.FIX(fdecs, leI),                else (nleE, F.FIX(fdecs, leI),
142                      rmvs(S.union(fvI, FU.freevars body),                      rmvs(S.union(fvI, FU.freevars body),
# Line 150  Line 150 
150      end      end
151    
152  and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =  and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
153      let val benv = S.union(S.make(map #1 args), env)      let val benv = S.union(S.addList(S.empty, map #1 args), env)
154          val (bodyE,bodyI,fvbI,bodyRet) = sexp benv body          val (bodyE,bodyI,fvbI,bodyRet) = sexp benv body
155      in case bodyI      in case bodyI
156          of F.RET[] =>          of F.RET[] =>
157             (fn e => F.FIX([(fk, f, args, bodyE bodyRet)], e),             (fn e => F.FIX([(fk, f, args, bodyE bodyRet)], e),
158              leI, fvI, leRet)              leI, fvI, leRet)
159           | _ =>           | _ =>
160             let val fvbIs = S.members(S.diff(fvbI, benv))             let val fvbIs = S.listItems(S.difference(fvbI, benv))
161                 val (nfk,fkE) = OU.fk_wrap(fk, NONE)                 val (nfk,fkE) = OU.fk_wrap(fk, NONE)
162    
163                 (* fdecE *)                 (* fdecE *)
# Line 203  Line 203 
203                 fun nleE e =                 fun nleE e =
204                     F.FIX([fdecE], F.FIX([fdecI], F.FIX([nfdec], leE e)))                     F.FIX([fdecE], F.FIX([fdecI], F.FIX([nfdec], leE e)))
205    
206             in if not(S.member fvI f) then (nleE, leI, fvI, leRet)             in if not(S.member(fvI, f)) then (nleE, leI, fvI, leRet)
207                else (nleE,                else (nleE,
208                      F.FIX([fdecI], F.FIX([nfdec], leI)),                      F.FIX([fdecI], F.FIX([nfdec], leI)),
209                      S.add(fE, S.union(S.rmv(f, fvI), S.inter(env, fvbI))),                      S.add(S.union(S.delete(fvI, f), S.intersection(env, fvbI)), fE),
210                      leRet)                      leRet)
211             end             end
212      end      end
# Line 217  Line 217 
217              if #inline tfk = F.IH_ALWAYS              if #inline tfk = F.IH_ALWAYS
218              then (fn e => body, body, FU.freevars body, body)              then (fn e => body, body, FU.freevars body, body)
219              else sexp env body              else sexp env body
220          val nenv = S.add(tf, env)          val nenv = S.add(env, tf)
221          val (leE,leI,fvI,leRet) = sexp nenv le          val (leE,leI,fvI,leRet) = sexp nenv le
222      in case (bodyI, S.members(S.diff(fvbI, env)))      in case (bodyI, S.listItems(S.difference(fvbI, env)))
223          of ((F.RET _ | F.RECORD(_,_,_,F.RET _)),_) =>          of ((F.RET _ | F.RECORD(_,_,_,F.RET _)),_) =>
224             (* split failed *)             (* split failed *)
225             (fn e => F.TFN((tfk, tf, args, bodyE bodyRet), leE e),             (fn e => F.TFN((tfk, tf, args, bodyE bodyRet), leE e),
# Line 228  Line 228 
228             (* everything was split out *)             (* everything was split out *)
229             let val ntfdec = ({inline=F.IH_ALWAYS}, tf, args, bodyE bodyRet)             let val ntfdec = ({inline=F.IH_ALWAYS}, tf, args, bodyE bodyRet)
230                 val nlE = fn e => F.TFN(ntfdec, leE e)                 val nlE = fn e => F.TFN(ntfdec, leE e)
231             in if not(S.member fvI tf) then (nlE, leI, fvI, leRet)             in if not(S.member(fvI, tf)) then (nlE, leI, fvI, leRet)
232                else (nlE, F.TFN(ntfdec, leI),                else (nlE, F.TFN(ntfdec, leI),
233                      S.rmv(tf, S.union(fvI, fvbI)), leRet)                      S.delete(S.union(fvI, fvbI), tf), leRet)
234             end             end
235           | (_,fvbIs) =>           | (_,fvbIs) =>
236             let (* tfdecE *)             let (* tfdecE *)
# Line 254  Line 254 
254                     F.TFN((tfk, tfE, args, bodyE),                     F.TFN((tfk, tfE, args, bodyE),
255                           F.TFN((tfkI, tf, argsI, bodyI), leE e))                           F.TFN((tfkI, tf, argsI, bodyI), leE e))
256    
257             in if not(S.member fvI tf) then (nleE, leI, fvI, leRet)             in if not(S.member(fvI, tf)) then (nleE, leI, fvI, leRet)
258                else (nleE,                else (nleE,
259                      F.TFN((tfkI, tf, argsI, bodyI), leI),                      F.TFN((tfkI, tf, argsI, bodyI), leI),
260                      S.add(tfE, S.union(S.rmv(tf, fvI), S.inter(env, fvbI))),                      S.add(S.union(S.delete(fvI, tf), S.intersection(env, fvbI)), tfE),
261                      leRet)                      leRet)
262             end             end
263      end      end
# Line 268  Line 268 
268  in case (bodyI, bodyRet)  in case (bodyI, bodyRet)
269      of (F.RET _,_) => ((fk, f, args, bodyE bodyRet), NONE)      of (F.RET _,_) => ((fk, f, args, bodyE bodyRet), NONE)
270       | (_,F.RECORD (rk,vs,lv,F.RET[lv'])) =>       | (_,F.RECORD (rk,vs,lv,F.RET[lv'])) =>
271         let val fvbIs = S.members fvbI         let val fvbIs = S.listItems fvbI
272    
273             (* fdecE *)             (* fdecE *)
274             val bodyE = bodyE(F.RECORD(rk, vs@(map F.VAR fvbIs), lv, F.RET[lv']))             val bodyE = bodyE(F.RECORD(rk, vs@(map F.VAR fvbIs), lv, F.RET[lv']))
Legend:
Removed from v.422  
changed lines
  Added in v.423
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge