[MLton-commit] r5532
Vesa Karvonen
vesak at mlton.org
Wed Apr 18 04:27:58 PDT 2007
Renamed Promise : PROMISE to Lazy : LAZY and exposed a number of things
from the Lazy module at the top-level.
----------------------------------------------------------------------
A mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml
D mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
A mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/lazy.sig
D mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig
A mltonlib/trunk/com/ssh/misc-util/unstable/lazy-test.sml
U mltonlib/trunk/com/ssh/misc-util/unstable/prettier.sml
D mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml
U mltonlib/trunk/com/ssh/misc-util/unstable/test.mlb
----------------------------------------------------------------------
Copied: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml (from rev 5531, mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml)
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/lazy.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -0,0 +1,45 @@
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Lazy :> LAZY = struct
+ datatype 'a status = LAZY of 'a t Thunk.t
+ | EAGER of (Exn.t, 'a) Sum.t
+ withtype 'a t = 'a status ref ref
+
+ fun lazy th = ref (ref (LAZY th))
+
+ fun eager x = ref (ref (EAGER (Sum.INR x)))
+
+ fun delay th = lazy (ref o ref o EAGER o (fn () => Exn.eval th))
+
+ fun replay s = Sum.sum (Exn.throw, Fn.id) s
+
+ fun force promise =
+ case !(!promise) of
+ EAGER x => replay x
+ | LAZY th => let
+ val promise' = th ()
+ in
+ case !(!promise) of
+ LAZY _ => (!promise := !(!promise')
+ ; promise := !promise'
+ ; force promise)
+ | EAGER x => replay x
+ end
+
+ fun toThunk promise = fn () => force promise
+
+ fun memo th = toThunk (delay th)
+
+ fun tie s k =
+ case !(!s) of
+ EAGER _ => raise Fix.Fix
+ | LAZY _ => s := !k
+
+ fun Y ? =
+ Tie.tier (fn () => Pair.map (Fn.id, tie)
+ (Sq.mk (lazy (Basic.raising Fix.Fix)))) ?
+end
Deleted: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/lazy/promise.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -1,45 +0,0 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-structure Promise :> PROMISE = struct
- datatype 'a status = LAZY of 'a t Thunk.t
- | EAGER of (Exn.t, 'a) Sum.t
- withtype 'a t = 'a status ref ref
-
- fun lazy th = ref (ref (LAZY th))
-
- fun eager x = ref (ref (EAGER (Sum.INR x)))
-
- fun delay th = lazy (ref o ref o EAGER o (fn () => Exn.eval th))
-
- fun replay s = Sum.sum (Exn.throw, Fn.id) s
-
- fun force promise =
- case !(!promise) of
- EAGER x => replay x
- | LAZY th => let
- val promise' = th ()
- in
- case !(!promise) of
- LAZY _ => (!promise := !(!promise')
- ; promise := !promise'
- ; force promise)
- | EAGER x => replay x
- end
-
- fun toThunk promise = fn () => force promise
-
- fun memo th = toThunk (delay th)
-
- fun tie s k =
- case !(!s) of
- EAGER _ => raise Fix.Fix
- | LAZY _ => s := !k
-
- fun Y ? =
- Tie.tier (fn () => Pair.map (Fn.id, tie)
- (Sq.mk (lazy (Basic.raising Fix.Fix)))) ?
-end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2007-04-18 11:27:56 UTC (rev 5532)
@@ -45,7 +45,7 @@
../../../detail/io/reader.sml
../../../detail/io/text-io.sml
../../../detail/io/writer.sml
- ../../../detail/lazy/promise.sml
+ ../../../detail/lazy/lazy.sml
../../../detail/ml/common/mono-seqs.sml
../../../detail/ml/common/scalars.sml
../../../detail/ml/smlnj/ints.sml
@@ -74,6 +74,6 @@
../../../detail/sequence/vector-slice.sml
../../../detail/sequence/vector.sml
../../../detail/text/mk-text-ext.fun
- ../../../public/lazy/promise.sig
+ ../../../public/lazy/lazy.sig
ext.sml
sigs.cm
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2007-04-18 11:27:56 UTC (rev 5532)
@@ -263,9 +263,9 @@
detail/ml/$(SML_COMPILER)/mono-array-slices.sml
detail/ml/$(SML_COMPILER)/texts.sml
- (* Promise *)
- public/lazy/promise.sig
- detail/lazy/promise.sml
+ (* Lazy *)
+ public/lazy/lazy.sig
+ detail/lazy/lazy.sml
(* ShiftOp *)
public/fn/shift-op.sig
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -61,6 +61,7 @@
signature INTEGER = INTEGER
signature INT_INF = INT_INF
signature ISO = ISO
+signature LAZY = LAZY
signature LIST = LIST
signature MONO_ARRAY = MONO_ARRAY
signature MONO_ARRAY_SLICE = MONO_ARRAY_SLICE
@@ -71,7 +72,6 @@
signature PAIR = PAIR
signature PRODUCT = PRODUCT
signature PRODUCT_TYPE = PRODUCT_TYPE
-signature PROMISE = PROMISE
signature READER = READER
signature REAL = REAL
signature REF = REF
@@ -138,13 +138,13 @@
structure LargeInt : INTEGER = LargeInt
structure LargeReal : REAL = LargeReal
structure LargeWord : WORD = LargeWord
+structure Lazy : LAZY = Lazy
structure List : LIST = List
structure Option : OPTION = Option
structure Order : ORDER = Order
structure Pair : PAIR = Pair
structure Position : INTEGER = Position
structure Product : PRODUCT = Product
-structure Promise : PROMISE = Promise
structure Reader : READER = Reader
structure Real : REAL = Real
structure Ref : REF where type 'a t = 'a ref = Ref
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/top-level.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
*
* This code is released under the MLton license, a BSD-style license.
* See the LICENSE file or http://mlton.org/License for details.
@@ -39,6 +39,15 @@
val op \> = Fn.\>
val op |< = Fn.|<
+(** === Lazy === *)
+
+type 'a lazy = 'a Lazy.t
+val delay = Lazy.delay
+val eager = Lazy.eager
+val force = Lazy.force
+val lazy = Lazy.lazy
+val memo = Lazy.memo
+
(** === Option === *)
val isNone = Option.isNone
Copied: mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/lazy.sig (from rev 5531, mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig)
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/lazy.sig 2007-04-18 11:27:56 UTC (rev 5532)
@@ -0,0 +1,82 @@
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * Lazy promises.
+ *
+ * The design is based on [http://srfi.schemers.org/srfi-45/ SRFI-45]
+ * ``Primitives for Expressing Iterative Lazy Algorithms'' by André van
+ * Tonder.
+ *
+ * The general recipe to express lazy algorithms is to
+ * - wrap all constructors with {delay (fn () => ...)},
+ * - apply {force} to arguments of destructors, and
+ * - wrap function bodies with {lazy (fn () => ...)}.
+ *)
+signature LAZY = sig
+ type 'a t
+ (** The abstract type of promises. *)
+
+ val delay : 'a Thunk.t -> 'a t
+ (**
+ * Takes a thunk of type {'a thunk} and returns a promise of type
+ * {'a t} which at some point in the future may be asked (by the
+ * {force} procedure) to evaluate the thunk and deliver the
+ * resulting value.
+ *)
+
+ val eager : 'a -> 'a t
+ (**
+ * Takes an argument of type {'a} and returns a promise of type
+ * {'a t}. As opposed to {delay}, the argument is evaluated eagerly.
+ *
+ * Semantically, writing
+ *
+ *> eager expression
+ *
+ * is equivalent to writing
+ *
+ *> let val value = expression in delay (fn () => value) end
+ *
+ * However, the former is more efficient since it does not require
+ * unnecessary creation and evaluation of thunks. We also have the
+ * equivalence
+ *
+ *> delay (fn () => expression) = lazy (eager expression)
+ *
+ * assuming that evaluation of the expression does not raise an
+ * exception.
+ *)
+
+ val force : 'a t -> 'a
+ (**
+ * Takes a promise of type {'a t} and returns a value of type {'a}
+ * as follows: If a value of type {'a} has been computed for the
+ * promise, this value is returned. Otherwise, the promise is first
+ * evaluated, then overwritten by the obtained promise or value, and
+ * then force is again applied (iteratively) to the promise.
+ *)
+
+ val lazy : 'a t Thunk.t -> 'a t
+ (**
+ * Takes a thunk returning a promise of type {'a t} and returns a
+ * promise of type {'a t} which at some point in the future may be
+ * asked (by the {force} procedure) to evaluate the thunk and
+ * deliver the resulting promise.
+ *)
+
+ val memo : 'a Thunk.t UnOp.t
+ (** {memo th} is equivalent to {toThunk (delay th)}. *)
+
+ val toThunk : 'a t -> 'a Thunk.t
+ (**
+ * Converts a promise into a thunk. This can be useful for working
+ * around the value restriction, for example.
+ *)
+
+ val Y : 'a t Tie.t
+ (** Fixpoint tier for promises. *)
+end
Deleted: mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/lazy/promise.sig 2007-04-18 11:27:56 UTC (rev 5532)
@@ -1,82 +0,0 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-(**
- * Lazy promises.
- *
- * The design is based on [http://srfi.schemers.org/srfi-45/ SRFI-45]
- * ``Primitives for Expressing Iterative Lazy Algorithms'' by André van
- * Tonder.
- *
- * The general recipe to express lazy algorithms is to
- * - wrap all constructors with {delay (fn () => ...)},
- * - apply {force} to arguments of destructors, and
- * - wrap function bodies with {lazy (fn () => ...)}.
- *)
-signature PROMISE = sig
- type 'a t
- (** The abstract type of promises. *)
-
- val delay : 'a Thunk.t -> 'a t
- (**
- * Takes a thunk of type {'a thunk} and returns a promise of type
- * {'a t} which at some point in the future may be asked (by the
- * {force} procedure) to evaluate the thunk and deliver the
- * resulting value.
- *)
-
- val eager : 'a -> 'a t
- (**
- * Takes an argument of type {'a} and returns a promise of type
- * {'a t}. As opposed to {delay}, the argument is evaluated eagerly.
- *
- * Semantically, writing
- *
- *> eager expression
- *
- * is equivalent to writing
- *
- *> let val value = expression in delay (fn () => value) end
- *
- * However, the former is more efficient since it does not require
- * unnecessary creation and evaluation of thunks. We also have the
- * equivalence
- *
- *> delay (fn () => expression) = lazy (eager expression)
- *
- * assuming that evaluation of the expression does not raise an
- * exception.
- *)
-
- val force : 'a t -> 'a
- (**
- * Takes a promise of type {'a t} and returns a value of type {'a}
- * as follows: If a value of type {'a} has been computed for the
- * promise, this value is returned. Otherwise, the promise is first
- * evaluated, then overwritten by the obtained promise or value, and
- * then force is again applied (iteratively) to the promise.
- *)
-
- val lazy : 'a t Thunk.t -> 'a t
- (**
- * Takes a thunk returning a promise of type {'a t} and returns a
- * promise of type {'a t} which at some point in the future may be
- * asked (by the {force} procedure) to evaluate the thunk and
- * deliver the resulting promise.
- *)
-
- val memo : 'a Thunk.t UnOp.t
- (** {memo th} is equivalent to {toThunk (delay th)}. *)
-
- val toThunk : 'a t -> 'a Thunk.t
- (**
- * Converts a promise into a thunk. This can be useful for working
- * around the value restriction, for example.
- *)
-
- val Y : 'a t Tie.t
- (** Fixpoint tier for promises. *)
-end
Copied: mltonlib/trunk/com/ssh/misc-util/unstable/lazy-test.sml (from rev 5531, mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/lazy-test.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -0,0 +1,176 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(*
+ * Unit tests for the {Lazy} module.
+ *)
+
+val () = let
+ open Type UnitTest
+
+ val fix = Tie.fix
+
+ local
+ open Lazy
+ in
+ val D = delay
+ val E = eager
+ val F = force
+ val L = lazy
+ val Y = Y
+ end
+
+ (* lazy stream *)
+ datatype 'a stream' = NIL | CONS of 'a * 'a stream
+ withtype 'a stream = 'a stream' Lazy.t
+
+ local
+ fun strip s = case F s of NIL => raise Empty | CONS x => x
+ in
+ fun hd s = #1 (strip s)
+ fun tl s = #2 (strip s)
+ end
+
+ fun cons x = E (CONS x)
+
+ fun streamDrop (s, i) =
+ L (fn () =>
+ if 0 = i then
+ s
+ else
+ streamDrop (tl s, i - 1))
+
+ fun streamSub (s, i) = hd (streamDrop (s, i))
+
+ (* helpers *)
+ fun inc x = (x += 1 ; !x)
+in
+ unitTests
+ (title "Lazy.fix")
+
+ (testRaises
+ Fix.Fix
+ (fn () =>
+ fix Y (fn invalid =>
+ (F invalid ; E ()))))
+
+ (testEq
+ int
+ (fn () => let
+ fun streamZipWith fxy (xs, ys) =
+ D (fn () =>
+ CONS (fxy (hd xs, hd ys),
+ streamZipWith fxy (tl xs, tl ys)))
+
+ val fibs =
+ fix Y (fn fibs =>
+ 0 </cons/> 1 </cons/>
+ (streamZipWith
+ op +
+ (L (fn () => tl fibs), fibs)))
+ in
+ {expect = 8,
+ actual = streamSub (fibs, 6)}
+ end))
+
+ (title "Lazy - memoization")
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 0
+ val s = D (fn () => inc count)
+ in
+ {expect = [1, 1, 1],
+ actual = [F s, F s, !count]}
+ end))
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 0
+ val s = D (fn () => inc count)
+ in
+ {expect = [2, 1],
+ actual = [F s + F s, !count]}
+ end))
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 0
+ val r = D (fn () => inc count)
+ val s = L (Thunk.mk r)
+ val t = L (Thunk.mk s)
+ in
+ {expect = [1, 1, 1],
+ actual = [F t, F r, !count]}
+ end))
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 0
+ fun ones () = D (fn () => CONS (inc count, ones ()))
+ val s = ones ()
+ in
+ {expect = [5, 5, 5],
+ actual = [streamSub (s, 4), streamSub (s, 4), !count]}
+ end))
+
+ (title "Lazy - reentrancy")
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 0
+ val x = ref 5
+ val p = fix Y (fn p =>
+ D (fn () =>
+ if inc count > !x then
+ !count
+ else
+ F p))
+ in
+ {expect = [6, 6],
+ actual = [F p, (x := 10 ; F p)]}
+ end))
+
+ (testEq
+ int
+ (fn () => let
+ val first = ref true
+ val f = fix Y (fn f =>
+ D (fn () =>
+ if !first then
+ (first := false ; F f)
+ else
+ 2))
+ in
+ {expect = 2,
+ actual = F f}
+ end))
+
+ (testEq
+ (list int)
+ (fn () => let
+ val count = ref 5
+ val p = fix Y (fn p =>
+ D (fn () =>
+ if !count <= 0 then
+ !count
+ else
+ (count -= 1
+ ; ignore (F p)
+ ; count += 2
+ ; !count)))
+ in
+ {expect = [5, 0, 10],
+ actual = [!count, F p, !count]}
+ end))
+
+ $
+end
Modified: mltonlib/trunk/com/ssh/misc-util/unstable/prettier.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/prettier.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/prettier.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -217,15 +217,11 @@
val equals : t (** {txt "="} *)
end = struct
structure Dbg = MkDbg (open DbgDefs val name = "Prettier")
- and C = Char and S = String and SS = Substring and P = Promise
+ and C = Char and S = String and SS = Substring
- local
- open P
- in
- val E = eager
- val F = force
- val L = lazy
- end
+ val E = eager
+ val F = force
+ val L = lazy
datatype t' =
EMPTY
@@ -236,7 +232,7 @@
| CHOICE of {wide : t, narrow : t}
| COLUMN of Int.t -> t
| NESTING of Int.t -> t
- withtype t = t' P.t
+ withtype t = t' Lazy.t
datatype elem =
STRING of String.t
@@ -374,7 +370,7 @@
NIL
| PRINT of String.t * t
| LINEFEED of Int.t * t
- withtype t = t' P.t
+ withtype t = t' Lazy.t
fun layout s doc =
case F doc of
Deleted: mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/promise-test.sml 2007-04-18 11:27:56 UTC (rev 5532)
@@ -1,176 +0,0 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-(*
- * Unit tests for the {Promise} module.
- *)
-
-val () = let
- open Type UnitTest
-
- val fix = Tie.fix
-
- local
- open Promise
- in
- val D = delay
- val E = eager
- val F = force
- val L = lazy
- val Y = Y
- end
-
- (* lazy stream *)
- datatype 'a stream' = NIL | CONS of 'a * 'a stream
- withtype 'a stream = 'a stream' Promise.t
-
- local
- fun strip s = case F s of NIL => raise Empty | CONS x => x
- in
- fun hd s = #1 (strip s)
- fun tl s = #2 (strip s)
- end
-
- fun cons x = E (CONS x)
-
- fun streamDrop (s, i) =
- L (fn () =>
- if 0 = i then
- s
- else
- streamDrop (tl s, i - 1))
-
- fun streamSub (s, i) = hd (streamDrop (s, i))
-
- (* helpers *)
- fun inc x = (x += 1 ; !x)
-in
- unitTests
- (title "Promise.fix")
-
- (testRaises
- Fix.Fix
- (fn () =>
- fix Y (fn invalid =>
- (F invalid ; E ()))))
-
- (testEq
- int
- (fn () => let
- fun streamZipWith fxy (xs, ys) =
- D (fn () =>
- CONS (fxy (hd xs, hd ys),
- streamZipWith fxy (tl xs, tl ys)))
-
- val fibs =
- fix Y (fn fibs =>
- 0 </cons/> 1 </cons/>
- (streamZipWith
- op +
- (L (fn () => tl fibs), fibs)))
- in
- {expect = 8,
- actual = streamSub (fibs, 6)}
- end))
-
- (title "Promise - memoization")
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 0
- val s = D (fn () => inc count)
- in
- {expect = [1, 1, 1],
- actual = [F s, F s, !count]}
- end))
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 0
- val s = D (fn () => inc count)
- in
- {expect = [2, 1],
- actual = [F s + F s, !count]}
- end))
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 0
- val r = D (fn () => inc count)
- val s = L (Thunk.mk r)
- val t = L (Thunk.mk s)
- in
- {expect = [1, 1, 1],
- actual = [F t, F r, !count]}
- end))
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 0
- fun ones () = D (fn () => CONS (inc count, ones ()))
- val s = ones ()
- in
- {expect = [5, 5, 5],
- actual = [streamSub (s, 4), streamSub (s, 4), !count]}
- end))
-
- (title "Promise - reentrancy")
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 0
- val x = ref 5
- val p = fix Y (fn p =>
- D (fn () =>
- if inc count > !x then
- !count
- else
- F p))
- in
- {expect = [6, 6],
- actual = [F p, (x := 10 ; F p)]}
- end))
-
- (testEq
- int
- (fn () => let
- val first = ref true
- val f = fix Y (fn f =>
- D (fn () =>
- if !first then
- (first := false ; F f)
- else
- 2))
- in
- {expect = 2,
- actual = F f}
- end))
-
- (testEq
- (list int)
- (fn () => let
- val count = ref 5
- val p = fix Y (fn p =>
- D (fn () =>
- if !count <= 0 then
- !count
- else
- (count -= 1
- ; ignore (F p)
- ; count += 2
- ; !count)))
- in
- {expect = [5, 0, 10],
- actual = [!count, F p, !count]}
- end))
-
- $
-end
Modified: mltonlib/trunk/com/ssh/misc-util/unstable/test.mlb
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/test.mlb 2007-04-18 08:24:10 UTC (rev 5531)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/test.mlb 2007-04-18 11:27:56 UTC (rev 5532)
@@ -14,9 +14,9 @@
$(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
lib.mlb
+ lazy-test.sml
misc-test.sml
prettier-test.sml
- promise-test.sml
ptr-cache-test.sml
qc-test-example.sml
show-test.sml
More information about the MLton-commit
mailing list