[MLton-commit] r6932

[Vesa Karvonen]

Distinguish between active and passive sockets.  Hmm... Does MLton
properly implement the phantom typing of sockets?

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

U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/socket-events.sml

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

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml	2008-10-13 23:05:51 UTC (rev 6931)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml	2008-10-13 23:19:41 UTC (rev 6932)
@@ -20,11 +20,12 @@
 
    structure Conn = struct
       datatype t =
-         IN of {socket : socket,
+         IN of {socket : Socket.active socket,
                 token : Token.t Ref.t,
                 live : {token : Token.t,
                         setExn : Exn.t Effect.t,
-                        recvCod : Unit.t monad} ResizableArray.t}
+                        recvCod : (Unit.t, Socket.active) monad}
+                        ResizableArray.t}
 
       fun close (IN {socket, ...}) =
           Socket.close socket

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml	2008-10-13 23:05:51 UTC (rev 6931)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml	2008-10-13 23:19:41 UTC (rev 6932)
@@ -5,9 +5,9 @@
  *)
 
 structure Protocol :> sig
-   val skip : Unit.t SocketEvents.monad
-   val recv : 'a Rep.t -> 'a SocketEvents.monad
-   val send : 'a Rep.t -> 'a -> Unit.t SocketEvents.monad
+   val skip : (Unit.t, Socket.active) SocketEvents.monad
+   val recv : 'a Rep.t -> ('a, Socket.active) SocketEvents.monad
+   val send : 'a Rep.t -> 'a -> (Unit.t, Socket.active) SocketEvents.monad
 
    structure Fingerprint : sig
       eqtype t
@@ -28,8 +28,8 @@
          CALL of {token : Token.t,
                   fingerprint : Fingerprint.t} (* value *)
       val t : t Rep.t
-      val recv : t SocketEvents.monad
-      val send : t -> Unit.t SocketEvents.monad
+      val recv : (t, Socket.active) SocketEvents.monad
+      val send : t -> (Unit.t, Socket.active) SocketEvents.monad
    end
 
    structure Reply : sig
@@ -38,15 +38,15 @@
        | RESULT of Token.t (* value *)
        | EXN of Token.t (* value *)
       val t : t Rep.t
-      val recv : t SocketEvents.monad
-      val send : t -> Unit.t SocketEvents.monad
+      val recv : (t, Socket.active) SocketEvents.monad
+      val send : t -> (Unit.t, Socket.active) SocketEvents.monad
    end
 
    structure Version : sig
       eqtype t
       val current : t
-      val recv : t SocketEvents.monad
-      val send : t -> Unit.t SocketEvents.monad
+      val recv : (t, Socket.active) SocketEvents.monad
+      val send : t -> (Unit.t, Socket.active) SocketEvents.monad
    end
 end = struct
    open SocketEvents

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml	2008-10-13 23:05:51 UTC (rev 6931)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml	2008-10-13 23:19:41 UTC (rev 6932)
@@ -9,7 +9,7 @@
 
    val entries :
        {fingerprint : Fingerprint.t,
-        procedure : Token.t -> Unit.t monad} List.t Ref.t =
+        procedure : Token.t -> (Unit.t, Socket.active) monad} List.t Ref.t =
        ref []
 
    fun find fingerprint =

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/socket-events.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/socket-events.sml	2008-10-13 23:05:51 UTC (rev 6931)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/socket-events.sml	2008-10-13 23:19:41 UTC (rev 6932)
@@ -7,27 +7,28 @@
 structure SocketEvents :> sig
    exception Closed
 
-   type socket = Socket.active INetSock.stream_sock
+   type 'm socket = 'm INetSock.stream_sock
 
-   include MONAD_CORE
-   where type 'a monad = socket -> (Exn.t, 'a) Sum.t Async.Event.t
+   type ('a, 'm) monad = 'm socket -> (Exn.t, 'a) Sum.t Async.Event.t
+   val return : 'a -> ('a, 'm) monad
+   val >>= : ('a, 'm) monad * ('a -> ('b, 'm) monad) -> ('b, 'm) monad
 
-   val error : Exn.t -> 'a monad
+   val error : Exn.t -> ('a, 'm) monad
 
-   val sockEvt : OS.IO.poll_desc UnOp.t -> socket monad
+   val sockEvt : OS.IO.poll_desc UnOp.t -> ('m socket, 'm) monad
 
-   val recv : Word8ArraySlice.t -> Word8ArraySlice.t monad
+   val recv : Word8ArraySlice.t -> (Word8ArraySlice.t, Socket.active) monad
 
-   val sendArr : Word8ArraySlice.t -> Unit.t monad
-   val sendVec : Word8VectorSlice.t -> Unit.t monad
+   val sendArr : Word8ArraySlice.t -> (Unit.t, Socket.active) monad
+   val sendVec : Word8VectorSlice.t -> (Unit.t, Socket.active) monad
 end = struct
    open PollLoop Async
 
    exception Closed
 
-   type socket = Socket.active INetSock.stream_sock
+   type 'm socket = 'm INetSock.stream_sock
 
-   type 'a monad = socket -> (Exn.t, 'a) Sum.t Async.Event.t
+   type ('a, 'm) monad = 'm socket -> (Exn.t, 'a) Sum.t Async.Event.t
    fun error e _ =
        case IVar.new ()
         of result => (IVar.fill result (INL e) ; IVar.read result)
@@ -83,10 +84,10 @@
                        | SOME n =>
                          lp (subslice (slice, n, NONE))))
    in
-      val sendArr : Word8ArraySlice.t -> Unit.t monad =
+      val sendArr : Word8ArraySlice.t -> (Unit.t, Socket.active) monad =
           mk Word8ArraySlice.isEmpty Word8ArraySlice.subslice Socket.sendArrNB
 
-      val sendVec : Word8VectorSlice.t -> Unit.t monad =
+      val sendVec : Word8VectorSlice.t -> (Unit.t, Socket.active) monad =
           mk Word8VectorSlice.isEmpty Word8VectorSlice.subslice Socket.sendVecNB
    end
 end