summaryrefslogtreecommitdiff
path: root/src/rpcify.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 19:01:04 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 19:01:04 -0400
commite5e468f67bf1442ad295681039ce31e17931ba5d (patch)
treed0d80327ab5a8d6c922a25646ac1c48ee20a57b9 /src/rpcify.sml
parent86440d5a251741c3c1a279646b949c35eb25b4a2 (diff)
Grid changed to use Dlist.replace; filters stopped working
Diffstat (limited to 'src/rpcify.sml')
-rw-r--r--src/rpcify.sml126
1 files changed, 4 insertions, 122 deletions
diff --git a/src/rpcify.sml b/src/rpcify.sml
index 4ed90228..0e5a1076 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -32,26 +32,12 @@ open Core
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 @@ fun frob file =
(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 @@ fun frob file =
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 frob file =
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 @@ fun frob file =
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