[MLton-commit] r5736

Vesa Karvonen vesak at mlton.org
Sat Jul 7 10:07:54 PDT 2007


Changed variant to take a word instead of an int.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
U   mltonlib/trunk/com/ssh/random/unstable/detail/mk-random-gen.fun
U   mltonlib/trunk/com/ssh/random/unstable/public/random-gen.sig

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml	2007-07-07 15:57:18 UTC (rev 5735)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml	2007-07-07 17:07:52 UTC (rev 5736)
@@ -71,10 +71,10 @@
               | _            => gen
       in
          IN {gen = G.sized (fn 0 => gen0 | _ => gen),
-             cog = fn INL a => G.variant 0 o cogS aS a
-                    | INR b => G.variant 1 o cogS bS b}
+             cog = fn INL a => G.variant 0w0 o cogS aS a
+                    | INR b => G.variant 0w1 o cogS bS b}
       end
-      val unit = IN {gen = G.return (), cog = const (G.variant 0)}
+      val unit = IN {gen = G.return (), cog = const (G.variant 0w0)}
       fun C0 _ = unit
       fun C1 _ = getT
       val data = getS
@@ -95,9 +95,9 @@
 
       fun list' (IN {gen = xGen, cog = xCog}) = let
          val xsGen = G.sized (0 <\ G.intInRange) >>= G.list xGen
-         fun xsCog [] = G.variant 0
+         fun xsCog [] = G.variant 0w0
            | xsCog (x::xs) =
-             universally (xCog x) o G.variant 1 o universally (xsCog xs)
+             universally (xCog x) o G.variant 0w1 o universally (xsCog xs)
       in
          IN {gen = xsGen, cog = xsCog}
       end
@@ -109,16 +109,16 @@
       fun refc a = iso' (getT a) (!, ref)
 
       val char = IN {gen = map chr (G.intInRange (0, Char.maxOrd)),
-                     cog = G.variant o ord}
+                     cog = G.variant o W.fromInt o ord}
       val string as IN {cog = stringCog, ...} = iso' (list' char) String.isoList
 
-      val bool = IN {gen = G.bool, cog = G.variant o Bool.toInt}
+      val bool = IN {gen = G.bool, cog = G.variant o W.fromInt o Bool.toInt}
 
       val int = IN {gen = map (fn w => W.toIntX (w - G.RNG.maxValue div 0w2))
                               (* XXX result may not fit an Int.t *)
                               (G.lift G.RNG.value),
-                    cog = G.variant}
-      val word = IN {gen = G.lift G.RNG.value, cog = G.variant o W.toIntX}
+                    cog = G.variant o W.fromInt}
+      val word = IN {gen = G.lift G.RNG.value, cog = G.variant}
       val real = IN {gen = G.sized ((fn r => G.realInRange (~r, r)) o real),
                      cog = stringCog o R.toString} (* XXX Real cog *)
 

Modified: mltonlib/trunk/com/ssh/random/unstable/detail/mk-random-gen.fun
===================================================================
--- mltonlib/trunk/com/ssh/random/unstable/detail/mk-random-gen.fun	2007-07-07 15:57:18 UTC (rev 5735)
+++ mltonlib/trunk/com/ssh/random/unstable/detail/mk-random-gen.fun	2007-07-07 17:07:52 UTC (rev 5736)
@@ -41,7 +41,7 @@
 
    fun promote a2b (n, r) a = a2b a (n, r)
 
-   fun variant v m = m o Pair.map (id, RNG.split (W.fromInt v + 0w1))
+   fun variant v m = m o Pair.map (id, RNG.split v)
 
    fun mapUnOp (to, from) eG2eG = let
       fun map f g = f o g

Modified: mltonlib/trunk/com/ssh/random/unstable/public/random-gen.sig
===================================================================
--- mltonlib/trunk/com/ssh/random/unstable/public/random-gen.sig	2007-07-07 15:57:18 UTC (rev 5735)
+++ mltonlib/trunk/com/ssh/random/unstable/public/random-gen.sig	2007-07-07 17:07:52 UTC (rev 5736)
@@ -27,7 +27,7 @@
 
    val Y : 'a t Tie.t
 
-   val variant : Int.t -> 'a t UnOp.t
+   val variant : Word.t -> 'a t UnOp.t
    val mapUnOp : ('a, 'b) Iso.t -> 'b t UnOp.t -> 'a t UnOp.t
 
    val sized : (Int.t -> 'a t) -> 'a t




More information about the MLton-commit mailing list