diff src/monoize.sml @ 614:5891f47d7cff

Parameterized RPC query
author Adam Chlipala <adamc@hcoop.net>
date Sun, 15 Feb 2009 13:03:09 -0500
parents 56aaa1941dad
children 8998114760c1
line wrap: on
line diff
--- a/src/monoize.sml	Sun Feb 15 12:33:41 2009 -0500
+++ b/src/monoize.sml	Sun Feb 15 13:03:09 2009 -0500
@@ -2228,8 +2228,26 @@
           | L.EServerCall (n, es, ek, t) =>
             let
                 val t = monoType env t
-                val (_, _, _, name) = Env.lookupENamed env n
+                val (_, ft, _, name) = Env.lookupENamed env n
                 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
+
+                fun encodeArgs (es, ft, acc, fm) =
+                    case (es, ft) of
+                        ([], _) => (rev acc, fm)
+                      | (e :: es, (L.TFun (dom, ran), _)) =>
+                        let
+                            val (e, fm) = urlifyExp env fm (e, monoType env dom)
+                        in
+                            encodeArgs (es, ran, e
+                                                 :: (L'.EPrim (Prim.String "/"), loc)
+                                                 :: acc, fm)
+                        end
+                      | _ => raise Fail "Monoize: Not enough arguments visible in RPC function type"
+
+                val (call, fm) = encodeArgs (es, ft, [], fm)
+                val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
+                                 (L'.EPrim (Prim.String name), loc) call
+
                 val (ek, fm) = monoExp (env, st, fm) ek
 
                 val ekf = (L'.EAbs ("f",
@@ -2246,7 +2264,7 @@
                                                         (L'.ERecord [], loc)), loc)), loc)), loc)
                 val ek = (L'.EApp (ekf, ek), loc)
             in
-                ((L'.EServerCall (name, es, ek, t), loc), fm)
+                ((L'.EServerCall (call, ek, t), loc), fm)
             end
     end