[MLton-commit] r6286
Matthew Fluet
fluet at mlton.org
Thu Dec 20 08:46:57 PST 2007
SideEffects predicate was not used for anything
----------------------------------------------------------------------
U mlton/trunk/mlton/ssa/remove-unused.fun
U mlton/trunk/mlton/ssa/remove-unused2.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/ssa/remove-unused.fun
===================================================================
--- mlton/trunk/mlton/ssa/remove-unused.fun 2007-12-19 13:49:59 UTC (rev 6285)
+++ mlton/trunk/mlton/ssa/remove-unused.fun 2007-12-20 16:46:56 UTC (rev 6286)
@@ -43,14 +43,6 @@
val isDeconed = isTop
end
-structure SideEffects =
- struct
- structure L = TwoPointLattice (val bottom = "does not side effect"
- val top = "side effects")
- open L
- val sideEffect = makeTop
- end
-
structure MayReturn =
struct
structure L = TwoPointLattice (val bottom = "does not return"
@@ -171,14 +163,13 @@
raises: (VarInfo.t * Type.t) vector option,
returnLabel: Label.t option ref,
returns: (VarInfo.t * Type.t) vector option,
- sideEffects: SideEffects.t,
used: Used.t,
wrappers: Block.t list ref}
fun layout (T {args,
mayRaise, mayReturn,
raises, returns,
- sideEffects, used,
+ used,
...})
= Layout.record [("args", Vector.layout
(Layout.tuple2 (VarInfo.layout, Type.layout))
@@ -193,7 +184,6 @@
(Vector.layout
(Layout.tuple2 (VarInfo.layout, Type.layout)))
returns),
- ("sideEffects", SideEffects.layout sideEffects),
("used", Used.layout used)]
local
@@ -207,7 +197,6 @@
val raises = make #raises
val returnLabel = make #returnLabel
val returns = make #returns
- val sideEffects = make #sideEffects
val used = make #used
val (wrappers', wrappers) = make' #wrappers
end
@@ -226,9 +215,6 @@
val isUsed = Used.isUsed o used
fun whenUsed (fi, th) = Used.whenUsed (used fi, th)
- val sideEffect = SideEffects.sideEffect o sideEffects
- fun flowSideEffects (fi, fi') = SideEffects.<= (sideEffects fi, sideEffects fi')
-
fun new {args: (VarInfo.t * Type.t) vector,
raises: (VarInfo.t * Type.t) vector option,
returns: (VarInfo.t * Type.t) vector option}: t
@@ -240,7 +226,6 @@
raises = raises,
returnLabel = ref NONE,
returns = returns,
- sideEffects = SideEffects.new (),
used = Used.new (),
wrappers = ref []}
end
@@ -398,16 +383,14 @@
val visitExpTh = fn e => fn () => visitExp e
fun maybeVisitVarExp (var, exp)
= Option.app (var, fn var => VarInfo.whenUsed (varInfo var, visitExpTh exp))
- fun visitStatement (Statement.T {exp, var, ...}, fi: FuncInfo.t)
+ fun visitStatement (Statement.T {exp, var, ...})
= if Exp.maySideEffect exp
- then (FuncInfo.sideEffect fi
- ; visitExp exp)
+ then visitExp exp
else maybeVisitVarExp (var, exp)
fun visitTransfer (t: Transfer.t, fi: FuncInfo.t)
= case t
of Arith {args, overflow, success, ...}
- => (FuncInfo.sideEffect fi;
- visitVars args;
+ => (visitVars args;
visitLabel overflow;
visitLabel success)
| Bug => ()
@@ -429,7 +412,6 @@
val fi' = funcInfo func
in
flowVarInfoTysVars (FuncInfo.args fi', args);
- FuncInfo.flowSideEffects (fi', fi);
case cont
of None => ()
| Caller
@@ -535,8 +517,7 @@
=> (FuncInfo.return fi;
flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
| Runtime {args, return, ...}
- => (FuncInfo.sideEffect fi;
- visitVars args;
+ => (visitVars args;
visitLabel return)
val visitTransfer
@@ -545,7 +526,7 @@
Unit.layout)
visitTransfer
fun visitBlock (Block.T {statements, transfer, ...}, fi: FuncInfo.t) =
- (Vector.foreach (statements, fn s => visitStatement (s, fi))
+ (Vector.foreach (statements, visitStatement)
; visitTransfer (transfer, fi))
(* Visit all reachable expressions. *)
val _ = Vector.foreach
@@ -566,8 +547,7 @@
doit Con.truee ; doit Con.falsee
end
val _ = Vector.foreach
- (globals, fn Statement.T {var, exp, ...} =>
- maybeVisitVarExp (var, exp))
+ (globals, visitStatement)
val _ = List.foreach
(functions, fn function =>
let
Modified: mlton/trunk/mlton/ssa/remove-unused2.fun
===================================================================
--- mlton/trunk/mlton/ssa/remove-unused2.fun 2007-12-19 13:49:59 UTC (rev 6285)
+++ mlton/trunk/mlton/ssa/remove-unused2.fun 2007-12-20 16:46:56 UTC (rev 6286)
@@ -41,14 +41,6 @@
val isDeconed = isTop
end
-structure SideEffects =
- struct
- structure L = TwoPointLattice (val bottom = "does not side effect"
- val top = "side effects")
- open L
- val sideEffect = makeTop
- end
-
structure MayReturn =
struct
structure L = TwoPointLattice (val bottom = "does not return"
@@ -190,14 +182,13 @@
raises: (VarInfo.t * Type.t) vector option,
returnLabel: Label.t option ref,
returns: (VarInfo.t * Type.t) vector option,
- sideEffects: SideEffects.t,
used: Used.t,
wrappers: Block.t list ref}
fun layout (T {args,
mayRaise, mayReturn,
raises, returns,
- sideEffects, used,
+ used,
...}) =
Layout.record [("args", Vector.layout
(Layout.tuple2 (VarInfo.layout, Type.layout))
@@ -212,7 +203,6 @@
(Vector.layout
(Layout.tuple2 (VarInfo.layout, Type.layout)))
returns),
- ("sideEffects", SideEffects.layout sideEffects),
("used", Used.layout used)]
local
@@ -226,7 +216,6 @@
val raises = make #raises
val returnLabel = make #returnLabel
val returns = make #returns
- val sideEffects = make #sideEffects
val used = make #used
val (wrappers', wrappers) = make' #wrappers
end
@@ -245,9 +234,6 @@
val isUsed = Used.isUsed o used
fun whenUsed (fi, th) = Used.whenUsed (used fi, th)
- val sideEffect = SideEffects.sideEffect o sideEffects
- fun flowSideEffects (fi, fi') = SideEffects.<= (sideEffects fi, sideEffects fi')
-
fun new {args: (VarInfo.t * Type.t) vector,
raises: (VarInfo.t * Type.t) vector option,
returns: (VarInfo.t * Type.t) vector option}: t =
@@ -259,7 +245,6 @@
raises = raises,
returnLabel = ref NONE,
returns = returns,
- sideEffects = SideEffects.new (),
used = Used.new (),
wrappers = ref []}
end
@@ -546,13 +531,12 @@
fun maybeVisitVarExp (var, exp) =
Option.app (var, fn var =>
VarInfo.whenUsed (varInfo var, visitExpTh exp))
- fun visitStatement (s, fi: FuncInfo.t option) =
+ fun visitStatement s =
case s of
Bind {exp, ty, var} =>
(Option.app (var, fn var => newVarInfo (var, ty))
; if Exp.maySideEffect exp
- then (Option.app(fi, FuncInfo.sideEffect)
- ; visitType ty
+ then (visitType ty
; visitExp exp)
else maybeVisitVarExp (var, exp))
| Profile _ => ()
@@ -575,28 +559,24 @@
in
VarInfo.whenUsed
(vi, fn () =>
- (Option.app (fi, FuncInfo.sideEffect)
- ; ConInfo.decon ci
+ (ConInfo.decon ci
; visitVar base
; visitVar value))
end
| Tuple =>
- (Option.app (fi, FuncInfo.sideEffect)
- ; visitVar base
+ (visitVar base
; visitVar value)
| Vector => Error.bug "RemoveUnused2.visitStatement: Update:non-Con|Tuple")
| _ => Error.bug "RemoveUnused2.visitStatement: Update:non-Object")
| VectorSub {index, vector} =>
- (Option.app(fi, FuncInfo.sideEffect)
- ; visitVar index
+ (visitVar index
; visitVar vector
; visitVar value)
end
fun visitTransfer (t: Transfer.t, fi: FuncInfo.t) =
case t of
Arith {args, overflow, success, ty, ...} =>
- (FuncInfo.sideEffect fi
- ; visitVars args
+ (visitVars args
; visitLabel overflow
; visitLabel success
; visitType ty)
@@ -619,7 +599,6 @@
val fi' = funcInfo func
val () = flowVarInfoTysVars (FuncInfo.args fi', args)
- val () = FuncInfo.flowSideEffects (fi', fi)
val () =
case cont of
None => ()
@@ -740,11 +719,10 @@
(FuncInfo.return fi
; flowVarInfoTysVars (valOf (FuncInfo.returns fi), xs))
| Runtime {args, return, ...} =>
- (FuncInfo.sideEffect fi
- ; visitVars args
+ (visitVars args
; visitLabel return)
fun visitBlock (Block.T {statements, transfer, ...}, fi: FuncInfo.t) =
- (Vector.foreach (statements, fn s => visitStatement (s, SOME fi))
+ (Vector.foreach (statements, visitStatement)
; visitTransfer (transfer, fi))
val visitBlockTh = fn (b, fi) => fn () => visitBlock (b, fi)
(* Visit all reachable expressions. *)
@@ -771,7 +749,7 @@
; doit Con.falsee
end
val () =
- Vector.foreach (globals, fn s => visitStatement (s, NONE))
+ Vector.foreach (globals, visitStatement)
val () =
List.foreach
(functions, fn function =>
More information about the MLton-commit
mailing list