[MLton-commit] r5381

[Vesa Karvonen]

Changed Reader and Writer to use the MONAD and CFUNC signatures without
the extra type parameter.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml	2007-03-02 06:57:39 UTC (rev 5380)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/reader.sml	2007-03-02 08:58:11 UTC (rev 5381)
@@ -5,23 +5,26 @@
  *)
 
 structure Reader :> READER = struct
+   open Reader
+
    infix >>=
 
+   type s = Univ.t
+
    structure Monad =
-      MkMonad'
-         (type ('a, 's) monad = ('a, 's) Reader.t
+      MkMonadP
+         (type 'a monad = ('a, s) Reader.t
           fun return a s = SOME (a, s)
-          fun rA >>= a2rB = Option.mapPartial (Fn.uncurry a2rB) o rA)
+          fun aM >>= a2bM = Option.mapPartial (Fn.uncurry a2bM) o aM
+          fun zero _ = NONE
+          fun plus (lM, rM) s = case lM s of NONE => rM s | result => result)
 
-   open Reader Monad
+   open Monad
 
-   type univ = Univ.t
-   type 'a u = ('a, univ) t
-
-   fun polymorphically uA2uB = let
+   fun polymorphically aM2bM = let
       val (to, from) = Univ.newIso ()
       fun map f = Option.map (Pair.map (Fn.id, f))
    in
-      Fn.map (to, map from) o uA2uB o Fn.map (from, map to)
+      Fn.map (to, map from) o aM2bM o Fn.map (from, map to)
    end
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml	2007-03-02 06:57:39 UTC (rev 5380)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/writer.sml	2007-03-02 08:58:11 UTC (rev 5381)
@@ -7,12 +7,11 @@
 structure Writer :> WRITER = struct
    open Writer
 
-   type ('a, 's) func = ('a, 's) t
+   type s = Univ.t
+
+   type 'a func = ('a, s) t
    fun map b2a wA = wA o Pair.map (b2a, Fn.id)
 
-   type univ = Univ.t
-   type 'a u = ('a, univ) t
-
    fun polymorphically uA2uB = let
       val (to, from) = Univ.newIso ()
       fun map f = Pair.map (Fn.id, f)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig	2007-03-02 06:57:39 UTC (rev 5380)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/reader.sig	2007-03-02 08:58:11 UTC (rev 5381)
@@ -8,12 +8,11 @@
 signature READER = sig
    type ('a, 's) t = 's -> ('a * 's) Option.t
 
-   include MONAD' where type ('a, 's) monad = ('a, 's) t
+   (** == Monad Interface == *)
 
-   (** == Typing == *)
+   type s
+   include MONADP_CORE where type 'a monad = ('a, s) t
+   structure Monad : MONADP where type 'a monad = ('a, s) t
 
-   type univ
-   type 'a u = ('a, univ) t
-
-   val polymorphically : ('a u -> 'b u) -> ('a, 's) t -> ('b, 's) t
+   val polymorphically : ('a monad -> 'b monad) -> ('a, 's) t -> ('b, 's) t
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig	2007-03-02 06:57:39 UTC (rev 5380)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/writer.sig	2007-03-02 08:58:11 UTC (rev 5381)
@@ -8,12 +8,10 @@
 signature WRITER = sig
    type ('a, 's) t = 'a * 's -> 's
 
-   include CFUNC' where type ('a, 's) func = ('a, 's) t
+   (** == Functor Interface == *)
 
-   (** == Typing == *)
+   type s
+   include CFUNC where type 'a func = ('a, s) t
 
-   type univ
-   type 'a u = ('a, univ) t
-
-   val polymorphically : ('a u -> 'b u) -> ('a, 's) t -> ('b, 's) t
+   val polymorphically : ('a func -> 'b func) -> ('a, 's) t -> ('b, 's) t
 end