[MLton-commit] r4051
Stephen Weeks
MLton@mlton.org
Mon, 29 Aug 2005 23:08:17 -0700
Change QuickSort.sortArray to return unit instead of an array, since
it really just side effects the array, not creating a new one.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton/basic/quick-sort.sig
U mlton/trunk/lib/mlton/basic/quick-sort.sml
U mlton/trunk/mlton/backend/allocate-registers.fun
U mlton/trunk/mlton/backend/machine.fun
U mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
U mlton/trunk/mlton/elaborate/elaborate-env.fun
U mlton/trunk/mlton/elaborate/type-env.fun
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton/basic/quick-sort.sig
===================================================================
--- mlton/trunk/lib/mlton/basic/quick-sort.sig 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/lib/mlton/basic/quick-sort.sig 2005-08-30 06:08:03 UTC (rev 4051)
@@ -12,7 +12,7 @@
* This is necessary to handle duplicate elements.
*)
(* sortArray mutates the array it is passed and returns the same array *)
- val sortArray: 'a array * ('a * 'a -> bool) -> 'a array
+ val sortArray: 'a array * ('a * 'a -> bool) -> unit
val sortList: 'a list * ('a * 'a -> bool) -> 'a list
val sortVector: 'a vector * ('a * 'a -> bool) -> 'a vector
end
Modified: mlton/trunk/lib/mlton/basic/quick-sort.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/quick-sort.sml 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/lib/mlton/basic/quick-sort.sml 2005-08-30 06:08:03 UTC (rev 4051)
@@ -21,9 +21,9 @@
* Then, it does an insertion sort over the whole array to fix up the unsorted
* segments.
*)
-fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): 'a array =
+fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): unit =
if 0 = Array.length a
- then a
+ then ()
else
let
fun x i = sub (a, i)
@@ -41,7 +41,7 @@
then ()
else
let
- val _ = swap (l, randInt (l, u))
+ val () = swap (l, randInt (l, u))
val t = x l
(* Partition based on page 115. *)
fun loop (i, j) =
@@ -86,16 +86,23 @@
else (i, xi))
val last = length a - 1
val () = swap (m, last)
- val _ = qsort (0, last - 1)
- val _ = InsertionSort.sort (a, op <=)
+ val () = qsort (0, last - 1)
+ val () = InsertionSort.sort (a, op <=)
in
- a
+ ()
end
-fun sortList (l, f) =
- Array.toList (sortArray (Array.fromList l, f))
-
-fun sortVector (v, f) =
- Array.toVector (sortArray (Array.fromVector v, f))
+local
+ fun make (from, to) (l, f) =
+ let
+ val a = from l
+ val () = sortArray (a, f)
+ in
+ to a
+ end
+in
+ val sortList = fn z => make (Array.fromList, Array.toList) z
+ val sortVector = fn z => make (Array.fromVector, Array.toVector) z
+end
end
Modified: mlton/trunk/mlton/backend/allocate-registers.fun
===================================================================
--- mlton/trunk/mlton/backend/allocate-registers.fun 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/mlton/backend/allocate-registers.fun 2005-08-30 06:08:03 UTC (rev 4051)
@@ -80,13 +80,19 @@
end
fun new (alloc): t =
- T (Array.toList
- (QuickSort.sortArray
- (Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
- {offset = offset,
- size = Type.bytes ty}),
- fn (r, r') => Bytes.<= (#offset r, #offset r'))))
+ let
+ val a =
+ Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
+ {offset = offset,
+ size = Type.bytes ty})
+ val () =
+ QuickSort.sortArray
+ (a, fn (r, r') => Bytes.<= (#offset r, #offset r'))
+ in
+ T (Array.toList a)
+ end
+
fun get (T alloc, ty) =
let
val slotSize = Type.bytes ty
@@ -205,10 +211,9 @@
(compress
{next = 0,
alloc =
- Array.toList
- (QuickSort.sortArray
- (Array.fromList rs, fn (r, r') =>
- Register.index r <= Register.index r'))})))
+ QuickSort.sortList
+ (rs, fn (r, r') =>
+ Register.index r <= Register.index r')})))
end
fun get (T f, ty: Type.t) =
Modified: mlton/trunk/mlton/backend/machine.fun
===================================================================
--- mlton/trunk/mlton/backend/machine.fun 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/mlton/backend/machine.fun 2005-08-30 06:08:03 UTC (rev 4051)
@@ -1141,10 +1141,9 @@
then offset :: liveOffsets
else liveOffsets
| _ => raise No)
- val liveOffsets =
- Vector.fromArray
- (QuickSort.sortArray
- (Array.fromList liveOffsets, Bytes.<=))
+ val liveOffsets = Array.fromList liveOffsets
+ val () = QuickSort.sortArray (liveOffsets, Bytes.<=)
+ val liveOffsets = Vector.fromArray liveOffsets
val liveOffsets' =
Vector.sub (frameOffsets, frameOffsetsIndex)
handle Subscript => raise No
Modified: mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2005-08-30 06:08:03 UTC (rev 4051)
@@ -529,12 +529,9 @@
layedOut = ref false,
status = ref None})
end))
- val entryLabels =
- Vector.map
- (Vector.fromArray
- (QuickSort.sortArray
- (Array.fromList (!entryLabels), fn ((_, i), (_, i')) => i <= i')),
- #1)
+ val a = Array.fromList (!entryLabels)
+ val () = QuickSort.sortArray (a, fn ((_, i), (_, i')) => i <= i')
+ val entryLabels = Vector.map (Vector.fromArray a, #1)
val labelChunk = #chunkLabel o labelInfo
val {get = chunkLabelIndex: ChunkLabel.t -> int, ...} =
Property.getSet (ChunkLabel.plist,
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2005-08-30 06:08:03 UTC (rev 4051)
@@ -1181,10 +1181,10 @@
uses = uses}
end)
val _ = current := old
- val a =
+ val a = Array.fromList elts
+ val () =
QuickSort.sortArray
- (Array.fromList elts,
- fn ({domain = d, ...}, {domain = d', ...}) =>
+ (a, fn ({domain = d, ...}, {domain = d', ...}) =>
Symbol.<= (toSymbol d, toSymbol d'))
in
Info.T a
@@ -1383,12 +1383,17 @@
types = doit types,
vals = doit vals})
fun ('a, 'b) finish (r, toSymbol: 'a -> Symbol.t) =
- QuickSort.sortArray
- (Array.fromList (!r),
- fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
- {domain = d', time = t',...}: ('a, 'b) Values.value) =>
- le ({domain = toSymbol d, time = t},
- {domain = toSymbol d', time = t'}))
+ let
+ val a = Array.fromList (!r)
+ val () =
+ QuickSort.sortArray
+ (a, fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
+ {domain = d', time = t',...}: ('a, 'b) Values.value) =>
+ le ({domain = toSymbol d, time = t},
+ {domain = toSymbol d', time = t'}))
+ in
+ a
+ end
in
{bass = finish (bass, Basid.toSymbol),
fcts = finish (fcts, Fctid.toSymbol),
Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun 2005-08-28 02:34:22 UTC (rev 4050)
+++ mlton/trunk/mlton/elaborate/type-env.fun 2005-08-30 06:08:03 UTC (rev 4051)
@@ -1301,10 +1301,14 @@
val unit = con (unit, Tycon.tuple, Vector.new0 ())
val unknown = unit
fun sortFields (fields: (Field.t * 'a) list) =
- Array.toVector
- (QuickSort.sortArray
- (Array.fromList fields, fn ((f, _), (f', _)) =>
- Field.<= (f, f')))
+ let
+ val a = Array.fromList fields
+ val () =
+ QuickSort.sortArray (a, fn ((f, _), (f', _)) =>
+ Field.<= (f, f'))
+ in
+ Array.toVector a
+ end
fun unsorted (t, fields: (Field.t * 'a) list) =
let
val v = sortFields fields