[MLton-commit] r4364
Stephen Weeks
MLton@mlton.org
Thu, 2 Mar 2006 12:14:17 -0800
Exported Timer.
Added Vector.size.
Added String.{concatV,exists,unfold}.
Used MLton.Word.rol to implement Word.rotateLeft.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton/basic/sources.cm
U mlton/trunk/lib/mlton/basic/string.sig
U mlton/trunk/lib/mlton/basic/string.sml
U mlton/trunk/lib/mlton/basic/vector.fun
U mlton/trunk/lib/mlton/basic/vector.sig
U mlton/trunk/lib/mlton/basic/word.sml
U mlton/trunk/lib/mlton/sources.cm
U mlton/trunk/lib/mlton-stubs/sources.cm
U mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton/basic/sources.cm
===================================================================
--- mlton/trunk/lib/mlton/basic/sources.cm 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/sources.cm 2006-03-02 20:14:16 UTC (rev 4364)
@@ -124,6 +124,7 @@
structure SysWord
structure Thread
structure Time
+structure Timer
structure Trace
structure Tree
structure TwoListQueue
Modified: mlton/trunk/lib/mlton/basic/string.sig
===================================================================
--- mlton/trunk/lib/mlton/basic/string.sig 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/string.sig 2006-03-02 20:14:16 UTC (rev 4364)
@@ -26,6 +26,7 @@
val baseName: t * t -> t
val compare: t * t -> Relation.t
val concat: t list -> t
+ val concatV: t vector -> t
val concatWith: t list * t -> t
val contains: t * char -> bool
val deleteSurroundingWhitespace: t -> t
@@ -41,6 +42,7 @@
val escapeC: t -> t
val escapeSML: t -> t
val existsi: t * (int * char -> bool) -> bool
+ val exists: t * (char -> bool) -> bool
val explode: t -> char list
(* extract (s, i, SOME j)
* returns the substring of s of length j starting at i.
@@ -103,6 +105,7 @@
val toUpper: t -> t
val tokens: t * (char -> bool) -> t list
val translate: t * (char -> t) -> t
+ val unfold: int * 'a * ('a -> char * 'a) -> t
end
Modified: mlton/trunk/lib/mlton/basic/string.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/string.sml 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/string.sml 2006-03-02 20:14:16 UTC (rev 4364)
@@ -11,8 +11,49 @@
struct
open String1
+ fun unfold (n, a, f) =
+ let
+ val r = ref a
+ in
+ tabulate (n, fn _ =>
+ let
+ val (b, a) = f (!r)
+ val () = r := a
+ in
+ b
+ end)
+ end
+
+ fun concatV ss =
+ if 0 = Vector.length ss then
+ ""
+ else
+ let
+ fun str i =
+ let
+ val s = Vector.sub (ss, i)
+ in
+ (s, String.size s, i, 0)
+ end
+ in
+ unfold
+ (Vector.fold (ss, 0, fn (s, n) => n + size s),
+ str 0, fn (s, n, i, j) =>
+ (String.sub (s, j),
+ let
+ val j = j + 1
+ in
+ if j = n then
+ str (i + 1)
+ else
+ (s, n, i, j)
+ end))
+ end
+
fun existsi (s, f) = Int.exists (0, size s, fn i => f (i, sub (s, i)))
+ fun exists (s, f) = existsi (s, f o #2)
+
fun keepAll (s: t, f: char -> bool): t =
implode (List.rev
(fold (s, [], fn (c, ac) => if f c then c :: ac else ac)))
Modified: mlton/trunk/lib/mlton/basic/vector.fun
===================================================================
--- mlton/trunk/lib/mlton/basic/vector.fun 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/vector.fun 2006-03-02 20:14:16 UTC (rev 4364)
@@ -13,6 +13,8 @@
open S
+val size = length
+
fun unfold (n, a, f) = unfoldi (n, a, f o #2)
fun tabulate (n, f) = unfoldi (n, (), fn (i, ()) => (f i, ()))
Modified: mlton/trunk/lib/mlton/basic/vector.sig
===================================================================
--- mlton/trunk/lib/mlton/basic/vector.sig 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/vector.sig 2006-03-02 20:14:16 UTC (rev 4364)
@@ -111,6 +111,7 @@
val removeDuplicates: 'a t * ('a * 'a -> bool) -> 'a t
val removeFirst: 'a t * ('a -> bool) -> 'a t
val rev: 'a t -> 'a t
+ val size: 'a t -> int
val splitLast: 'a t -> 'a t * 'a
val tabulate: int * (int -> 'a) -> 'a t
val tabulator: int * (('a -> unit) -> unit) -> 'a t
Modified: mlton/trunk/lib/mlton/basic/word.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/word.sml 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/basic/word.sml 2006-03-02 20:14:16 UTC (rev 4364)
@@ -23,15 +23,7 @@
orb (w (2, 0w16), w (3, 0w24)))
end
- local
- val wordSize = fromInt wordSize
- in
- fun rotateLeft (w: t, n: t) =
- let val l = n mod wordSize
- val r = wordSize - l
- in orb (<< (w, l), >> (w, r))
- end
- end
+ val rotateLeft = MLton.Word.rol
val fromWord = fn x => x
val toWord = fn x => x
Modified: mlton/trunk/lib/mlton/sources.cm
===================================================================
--- mlton/trunk/lib/mlton/sources.cm 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton/sources.cm 2006-03-02 20:14:16 UTC (rev 4364)
@@ -145,6 +145,7 @@
structure SysWord
structure Thread
structure Time
+structure Timer
structure Trace
structure Tree
structure TwoListQueue
Modified: mlton/trunk/lib/mlton-stubs/sources.cm
===================================================================
--- mlton/trunk/lib/mlton-stubs/sources.cm 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton-stubs/sources.cm 2006-03-02 20:14:16 UTC (rev 4364)
@@ -55,6 +55,7 @@
structure SysWord
structure TextIO
structure Time
+structure Timer
structure Unix
structure Unsafe
structure Vector
Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2006-03-02 19:55:59 UTC (rev 4363)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2006-03-02 20:14:16 UTC (rev 4364)
@@ -58,6 +58,7 @@
structure SysWord
structure TextIO
structure Time
+structure Timer
structure Unix
structure Unsafe
structure Vector