[MLton-commit] r6500
Vesa Karvonen
vesak at mlton.org
Sat Mar 22 23:14:22 PST 2008
More iterators.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml 2008-03-22 14:17:10 UTC (rev 6499)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml 2008-03-23 07:14:21 UTC (rev 6500)
@@ -5,26 +5,38 @@
*)
structure Iter :> ITER = struct
- infix 1 <|> until when by
+ open Product UnPr Effect Fn
+
+ infix 1 <|> whilst whilst' until until' when unless by
infix 0 >>= &
- datatype product = datatype Product.product
-
type 'a t = ('a, Unit.t) CPS.t
structure Monad =
MkMonadP (type 'a monad = 'a t
open CPS
val zero = ignore
- fun a <|> b = b o Effect.obs a)
+ fun a <|> b = b o obs a)
open Monad
fun unfold g s f =
case g s of NONE => () | SOME (x, s) => (f x : Unit.t ; unfold g s f)
- exception S
- fun (m until p) f = m (fn x => if p x then raise S else f x) handle S => ()
+ fun (m until p) f = let
+ exception S
+ in
+ m (fn x => if p x then raise S else f x) handle S => ()
+ end
+ fun (m until' p) f = let
+ exception S
+ in
+ m (fn x => (f x : Unit.t ; if p x then raise S else ())) handle S => ()
+ end
+
+ fun m whilst p = m until neg p
+ fun m whilst' p = m until' neg p
+
fun indexFromBy i d m f =
(fn i => m (fn a => f (a & !i) before i := !i+d)) (ref i)
fun indexFrom i = indexFromBy i 1
@@ -32,30 +44,54 @@
fun iterate f = unfold (fn x => SOME (x, f x))
- fun m when p = m >>= (fn x => if p x then return x else zero)
+ fun m unless p = m >>= (fn x => if p x then zero else return x)
+ fun m when p = m unless neg p
+
fun m by f = map f m
fun subscript b = if b then () else raise Subscript
+ fun repeat x = iterate id x
+ fun replicate n =
+ (subscript (0 <= n)
+ ; fn x => unfold (fn 0 => NONE | n => SOME (x, n-1)) n)
+ fun cycle m f = (m f : Unit.t ; cycle m f)
+
+ fun take n =
+ (subscript (0 <= n)
+ ; fn m => fn f => case ref n of n =>
+ if !n <= 0 then () else (m until' (fn _ => (n := !n-1 ; !n <= 0))) f)
+
val up = iterate (fn x => x+1)
fun upToBy l u d =
(subscript (l <= u andalso 0 < d)
- ; unfold (fn l => if l<u then SOME (l, l+d) else NONE) l)
+ ; unfold (fn l => if l < u then SOME (l, l+d) else NONE) l)
fun upTo l u = upToBy l u 1
-
val down = unfold (fn x => SOME (x-1, x-1))
fun downToBy u l d =
(subscript (l <= u andalso 0 < d)
- ; unfold (fn u => if l<u then SOME (u-d, u-d) else NONE) u)
+ ; unfold (fn u => if l < u then SOME (u-d, u-d) else NONE) u)
fun downTo u l = downToBy u l 1
+ val integers = up 0
+ fun rangeBy f t d = let
+ val op < = case Int.compare (f, t)
+ of LESS => op <
+ | EQUAL => op <>
+ | GREATER => op >
+ in
+ subscript (f = t orelse f < t andalso 0 < d)
+ ; unfold (fn f => if f < t then SOME (f, f+d) else NONE) f
+ end
+ fun range f t = if f < t then rangeBy f t 1 else rangeBy f t ~1
+
fun inList s = unfold List.getItem s
fun inArraySlice s = unfold BasisArraySlice.getItem s
fun inVectorSlice s = unfold BasisVectorSlice.getItem s
- fun inArray s = Fn.flip Array.app s
- fun inVector s = Fn.flip Vector.app s
+ fun inArray s = flip Array.app s
+ fun inVector s = flip Vector.app s
val inCharArraySlice = unfold BasisCharArraySlice.getItem
val inCharVectorSlice = unfold BasisCharVectorSlice.getItem
@@ -63,13 +99,13 @@
val inWord8ArraySlice = unfold BasisWord8ArraySlice.getItem
val inWord8VectorSlice = unfold BasisWord8VectorSlice.getItem
- val inCharArray = Fn.flip CharArray.app
- val inCharVector = Fn.flip CharVector.app
+ val inCharArray = flip CharArray.app
+ val inCharVector = flip CharVector.app
val inString = inCharVector
- val inWord8Array = Fn.flip Word8Array.app
- val inWord8Vector = Fn.flip Word8Vector.app
+ val inWord8Array = flip Word8Array.app
+ val inWord8Vector = flip Word8Vector.app
- val for = Fn.id
+ val for = id
fun fold f s m = (fn s => (m (fn x => s := f (x, !s)) : Unit.t ; !s)) (ref s)
fun reduce zero plus one = fold plus zero o map one
fun find p m = let
@@ -78,4 +114,6 @@
NONE before m (fn x => if p x then raise S x else ()) handle S x => SOME x
end
fun collect m = rev (fold op :: [] m)
+ fun first m = find (const true) m
+ fun last m = fold (SOME o #1) NONE m
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig 2008-03-22 14:17:10 UTC (rev 6499)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig 2008-03-23 07:14:21 UTC (rev 6500)
@@ -40,11 +40,29 @@
val collect : 'a t -> 'a List.t
(** {collect [<x(0), x(1), ..., x(n)>] = [x(0), x(1), ..., x(n)]} *)
- (** == Combinators == *)
+ val first : 'a t -> 'a Option.t
+ (**
+ *> first [<>] = NONE
+ *> first [<x(0), x(1), ...>] = SOME x(0)
+ *
+ * Only the first element, if any, of the iterator will be computed.
+ *)
+ val last : 'a t -> 'a Option.t
+ (**
+ *> first [<>] = NONE
+ *> first [<x(0), x(1), ..., x(n)>] = SOME x(n)
+ *
+ * Note that all elements of the iterator will be computed.
+ *)
+
+ (** == Monad == *)
+
include MONADP_CORE where type 'a monad = 'a t
structure Monad : MONADP where type 'a monad = 'a t
+ (** == Unfolding == *)
+
val unfold : ('a, 's) Reader.t -> 's -> 'a t
(**
*> unfold g s f =
@@ -52,25 +70,10 @@
*> | SOME (x, s) => (f x ; unfold g s f)
*)
- val until : 'a t * 'a UnPr.t -> 'a t
- (**
- * {[<x(0), x(1), ...>] until p = [<x(0), x(1), ..., x(n)>]} where {p
- * x(i) = false} for all {0<=i<=n} and {p x(n+1) = true}.
- *)
-
- val indexFromBy : Int.t -> Int.t -> 'a t -> ('a, Int.t) Product.t t
- (** {indexFromBy i d [<x(0), x(1), ...>] = [<x(0) & i+0*d, x(1) & i+1*d, ...>]} *)
-
- val indexFrom : Int.t -> 'a t -> ('a, Int.t) Product.t t
- (** {indexFrom i = indexFromBy i 1} *)
-
- val index : 'a t -> ('a, Int.t) Product.t t
- (** {index = indexFrom 0} *)
-
val iterate : 'a UnOp.t -> 'a -> 'a t
(** {iterate f x = [<x, f x, f (f x), ...>]} *)
- val when : 'a t * 'a UnPr.t -> 'a t
+ (** == Combinators == *)
val by : 'a t * ('a -> 'b) -> 'b t
(**
@@ -79,6 +82,10 @@
* {s by f} is the same as {Monad.map f s}.
*)
+ val unless : 'a t * 'a UnPr.t -> 'a t
+ val when : 'a t * 'a UnPr.t -> 'a t
+ (** {m when p = m unless neg p} *)
+
val >< : 'a t * 'b t -> ('a, 'b) Product.t t
(**
*> [<x(0), x(1), ...>] >< [<y(0), y(1), ..., y(n)>] =
@@ -89,8 +96,70 @@
* This is the same as {Monad.><}.
*)
- (** == Iterating over Integers == *)
+ (** == Repetition == *)
+ val repeat : 'a -> 'a t
+ (** {repeat x = [<x, x, ...>]} *)
+
+ val replicate : Int.t -> 'a -> 'a t
+ (** {replicate n x = [<x, x, ..., x>]} *)
+
+ val cycle : 'a t UnOp.t
+ (**
+ *> cycle [<x(0), x(1), ..., x(n)>] =
+ *> [<x(0), x(1), ..., x(n),
+ *> x(0), x(1), ..., x(n),
+ *> ...>]
+ *)
+
+ (** == Stopping == *)
+
+ val take : Int.t -> 'a t UnOp.t
+ (**
+ *> take n [<x(0), x(1), ..., x(m)>] = [<x(0), x(1), ..., x(m)>], m <= n
+ *> take n [<x(0), x(1), ..., x(n-1), ...>] = [<x(0), x(1), ..., x(n-1)>]
+ *)
+
+ val until : 'a t * 'a UnPr.t -> 'a t
+ (**
+ * {[<x(0), x(1), ...>] until p = [<x(0), x(1), ..., x(n)>]} where {p
+ * x(i) = false} for all {0<=i<=n} and {p x(n+1) = true}.
+ *)
+
+ val until' : 'a t * 'a UnPr.t -> 'a t
+ (**
+ * {[<x(0), x(1), ...>] until' p = [<x(0), x(1), ..., x(n)>]} where {p
+ * x(i) = false} for all {0<=i<n} and {p x(n) = true}.
+ *)
+
+ val whilst : 'a t * 'a UnPr.t -> 'a t
+ (** {m whilst p = m until neg p} *)
+
+ val whilst' : 'a t * 'a UnPr.t -> 'a t
+ (** {m whilst' p = m until' neg p} *)
+
+ (** == Indexing == *)
+
+ val indexFromBy : Int.t -> Int.t -> 'a t -> ('a, Int.t) Product.t t
+ (**
+ *> indexFromBy i d [<x(0), x(1), ...>] = [<x(0) & i+0*d, x(1) & i+1*d, ...>]
+ *)
+
+ val indexFrom : Int.t -> 'a t -> ('a, Int.t) Product.t t
+ (** {indexFrom i = indexFromBy i 1} *)
+
+ val index : 'a t -> ('a, Int.t) Product.t t
+ (** {index = indexFrom 0} *)
+
+ (** == Iterating over Integers ==
+ *
+ * Note that the semantics of the {range[By]} iterators are different
+ * from the semantics of the {(up|down)[To[By]]} iterators.
+ *
+ * Given an invalid specification of a range, the iterators over
+ * integers raise {Subscript}.
+ *)
+
val up : Int.t -> Int.t t
(** {up l = [<l, l+1, ...>]} *)
@@ -98,7 +167,7 @@
(** {upTo l u = [<l, l+1, ..., u-1>]} *)
val upToBy : Int.t -> Int.t -> Int.t -> Int.t t
- (** {upToBy l u d = [<l+0*d, l+1*d, ..., l + (u-l) div d * d>]} *)
+ (** {upToBy l u d = [<l + 0*d, l + 1*d, ..., l + (u-l) div d * d>]} *)
val down : Int.t -> Int.t t
(** {down u = [<u-1, u-2, ...>]} *)
@@ -107,8 +176,26 @@
(** {downTo u l = [<u-1, u-2, ..., l>]} *)
val downToBy : Int.t -> Int.t -> Int.t -> Int.t t
- (** {downToBy u l d = [<u-1*d, u-2*d, ..., u - (u-l+d-1) div d * d>]} *)
+ (**
+ *> downToBy u l d = [<u - 1*d, u - 2*d, ..., u - (u-l+d-1) div d * d>]
+ *
+ * Note that {u - (u-l+d-1) div d * d} may be less than {l}.
+ *)
+ val range : Int.t -> Int.t -> Int.t t
+ (** {range f t = if f < t then rangeBy f t 1 else rangeBy f t ~1} *)
+
+ val rangeBy : Int.t -> Int.t -> Int.t -> Int.t t
+ (**
+ *> rangeBy f t d = [<f + 0*d, f + 1*d, ..., f + (t-f) div d * d>]
+ *
+ * If {f < t} then it must be that {0 < d}. If {f > t} then it must be
+ * that {0 > d}.
+ *)
+
+ val integers : Int.t t
+ (** {integers = [<0, 1, 2, ...>]} *)
+
(** == Iterators Over Standard Sequences == *)
val inList : 'a List.t -> 'a t
More information about the MLton-commit
mailing list