1 (* Copyright (C) 1999-2006, 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.
9 functor XmlSimplify (S: XML_SIMPLIFY_STRUCTS): XML_SIMPLIFY =
14 structure SimplifyTypes = SimplifyTypes (structure Input = S
17 type pass = {name: string,
18 doit: Program.t -> Program.t,
21 val xmlPassesDefault =
22 {name = "xmlShrink", doit = S.shrink, execute = true} ::
23 {name = "xmlSimplifyTypes", doit = SimplifyTypes.simplifyTypes, execute = true} ::
26 val xmlPassesMinimal =
29 val xmlPasses : pass list ref = ref xmlPassesDefault
32 type passGen = string -> pass option
34 fun mkSimplePassGen (name, doit): passGen =
35 let val count = Counter.new 1
36 in fn s => if s = name
37 then SOME {name = concat [name, "#",
38 Int.toString (Counter.next count)],
45 (List.map([("xmlShrink", S.shrink),
46 ("xmlSimplifyTypes", SimplifyTypes.simplifyTypes)],
49 fun xmlPassesSetCustom s =
52 (let val ss = String.split (s, #":")
56 case (List.peekMap (passGens, fn gen => gen s)) of
57 NONE => esc (Result.No s)
63 val xmlPassesString = ref "default"
64 val xmlPassesGet = fn () => !xmlPassesString
65 val xmlPassesSet = fn s =>
67 val _ = xmlPassesString := s
70 "default" => (xmlPasses := xmlPassesDefault
72 | "minimal" => (xmlPasses := xmlPassesMinimal
74 | _ => xmlPassesSetCustom s
76 val _ = List.push (Control.optimizationPasses,
77 {il = "xml", get = xmlPassesGet, set = xmlPassesSet})
79 fun pass ({name, doit}, p) =
86 Control.No, p, Control.Layouts Program.layouts)
90 {display = Control.Layouts Program.layouts,
92 stats = Program.layoutStats,
95 thunk = fn () => doit p,
96 typeCheck = typeCheck}
100 fun maybePass ({name, doit, execute}, p) =
101 if List.foldr (!Control.executePasses, execute, fn ((re, new), old) =>
102 if Regexp.Compiled.matchesAll (re, name)
105 then pass ({name = name, doit = doit}, p)
106 else (Control.messageStr (Control.Pass, name ^ " skipped"); p)
111 (!xmlPasses, p, fn ({name, doit, execute}, p) =>
112 maybePass ({name = name, doit = doit, execute = execute}, p))
118 val simplify = fn p => let
119 (* Always want to type check the initial and final XML
120 * programs, even if type checking is turned off, just