Mercurial > urweb

comparison src/monoize.sml @ 1240:beb67ff4c8a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'also' policies and policy reduction; calendar in good shape
author Adam Chlipala <adamc@hcoop.net>
date Thu, 15 Apr 2010 10:00:30 -0400
parents a2cd6664f57f
children 459a334345ae
comparison
equal deleted inserted replaced
1239:30f789d5e2ad 1240:beb67ff4c8a0
3740 fm, 3740 fm,
3741 [(L'.DTask (e1, e2), loc)]) 3741 [(L'.DTask (e1, e2), loc)])
3742 end 3742 end
3743 | L.DPolicy e => 3743 | L.DPolicy e =>
3744 let 3744 let
3745 val (e, make) = 3745 fun policies (e, fm) =
3746 case #1 e of 3746 case #1 e of
3747 L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) => 3747 L.EFfiApp ("Basis", "also", [e1, e2]) =>
3748 (e, L'.PolClient) 3748 let
3749 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) => 3749 val (ps1, fm) = policies (e1, fm)
3750 (e, L'.PolInsert) 3750 val (ps2, fm) = policies (e2, fm)
3751 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) => 3751 in
3752 (e, L'.PolDelete) 3752 (ps1 @ ps2, fm)
3753 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) => 3753 end
3754 (e, L'.PolUpdate) 3754 | _ =>
3755 | L.EFfiApp ("Basis", "sendOwnIds", [e]) => 3755 let
3756 (e, L'.PolSequence) 3756 val (e, make) =
3757 | _ => (poly (); (e, L'.PolClient)) 3757 case #1 e of
3758 3758 L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
3759 val (e, fm) = monoExp (env, St.empty, fm) e 3759 (e, L'.PolClient)
3760 in 3760 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
3761 SOME (env, 3761 (e, L'.PolInsert)
3762 fm, 3762 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
3763 [(L'.DPolicy (make e), loc)]) 3763 (e, L'.PolDelete)
3764 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) =>
3765 (e, L'.PolUpdate)
3766 | L.EFfiApp ("Basis", "sendOwnIds", [e]) =>
3767 (e, L'.PolSequence)
3768 | _ => (poly (); (e, L'.PolClient))
3769
3770 val (e, fm) = monoExp (env, St.empty, fm) e
3771 in
3772 ([(L'.DPolicy (make e), loc)], fm)
3773 end
3774
3775 val (ps, fm) = policies (e, fm)
3776 in
3777 SOME (env, fm, ps)
3764 end 3778 end
3765 end 3779 end
3766 3780
3767 datatype expungable = Client | Channel 3781 datatype expungable = Client | Channel
3768 3782