[MLton] cvs commit: rewrote x86.Block.compress to run in linear time
Stephen Weeks
sweeks@mlton.org
Thu, 1 Jul 2004 12:54:28 -0700
sweeks 04/07/01 12:54:26
Modified: mlton/codegen/x86-codegen x86.fun
Log:
MAIL rewrote x86.Block.compress to run in linear time
Revision Changes Path
1.53 +51 -45 mlton/mlton/codegen/x86-codegen/x86.fun
Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- x86.fun 12 Apr 2004 17:53:02 -0000 1.52
+++ x86.fun 1 Jul 2004 19:54:25 -0000 1.53
@@ -4205,52 +4205,58 @@
then Transfer.toString (valOf transfer)
else "NONE");
print "\n")
+
+ val compress': t' list -> t' list =
+ fn l =>
+ List.fold
+ (rev l, [],
+ fn (b' as T' {entry, profileLabel, statements, transfer}, ac) =>
+ case transfer of
+ SOME transfer => b' :: ac
+ | NONE =>
+ case ac of
+ [] => Error.bug "compress' with dangling transfer"
+ | b2' :: ac =>
+ let
+ val T' {entry = entry2,
+ profileLabel = profileLabel2,
+ statements = statements2,
+ transfer = transfer2} = b2'
+ in
+ case entry2 of
+ SOME _ =>
+ Error.bug "compress' with mismatched transfer"
+ | NONE =>
+ let
+ val (pl, ss) =
+ case (profileLabel, statements) of
+ (NONE, []) =>
+ (profileLabel2, statements2)
+ | _ =>
+ (profileLabel,
+ statements
+ @ (ProfileLabel.toAssemblyOpt
+ profileLabel2)
+ @ statements2)
+ in
+ T' {entry = entry,
+ profileLabel = pl,
+ statements = ss,
+ transfer = transfer2} :: ac
+ end
+ end)
- val rec compress
- = fn [] => []
- | [T' {entry = SOME entry1,
- profileLabel = profileLabel1,
- statements = statements1,
- transfer = SOME transfer1}]
- => [T {entry = entry1,
- profileLabel = profileLabel1,
- statements = statements1,
- transfer = transfer1}]
- | (T' {entry = SOME entry1,
- profileLabel = profileLabel1,
- statements = statements1,
- transfer = SOME transfer1})::blocks
- => (T {entry = entry1,
- profileLabel = profileLabel1,
- statements = statements1,
- transfer = transfer1})::(compress blocks)
- | (T' {entry = SOME entry1,
- profileLabel = NONE,
- statements = [],
- transfer = NONE})::
- (T' {entry = NONE,
- profileLabel = profileLabel2,
- statements = statements2,
- transfer = transfer2})::blocks
- => compress ((T' {entry = SOME entry1,
- profileLabel = profileLabel2,
- statements = statements2,
- transfer = transfer2})::blocks)
- | (T' {entry = SOME entry1,
- profileLabel = profileLabel1,
- statements = statements1,
- transfer = NONE})::
- (T' {entry = NONE,
- profileLabel = profileLabel2,
- statements = statements2,
- transfer = transfer2})::blocks
- => compress ((T' {entry = SOME entry1,
- profileLabel = profileLabel1,
- statements = statements1 @
- (ProfileLabel.toAssemblyOpt profileLabel2) @
- statements2,
- transfer = transfer2})::blocks)
- | _ => Error.bug "Blocks.compress"
+ val compress: t' list -> t list =
+ fn l =>
+ List.map
+ (compress' l, fn T' {entry, profileLabel, statements, transfer} =>
+ case (entry, transfer) of
+ (SOME e, SOME t) =>
+ T {entry = e,
+ profileLabel = profileLabel,
+ statements = statements,
+ transfer = t}
+ | _ => Error.bug "compress")
end
structure Chunk =