diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-10-25 14:07:10 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-10-25 14:07:10 -0400 |
| commit | 5a88b41a6655f601c989ae94ce1fc8bb391ca630 (patch) | |
| tree | 95685ca6f24d0e3511588ae55bbdd8a121f97994 /src/reduce.sml | |
| parent | 31da370dd5fae72ddf756aa5ef54241b099fd617 (diff) | |
RPC uses VM support for call/cc
Diffstat (limited to 'src/reduce.sml')
| -rw-r--r-- | src/reduce.sml | 101 |
1 files changed, 1 insertions, 100 deletions
diff --git a/src/reduce.sml b/src/reduce.sml index 38465fda..1310c7d0 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -409,102 +409,6 @@ fun kindConAndExp (namedC, namedE) = case #1 e of EApp ((EApp - ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), - t1), - _), t2), _), - (EFfi ("Basis", "transaction_monad"), _)), _), - (EServerCall (n, es, (EAbs (_, _, _, ke), _), dom, ran), _)), _), - trans3) => - let - val e' = (EFfi ("Basis", "bind"), loc) - val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) - val e' = (ECApp (e', dom), loc) - val e' = (ECApp (e', t2), loc) - val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) - val e' = (EApp (e', ke), loc) - val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) - val e' = reassoc e' - val e' = (EAbs ("x", dom, t2, e'), loc) - val e' = (EServerCall (n, es, e', dom, t2), loc) - in - e' - end - - | EApp - ((EApp - ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), - t1), - _), t2), _), - (EFfi ("Basis", "transaction_monad"), _)), _), - (EServerCall (n, es, ke, dom, ran), _)), _), - trans3) => - let - val e' = (EFfi ("Basis", "bind"), loc) - val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) - val e' = (ECApp (e', dom), loc) - val e' = (ECApp (e', t2), loc) - val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) - val e' = (EApp (e', exp (UnknownE :: env') - (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), - loc) - val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) - val e' = reassoc e' - val e' = (EAbs ("x", dom, t2, e'), loc) - val e' = (EServerCall (n, es, e', dom, t2), loc) - in - e' - end - - | EApp - ((EApp - ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), - t1), - _), t2), _), - (EFfi ("Basis", "transaction_monad"), _)), _), - (ETailCall (n, es, (EAbs (_, _, _, ke), _), dom, ran), _)), _), - trans3) => - let - val e' = (EFfi ("Basis", "bind"), loc) - val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) - val e' = (ECApp (e', dom), loc) - val e' = (ECApp (e', t2), loc) - val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) - val e' = (EApp (e', ke), loc) - val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) - val e' = reassoc e' - val e' = (EAbs ("x", dom, t2, e'), loc) - val e' = (ETailCall (n, es, e', dom, t2), loc) - in - e' - end - - | EApp - ((EApp - ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), - t1), - _), t2), _), - (EFfi ("Basis", "transaction_monad"), _)), _), - (ETailCall (n, es, ke, dom, ran), _)), _), - trans3) => - let - val e' = (EFfi ("Basis", "bind"), loc) - val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) - val e' = (ECApp (e', dom), loc) - val e' = (ECApp (e', t2), loc) - val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) - val e' = (EApp (e', exp (UnknownE :: env') - (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), - loc) - val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) - val e' = reassoc e' - val e' = (EAbs ("x", dom, t2, e'), loc) - val e' = (ETailCall (n, es, e', dom, t2), loc) - in - e' - end - - | EApp - ((EApp ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt), _), _), _), t3), _), me), _), @@ -792,10 +696,7 @@ fun kindConAndExp (namedC, namedE) = | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc) - | EServerCall (n, es, e, t1, t2) => (EServerCall (n, map (exp env) es, exp env e, - con env t1, con env t2), loc) - | ETailCall (n, es, e, t1, t2) => (ETailCall (n, map (exp env) es, exp env e, - con env t1, con env t2), loc) + | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc) in (*if dangling (edepth' (deKnown env)) r then (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all), |