Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009 Wesley W. Tersptra. |
2 | * | |
3 | * MLton is released under a BSD-style license. | |
4 | * See the file MLton-LICENSE for details. | |
5 | *) | |
6 | ||
7 | functor CombineConversions (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM = | |
8 | struct | |
9 | ||
10 | open S | |
11 | ||
12 | (* | |
13 | * This pass looks for and simplifies nested calls to (signed) | |
14 | * extension/truncation. | |
15 | * | |
16 | * It processes each block in dfs order (visiting defs before uses): | |
17 | * If the statement is not a PrimApp Word_extdToWords, skip it. | |
18 | * After processing a conversion, it tags the Var for subsequent | |
19 | * use. | |
20 | * When inspecting a conversion, check if the Var operand is also | |
21 | * the result of a conversion. If it is, try to combine the two | |
22 | * operations. Repeatedly simplify until hitting either a | |
23 | * non-conversion Var or a case where the conversion cannot be | |
24 | * simplified. | |
25 | * | |
26 | * The optimization rules are very simple: | |
27 | * x1 : word<W1> = ... | |
28 | * x2 : word<W2> = Word_extdToWord (W1, W2, {signed=s1}) x1 | |
29 | * x3 : word<W3> = Word_extdToWord (W2, W3, {signed=s2}) x2 | |
30 | * | |
31 | * If W1 = W2, then there is no conversions before x_1. | |
32 | * This is guaranteed because W2 = W3 will always trigger optimization. | |
33 | * | |
34 | * Case W1 <= W3 <= W2: | |
35 | * x3 = Word_extdToWord (W1, W3, {signed=s1}) x1 | |
36 | * Case W1 < W2 < W3 AND (NOT s1 OR s2): | |
37 | * x3 = Word_extdToWord (W1, W3, {signed=s1}) x1 | |
38 | * Case W1 = W2 < W3: | |
39 | * unoptimized | |
40 | * because there are no conversions past W1 and x2 = x1 | |
41 | * | |
42 | * Case W3 <= W2 <= W1: | |
43 | * Case W3 <= W1 <= W2: | |
44 | * x_3 = Word_extdToWord (W1, W3, {signed=_}) x1 | |
45 | * because W3 <= W1 && W3 <= W2, just clip x1 | |
46 | * | |
47 | * Case W2 < W1 <= W3: | |
48 | * Case W2 < W3 <= W1: | |
49 | * unoptimized | |
50 | * because W2 < W1 && W2 < W3, has truncation effect | |
51 | * | |
52 | * Case W1 < W2 < W3 AND s1 AND (NOT s2): | |
53 | * unoptimized | |
54 | * because each conversion affects the result separately | |
55 | *) | |
56 | ||
57 | val { get : Var.t -> ((WordSize.t | |
58 | * WordSize.t | |
59 | * {signed:bool}) | |
60 | * Var.t) option, | |
61 | set, ... } = | |
62 | Property.getSetOnce (Var.plist, Property.initConst NONE) | |
63 | ||
64 | fun rules x3 (conversion as ((W2, W3, {signed=s2}), x2)) = | |
65 | let | |
66 | val { <, <=, ... } = Relation.compare WordSize.compare | |
67 | ||
68 | fun stop () = set (x3, SOME conversion) | |
69 | fun loop ((W1, _, {signed=s1}), x1) = | |
70 | rules x3 ((W1, W3, {signed=s1}), x1) | |
71 | in | |
72 | case get x2 of | |
73 | NONE => stop () | |
74 | | SOME (prev as ((W1, _, {signed=s1}), _)) => | |
75 | if W1 <= W3 andalso W3 <= W2 then loop prev else | |
76 | if W1 < W2 andalso W2 < W3 andalso (not s1 orelse s2) | |
77 | then loop prev else | |
78 | if W3 <= W1 andalso W3 <= W2 then loop prev else | |
79 | (* If W2=W3, we never reach here *) | |
80 | stop () | |
81 | end | |
82 | ||
83 | fun markStatement stmt = | |
84 | case stmt of | |
85 | Statement.T { exp = Exp.PrimApp { args, prim, targs=_ }, | |
86 | ty = _, | |
87 | var = SOME v } => | |
88 | (case Prim.name prim of | |
89 | Prim.Name.Word_extdToWord a => rules v (a, Vector.first args) | |
90 | | _ => ()) | |
91 | | _ => () | |
92 | ||
93 | fun mapStatement stmt = | |
94 | let | |
95 | val Statement.T { exp, ty, var } = stmt | |
96 | val exp = | |
97 | case Option.map (var, get) of | |
98 | SOME (SOME (prim as (W2, W3, _), x2)) => | |
99 | if WordSize.equals (W2, W3) | |
100 | then Exp.Var x2 | |
101 | else Exp.PrimApp { args = Vector.new1 x2, | |
102 | prim = Prim.wordExtdToWord prim, | |
103 | targs = Vector.new0 () } | |
104 | | _ => exp | |
105 | in | |
106 | Statement.T { exp = exp, ty = ty, var = var } | |
107 | end | |
108 | ||
109 | fun transform program = | |
110 | let | |
111 | val Program.T { datatypes, functions, globals, main } = program | |
112 | val shrink = shrinkFunction {globals = globals} | |
113 | ||
114 | val functions = | |
115 | List.revMap | |
116 | (functions, fn f => | |
117 | let | |
118 | (* Traverse blocks in dfs order, marking their statements *) | |
119 | fun markBlock (Block.T {statements, ... }) = | |
120 | (Vector.foreach (statements, markStatement); fn () => ()) | |
121 | val () = Function.dfs (f, markBlock) | |
122 | ||
123 | (* Map the statements using the marks *) | |
124 | val {args, blocks, mayInline, name, raises, returns, start} = | |
125 | Function.dest f | |
126 | ||
127 | fun mapBlock block = | |
128 | let | |
129 | val Block.T {args, label, statements, transfer} = block | |
130 | in | |
131 | Block.T {args = args, | |
132 | label = label, | |
133 | statements = Vector.map (statements, mapStatement), | |
134 | transfer = transfer} | |
135 | end | |
136 | ||
137 | val f = | |
138 | Function.new {args = args, | |
139 | blocks = Vector.map (blocks, mapBlock), | |
140 | mayInline = mayInline, | |
141 | name = name, | |
142 | raises = raises, | |
143 | returns = returns, | |
144 | start = start} | |
145 | ||
146 | val f = shrink f | |
147 | in | |
148 | f | |
149 | end) | |
150 | ||
151 | val () = Vector.foreach (globals, Statement.clear) | |
152 | in | |
153 | Program.T { datatypes = datatypes, | |
154 | functions = functions, | |
155 | globals = globals, | |
156 | main = main } | |
157 | end | |
158 | ||
159 | end |