diff src/monoize.sml @ 1254:935a981f4380

Merge
author Adam Chlipala <adamc@hcoop.net>
date Thu, 06 May 2010 13:57:01 -0400
parents beb67ff4c8a0
children 459a334345ae
line wrap: on
line diff
--- a/src/monoize.sml	Sat Apr 17 13:57:10 2010 -0400
+++ b/src/monoize.sml	Thu May 06 13:57:01 2010 -0400
@@ -2580,6 +2580,8 @@
                                          "octet_length"
                                      else
                                          "length")), loc), fm)
+          | L.ECApp ((L.EFfi ("Basis", "sql_known"), _), _) =>
+            ((L'.EFfi ("Basis", "sql_known"), loc), fm)
 
           | (L.ECApp (
              (L.ECApp (
@@ -3738,6 +3740,42 @@
                       fm,
                       [(L'.DTask (e1, e2), loc)])
             end
+          | L.DPolicy e =>
+            let
+                fun policies (e, fm) =
+                    case #1 e of
+                        L.EFfiApp ("Basis", "also", [e1, e2]) =>
+                        let
+                            val (ps1, fm) = policies (e1, fm)
+                            val (ps2, fm) = policies (e2, fm)
+                        in
+                            (ps1 @ ps2, fm)
+                        end
+                      | _ =>
+                        let
+                            val (e, make) =
+                                case #1 e of
+                                    L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
+                                    (e, L'.PolClient)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
+                                    (e, L'.PolInsert)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
+                                    (e, L'.PolDelete)
+                                  | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) =>
+                                    (e, L'.PolUpdate)
+                                  | L.EFfiApp ("Basis", "sendOwnIds", [e]) =>
+                                    (e, L'.PolSequence)
+                                  | _ => (poly (); (e, L'.PolClient))
+
+                            val (e, fm) = monoExp (env, St.empty, fm) e
+                        in
+                            ([(L'.DPolicy (make e), loc)], fm)
+                        end
+
+                val (ps, fm) = policies (e, fm)
+            in
+                SOME (env, fm, ps)
+            end
     end
 
 datatype expungable = Client | Channel