SCM Repository
Annotation of /sml/trunk/src/cml/cml-lib/simple-rpc.sml
Parent Directory
|
Revision Log
Revision 2 - (view) (download)
1 : | monnier | 2 | (* simple-rpc.sml |
2 : | * | ||
3 : | * COPYRIGHT (c) 1997 AT&T Labs Research. | ||
4 : | * | ||
5 : | * Generators for simple RPC protocols. | ||
6 : | *) | ||
7 : | |||
8 : | structure SimpleRPC : SIMPLE_RPC = | ||
9 : | struct | ||
10 : | |||
11 : | type 'a event = 'a CML.event | ||
12 : | |||
13 : | fun mkRPC f = let | ||
14 : | val reqMb = Mailbox.mailbox() | ||
15 : | fun call arg = let | ||
16 : | val replV = SyncVar.iVar() | ||
17 : | in | ||
18 : | Mailbox.send(reqMb, (arg, replV)); | ||
19 : | SyncVar.iGet replV | ||
20 : | end | ||
21 : | val reqEvt = Mailbox.recvEvt reqMb | ||
22 : | val entry = CML.wrap ( | ||
23 : | reqEvt, | ||
24 : | fn (arg, replV) => SyncVar.iPut(replV, f arg)) | ||
25 : | in | ||
26 : | { call = call, entryEvt = entry } | ||
27 : | end | ||
28 : | |||
29 : | fun mkRPC_In f = let | ||
30 : | val reqMb = Mailbox.mailbox() | ||
31 : | fun call arg = let | ||
32 : | val replV = SyncVar.iVar() | ||
33 : | in | ||
34 : | Mailbox.send(reqMb, (arg, replV)); | ||
35 : | SyncVar.iGet replV | ||
36 : | end | ||
37 : | val reqEvt = Mailbox.recvEvt reqMb | ||
38 : | fun entry state = CML.wrap ( | ||
39 : | reqEvt, | ||
40 : | fn (arg, replV) => SyncVar.iPut(replV, f(arg, state))) | ||
41 : | in | ||
42 : | { call = call, entryEvt = entry } | ||
43 : | end | ||
44 : | |||
45 : | fun mkRPC_InOut f = let | ||
46 : | val reqMb = Mailbox.mailbox() | ||
47 : | fun call arg = let | ||
48 : | val replV = SyncVar.iVar() | ||
49 : | in | ||
50 : | Mailbox.send(reqMb, (arg, replV)); | ||
51 : | SyncVar.iGet replV | ||
52 : | end | ||
53 : | val reqEvt = Mailbox.recvEvt reqMb | ||
54 : | fun entry state = CML.wrap ( | ||
55 : | reqEvt, | ||
56 : | fn (arg, replV) => let val (res, state') = f(arg, state) | ||
57 : | in | ||
58 : | SyncVar.iPut(replV, res); state' | ||
59 : | end) | ||
60 : | in | ||
61 : | { call = call, entryEvt = entry } | ||
62 : | end | ||
63 : | |||
64 : | end |
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |