Mercurial > urweb

comparison src/monoize.sml @ 614:5891f47d7cff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parameterized RPC query
author Adam Chlipala <adamc@hcoop.net>
date Sun, 15 Feb 2009 13:03:09 -0500
parents 56aaa1941dad
children 8998114760c1
comparison
equal deleted inserted replaced
613:c5991cdb0c4b 614:5891f47d7cff
2226 end 2226 end
2227 2227
2228 | L.EServerCall (n, es, ek, t) => 2228 | L.EServerCall (n, es, ek, t) =>
2229 let 2229 let
2230 val t = monoType env t 2230 val t = monoType env t
2231 val (_, _, _, name) = Env.lookupENamed env n 2231 val (_, ft, _, name) = Env.lookupENamed env n
2232 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es 2232 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
2233
2234 fun encodeArgs (es, ft, acc, fm) =
2235 case (es, ft) of
2236 ([], _) => (rev acc, fm)
2237 | (e :: es, (L.TFun (dom, ran), _)) =>
2238 let
2239 val (e, fm) = urlifyExp env fm (e, monoType env dom)
2240 in
2241 encodeArgs (es, ran, e
2242 :: (L'.EPrim (Prim.String "/"), loc)
2243 :: acc, fm)
2244 end
2245 | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type"
2246
2247 val (call, fm) = encodeArgs (es, ft, [], fm)
2248 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
2249 (L'.EPrim (Prim.String name), loc) call
2250
2233 val (ek, fm) = monoExp (env, st, fm) ek 2251 val (ek, fm) = monoExp (env, st, fm) ek
2234 2252
2235 val ekf = (L'.EAbs ("f", 2253 val ekf = (L'.EAbs ("f",
2236 (L'.TFun (t, 2254 (L'.TFun (t,
2237 (L'.TFun ((L'.TRecord [], loc), 2255 (L'.TFun ((L'.TRecord [], loc),
2244 (L'.EApp ((L'.EApp ((L'.ERel 1, loc), 2262 (L'.EApp ((L'.EApp ((L'.ERel 1, loc),
2245 (L'.ERel 0, loc)), loc), 2263 (L'.ERel 0, loc)), loc),
2246 (L'.ERecord [], loc)), loc)), loc)), loc) 2264 (L'.ERecord [], loc)), loc)), loc)), loc)
2247 val ek = (L'.EApp (ekf, ek), loc) 2265 val ek = (L'.EApp (ekf, ek), loc)
2248 in 2266 in
2249 ((L'.EServerCall (name, es, ek, t), loc), fm) 2267 ((L'.EServerCall (call, ek, t), loc), fm)
2250 end 2268 end
2251 end 2269 end
2252 2270
2253 fun monoDecl (env, fm) (all as (d, loc)) = 2271 fun monoDecl (env, fm) (all as (d, loc)) =
2254 let 2272 let