diff src/rpcify.sml @ 957:2831be2daf2e

Grid changed to use Dlist.replace; filters stopped working
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Sep 2009 19:01:04 -0400
parents d80734855790
children dfe34fad749d
line wrap: on
line diff
--- a/src/rpcify.sml	Thu Sep 17 17:17:49 2009 -0400
+++ b/src/rpcify.sml	Thu Sep 17 19:01:04 2009 -0400
@@ -32,26 +32,12 @@
 structure U = CoreUtil
 structure E = CoreEnv
 
-fun multiLiftExpInExp n e =
-    if n = 0 then
-        e
-    else
-        multiLiftExpInExp (n - 1) (E.liftExpInExp 0 e)
-
 structure IS = IntBinarySet
 structure IM = IntBinaryMap
 
-structure SS = BinarySetFn(struct
-                           type ord_key = string
-                           val compare = String.compare
-                           end)
-
 type state = {
      exported : IS.set,
-     export_decls : decl list,
-
-     cpsed : exp' IM.map,
-     rpc : IS.set
+     export_decls : decl list
 }
 
 fun frob file =
@@ -124,9 +110,7 @@
                                          (DExport (Rpc ReadWrite, n), loc) :: #export_decls st)
 
                                 val st = {exported = exported,
-                                          export_decls = export_decls,
-                                          cpsed = #cpsed st,
-                                          rpc = #rpc st}
+                                          export_decls = export_decls}
 
                                 val k = (ECApp ((EFfi ("Basis", "return"), loc),
                                                 (CFfi ("Basis", "transaction"), loc)), loc)
@@ -145,11 +129,6 @@
                     else
                         (e, st)
 
-                  | ENamed n =>
-                    (case IM.find (#cpsed st, n) of
-                         NONE => (e, st)
-                       | SOME re => (re, st))
-
                   | _ => (e, st)
             end
 
@@ -159,99 +138,6 @@
 
         fun decl (d, st : state) =
             let
-                val makesServerCall = U.Exp.exists {kind = fn _ => false,
-                                                    con = fn _ => false,
-                                                    exp = fn EFfi ("Basis", "rpc") => true
-                                                           | ENamed n => IS.member (#rpc st, n)
-                                                           | _ => false}
-
-                val (d, st) =
-                    case #1 d of
-                        DValRec vis =>
-                        if List.exists (fn (_, _, _, e, _) => makesServerCall e) vis then
-                            let
-                                val rpc = foldl (fn ((_, n, _, _, _), rpc) =>
-                                                    IS.add (rpc, n)) (#rpc st) vis
-
-                                val (cpsed, vis') =
-                                    foldl (fn (vi as (x, n, t, e, s), (cpsed, vis')) =>
-                                              let
-                                                  fun getArgs (t, acc) =
-                                                      case #1 t of
-                                                          TFun (dom, ran) =>
-                                                          getArgs (ran, dom :: acc)
-                                                        | _ => (rev acc, t)
-                                                  val (ts, ran) = getArgs (t, [])
-                                                  val ran = case #1 ran of
-                                                                CApp (_, ran) => ran
-                                                              | _ => raise Fail "Rpcify: Tail function not transactional"
-                                                  val len = length ts
-
-                                                  val loc = #2 e
-                                                  val args = ListUtil.mapi
-                                                                 (fn (i, _) =>
-                                                                     (ERel (len - i - 1), loc))
-                                                                 ts
-                                                  val k = (EFfi ("Basis", "return"), loc)
-                                                  val trans = (CFfi ("Basis", "transaction"), loc)
-                                                  val k = (ECApp (k, trans), loc)
-                                                  val k = (ECApp (k, ran), loc)
-                                                  val k = (EApp (k, (EFfi ("Basis", "transaction_monad"),
-                                                                     loc)), loc)
-                                                  val re = (ETailCall (n, args, k, ran, ran), loc)
-                                                  val (re, _) = foldr (fn (dom, (re, ran)) =>
-                                                                          ((EAbs ("x", dom, ran, re),
-                                                                            loc),
-                                                                           (TFun (dom, ran), loc)))
-                                                                      (re, ran) ts
-
-                                                  val be = multiLiftExpInExp (len + 1) e
-                                                  val be = ListUtil.foldli
-                                                               (fn (i, _, be) =>
-                                                                   (EApp (be, (ERel (len - i), loc)), loc))
-                                                               be ts
-                                                  val ne = (EFfi ("Basis", "bind"), loc)
-                                                  val ne = (ECApp (ne, trans), loc)
-                                                  val ne = (ECApp (ne, ran), loc)
-                                                  val unit = (TRecord (CRecord ((KType, loc), []),
-                                                                       loc), loc)
-                                                  val ne = (ECApp (ne, unit), loc)
-                                                  val ne = (EApp (ne, (EFfi ("Basis", "transaction_monad"),
-                                                                       loc)), loc)
-                                                  val ne = (EApp (ne, be), loc)
-                                                  val ne = (EApp (ne, (ERel 0, loc)), loc)
-                                                  val tunit = (CApp (trans, unit), loc)
-                                                  val kt = (TFun (ran, tunit), loc)
-                                                  val ne = (EAbs ("k", kt, tunit, ne), loc)
-                                                  val (ne, res) = foldr (fn (dom, (ne, ran)) =>
-                                                                            ((EAbs ("x", dom, ran, ne), loc),
-                                                                             (TFun (dom, ran), loc)))
-                                                                        (ne, (TFun (kt, tunit), loc)) ts
-                                              in
-                                                  (IM.insert (cpsed, n, #1 re),
-                                                   (x, n, res, ne, s) :: vis')
-                                              end)
-                                          (#cpsed st, []) vis
-                            in
-                                ((DValRec (rev vis'), ErrorMsg.dummySpan),
-                                 {exported = #exported st,
-                                  export_decls = #export_decls st,
-                                  cpsed = cpsed,
-                                  rpc = rpc})
-                            end
-                        else
-                            (d, st)
-                      | DVal (x, n, t, e, s) =>
-                        (d,
-                         {exported = #exported st,
-                          export_decls = #export_decls st,
-                          cpsed = #cpsed st,
-                          rpc = if makesServerCall e then
-                                    IS.add (#rpc st, n)
-                                else
-                                    #rpc st})
-                      | _ => (d, st)
-
                 val (d, st) = U.Decl.foldMap {kind = fn x => x,
                                               con = fn x => x,
                                               exp = exp,
@@ -260,16 +146,12 @@
             in
                 (#export_decls st @ [d],
                  {exported = #exported st,
-                  export_decls = [],
-                  cpsed = #cpsed st,
-                  rpc = #rpc st})
+                  export_decls = []})
             end
 
         val (file, _) = ListUtil.foldlMapConcat decl
                         {exported = IS.empty,
-                         export_decls = [],
-                         cpsed = IM.empty,
-                         rpc = rpcBaseIds}
+                         export_decls = []}
                         file
     in
         file