Mercurial > urweb

comparison src/rpcify.sml @ 679:44f23712020d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Chat example working nicely, but without dead channel removal
author Adam Chlipala <adamc@hcoop.net>
date Thu, 26 Mar 2009 18:26:50 -0400
parents f73913d97a40
children 9b29ce0babb8
comparison
equal deleted inserted replaced
678:5ff1ff38e2db 679:44f23712020d
49 val ssBasis = SS.addList (SS.empty, 49 val ssBasis = SS.addList (SS.empty,
50 ["requestHeader", 50 ["requestHeader",
51 "query", 51 "query",
52 "dml", 52 "dml",
53 "nextval", 53 "nextval",
54 "new_channel", 54 "channel",
55 "subscribe", 55 "subscribe",
56 "send"]) 56 "send"])
57 57
58 val csBasis = SS.addList (SS.empty, 58 val csBasis = SS.addList (SS.empty,
59 ["source", 59 ["get",
60 "get",
61 "set", 60 "set",
62 "alert", 61 "alert",
63 "recv"]) 62 "recv"])
64 63
65 type state = { 64 type state = {
74 } 73 }
75 74
76 fun frob file = 75 fun frob file =
77 let 76 let
78 fun sideish (basis, ssids) e = 77 fun sideish (basis, ssids) e =
79 case #1 e of 78 U.Exp.exists {kind = fn _ => false,
80 ERecord _ => false 79 con = fn _ => false,
81 | _ => 80 exp = fn ENamed n => IS.member (ssids, n)
82 U.Exp.exists {kind = fn _ => false, 81 | EFfi ("Basis", x) => SS.member (basis, x)
83 con = fn _ => false, 82 | EFfiApp ("Basis", x, _) => SS.member (basis, x)
84 exp = fn ENamed n => IS.member (ssids, n) 83 | _ => false}
85 | EFfi ("Basis", x) => SS.member (basis, x) 84 (U.Exp.map {kind = fn x => x,
86 | EFfiApp ("Basis", x, _) => SS.member (basis, x) 85 con = fn x => x,
87 | _ => false} e 86 exp = fn ERecord _ => ERecord []
87 | x => x} e)
88 88
89 fun whichIds basis = 89 fun whichIds basis =
90 let 90 let
91 fun decl ((d, _), ssids) = 91 fun decl ((d, _), ssids) =
92 let 92 let
154 in 154 in
155 case #1 e' of 155 case #1 e' of
156 ENamed n => (n, args) 156 ENamed n => (n, args)
157 | EApp (e1, e2) => getApp (e1, e2 :: args) 157 | EApp (e1, e2) => getApp (e1, e2 :: args)
158 | _ => (ErrorMsg.errorAt loc "Mixed client/server code doesn't use a named function for server part"; 158 | _ => (ErrorMsg.errorAt loc "Mixed client/server code doesn't use a named function for server part";
159 Print.prefaces "Bad" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))]; 159 (*Print.prefaces "Bad" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*)
160 (0, [])) 160 (0, []))
161 end 161 end
162 162
163 fun newRpc (trans1, trans2, st : state) = 163 fun newRpc (trans1, trans2, st : state) =
164 let 164 let
182 182
183 maxName = #maxName st} 183 maxName = #maxName st}
184 184
185 val ran = 185 val ran =
186 case IM.find (tfuncs, n) of 186 case IM.find (tfuncs, n) of
187 NONE => (Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))]; 187 NONE => ((*Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];*)
188 raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n)) 188 raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n))
189 | SOME (_, _, ran, _) => ran 189 | SOME (_, _, ran, _) => ran
190 190
191 val e' = EServerCall (n, args, trans2, ran) 191 val e' = EServerCall (n, args, trans2, ran)
192 in 192 in