diff src/rpcify.sml @ 609:56aaa1941dad

First gimpy RPC
author Adam Chlipala <adamc@hcoop.net>
date Sun, 15 Feb 2009 10:32:50 -0500
parents 330a7de47914
children c5991cdb0c4b
line wrap: on
line diff
--- a/src/rpcify.sml	Sun Feb 15 09:27:36 2009 -0500
+++ b/src/rpcify.sml	Sun Feb 15 10:32:50 2009 -0500
@@ -98,6 +98,29 @@
         val serverSide = sideish (ssBasis, ssids)
         val clientSide = sideish (csBasis, csids)
 
+        val tfuncs = foldl
+                     (fn ((d, _), tfuncs) =>
+                         let
+                             fun doOne ((_, n, t, _, _), tfuncs) =
+                                 let
+                                     fun crawl ((t, _), args) =
+                                         case t of
+                                             CApp ((CFfi ("Basis", "transaction"), _), ran) => SOME (rev args, ran)
+                                           | TFun (arg, rest) => crawl (rest, arg :: args)
+                                           | _ => NONE
+                                 in
+                                     case crawl (t, []) of
+                                         NONE => tfuncs
+                                       | SOME sg => IM.insert (tfuncs, n, sg)
+                                 end
+                         in
+                             case d of
+                                 DVal vi => doOne (vi, tfuncs)
+                               | DValRec vis => foldl doOne tfuncs vis
+                               | _ => tfuncs
+                         end)
+                     IM.empty file
+                             
         fun exp (e, st) =
             case e of
                 EApp (
@@ -130,8 +153,13 @@
 
                                    exported = exported,
                                    export_decls = export_decls}
+
+                         val ran =
+                             case IM.find (tfuncs, n) of
+                                 NONE => raise Fail "Rpcify: Undetected transaction function"
+                               | SOME (_, ran) => ran
                      in
-                         (EServerCall (n, args, trans2), st)
+                         (EServerCall (n, args, trans2, ran), st)
                      end
                    | _ => (e, st))
               | _ => (e, st)