Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cml/cml-lib/mk-rpc.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/cml-lib/mk-rpc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* mk-rpc.sml
2 :     *
3 :     *)
4 :    
5 :     structure MakeRPC =
6 :     struct
7 :    
8 :     fun mkRPC (f : 'a -> '_b -> ('a * '_c)) = let
9 :     val (reqCh : ('_b * '_c CML.cond_var) CML.chan) = CML.channel ()
10 :     (* the client side call *)
11 :     fun call arg = let
12 :     val reply = CML.condVar ()
13 :     in
14 :     CML.send (reqCh, (arg, reply));
15 :     CML.readVar reply
16 :     end
17 :     (* the server side entry event *)
18 :     fun entry state = let
19 :     fun doCall (arg, replyV) = let
20 :     val (newState, result) = f state arg
21 :     in
22 :     CML.writeVar(replyV, result);
23 :     newState
24 :     end
25 :     in
26 :     CML.wrap(CML.receive reqCh, doCall)
27 :     end
28 :     in
29 :     {call=call, entry=entry}
30 :     end
31 :    
32 :     fun server entries initState = let
33 :     fun bind state f = f state
34 :     fun select state = CML.select (map (bind state) entries)
35 :     fun loop state = loop(select state)
36 :     in
37 :     CML.spawn (fn () => loop initState);
38 :     ()
39 :     end
40 :    
41 :     end;
42 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0