[MLton-commit] r6948

[Vesa Karvonen]

Factored out the procedure signatures to a function (mkLib) that is used in
both the client and the server.

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

U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.mlb
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.use
A   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/common.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.mlb
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml
U   mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.use

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

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.mlb	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.mlb	2008-10-17 22:57:20 UTC (rev 6948)
@@ -15,6 +15,7 @@
    "warnUnused true"
 in
    local
+      common.sml
       client.sml
    in
    end

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml	2008-10-17 22:57:20 UTC (rev 6948)
@@ -7,25 +7,16 @@
 val conn = Client.Conn.byName {host = "127.0.0.1", port = 45678}
 
 local
-   fun mk signature' conn =
-       Client.Reply.sync o Client.declare signature' conn
+   fun mk s = verbose "client: " s (Client.Reply.sync o Client.declare s conn)
 in
-   val bind = mk (Pair.t (String.t, Int.t), Unit.t, "bind") conn
-   val find = mk (String.t, Option.t Int.t, "find") conn
-   val bindings =
-       mk (Unit.t, List.t (Pair.t (String.t, Int.t)), "bindings") conn
+   val {bind, bindings, find} =
+       mkLib {bind = mk, bindings = mk, find = mk}
 end
 
-fun tell x =
-    printlns [x, " => ",
-              case find x
-               of NONE => "undefined"
-                | SOME x => Int.toString x]
-
 val () =
-    (tell "x"
+    (find "x" >| ignore
    ; bind ("x", 1234)
-   ; tell "x"
-   ; println (Generic.show (List.t (Pair.t (String.t, Int.t))) (bindings ())))
+   ; find "x" >| ignore
+   ; bindings () >| ignore)
 
 val () = Client.Conn.close conn

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.use
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.use	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.use	2008-10-17 22:57:20 UTC (rev 6948)
@@ -7,4 +7,5 @@
 lib ["${MLTON_LIB}/com/ssh/extended-basis/unstable/basis.use",
      "../lib-client.use",
      "${APPLICATION}/generic.use",
+     "common.sml",
      "client.sml"] ;

Added: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/common.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/common.sml	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/common.sml	2008-10-17 22:57:20 UTC (rev 6948)
@@ -0,0 +1,21 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+fun mkLib {bind, bindings, find} =
+    {bind = bind (Pair.t (String.t, Int.t), Unit.t, "bind"),
+     bindings =
+      bindings (Unit.t, List.t (Pair.t (String.t, Int.t)), "bindings"),
+     find = find (String.t, Option.t Int.t, "find")}
+
+fun verbose h (d, c, n) f x =
+    try (fn () => f x,
+         fn y =>
+            (printlns [h, n, " ", Generic.show d x, " => ", Generic.show c y]
+           ; y),
+         fn e =>
+            (printlns
+              [h, n, " ", Generic.show d x, " raised ", Generic.show Exn.t e]
+           ; raise e))


Property changes on: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/common.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.mlb	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.mlb	2008-10-17 22:57:20 UTC (rev 6948)
@@ -15,6 +15,7 @@
    "warnUnused true"
 in
    local
+      common.sml
       server.sml
    in
    end

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml	2008-10-17 22:57:20 UTC (rev 6948)
@@ -15,11 +15,9 @@
 val () = let
    open Server
    val procMap = ProcMap.new ()
-   fun add ? = ProcMap.add procMap ?
+   fun ` f s = ProcMap.add procMap s (verbose "server: " s f)
 in
-   add (Pair.t (String.t, Int.t), Unit.t, "bind") bind
- ; add (String.t, Option.t Int.t, "find") find
- ; add (Unit.t, List.t (Pair.t (String.t, Int.t)), "bindings") bindings
+   mkLib {bind = `bind, bindings = `bindings, find = `find} >| ignore
  ; TCP.start procMap let
       open TCP.Opts
    in

Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.use
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.use	2008-10-17 20:01:48 UTC (rev 6947)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.use	2008-10-17 22:57:20 UTC (rev 6948)
@@ -7,4 +7,5 @@
 lib ["${MLTON_LIB}/com/ssh/extended-basis/unstable/basis.use",
      "../lib-server.use",
      "${APPLICATION}/generic.use",
+     "common.sml",
      "server.sml"] ;