# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1271340030 14400
# Node ID beb67ff4c8a0a9581a8b011bd806166e279fc430
# Parent  30f789d5e2ad1b4c38da023d2bf3634a0fa409a7
'also' policies and policy reduction; calendar in good shape

diff -r 30f789d5e2ad -r beb67ff4c8a0 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Thu Apr 15 08:48:41 2010 -0400
+++ b/lib/ur/basis.urs	Thu Apr 15 10:00:30 2010 -0400
@@ -818,5 +818,6 @@
                 => sql_query [] ([Old = fs, New = fs] ++ tables) []
                 -> sql_policy
 
+val also : sql_policy -> sql_policy -> sql_policy
 
 val debug : string -> transaction unit
diff -r 30f789d5e2ad -r beb67ff4c8a0 src/compiler.sml
--- a/src/compiler.sml	Thu Apr 15 08:48:41 2010 -0400
+++ b/src/compiler.sml	Thu Apr 15 10:00:30 2010 -0400
@@ -75,7 +75,7 @@
 }
 
 val debug = ref false
-val doIflow = ref true
+val doIflow = ref false
 
 fun transform (ph : ('src, 'dst) phase) name = {
     func = fn input => let
diff -r 30f789d5e2ad -r beb67ff4c8a0 src/monoize.sml
--- a/src/monoize.sml	Thu Apr 15 08:48:41 2010 -0400
+++ b/src/monoize.sml	Thu Apr 15 10:00:30 2010 -0400
@@ -3742,25 +3742,39 @@
             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
+                            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,
-                      [(L'.DPolicy (make e), loc)])
+                SOME (env, fm, ps)
             end
     end
 
diff -r 30f789d5e2ad -r beb67ff4c8a0 src/reduce.sml
--- a/src/reduce.sml	Thu Apr 15 08:48:41 2010 -0400
+++ b/src/reduce.sml	Thu Apr 15 10:00:30 2010 -0400
@@ -668,14 +668,23 @@
                                       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