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/eXene/lib/iccc/atom-server.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/iccc/atom-server.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* atom-server.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * A Client-side server for atoms.
6 :     *)
7 :    
8 :     signature ATOM_SERVER =
9 :     sig
10 :    
11 :     type atom = XProtTypes.atom
12 :     type atom_server
13 :    
14 :     val mkServer : XDisplay.xdisplay -> atom_server
15 :    
16 :     val internAtom : atom_server -> string -> atom
17 :     val lookupAtom : atom_server -> string -> atom option
18 :     val nameOfAtom : atom_server -> atom -> string
19 :    
20 :     end (* ATOM_SERVER *)
21 :    
22 :     structure AtomServer : ATOM_SERVER =
23 :     struct
24 :    
25 :     type atom = XProtTypes.atom
26 :    
27 :     datatype request
28 :     = REQ_intern of (string * atom SyncVar.ivar)
29 :     | REQ_lookup of (string * atom option SyncVar.ivar)
30 :     | REQ_name of (atom * string SyncVar.ivar)
31 :    
32 :     datatype atom_server = AtomServer of request CML.chan
33 :    
34 :     fun intern conn arg = XReply.decodeInternAtomReply (
35 :     CML.sync (XIo.requestReply conn (XRequest.encodeInternAtom arg)))
36 :    
37 :     fun mkServer (XDisplay.XDPY{conn, ...}) = let
38 :     val reqCh = CML.channel()
39 :     (** NOTE: we are currently not using the local table; we also need to have
40 :     ** a string --> atom mapping, and should initialize it with the standard atoms.
41 :     **)
42 :     val atomTbl = XAtomTbl.mkTable (32, Fail "AtomTbl")
43 :     val insert = XAtomTbl.insert atomTbl
44 :     val find = XAtomTbl.find atomTbl
45 :     fun handleReq (REQ_intern(id, replyV)) =
46 :     SyncVar.iPut(replyV, intern conn {name = id, only_if_exists = false})
47 :     | handleReq (REQ_lookup(id, replyV)) = (
48 :     case (intern conn {name = id, only_if_exists = true})
49 :     of (XProtTypes.XAtom 0w0) => SyncVar.iPut(replyV, NONE)
50 :     | atom => SyncVar.iPut(replyV, SOME atom)
51 :     (* end case *))
52 :     | handleReq (REQ_name(atom, replyV)) = let
53 :     val name = XReply.decodeGetAtomNameReply (
54 :     CML.sync (XIo.requestReply conn
55 :     (XRequest.encodeGetAtomName{atom = atom})))
56 :     in
57 :     SyncVar.iPut(replyV, name)
58 :     end
59 :     fun loop () = (handleReq(CML.recv reqCh); loop())
60 :     in
61 :     CML.spawn loop;
62 :     AtomServer reqCh
63 :     end (* mkServer *)
64 :    
65 :     fun rpc reqFn (AtomServer reqCh) arg = let
66 :     val replyV = SyncVar.iVar()
67 :     in
68 :     CML.send(reqCh, reqFn(arg, replyV));
69 :     SyncVar.iGet replyV
70 :     end
71 :    
72 :     val internAtom = rpc REQ_intern
73 :     val lookupAtom = rpc REQ_lookup
74 :     val nameOfAtom = rpc REQ_name
75 :    
76 :     end; (* AtomServer *)
77 :    

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