1 (* Copyright (C) 1999-2005, 2008 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
10 * Remove loop invariant args to local loops.
11 * fun loop (x, y) = ... loop (x, z) ...
16 * let fun loop' (y) = ... loop' (z) ...
21 functor LoopInvariant (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM =
27 fun transform (Program.T {globals, datatypes, functions, main}) =
29 val shrink = shrinkFunction {globals = globals}
31 fun simplifyFunction f =
33 val {args, blocks, mayInline, name, raises, returns, start} =
35 val {get = labelInfo: Label.t -> {callsSelf: bool ref,
37 invariant: (Var.t * bool ref) vector,
38 newLabel: Label.t option ref},
39 set = setLabelInfo, ...} =
42 Property.initRaise ("LoopInvariant.labelInfo", Label.layout))
46 (blocks, fn Block.T {label, args, ...} =>
48 {callsSelf = ref false,
50 invariant = Vector.map (args, fn (x, _) =>
52 newLabel = ref NONE}))
54 fun visit (Block.T {label, transfer, ...}): unit -> unit =
56 val {visited, ...} = labelInfo label
57 val _ = visited := true
62 val {callsSelf, visited, invariant, ...} = labelInfo dst
65 then (callsSelf := true
67 (args, invariant, fn (x, (y, b)) =>
68 if !b andalso not (Var.equals (x, y))
75 fn () => visited := false
77 val _ = Function.dfs (f, visit)
78 fun remove (xs: 'a vector, invariant: ('b * bool ref) vector)
80 Vector.keepAllMap2 (xs, invariant, fn (x, (_, b)) =>
81 if !b then NONE else SOME x)
83 val newBlocks = ref []
84 fun visit (Block.T {label, args, statements, transfer})
87 val {callsSelf, invariant, newLabel, ...} = labelInfo label
90 andalso Vector.exists (invariant, ! o #2)
91 then newLabel := SOME (Label.new label)
97 val {invariant, newLabel, ...} = labelInfo dst
103 args = remove (args, invariant)}
106 val (args, statements, transfer) =
108 NONE => (args, statements, transfer)
115 in seq [Label.layout label,
123 (args, invariant, ([], [], []),
124 fn ((x, t), (_, b), (ofs, ifs, ias)) =>
126 then ((x, t) :: ofs, ifs, ias)
127 else let val x' = Var.new x
135 Block.T {label = label',
136 args = Vector.fromList innerFormals,
137 statements = statements,
138 transfer = transfer})
139 ; (Vector.fromList outerFormals,
142 args = Vector.fromList innerActuals})
146 Block.T {label = label,
148 statements = statements,
149 transfer = transfer})
151 fn () => newLabel := NONE
153 val _ = Function.dfs (f, visit)
154 val blocks = Vector.fromList (!newBlocks)
156 shrink (Function.new {args = args,
158 mayInline = mayInline,
165 Program.T {datatypes = datatypes,
167 functions = List.revMap (functions, simplifyFunction),
169 val _ = Program.clearTop program