[MLton-commit] r5375

[Vesa Karvonen]

Signature tweak: expose MONAD[P]_CORE at the top-level and have a
substructure Monad : MONAD[P].  This is to make code more resistant to
changes in the MONAD[P] signatures.  The MONAD[P]_CORE signatures are
supposed to be relatively stable.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml
U   mltonlib/trunk/com/ssh/misc-util/unstable/random-gen.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml	2007-03-01 16:55:51 UTC (rev 5374)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/arbitrary.sml	2007-03-01 17:07:11 UTC (rev 5375)
@@ -45,6 +45,7 @@
              typ : 'a Typ.t}
    type 'a arbitrary_t = 'a t
 
+   val map = G.Monad.map
    val op >>= = G.>>=
 
    fun arbitrary (IN {gen, ...}) = gen
@@ -52,7 +53,7 @@
        IN {gen = gen, cog = cog, typ = typ}
 
    fun iso (IN {gen, cog, typ, ...}) (iso as (a2b, b2a)) =
-       IN {gen = G.map b2a gen,
+       IN {gen = map b2a gen,
            cog = fn n => cog n o a2b,
            typ = Typ.iso typ iso}
 
@@ -62,9 +63,9 @@
    val bool = IN {gen = G.bool,
                   cog = const (G.split o (fn false => 0w1 | true => 0w2)),
                   typ = Typ.bool}
-   val int  = IN {gen = G.map (fn w => (* XXX result may not fit an Int.int *)
-                                  W.toIntX (w - G.maxValue div 0w2))
-                              (G.lift G.value),
+   val int  = IN {gen = map (fn w => W.toIntX (w - G.maxValue div 0w2))
+                            (* XXX result may not fit an Int.int *)
+                            (G.lift G.value),
                   cog = const (G.split o W.fromInt),
                   typ = Typ.int}
    val word = IN {gen = G.lift G.value,
@@ -84,7 +85,7 @@
 
    fun (IN {gen = aGen, cog = aCog, typ = aTyp, ...}) *`
        (IN {gen = bGen, cog = bCog, typ = bTyp, ...}) =
-       IN {gen = G.>>& (aGen, bGen),
+       IN {gen = G.Monad.>>& (aGen, bGen),
            cog = fn n => fn a & b => aCog n a o G.split 0w643 o bCog n b,
            typ = Typ.*` (aTyp, bTyp)}
 
@@ -114,8 +115,8 @@
 
    fun (IN {gen = aGen, cog = aCog, typ = aTyp, ...}) +`
        (IN {gen = bGen, cog = bCog, typ = bTyp, ...}) = let
-      val aGen = G.map INL aGen
-      val bGen = G.map INR bGen
+      val aGen = map INL aGen
+      val bGen = map INR bGen
       val halve = G.resize (op div /> 2)
       val aGenHalf = G.frequency [(2, halve aGen), (1, bGen)]
       val bGenHalf = G.frequency [(1, aGen), (2, halve bGen)]
@@ -155,7 +156,7 @@
 
    fun vector a = iso (list a) Vector.isoList
 
-   val char = IN {gen = G.map chr (G.intInRange (0, Char.maxOrd)),
+   val char = IN {gen = map chr (G.intInRange (0, Char.maxOrd)),
                   cog = const (G.split o W.fromInt o ord),
                   typ = Typ.char}
 

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml	2007-03-01 16:55:51 UTC (rev 5374)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/maybe.sml	2007-03-01 17:07:11 UTC (rev 5375)
@@ -13,7 +13,8 @@
  *)
 structure Maybe :> sig
    type 'v t
-   include MONADP where type 'v monad = 'v t
+   include MONADP_CORE where type 'v monad = 'v t
+   structure Monad : MONADP where type 'v monad = 'v t
    val ` : 'a -> 'a t
    val liftBinFn : ('a * 'b -> 'c) -> 'a t * 'b t -> 'c t (* XXX move to MONAD *)
    val get : 'a t -> 'a Option.t
@@ -27,14 +28,14 @@
 end = struct
    type 'v t = 'v Option.t Thunk.t
    fun ` x = const (SOME x)
-   structure MonadP =
+   structure Monad =
      MkMonadP
        (type 'v monad = 'v t
         val return = `
         fun (aM >>= a2bM) () = case aM () of NONE => NONE | SOME a => a2bM a ()
         fun zero () = NONE
         fun plus (l, r) () = case l () of NONE => r () | r => r)
-   open MonadP
+   open Monad
    fun liftBinFn f (aM, bM) = map f (aM >>* bM)
    fun get q = q ()
    fun mk f k () = f k

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/random-gen.sig
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/random-gen.sig	2007-03-01 16:55:51 UTC (rev 5374)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/random-gen.sig	2007-03-01 17:07:11 UTC (rev 5375)
@@ -18,8 +18,10 @@
 
    val lift : (t -> 'a) -> 'a gen
 
-   include MONAD where type 'a monad = 'a gen
+   include MONAD_CORE where type 'a monad = 'a gen
 
+   structure Monad : MONAD where type 'a monad = 'a gen
+
    val promote : ('a -> 'b gen) -> ('a -> 'b) gen
 
    val sized : (Int.t -> 'a gen) -> 'a gen