# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1271009477 14400
# Node ID 950d1e540df649c204937ffdca5efbf37ce50401
# Parent  3950cf1f5736cfcc868edfebe2491a280fda14df
Tweaks to table signatures and MonoOpt summarizing

diff -r 3950cf1f5736 -r 950d1e540df6 src/elaborate.sml
--- a/src/elaborate.sml	Sun Apr 11 13:18:32 2010 -0400
+++ b/src/elaborate.sml	Sun Apr 11 14:11:17 2010 -0400
@@ -2237,14 +2237,21 @@
       | L.SgiTable (x, c, pe, ce) =>
         let
             val cstK = (L'.KRecord (L'.KRecord (L'.KUnit, loc), loc), loc)
-            val x' = x ^ "_hidden_constraints"
-            val (env', hidden_n) = E.pushCNamed env x' cstK NONE
-            val hidden = (L'.CNamed hidden_n, loc)
 
             val (c', ck, gs') = elabCon (env, denv) c
             val pkey = cunif (loc, cstK)
             val visible = cunif (loc, cstK)
-            val uniques = (L'.CConcat (visible, hidden), loc)
+            val (env', ds, uniques) =
+                case (#1 pe, #1 ce) of
+                    (L.EVar (["Basis"], "no_primary_key", _), L.EVar (["Basis"], "no_constraint", _)) =>
+                    let
+                        val x' = x ^ "_hidden_constraints"
+                        val (env', hidden_n) = E.pushCNamed env x' cstK NONE
+                        val hidden = (L'.CNamed hidden_n, loc)
+                    in
+                        (env', [(L'.SgiConAbs (x', hidden_n, cstK), loc)], (L'.CConcat (visible, hidden), loc))
+                    end
+                  | _ => (env, [], visible)
 
             val ct = tableOf ()
             val ct = (L'.CApp (ct, c'), loc)
@@ -2272,8 +2279,7 @@
             checkCon env' pe' pet pst;
             checkCon env' ce' cet cst;
 
-            ([(L'.SgiConAbs (x', hidden_n, cstK), loc),
-              (L'.SgiVal (x, n, ct), loc)], (env', denv, gs''' @ gs'' @ gs' @ gs))
+            (ds @ [(L'.SgiVal (x, n, ct), loc)], (env', denv, gs''' @ gs'' @ gs' @ gs))
         end
 
       | L.SgiStr (x, sgn) =>
diff -r 3950cf1f5736 -r 950d1e540df6 src/mono_reduce.sml
--- a/src/mono_reduce.sml	Sun Apr 11 13:18:32 2010 -0400
+++ b/src/mono_reduce.sml	Sun Apr 11 14:11:17 2010 -0400
@@ -77,7 +77,7 @@
       | EDml _ => true
       | ENextval _ => true
       | ESetval _ => true
-      | EUnurlify _ => true
+      | EUnurlify _ => false
       | EAbs _ => false
 
       | EPrim _ => false
@@ -257,8 +257,11 @@
          WritePage
        | ReadDb
        | WriteDb
+       | ReadCookie
+       | WriteCookie
        | UseRel
        | Unsure
+       | Abort
 
 fun p_event e =
     let
@@ -268,8 +271,11 @@
             WritePage => string "WritePage"
           | ReadDb => string "ReadDb"
           | WriteDb => string "WriteDb"
+          | ReadCookie => string "ReadCookie"
+          | WriteCookie => string "WriteCookie"
           | UseRel => string "UseRel"
           | Unsure => string "Unsure"
+          | Abort => string "Abort"
     end
 
 val p_events = Print.p_list p_event
@@ -377,6 +383,8 @@
                       | ENone _ => []
                       | ESome (_, e) => summarize d e
                       | EFfi _ => []
+                      | EFfiApp ("Basis", "get_cookie", [e]) =>
+                        summarize d e @ [ReadCookie]
                       | EFfiApp (m, x, es) =>
                         if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then
                             List.concat (map (summarize d) es) @ [Unsure]
@@ -440,9 +448,9 @@
                         end
                       | EStrcat (e1, e2) => summarize d e1 @ summarize d e2
 
-                      | EError (e, _) => summarize d e @ [Unsure]
-                      | EReturnBlob {blob = e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Unsure]
-                      | ERedirect (e, _) => summarize d e @ [Unsure]
+                      | EError (e, _) => summarize d e @ [Abort]
+                      | EReturnBlob {blob = e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort]
+                      | ERedirect (e, _) => summarize d e @ [Abort]
 
                       | EWrite e => summarize d e @ [WritePage]
                                     
@@ -526,6 +534,8 @@
                                 val writesPage = does WritePage
                                 val readsDb = does ReadDb
                                 val writesDb = does WriteDb
+                                val readsCookie = does ReadCookie
+                                val writesCookie = does ReadCookie
 
                                 fun verifyUnused eff =
                                     case eff of
@@ -542,6 +552,10 @@
                                           | WritePage => not writesPage andalso verifyCompatible effs
                                           | ReadDb => not writesDb andalso verifyCompatible effs
                                           | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
+                                          | ReadCookie => not writesCookie andalso verifyCompatible effs
+                                          | WriteCookie => not writesCookie andalso not readsCookie
+                                                           andalso verifyCompatible effs
+                                          | Abort => true
                             in
                                 (*Print.prefaces "verifyCompatible"
                                                  [("e'", MonoPrint.p_exp env e'),