Mercurial > urweb

comparison src/monoize.sml @ 1254:935a981f4380

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge
author Adam Chlipala <adamc@hcoop.net>
date Thu, 06 May 2010 13:57:01 -0400
parents beb67ff4c8a0
children 459a334345ae
comparison
equal deleted inserted replaced
1198:b52929351402 1254:935a981f4380
2578 | L.EFfi ("Basis", "sql_octet_length") => 2578 | L.EFfi ("Basis", "sql_octet_length") =>
2579 ((L'.EPrim (Prim.String (if #supportsOctetLength (Settings.currentDbms ()) then 2579 ((L'.EPrim (Prim.String (if #supportsOctetLength (Settings.currentDbms ()) then
2580 "octet_length" 2580 "octet_length"
2581 else 2581 else
2582 "length")), loc), fm) 2582 "length")), loc), fm)
2583 | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) =>
2584 ((L'.EFfi ("Basis", "sql_known"), loc), fm)
2583 2585
2584 | (L.ECApp ( 2586 | (L.ECApp (
2585 (L.ECApp ( 2587 (L.ECApp (
2586 (L.ECApp ( 2588 (L.ECApp (
2587 (L.ECApp ( 2589 (L.ECApp (
3736 in 3738 in
3737 SOME (env, 3739 SOME (env,
3738 fm, 3740 fm,
3739 [(L'.DTask (e1, e2), loc)]) 3741 [(L'.DTask (e1, e2), loc)])
3740 end 3742 end
3743 | L.DPolicy e =>
3744 let
3745 fun policies (e, fm) =
3746 case #1 e of
3747 L.EFfiApp ("Basis", "also", [e1, e2]) =>
3748 let
3749 val (ps1, fm) = policies (e1, fm)
3750 val (ps2, fm) = policies (e2, fm)
3751 in
3752 (ps1 @ ps2, fm)
3753 end
3754 | _ =>
3755 let
3756 val (e, make) =
3757 case #1 e of
3758 L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
3759 (e, L'.PolClient)
3760 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
3761 (e, L'.PolInsert)
3762 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
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)
3778 end
3741 end 3779 end
3742 3780
3743 datatype expungable = Client | Channel 3781 datatype expungable = Client | Channel
3744 3782
3745 fun monoize env file = 3783 fun monoize env file =