'also' policies and policy reduction; calendar in good shape

4 files changed, 49 insertions, 25 deletions

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 5a30f3f4..13d52960 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -818,5 +818,6 @@ val mayUpdate : fs ::: {Type} -> tables ::: {{Type}} -> [[Old, New] ~ tables]
                 => sql_query [] ([Old = fs, New = fs] ++ tables) []
                 -> sql_policy
 
+val also : sql_policy -> sql_policy -> sql_policy
 
 val debug : string -> transaction unit
diff --git a/src/compiler.sml b/src/compiler.sml
index ba10ed74..def0e6c3 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -75,7 +75,7 @@ type ('src, 'dst) transform = {
 }
 
 val debug = ref false
-val doIflow = ref true
+val doIflow = ref false
 
 fun transform (ph : ('src, 'dst) phase) name = {
     func = fn input => let
diff --git a/src/monoize.sml b/src/monoize.sml
index 3983624b..e6c91abd 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3742,25 +3742,39 @@ fun monoDecl (env, fm) (all as (d, loc)) =
             end
           | L.DPolicy e =>
             let
-                val (e, make) =
+                fun policies (e, fm) =
                     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))
+                        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 (e, fm) = monoExp (env, St.empty, fm) e
+                val (ps, fm) = policies (e, fm)
             in
-                SOME (env,
-                      fm,
-                      [(L'.DPolicy (make e), loc)])
+                SOME (env, fm, ps)
             end
     end
 
diff --git a/src/reduce.sml b/src/reduce.sml
index cefe1955..b2911a5f 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -668,14 +668,23 @@ fun reduce file =
                                       exp = fn (_, n) => n + 1} 0
 
         fun mayInline (polyC, n, t, e) =
-            case IM.find (uses, n) of
-                NONE => false
-              | SOME count => count <= 1
-                              orelse (case #1 e of
-                                          ERecord _ => true
-                                        | _ => false)
-                              orelse isPoly polyC t
-                              orelse size e <= Settings.getCoreInline ()
+            let
+                fun isPolicy t =
+                    case #1 t of
+                        CFfi ("Basis", "sql_policy") => true
+                      | TFun (_, t) => isPolicy t
+                      | _ => false
+            in
+                case IM.find (uses, n) of
+                    NONE => false
+                  | SOME count => count <= 1
+                                  orelse (case #1 e of
+                                              ERecord _ => true
+                                            | _ => false)
+                                  orelse isPolicy t
+                                  orelse isPoly polyC t
+                                  orelse size e <= Settings.getCoreInline ()
+            end
 
         fun doDecl (d as (_, loc), st as (polyC, namedC, namedE)) =
             case #1 d of