1 (* Copyright (C) 2017 Matthew Fluet.
2 * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 functor Simplify2 (S: SIMPLIFY2_STRUCTS): SIMPLIFY2 =
15 structure DeepFlatten = DeepFlatten (S)
16 structure Profile2 = Profile2 (S)
17 structure RefFlatten = RefFlatten (S)
18 structure RemoveUnused2 = RemoveUnused2 (S)
19 structure Zone = Zone (S)
21 type pass = {name: string,
22 doit: Program.t -> Program.t,
25 val ssa2PassesDefault =
26 {name = "deepFlatten", doit = DeepFlatten.transform2, execute = true} ::
27 {name = "refFlatten", doit = RefFlatten.transform2, execute = true} ::
28 {name = "removeUnused5", doit = RemoveUnused2.transform2, execute = true} ::
29 {name = "zone", doit = Zone.transform2, execute = true} ::
32 val ssa2PassesMinimal =
35 val ssa2Passes : pass list ref = ref ssa2PassesDefault
38 type passGen = string -> pass option
40 fun mkSimplePassGen (name, doit): passGen =
41 let val count = Counter.new 1
42 in fn s => if s = name
43 then SOME {name = concat [name, "#",
44 Int.toString (Counter.next count)],
52 List.map([("deepFlatten", DeepFlatten.transform2),
53 ("refFlatten", RefFlatten.transform2),
54 ("removeUnused", RemoveUnused2.transform2),
55 ("zone", Zone.transform2),
56 ("ssa2AddProfile", Profile2.addProfile),
57 ("ssa2DropProfile", Profile2.dropProfile),
58 ("ssa2EliminateDeadBlocks", S.eliminateDeadBlocks),
59 ("ssa2OrderFunctions", S.orderFunctions),
60 ("ssa2ReverseFunctions", S.reverseFunctions),
61 ("ssa2Shrink", S.shrink)],
64 fun ssa2PassesSetCustom s =
67 (let val ss = String.split (s, #":")
71 case (List.peekMap (passGens, fn gen => gen s)) of
72 NONE => esc (Result.No s)
78 val ssa2PassesString = ref "default"
79 val ssa2PassesGet = fn () => !ssa2PassesString
80 val ssa2PassesSet = fn s =>
82 val _ = ssa2PassesString := s
85 "default" => (ssa2Passes := ssa2PassesDefault
87 | "minimal" => (ssa2Passes := ssa2PassesMinimal
89 | _ => ssa2PassesSetCustom s
91 val _ = List.push (Control.optimizationPasses,
92 {il = "ssa2", get = ssa2PassesGet, set = ssa2PassesSet})
94 fun pass ({name, doit, midfix}, p) =
100 suffix = midfix ^ "pre.ssa2"},
101 Control.No, p, Control.Layouts Program.layouts)
104 Control.passTypeCheck
105 {display = Control.Layouts Program.layouts,
107 stats = Program.layoutStats,
109 suffix = midfix ^ "post.ssa2",
110 thunk = fn () => doit p,
111 typeCheck = typeCheck}
115 fun maybePass ({name, doit, execute, midfix}, p) =
116 if List.foldr (!Control.executePasses, execute, fn ((re, new), old) =>
117 if Regexp.Compiled.matchesAll (re, name)
120 then pass ({name = name, doit = doit, midfix = midfix}, p)
121 else (Control.messageStr (Control.Pass, name ^ " skipped"); p)
127 val midfix = if !Control.loopSsa2Passes = 1
129 else concat [Int.toString n, "."]
131 if n = !Control.loopSsa2Passes
136 (!ssa2Passes, p, fn ({name, doit, execute}, p) =>
137 maybePass ({name = name, doit = doit, execute = execute, midfix = midfix}, p)))
139 val p = simplify' 0 p
144 val simplify = fn p => let
145 (* Always want to type check the initial and final SSA
146 * programs, even if type checking is turned off, just
152 if !Control.profile <> Control.ProfileNone
153 andalso !Control.profileIL = Control.ProfileSSA2
154 then pass ({name = "ssa2AddProfile",
155 doit = Profile2.addProfile,
158 val p = maybePass ({name = "ssa2OrderFunctions",
159 doit = S.orderFunctions,