Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009,2017 Matthew Fluet. |
2 | * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | (* Restore SSA | |
11 | * | |
12 | * Based primarily on Section 19.1 of Appel's "Modern Compiler Implementation in ML", | |
13 | * (but see the caveats in the comments below). | |
14 | * The main deviation is the calculation of liveness of the violating variables, | |
15 | * which is used to predicate the insertion of phi arguments. This is due to | |
16 | * the algorithm's bias towards imperative languages, for which it makes the | |
17 | * assumption that all variables are defined in the start block and all variables | |
18 | * are "used" at exit. | |
19 | * This is "optimized" for restoration of functions with small numbers of violating | |
20 | * variables -- use bool vectors to represent sets of violating variables. | |
21 | * Also, we use a Promise.t to suspend part of the dominance frontier computation. | |
22 | * | |
23 | * Requirements: no violation in globals; this is checked. | |
24 | *) | |
25 | ||
26 | functor Restore (S: RESTORE_STRUCTS): RESTORE = | |
27 | struct | |
28 | ||
29 | structure Control = | |
30 | struct | |
31 | open Control | |
32 | fun diagnostics _ = () | |
33 | end | |
34 | ||
35 | open S | |
36 | open Exp Transfer | |
37 | ||
38 | structure LabelInfo = | |
39 | struct | |
40 | datatype t = T of {args: (Var.t * Type.t) vector ref, | |
41 | preds: Label.t list ref, | |
42 | defs: bool vector ref, | |
43 | uses: bool vector ref, | |
44 | live: bool array ref, | |
45 | dtindex: int ref, | |
46 | df: Label.t vector Promise.t ref, | |
47 | phi: Var.t list ref, | |
48 | phiArgs: Var.t vector ref, | |
49 | queued: bool ref} | |
50 | ||
51 | fun layout (T {preds, defs, uses, live, dtindex, df, phiArgs, ...}) | |
52 | = let open Layout | |
53 | in record [("preds", List.layout Label.layout (!preds)), | |
54 | ("defs", Vector.layout Bool.layout (!defs)), | |
55 | ("uses", Vector.layout Bool.layout (!uses)), | |
56 | ("live", Array.layout Bool.layout (!live)), | |
57 | ("dtindex", Int.layout (!dtindex)), | |
58 | ("df", Promise.layout (Vector.layout Label.layout) (!df)), | |
59 | ("phiArgs", Vector.layout Var.layout (!phiArgs))] | |
60 | end | |
61 | ||
62 | local | |
63 | fun make f (T r) = f r | |
64 | fun make' f = (make f, ! o (make f)) | |
65 | in | |
66 | val (args, args') = make' #args | |
67 | val (preds, preds') = make' #preds | |
68 | val (defs, defs') = make' #defs | |
69 | val (uses, uses') = make' #uses | |
70 | val (live, live') = make' #live | |
71 | val (dtindex, dtindex') = make' #dtindex | |
72 | val (df, df') = make' #df | |
73 | val (phi, _) = make' #phi | |
74 | val (phiArgs, phiArgs') = make' #phiArgs | |
75 | val (queued, _) = make' #queued | |
76 | end | |
77 | ||
78 | fun new (): t = T {args = ref (Vector.new0 ()), | |
79 | preds = ref [], | |
80 | defs = ref (Vector.new0 ()), | |
81 | uses = ref (Vector.new0 ()), | |
82 | live = ref (Array.new0 ()), | |
83 | dtindex = ref ~1, | |
84 | df = ref (Promise.delay (fn () => Vector.new0 ())), | |
85 | phi = ref [], | |
86 | phiArgs = ref (Vector.new0 ()), | |
87 | queued = ref false} | |
88 | end | |
89 | ||
90 | structure Cardinality = | |
91 | struct | |
92 | structure L = ThreePointLattice(val bottom = "zero" | |
93 | val mid = "one" | |
94 | val top = "many") | |
95 | open L | |
96 | ||
97 | val isZero = isBottom | |
98 | val isOne = isMid | |
99 | val makeOne = makeMid | |
100 | val isMany = isTop | |
101 | val makeMany = makeTop | |
102 | val whenMany = whenTop | |
103 | ||
104 | val inc: t -> unit | |
105 | = fn c => if isZero c | |
106 | then makeOne c | |
107 | else if isOne c | |
108 | then makeMany c | |
109 | else () | |
110 | end | |
111 | ||
112 | structure VarInfo = | |
113 | struct | |
114 | datatype t = T of {defs: Cardinality.t, | |
115 | ty: Type.t ref, | |
116 | index: int ref, | |
117 | defSites: Label.t list ref, | |
118 | useSites: Label.t list ref, | |
119 | vars: Var.t list ref} | |
120 | ||
121 | fun layout (T {defs, index, defSites, useSites, vars, ...}) | |
122 | = let open Layout | |
123 | in record [("defs", Cardinality.layout defs), | |
124 | ("index", Int.layout (!index)), | |
125 | ("defSites", List.layout Label.layout (!defSites)), | |
126 | ("useSites", List.layout Label.layout (!useSites)), | |
127 | ("vars", List.layout Var.layout (!vars))] | |
128 | end | |
129 | ||
130 | local | |
131 | fun make f (T r) = f r | |
132 | fun make' f = (make f, ! o (make f)) | |
133 | in | |
134 | val defs = make #defs | |
135 | val (index,index') = make' #index | |
136 | val (_,defSites') = make' #defSites | |
137 | val (_,useSites') = make' #useSites | |
138 | val (ty,ty') = make' #ty | |
139 | end | |
140 | fun addDef (T {defs, ...}) = Cardinality.inc defs | |
141 | fun addDefSite (T {defSites, ...}, l) = List.push(defSites, l) | |
142 | fun addUseSite (T {useSites, ...}, l) = List.push(useSites, l) | |
143 | val violates = Cardinality.isMany o defs | |
144 | fun whenViolates (T {defs, ...}, th) = Cardinality.whenMany (defs, th) | |
145 | ||
146 | fun new (): t = T {defs = Cardinality.new (), | |
147 | index = ref ~1, | |
148 | defSites = ref [], | |
149 | useSites = ref [], | |
150 | ty = ref Type.unit, | |
151 | vars = ref []} | |
152 | ||
153 | fun pushVar (T {vars, ...}, var) = List.push (vars, var) | |
154 | fun popVar (T {vars, ...}) = ignore (List.pop vars) | |
155 | fun peekVar (T {vars, ...}) = case !vars | |
156 | of [] => NONE | |
157 | | h::_ => SOME h | |
158 | end | |
159 | ||
160 | fun restoreFunction {globals: Statement.t vector} | |
161 | = let | |
162 | exception NoViolations | |
163 | ||
164 | val {get = varInfo: Var.t -> VarInfo.t, ...} | |
165 | = Property.get | |
166 | (Var.plist, Property.initFun (fn _ => VarInfo.new ())) | |
167 | ||
168 | val {get = labelInfo: Label.t -> LabelInfo.t, ...} | |
169 | = Property.get | |
170 | (Label.plist, Property.initFun (fn _ => LabelInfo.new ())) | |
171 | ||
172 | fun mkQueue () | |
173 | = let | |
174 | val todo = ref [] | |
175 | in | |
176 | {enque = fn (l, li) => let | |
177 | val queued = LabelInfo.queued li | |
178 | in | |
179 | if !queued | |
180 | then () | |
181 | else (queued := true ; | |
182 | List.push (todo, (l,li))) | |
183 | end, | |
184 | deque = fn () => case !todo | |
185 | of [] => NONE | |
186 | | (l,li)::todo' | |
187 | => (todo := todo'; | |
188 | LabelInfo.queued li := false; | |
189 | SOME (l,li))} | |
190 | end | |
191 | ||
192 | fun mkPost () | |
193 | = let | |
194 | val post = ref [] | |
195 | in | |
196 | {addPost = fn th => List.push (post, th), | |
197 | post = fn () => List.foreach(!post, fn th => th ())} | |
198 | end | |
199 | ||
200 | (* check for violations in globals *) | |
201 | fun addDef (x, ty) | |
202 | = let | |
203 | val vi = varInfo x | |
204 | in | |
205 | VarInfo.ty vi := ty ; | |
206 | VarInfo.addDef vi ; | |
207 | VarInfo.whenViolates | |
208 | (vi, fn () => Error.bug "Restore.restore: violation in globals") | |
209 | end | |
210 | val _ | |
211 | = Vector.foreach | |
212 | (globals, fn Statement.T {var, ty, ...} => | |
213 | Option.app (var, fn x => addDef (x, ty))) | |
214 | in | |
215 | fn (f: Function.t) => | |
216 | let | |
217 | val {args, blocks, mayInline, name, returns, raises, start} = | |
218 | Function.dest f | |
219 | (* check for violations *) | |
220 | val violations = ref [] | |
221 | fun addDef (x, ty) | |
222 | = let | |
223 | val vi = varInfo x | |
224 | in | |
225 | if VarInfo.violates vi | |
226 | then () | |
227 | else (VarInfo.ty vi := ty ; | |
228 | VarInfo.addDef vi ; | |
229 | if VarInfo.violates vi | |
230 | then List.push (violations, x) | |
231 | else ()) | |
232 | end | |
233 | val _ = Function.foreachVar (f, addDef) | |
234 | ||
235 | (* escape early *) | |
236 | val _ = if List.isEmpty (!violations) | |
237 | then (Control.diagnostics | |
238 | (fn display => | |
239 | let | |
240 | open Layout | |
241 | in | |
242 | display (seq [Func.layout name, | |
243 | str " NoViolations"]) | |
244 | end); | |
245 | raise NoViolations) | |
246 | else () | |
247 | ||
248 | (* init violations *) | |
249 | val index = ref 0 | |
250 | val violations | |
251 | = Vector.fromListMap | |
252 | (!violations, fn x => | |
253 | let | |
254 | val vi = varInfo x | |
255 | val _ = VarInfo.index vi := (!index) | |
256 | val _ = Int.inc index | |
257 | in | |
258 | x | |
259 | end) | |
260 | val numViolations = !index | |
261 | ||
262 | (* Diagnostics *) | |
263 | val _ = Control.diagnostics | |
264 | (fn display => | |
265 | let | |
266 | open Layout | |
267 | in | |
268 | display (seq [Func.layout name, | |
269 | str " Violations: ", | |
270 | Vector.layout Var.layout violations]) | |
271 | end) | |
272 | ||
273 | (* init entryBlock *) | |
274 | val entry = Label.newNoname () | |
275 | val entryBlock = Block.T {label = entry, | |
276 | args = args, | |
277 | statements = Vector.new0 (), | |
278 | transfer = Goto {dst = start, | |
279 | args = Vector.new0 ()}} | |
280 | ||
281 | (* compute dominator tree *) | |
282 | val dt = Function.dominatorTree f | |
283 | val dt' = Tree.T (entryBlock, Vector.new1 dt) | |
284 | ||
285 | (* compute df (dominance frontier) *) | |
286 | (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *) | |
287 | (* also computes defSites and useSites of violating variables *) | |
288 | (* also computes preds, defs, and uses *) | |
289 | val dtindex = ref 0 | |
290 | fun doitTree (Tree.T (Block.T {label, args, statements, transfer}, | |
291 | children)) | |
292 | = let | |
293 | val li = labelInfo label | |
294 | ||
295 | val _ = LabelInfo.args li := args | |
296 | ||
297 | val _ = Transfer.foreachLabel | |
298 | (transfer, fn l => | |
299 | List.push (LabelInfo.preds (labelInfo l), label)) | |
300 | ||
301 | val defs = Array.new (numViolations, false) | |
302 | val uses = Array.new (numViolations, false) | |
303 | fun addDef x | |
304 | = let | |
305 | val vi = varInfo x | |
306 | in | |
307 | if VarInfo.violates vi | |
308 | then let | |
309 | val index = VarInfo.index' vi | |
310 | in | |
311 | VarInfo.addDefSite (varInfo x, label); | |
312 | Array.update (defs, index, true); | |
313 | Array.update (uses, index, false) | |
314 | end | |
315 | else () | |
316 | end | |
317 | fun addUse x | |
318 | = let | |
319 | val vi = varInfo x | |
320 | in | |
321 | if VarInfo.violates vi | |
322 | then let | |
323 | val index = VarInfo.index' vi | |
324 | in | |
325 | VarInfo.addUseSite (varInfo x, label); | |
326 | Array.update (uses, index, true) | |
327 | end | |
328 | else () | |
329 | end | |
330 | val _ = Transfer.foreachVar (transfer, addUse) | |
331 | val _ = Vector.foreachr | |
332 | (statements, fn Statement.T {var, exp, ...} => | |
333 | (Option.app (var, addDef); | |
334 | Exp.foreachVar (exp, addUse))) | |
335 | val _ = Vector.foreach (args, addDef o #1) | |
336 | val _ = LabelInfo.defs li := Array.toVector defs | |
337 | val _ = LabelInfo.uses li := Array.toVector uses | |
338 | val _ = LabelInfo.live li := Array.new (numViolations, false) | |
339 | ||
340 | val _ = Int.inc dtindex | |
341 | val dtindexMin = !dtindex | |
342 | val _ = LabelInfo.dtindex li := dtindexMin | |
343 | val _ = Vector.foreach(children, doitTree) | |
344 | val dtindexMax = !dtindex | |
345 | fun dominates l | |
346 | = let val dtindex = LabelInfo.dtindex' (labelInfo l) | |
347 | in dtindexMin < dtindex andalso dtindex <= dtindexMax | |
348 | end | |
349 | ||
350 | fun promise () | |
351 | = let | |
352 | val df = ref [] | |
353 | fun addDF l | |
354 | = if List.contains(!df, l, Label.equals) | |
355 | then () | |
356 | else List.push(df,l) | |
357 | val _ = Transfer.foreachLabel | |
358 | (transfer, fn l => | |
359 | if Vector.exists | |
360 | (children, fn Tree.T (b, _) => | |
361 | Label.equals (Block.label b, l)) | |
362 | then () | |
363 | else addDF l) | |
364 | val _ = Vector.foreach | |
365 | (children, fn Tree.T (Block.T {label, ...}, _) => | |
366 | let | |
367 | val li = labelInfo label | |
368 | in | |
369 | Vector.foreach | |
370 | (Promise.force (LabelInfo.df' li), fn l => | |
371 | if dominates l | |
372 | then () | |
373 | else addDF l) | |
374 | end) | |
375 | in | |
376 | Vector.fromList (!df) | |
377 | end | |
378 | val _ = LabelInfo.df li := Promise.delay promise | |
379 | in | |
380 | () | |
381 | end | |
382 | val _ = doitTree dt' | |
383 | ||
384 | (* compute liveness *) | |
385 | val _ | |
386 | = Vector.foreach | |
387 | (violations, fn x => | |
388 | let | |
389 | val {enque, deque} = mkQueue () | |
390 | val enque = fn l => enque (l, labelInfo l) | |
391 | ||
392 | val vi = varInfo x | |
393 | val index = VarInfo.index' vi | |
394 | val useSites = VarInfo.useSites' vi | |
395 | val _ = List.foreach (useSites, enque) | |
396 | ||
397 | fun doit (_,li) | |
398 | = let | |
399 | val uses = LabelInfo.uses' li | |
400 | val defs = LabelInfo.defs' li | |
401 | val live = LabelInfo.live' li | |
402 | in | |
403 | if Array.sub (live, index) | |
404 | orelse | |
405 | (Vector.sub(defs, index) | |
406 | andalso | |
407 | not (Vector.sub (uses, index))) | |
408 | then () | |
409 | else (Array.update(live, index, true) ; | |
410 | List.foreach (LabelInfo.preds' li, enque)) | |
411 | end | |
412 | fun loop () | |
413 | = case deque () | |
414 | of NONE => () | |
415 | | SOME (l,li) => (doit (l, li); loop ()) | |
416 | in | |
417 | loop () | |
418 | end) | |
419 | ||
420 | (* insert phi-functions *) | |
421 | (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML" | |
422 | * (beware: Alg. 19.6 (both in the book and as corrected by the | |
423 | * errata) has numerous typos; and this implementation computes sets of | |
424 | * variables that must have phi-functions at a node, which is close to | |
425 | * the algorithm in the book, but the reverse of the algorithm as | |
426 | * corrected by the errata, which computes sets of nodes that must have | |
427 | * a phi-functions for a variable.) | |
428 | *) | |
429 | val _ | |
430 | = Vector.foreach | |
431 | (violations, fn x => | |
432 | let | |
433 | val {enque, deque} = mkQueue () | |
434 | ||
435 | val vi = varInfo x | |
436 | val index = VarInfo.index' vi | |
437 | val defSites = VarInfo.defSites' vi | |
438 | val _ = List.foreach | |
439 | (defSites, fn l => | |
440 | enque (l, labelInfo l)) | |
441 | ||
442 | fun doit (_,li) | |
443 | = Vector.foreach | |
444 | (Promise.force (LabelInfo.df' li), fn l => | |
445 | let | |
446 | val li = labelInfo l | |
447 | val live = LabelInfo.live' li | |
448 | val phi = LabelInfo.phi li | |
449 | in | |
450 | if Array.sub(live, index) | |
451 | andalso | |
452 | not (List.contains(!phi, x, Var.equals)) | |
453 | then (List.push(phi, x); | |
454 | enque (l, li)) | |
455 | else () | |
456 | end) | |
457 | fun loop () | |
458 | = case deque () | |
459 | of NONE => () | |
460 | | SOME (l,li) => (doit (l, li); loop ()) | |
461 | in | |
462 | loop () | |
463 | end) | |
464 | ||
465 | (* finalize phi args *) | |
466 | fun visitBlock (Block.T {label, ...}) | |
467 | = let | |
468 | val li = labelInfo label | |
469 | val phi = LabelInfo.phi li | |
470 | val phiArgs = LabelInfo.phiArgs li | |
471 | in | |
472 | phiArgs := Vector.fromList (!phi) ; | |
473 | phi := [] | |
474 | end | |
475 | val _ = visitBlock entryBlock | |
476 | val _ = Vector.foreach (blocks, visitBlock) | |
477 | ||
478 | (* Diagnostics *) | |
479 | val _ = Control.diagnostics | |
480 | (fn display => | |
481 | let | |
482 | open Layout | |
483 | in | |
484 | Vector.foreach | |
485 | (violations, fn x => | |
486 | display (seq [Var.layout x, | |
487 | str " ", | |
488 | VarInfo.layout (varInfo x)])); | |
489 | Vector.foreach | |
490 | (blocks, fn Block.T {label, ...} => | |
491 | display (seq [Label.layout label, | |
492 | str " ", | |
493 | LabelInfo.layout (labelInfo label)])) | |
494 | end) | |
495 | ||
496 | (* rewrite *) | |
497 | val blocks = ref [] | |
498 | fun rewriteVar (x: Var.t) | |
499 | = case VarInfo.peekVar (varInfo x) | |
500 | of NONE => x | |
501 | | SOME x' => x' | |
502 | fun rewriteStatement (addPost: (unit -> unit) -> unit) (Statement.T {var, ty, exp}) | |
503 | = let | |
504 | val exp = Exp.replaceVar (exp, rewriteVar) | |
505 | val var | |
506 | = case var | |
507 | of NONE => NONE | |
508 | | SOME x => let | |
509 | val vi = varInfo x | |
510 | in | |
511 | if VarInfo.violates vi | |
512 | then let | |
513 | val x' = Var.new x | |
514 | in | |
515 | addPost (fn _ => VarInfo.popVar vi) ; | |
516 | VarInfo.pushVar (vi, x'); | |
517 | SOME x' | |
518 | end | |
519 | else SOME x | |
520 | end | |
521 | in | |
522 | Statement.T {var = var, | |
523 | ty = ty, | |
524 | exp = exp} | |
525 | end | |
526 | local | |
527 | type t = {dst: Label.t, | |
528 | phiArgs: Var.t vector, | |
529 | route: Label.t, | |
530 | hash: Word.t} | |
531 | val routeTable : t HashSet.t = HashSet.new {hash = #hash} | |
532 | in | |
533 | fun route dst | |
534 | = let | |
535 | val li = labelInfo dst | |
536 | val phiArgs = LabelInfo.phiArgs' li | |
537 | in | |
538 | if Vector.isEmpty phiArgs | |
539 | then dst | |
540 | else let | |
541 | val phiArgs = Vector.map | |
542 | (phiArgs, valOf o VarInfo.peekVar o varInfo) | |
543 | val hash = Vector.fold | |
544 | (phiArgs, Label.hash dst, fn (x, h) => | |
545 | Word.xorb(Var.hash x, h)) | |
546 | val {route, ...} | |
547 | = HashSet.lookupOrInsert | |
548 | (routeTable, hash, | |
549 | fn {dst = dst', phiArgs = phiArgs', ... } => | |
550 | Label.equals (dst, dst') | |
551 | andalso | |
552 | Vector.equals (phiArgs, phiArgs', Var.equals), | |
553 | fn () => | |
554 | let | |
555 | val route = Label.new dst | |
556 | val args = Vector.map | |
557 | (LabelInfo.args' li, fn (x,ty) => | |
558 | (Var.new x, ty)) | |
559 | val args' = Vector.concat | |
560 | [Vector.map(args, #1), | |
561 | phiArgs] | |
562 | val block = Block.T | |
563 | {label = route, | |
564 | args = args, | |
565 | statements = Vector.new0 (), | |
566 | transfer = Goto {dst = dst, | |
567 | args = args'}} | |
568 | val _ = List.push (blocks, block) | |
569 | in | |
570 | {dst = dst, | |
571 | phiArgs = phiArgs, | |
572 | route = route, | |
573 | hash = hash} | |
574 | end) | |
575 | in | |
576 | route | |
577 | end | |
578 | end | |
579 | end | |
580 | fun rewriteTransfer (t: Transfer.t) | |
581 | = Transfer.replaceLabelVar (t, route, rewriteVar) | |
582 | fun visitBlock' (Block.T {label, args, statements, transfer}) | |
583 | = let | |
584 | val {addPost, post} = mkPost () | |
585 | val li = labelInfo label | |
586 | fun doit x = let | |
587 | val vi = varInfo x | |
588 | val ty = VarInfo.ty' vi | |
589 | in | |
590 | if VarInfo.violates vi | |
591 | then let | |
592 | val x' = Var.new x | |
593 | in | |
594 | addPost (fn _ => VarInfo.popVar vi) ; | |
595 | VarInfo.pushVar (vi, x') ; | |
596 | (x', ty) | |
597 | end | |
598 | else (x, ty) | |
599 | end | |
600 | val args = Vector.map | |
601 | (args, fn (x, _) => doit x) | |
602 | val phiArgs = Vector.map | |
603 | (LabelInfo.phiArgs' li, fn x => doit x) | |
604 | val args = Vector.concat [args, phiArgs] | |
605 | val statements | |
606 | = if Vector.exists(LabelInfo.defs' li, fn b => b) | |
607 | orelse | |
608 | Vector.exists(LabelInfo.uses' li, fn b => b) | |
609 | then Vector.map (statements, rewriteStatement addPost) | |
610 | else statements | |
611 | val transfer = rewriteTransfer transfer | |
612 | val block = Block.T {label = label, | |
613 | args = args, | |
614 | statements = statements, | |
615 | transfer = transfer} | |
616 | in | |
617 | (block, post) | |
618 | end | |
619 | fun visitBlock block | |
620 | = let val (block, post) = visitBlock' block | |
621 | in List.push (blocks, block) ; post | |
622 | end | |
623 | fun rewrite () | |
624 | = let | |
625 | local | |
626 | val (Block.T {label, args, statements, transfer}, post) | |
627 | = visitBlock' entryBlock | |
628 | val entryBlock = Block.T {label = label, | |
629 | args = Vector.new0 (), | |
630 | statements = statements, | |
631 | transfer = transfer} | |
632 | val _ = List.push (blocks, entryBlock) | |
633 | in | |
634 | val args = args | |
635 | val post = post | |
636 | end | |
637 | val _ = Tree.traverse (Function.dominatorTree f, visitBlock) | |
638 | val _ = post () | |
639 | in | |
640 | Function.new {args = args, | |
641 | blocks = Vector.fromList (!blocks), | |
642 | mayInline = mayInline, | |
643 | name = name, | |
644 | raises = raises, | |
645 | returns = returns, | |
646 | start = entry} | |
647 | end | |
648 | val f = rewrite () | |
649 | in | |
650 | f | |
651 | end | |
652 | handle NoViolations => f | |
653 | end | |
654 | ||
655 | val traceRestoreFunction | |
656 | = Trace.trace ("Restore.restoreFunction", | |
657 | Func.layout o Function.name, | |
658 | Func.layout o Function.name) | |
659 | ||
660 | val restoreFunction | |
661 | = fn g => | |
662 | let | |
663 | val r = restoreFunction g | |
664 | in | |
665 | fn f => traceRestoreFunction r f | |
666 | end | |
667 | ||
668 | fun restore (Program.T {datatypes, globals, functions, main}) | |
669 | = let | |
670 | val r = restoreFunction {globals = globals} | |
671 | in | |
672 | Program.T {datatypes = datatypes, | |
673 | globals = globals, | |
674 | functions = List.revMap (functions, r), | |
675 | main = main} | |
676 | end | |
677 | (* quell unused warning *) | |
678 | val _ = restore | |
679 | end |