[MLton-commit] r6511
Vesa Karvonen
vesak at mlton.org
Fri Mar 28 04:04:35 PST 2008
Interface redesign for Iter. Also some minor additions.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig
U mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml
----------------------------------------------------------------------
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-26 18:17:47 UTC (rev 6510)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/control/iter.sml 2008-03-28 12:04:34 UTC (rev 6511)
@@ -5,9 +5,9 @@
*)
structure Iter :> ITER = struct
- open Product UnPr Effect Fn
+ open Option Product UnPr Effect Fn
- infix 1 <|> whilst whilst' until until' when unless by
+ infix 1 <|>
infix 0 >>= &
type 'a t = ('a, Unit.t) CPS.t
@@ -22,70 +22,65 @@
fun unfold g s f =
case g s of NONE => () | SOME (x, s) => (f x : Unit.t ; unfold g s f)
- fun (m until p) f = let
+ fun until p m 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
+ fun until' p m 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 whilst p = until (neg p)
+ fun whilst' p = 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
- fun index m = indexFrom 0 m
+ fun subscript b = if b then () else raise Subscript
+ fun take n =
+ (subscript (0 <= n)
+ ; fn m => fn f => case ref n of n =>
+ if !n <= 0 then () else until' (fn _ => (n := !n-1 ; !n <= 0)) m f)
+
fun iterate f = unfold (fn x => SOME (x, f x))
- fun m unless p = m >>= (fn x => if p x then zero else return x)
- fun m when p = m unless neg p
+ fun filter p m = m >>= (fn x => if p x then return x else zero)
- 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)
+ type ('f, 't, 'b) mod = 'f * 't * 'b
- 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)
- 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)
- fun downTo u l = downToBy u l 1
- val integers = up 0
+ fun From ? = Fold.mapSt1 (fn f => fn (_, t, b) => (f, t, b)) ?
+ fun To ? = Fold.mapSt1 (fn t => fn (f, _, b) => (f, t, b)) ?
+ fun By ? = Fold.mapSt1 (fn b => fn (f, t, _) => (f, t, b)) ?
- 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 up ? = Fold.wrap ((0, (), 1), fn (l, (), s) =>
+ (subscript (0 < s) ; iterate (fn l => l+s) l)) ?
+ fun down ? = Fold.wrap ((0, (), 1), fn (u, (), s) =>
+ (subscript (0 < s) ; iterate (fn u => u-s) (u-s))) ?
+
+ fun upTo u = Fold.wrap ((0, u, 1), fn (l, u, s) =>
+ (subscript (l = u orelse 0 < s)
+ ; unfold (fn l => if l < u then SOME (l, l+s) else NONE) l))
+
+ fun downFrom u = Fold.wrap ((u, 0, 1), fn (u, l, s) =>
+ (subscript (l = u orelse 0 < s)
+ ; unfold (fn u => if l < u then SOME (u-s, u-s) else NONE) u))
+
+ val integers = up Fold.$
+
+ fun index ? = Fold.wrap ((0, (), 1), fn (i, (), d) =>
+ fn m => fn f => (fn i => m (fn a => f (a & !i) before i := !i+d)) (ref i)) ?
+
fun inList s = unfold List.getItem s
+ fun onList s = unfold (fn [] => NONE | l as _::t => SOME (l, t)) s
fun inArraySlice s = unfold BasisArraySlice.getItem s
fun inVectorSlice s = unfold BasisVectorSlice.getItem s
@@ -116,4 +111,6 @@
fun collect m = rev (fold op :: [] m)
fun first m = find (const true) m
fun last m = fold (SOME o #1) NONE m
+ fun all p = isNone o find (neg p)
+ fun exists p = isSome o find p
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-26 18:17:47 UTC (rev 6510)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/control/iter.sig 2008-03-28 12:04:34 UTC (rev 6511)
@@ -11,20 +11,23 @@
(** == Running Iterators == *)
- val for : 'a t -> ('a, Unit.t) CPS.t
+ val all : 'a UnPr.t -> 'a t UnPr.t
(**
- *> for [<>] f = ()
- *> for [<x(0), x(1), ...>] f = (f x(0) ; for [<x(1), ...>] f)
+ *> all p [<>] = true
+ *> all p [<x(0), x(1), ...>] = p x(0) andalso all p [<x(1), ...>]
*
- * This is actually the identity function and is provided purely for
- * syntactic sugar.
+ *> all = neg o exists o neg
*)
- val fold : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val collect : 'a t -> 'a List.t
+ (** {collect [<x(0), x(1), ..., x(n)>] = [x(0), x(1), ..., x(n)]} *)
+
+ val exists : 'a UnPr.t -> 'a t UnPr.t
(**
- *> fold f s [<>] = s
- *> fold f s [<x(0), x(1), ..., x(n)>] =
- *> fold f (f (x(0), s)) [<x(1), ..., x(n)>]
+ *> exists p [<>] = false
+ *> exists p [<x(0), x(1), ...>] = p x(0) orelse exists p [<x(1), ...>]
+ *
+ *> exists = neg o all o neg
*)
val find : 'a UnPr.t -> 'a t -> 'a Option.t
@@ -34,12 +37,6 @@
*> if p x(0) then SOME x(n) else find p [<x(1), ...>]
*)
- val reduce : 'b -> 'b BinOp.t -> ('a -> 'b) -> 'a t -> 'b
- (** {reduce zero plus one = fold plus zero o Monad.map one} *)
-
- val collect : 'a t -> 'a List.t
- (** {collect [<x(0), x(1), ..., x(n)>] = [x(0), x(1), ..., x(n)]} *)
-
val first : 'a t -> 'a Option.t
(**
*> first [<>] = NONE
@@ -48,6 +45,22 @@
* Only the first element, if any, of the iterator will be computed.
*)
+ val fold : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ (**
+ *> fold f s [<>] = s
+ *> fold f s [<x(0), x(1), ..., x(n)>] =
+ *> fold f (f (x(0), s)) [<x(1), ..., x(n)>]
+ *)
+
+ val for : 'a t -> ('a, Unit.t) CPS.t
+ (**
+ *> for [<>] f = ()
+ *> for [<x(0), x(1), ...>] f = (f x(0) ; for [<x(1), ...>] f)
+ *
+ * This is actually the identity function and is provided purely for
+ * syntactic sugar.
+ *)
+
val last : 'a t -> 'a Option.t
(**
*> first [<>] = NONE
@@ -56,8 +69,14 @@
* Note that all elements of the iterator will be computed.
*)
- (** == Monad == *)
+ val reduce : 'b -> 'b BinOp.t -> ('a -> 'b) -> 'a t -> 'b
+ (** {reduce zero plus one = fold plus zero o Monad.map one} *)
+ (** == Monad ==
+ *
+ * Iterators essentially form a monad with plus.
+ *)
+
include MONADP_CORE where type 'a monad = 'a t
structure Monad : MONADP where type 'a monad = 'a t
@@ -75,17 +94,14 @@
(** == Combinators == *)
- val by : 'a t * ('a -> 'b) -> 'b t
+ val filter : 'a UnPr.t -> 'a t UnOp.t
(**
- *> [<x(0), x(1), ...>] by f = [<f x(0), f x(1), ...>]
+ *> filter p [<x(0), x(1), ...>] =
+ *> (if p x(0) then [<x(0)>] else [<>]) <|> filter p [<x(1), ...>]
*
- * {s by f} is the same as {Monad.map f s}.
+ *> fun filter p m = m >>= (fn x => if p x then return x else zero)
*)
- 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)>] =
@@ -102,7 +118,7 @@
(** {repeat x = [<x, x, ...>]} *)
val replicate : Int.t -> 'a -> 'a t
- (** {replicate n x = [<x, x, ..., x>]} *)
+ (** {replicate n x = [<x(1), x(2), ..., x(n)>]} *)
val cycle : 'a t UnOp.t
(**
@@ -112,7 +128,7 @@
*> ...>]
*)
- (** == Stopping == *)
+ (** == Stopping Early == *)
val take : Int.t -> 'a t UnOp.t
(**
@@ -120,84 +136,109 @@
*> 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
+ val until : 'a UnPr.t -> 'a t UnOp.t
(**
- * {[<x(0), x(1), ...>] until p = [<x(0), x(1), ..., x(n)>]} where {p
+ * {until p [<x(0), x(1), ...>] = [<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
+ val until' : 'a UnPr.t -> 'a t UnOp.t
(**
- * {[<x(0), x(1), ...>] until' p = [<x(0), x(1), ..., x(n)>]} where {p
+ * {until' p [<x(0), x(1), ...>] = [<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 UnPr.t -> 'a t UnOp.t
+ (** {whilst = until o neg} *)
- val whilst' : 'a t * 'a UnPr.t -> 'a t
- (** {m whilst' p = m until' neg p} *)
+ val whilst' : 'a UnPr.t -> 'a t UnOp.t
+ (** {whilst' = until' o neg} *)
- (** == 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 ==
+ (** == Optional Argument Modifiers ==
*
- * 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}.
+ * The following modifiers are used to specify additional optional
+ * arguments to a number of iterators. They are optional and can
+ * be specified in any order. The default value, when a modifier is
+ * absent, depends on the iterator.
*)
- val up : Int.t -> Int.t t
- (** {up l = [<l, l+1, ...>]} *)
+ type ('f, 't, 'b) mod
- val upTo : Int.t -> Int.t -> Int.t t
- (** {upTo l u = [<l, l+1, ..., u-1>]} *)
+ val From : ('f,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t, 'k) Fold.s1
- 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>]} *)
+ val To : ('t,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t, 'k) Fold.s1
- val down : Int.t -> Int.t t
- (** {down u = [<u-1, u-2, ...>]} *)
+ val By : ('b,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t,
+ (('f, 't, 'b) mod, 'd, 'r) Fold.t, 'k) Fold.s1
- val downTo : Int.t -> Int.t -> Int.t t
- (** {downTo u l = [<u-1, u-2, ..., l>]} *)
+ (** == Iterating over Integer Ranges == *)
- val downToBy : Int.t -> Int.t -> Int.t -> Int.t t
+ val upTo : Int.t -> (((Int.t, Int.t, Int.t) mod,
+ (Int.t, Int.t, Int.t) mod,
+ Int.t t) Fold.t, 'k) CPS.t
(**
- *> downToBy u l d = [<u - 1*d, u - 2*d, ..., u - (u-l+d-1) div d * d>]
+ *> upTo u From l By d $ =
+ *> [<l + 0*d, l + 1*d, ..., l + (u-l) div d * d>]
*
+ * Defaults: {From 0 By 1}
+ *)
+
+ val downFrom : Int.t -> (((Int.t, Int.t, Int.t) mod,
+ (Int.t, Int.t, Int.t) mod,
+ Int.t t) Fold.t, 'k) CPS.t
+ (**
+ *> downFrom u To l By 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}.
+ *
+ * Defaults: {To 0 By 1}
*)
- 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 up : (((Int.t, Unit.t, Int.t) mod,
+ (Int.t, Unit.t, Int.t) mod,
+ Int.t t) Fold.t, 'k) CPS.t
+ (**
+ *> up From l By d $ = [<l + 0*d, l + 1*d, ...>]
+ *
+ * Defaults: {From 0 By 1}
+ *)
- val rangeBy : Int.t -> Int.t -> Int.t -> Int.t t
+ val down : (((Int.t, Unit.t, Int.t) mod,
+ (Int.t, Unit.t, Int.t) mod,
+ Int.t t) Fold.t, 'k) CPS.t
(**
- *> rangeBy f t d = [<f + 0*d, f + 1*d, ..., f + (t-f) div d * d>]
+ *> down From u By d $ = [<u - 1*d, u - 2*d, ...>]
*
- * If {f < t} then it must be that {0 < d}. If {f > t} then it must be
- * that {0 > d}.
+ * Defaults: {From 0 By 1}
*)
val integers : Int.t t
- (** {integers = [<0, 1, 2, ...>]} *)
+ (** {integers = up $ = [<0, 1, 2, ...>]} *)
- (** == Iterators Over Standard Sequences == *)
+ (** == Indexing == *)
+ val index : (((Int.t, Unit.t, Int.t) mod,
+ (Int.t, Unit.t, Int.t) mod,
+ 'a t -> ('a, Int.t) Product.t t) Fold.t, 'k) CPS.t
+ (**
+ *> index From i By d $ [<x(0), x(1), ...>] =
+ *> [<x(0) & i+0*d, x(1) & i+1*d, ...>]
+ *
+ * Defaults: {From 0 By 1}
+ *)
+
+ (** == Iterators Over Standard Sequences ==
+ *
+ * Each of the {inX} iterators iterates over all the elements in the
+ * given sequence of type {X}.
+ *)
+
val inList : 'a List.t -> 'a t
val inArray : 'a Array.t -> 'a t
@@ -215,4 +256,14 @@
val inWord8ArraySlice : Word8ArraySlice.t -> Word8.t t
val inWord8Vector : Word8Vector.t -> Word8.t t
val inWord8VectorSlice : Word8VectorSlice.t -> Word8.t t
+
+ val onList : 'a List.t -> 'a List.t t
+ (**
+ *> onList [] = [<>]
+ *> onList [x(0), x(1), ..., x(n)] =
+ *> [<[x(0), x(1), ..., x(n)],
+ *> [x(1), ..., x(n)],
+ *> ...,
+ *> [x(n)]>]
+ *)
end
Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml 2008-03-26 18:17:47 UTC (rev 6510)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml 2008-03-28 12:04:34 UTC (rev 6511)
@@ -67,7 +67,7 @@
fun render () = let
val color = if SDL.Key.isPressed SDL.Key.Sym.SPACE then red else green
in
- (upToBy 0 w chestW >< upToBy 0 h chestH)
+ (upTo w By chestW $ >< upTo h By chestH $)
(fn x & y =>
SDL.Surface.blitRect
chest {pos = {x=0, y=0}, dim = chestDim}
More information about the MLton-commit
mailing list