comparison src/tag.sml @ 1946:f1485ed65d6c

Avoid some spurious error messages about link/form incompatibility; change the text of that error message to include RPC handlers
author Adam Chlipala <adam@chlipala.net>
date Sun, 29 Dec 2013 10:29:26 -0500
parents 6745eafff617
children
comparison
equal deleted inserted replaced
1945:8b1692660dac 1946:f1485ed65d6c
39 end) 39 end)
40 40
41 fun kind (k, s) = (k, s) 41 fun kind (k, s) = (k, s)
42 fun con (c, s) = (c, s) 42 fun con (c, s) = (c, s)
43 43
44 fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for both a link and a form"); 44 fun both (loc, f) = (ErrorMsg.errorAt loc ("Function " ^ f ^ " needed for multiple modes (link, form, RPC handler).");
45 TextIO.output (TextIO.stdErr, 45 TextIO.output (TextIO.stdErr,
46 "Make sure that the signature of the containing module hides any form handlers.\n")) 46 "Make sure that the signature of the containing module hides any form/RPC handlers.\n"))
47 47
48 fun exp env (e, s) = 48 fun exp env (e, s) =
49 let 49 let
50 fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) = 50 fun tagIt (e, ek : export_kind, newAttr, (count, tags, byTag, newTags)) =
51 let 51 let
143 in 143 in
144 (((CName newAttr, loc), e', t), s) 144 (((CName newAttr, loc), e', t), s)
145 end 145 end
146 in 146 in
147 case x of 147 case x of
148 (CName "Link", _) => tagIt' (Link ReadWrite, "Link") 148 (CName "Link", _) => tagIt' (Link ReadCookieWrite, "Link")
149 | (CName "Action", _) => tagIt' (Action ReadWrite, "Action") 149 | (CName "Action", _) => tagIt' (Action ReadWrite, "Action")
150 | _ => ((x, e, t), s) 150 | _ => ((x, e, t), s)
151 end) 151 end)
152 s xets 152 s xets
153 in 153 in
178 178
179 | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s) 179 | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s)
180 180
181 | EFfiApp ("Basis", "url", [(e, t)]) => 181 | EFfiApp ("Basis", "url", [(e, t)]) =>
182 let 182 let
183 val (e, s) = tagIt (e, Link ReadWrite, "Url", s) 183 val (e, s) = tagIt (e, Link ReadCookieWrite, "Url", s)
184 in 184 in
185 (EFfiApp ("Basis", "url", [(e, t)]), s) 185 (EFfiApp ("Basis", "url", [(e, t)]), s)
186 end 186 end
187 187
188 | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s) 188 | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s)
199 val (_, _, eo, _) = E.lookupENamed env n 199 val (_, _, eo, _) = E.lookupENamed env n
200 in 200 in
201 case eo of 201 case eo of
202 SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => 202 SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) =>
203 let 203 let
204 val (e, s) = tagIt (e', Link ReadWrite, "Url", s) 204 val (e, s) = tagIt (e', Link ReadCookieWrite, "Url", s)
205 in 205 in
206 (EFfiApp ("Basis", "url", [(e, t)]), s) 206 (EFfiApp ("Basis", "url", [(e, t)]), s)
207 end 207 end
208 | _ => (e, s) 208 | _ => (e, s)
209 end 209 end