Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2005-2007 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | functor PrePasses2 (S: PREPASSES2_STRUCTS): PREPASSES2 = | |
9 | struct | |
10 | ||
11 | open S | |
12 | ||
13 | structure DeadBlocks = | |
14 | struct | |
15 | ||
16 | fun eliminateFunction f = | |
17 | let | |
18 | val {args, blocks, mayInline, name, raises, returns, start} = | |
19 | Function.dest f | |
20 | val {get = isLive, set = setLive, rem} = | |
21 | Property.getSetOnce (Label.plist, Property.initConst false) | |
22 | val _ = Function.dfs (f, fn Block.T {label, ...} => | |
23 | (setLive (label, true) | |
24 | ; fn () => ())) | |
25 | val f = | |
26 | if Vector.forall (blocks, isLive o Block.label) | |
27 | then f | |
28 | else | |
29 | let | |
30 | val blocks = | |
31 | Vector.keepAll | |
32 | (blocks, isLive o Block.label) | |
33 | in | |
34 | Function.new {args = args, | |
35 | blocks = blocks, | |
36 | mayInline = mayInline, | |
37 | name = name, | |
38 | raises = raises, | |
39 | returns = returns, | |
40 | start = start} | |
41 | end | |
42 | val _ = Vector.foreach (blocks, rem o Block.label) | |
43 | in | |
44 | f | |
45 | end | |
46 | ||
47 | fun eliminate (Program.T {datatypes, globals, functions, main}) = | |
48 | Program.T {datatypes = datatypes, | |
49 | globals = globals, | |
50 | functions = List.revMap (functions, eliminateFunction), | |
51 | main = main} | |
52 | end | |
53 | ||
54 | val eliminateDeadBlocksFunction = DeadBlocks.eliminateFunction | |
55 | (* quell unused warning *) | |
56 | val _ = eliminateDeadBlocksFunction | |
57 | val eliminateDeadBlocks = DeadBlocks.eliminate | |
58 | ||
59 | ||
60 | structure Order = | |
61 | struct | |
62 | ||
63 | fun orderFunctions (p as Program.T {globals, datatypes, main, ...}) = | |
64 | let | |
65 | val functions = ref [] | |
66 | val () = | |
67 | Program.dfs | |
68 | (p, fn f => | |
69 | let | |
70 | val {args, mayInline, name, raises, returns, start, ...} = | |
71 | Function.dest f | |
72 | val blocks = ref [] | |
73 | val () = | |
74 | Function.dfs | |
75 | (f, fn b => | |
76 | (List.push (blocks, b) | |
77 | ; fn () => ())) | |
78 | val f = Function.new {args = args, | |
79 | blocks = Vector.fromListRev (!blocks), | |
80 | mayInline = mayInline, | |
81 | name = name, | |
82 | raises = raises, | |
83 | returns = returns, | |
84 | start = start} | |
85 | in | |
86 | List.push (functions, f) | |
87 | ; fn () => () | |
88 | end) | |
89 | in | |
90 | Program.T {datatypes = datatypes, | |
91 | globals = globals, | |
92 | functions = List.rev (!functions), | |
93 | main = main} | |
94 | end | |
95 | ||
96 | end | |
97 | ||
98 | val orderFunctions = Order.orderFunctions | |
99 | ||
100 | ||
101 | structure Reverse = | |
102 | struct | |
103 | ||
104 | fun reverseFunctions (Program.T {globals, datatypes, functions, main}) = | |
105 | Program.T {datatypes = datatypes, | |
106 | globals = globals, | |
107 | functions = List.rev functions, | |
108 | main = main} | |
109 | end | |
110 | ||
111 | val reverseFunctions = Reverse.reverseFunctions | |
112 | ||
113 | end |