1 (* Copyright (C) 1999-2007 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 Peephole(T : PEEPHOLE_TYPES): PEEPHOLE =
13 datatype statement_border = Empty
15 type statement_element = (int * int option) * (statement_type -> bool)
16 type transfer_element = transfer_type -> bool
18 val One : (statement_type -> bool) -> statement_element
19 = fn p => ((1, SOME 1), p)
20 val All : (statement_type -> bool) -> statement_element
21 = fn p => ((0, NONE), p)
23 type template = {start: statement_border,
24 statements: statement_element list,
25 finish: statement_border,
26 transfer: transfer_element}
28 type match = {entry: entry_type,
29 profileLabel: profileLabel_type,
30 start: statement_type list,
31 statements: statement_type list list,
32 finish: statement_type list,
33 transfer: transfer_type}
35 type rewriter = match -> block option
37 type callback = bool -> unit
39 type optimization = {template: template,
44 = Start of {block: block}
45 | Continue of {remaining: optimization list,
47 | Done of {block: block}
49 type find_state = {remaining: optimization list,
50 state: {entry: entry_type,
51 profileLabel: profileLabel_type,
52 start: statement_type list,
53 finish: statement_type list,
54 transfer: transfer_type}}
61 val (tt,ff) = split (t, p)
67 val rec matcher' : {template_statement: statement_element,
68 statement: statement_type list,
69 finish: statement_type list} ->
70 {statement: statement_type list,
71 finish: statement_type list} option
73 {template_statement = ((0, SOME 0), _),
76 => SOME {statement = List.rev statement,
79 {template_statement = ((0, SOME 1), p),
83 of [] => SOME {statement = List.rev statement,
85 | (statement'::finish')
87 then SOME {statement = List.rev (statement'::statement),
89 else SOME {statement = List.rev statement,
92 {template_statement = ((1, SOME 1), p),
97 | (statement'::finish')
99 then SOME {statement = List.rev (statement'::statement),
103 {template_statement = ((0, SOME i), p),
107 of [] => SOME {statement = List.rev statement,
109 | (statement'::finish')
111 then matcher' {template_statement = ((0, SOME (i-1)), p),
112 statement = statement'::statement,
114 else SOME {statement = List.rev statement,
117 {template_statement = ((0, NONE), p),
121 val (statement',finish') = split (finish, p)
123 SOME {statement = List.fold(statement,
128 | {template_statement = ((min, max), p),
130 finish = (statement'::finish')}
132 then matcher' {template_statement
133 = ((Int.max(min-1,0),
134 Option.map(max,fn i => i - 1)), p),
135 statement = statement'::statement,
140 val rec matcher : {template_statements: statement_element list,
141 statements: statement_type list list,
142 finish: statement_type list} ->
143 {statements: statement_type list list,
144 finish: statement_type list} option
145 = fn {template_statements = [],
148 => SOME {statements = List.rev statements,
150 | {template_statements = (template_statement::template_statements),
153 => (case matcher' {template_statement = template_statement,
157 | SOME {statement, finish}
158 => matcher {template_statements = template_statements,
159 statements = statement::statements,
162 fun peepholeBlock' {optimizations: optimization list,
163 match_state: match_state}
165 fun next {remaining: optimization list,
166 state as {entry, profileLabel, start, finish, transfer}} :
174 => SOME {remaining = optimizations,
175 state = {entry = entry,
176 profileLabel = profileLabel,
177 start = statement::start,
179 transfer = transfer}})
181 => SOME {remaining = remaining,
184 fun findMatch' (find_state
185 as {remaining as {template = {start
188 = template_statements,
192 = template_transfer},
202 = (case next find_state
203 of SOME find_state => findMatch' find_state
205 => Done {block = T {entry = entry,
206 profileLabel = profileLabel,
207 statements = List.fold(start,
210 transfer = transfer}})
212 if not (template_transfer transfer)
214 else if template_start = Empty
216 not (List.isEmpty start)
218 else case matcher {template_statements = template_statements,
222 | SOME {statements, finish}
223 => if template_finish = Empty
225 not (List.isEmpty finish)
227 else Continue {remaining = remaining,
230 profileLabel = profileLabel,
232 statements = statements,
234 transfer = transfer}}
236 | findMatch' _ = Error.bug "Peephole.peepholeBlock'.findMatch'"
238 fun findMatch (match_state: match_state) : match_state
240 of Start {block = T {entry, profileLabel,
241 statements, transfer}}
244 = {remaining = optimizations,
245 state = {entry = entry,
246 profileLabel = profileLabel,
249 transfer = transfer}}
251 findMatch' find_state
253 | Continue {remaining,
262 val finish = List.foldr(statements,
266 = {remaining = remaining,
267 state = {entry = entry,
268 profileLabel = profileLabel,
271 transfer = transfer}}
274 of NONE => Done {block
276 profileLabel = profileLabel,
277 statements = List.fold(start,
280 transfer = transfer}}
281 | SOME find_state => findMatch' find_state
283 | Done _ => match_state
285 fun peepholeBlock'' {match_state: match_state,
287 = case findMatch match_state
288 of match_state as Continue {remaining = {rewriter,
292 => (case rewriter match
295 peepholeBlock'' {match_state
296 = Start {block = block},
300 peepholeBlock'' {match_state = match_state,
302 | Done {block} => {block = block, changed = changed}
303 | _ => Error.bug "Peephole.peepholeBlock''"
306 of [] => (case match_state
307 of Start {block = block} => {block = block,
309 | _ => Error.bug "Peephole.peepholeBlock'")
310 | _ => peepholeBlock'' {match_state = match_state,
314 fun peepholeBlock {block: block,
315 optimizations: optimization list}
316 = peepholeBlock' {optimizations = optimizations,
317 match_state = Start {block = block}}
319 fun peepholeBlocks {blocks: block list,
320 optimizations: optimization list}
322 val {blocks, changed}
325 {blocks = [], changed = false},
326 fn (block,{blocks,changed})
330 = peepholeBlock' {optimizations = optimizations,
331 match_state = Start {block = block}}
333 {blocks = block'::blocks,
334 changed = changed orelse changed'}