# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1225986482 18000
# Node ID 5c9606deacb683f982014629680c21ee01ab1533
# Parent  d34834af451232a24da9ca60087c99c8448b26ab
Cookies through shake2

diff -r d34834af4512 -r 5c9606deacb6 src/core.sml
--- a/src/core.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/core.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -120,6 +120,7 @@
        | DTable of string * int * con * string
        | DSequence of string * int * string
        | DDatabase of string
+       | DCookie of string * int * con * string
 
 withtype decl = decl' located
 
diff -r d34834af4512 -r 5c9606deacb6 src/core_env.sml
--- a/src/core_env.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/core_env.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -257,6 +257,12 @@
             pushENamed env x n t NONE s
         end
       | DDatabase _ => env
+      | DCookie (x, n, c, s) =>
+        let
+            val t = (CApp ((CFfi ("Basis", "http_cookie"), loc), c), loc)
+        in
+            pushENamed env x n t NONE s
+        end
 
 fun patBinds env (p, loc) =
     case p of
diff -r d34834af4512 -r 5c9606deacb6 src/core_print.sml
--- a/src/core_print.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/core_print.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -504,6 +504,17 @@
       | DDatabase s => box [string "database",
                             space,
                             string s]
+      | DCookie (x, n, c, s) => box [string "cookie",
+                                     space,
+                                     p_named x n,
+                                     space,
+                                     string "as",
+                                     space,
+                                     string s,
+                                     space,
+                                     string ":",
+                                     space,
+                                     p_con env c]
 
 fun p_file env file =
     let
diff -r d34834af4512 -r 5c9606deacb6 src/core_util.sml
--- a/src/core_util.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/core_util.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -656,10 +656,14 @@
               | DExport _ => S.return2 dAll
               | DTable (x, n, c, s) =>
                 S.map2 (mfc ctx c,
-                        fn c' =>
-                           (DTable (x, n, c', s), loc))
+                     fn c' =>
+                        (DTable (x, n, c', s), loc))
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
+              | DCookie (x, n, c, s) =>
+                S.map2 (mfc ctx c,
+                     fn c' =>
+                        (DCookie (x, n, c', s), loc))
 
         and mfvi ctx (x, n, t, e, s) =
             S.bind2 (mfc ctx t,
@@ -755,6 +759,12 @@
                                             bind (ctx, NamedE (x, n, t, NONE, s))
                                         end
                                       | DDatabase _ => ctx
+                                      | DCookie (x, n, c, s) =>
+                                        let
+                                            val t = (CApp ((CFfi ("Basis", "http_cookie"), #2 d'), c), #2 d')
+                                        in
+                                            bind (ctx, NamedE (x, n, t, NONE, s))
+                                        end
                             in
                                 S.map2 (mff ctx' ds',
                                      fn ds' =>
@@ -807,7 +817,8 @@
                           | DExport _ => count
                           | DTable (_, n, _, _) => Int.max (n, count)
                           | DSequence (_, n, _) => Int.max (n, count)
-                          | DDatabase _ => count) 0
+                          | DDatabase _ => count
+                          | DCookie (_, n, _, _) => Int.max (n, count)) 0
               
 end
 
diff -r d34834af4512 -r 5c9606deacb6 src/corify.sml
--- a/src/corify.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/corify.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -981,6 +981,14 @@
 
       | L.DDatabase s => ([(L'.DDatabase s, loc)], st)
 
+      | L.DCookie (_, x, n, c) =>
+        let
+            val (st, n) = St.bindVal st x n
+            val s = doRestify (mods, x)
+        in
+            ([(L'.DCookie (x, n, corifyCon st c, s), loc)], st)
+        end
+
 and corifyStr mods ((str, _), st) =
     case str of
         L.StrConst ds =>
@@ -1034,7 +1042,8 @@
                              | L.DExport _ => n
                              | L.DTable (_, _, n', _) => Int.max (n, n')
                              | L.DSequence (_, _, n') => Int.max (n, n')
-                             | L.DDatabase _ => n)
+                             | L.DDatabase _ => n
+                             | L.DCookie (_, _, n', _) => Int.max (n, n'))
                        0 ds
 
 and maxNameStr (str, _) =
diff -r d34834af4512 -r 5c9606deacb6 src/shake.sml
--- a/src/shake.sml	Thu Nov 06 10:43:48 2008 -0500
+++ b/src/shake.sml	Thu Nov 06 10:48:02 2008 -0500
@@ -68,7 +68,9 @@
                                      (cdef, IM.insert (edef, n, ([], c, dummye)))
                                    | ((DSequence (_, n, _), _), (cdef, edef)) =>
                                      (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
-                                   | ((DDatabase _, _), acc) => acc)
+                                   | ((DDatabase _, _), acc) => acc
+                                   | ((DCookie (_, n, c, _), _), (cdef, edef)) =>
+                                     (cdef, IM.insert (edef, n, ([], c, dummye))))
                                  (IM.empty, IM.empty) file
 
         fun kind (_, s) = s
@@ -136,7 +138,8 @@
                       | (DExport _, _) => true
                       | (DTable _, _) => true
                       | (DSequence _, _) => true
-                      | (DDatabase _, _) => true) file
+                      | (DDatabase _, _) => true
+                      | (DCookie _, _) => true) file
     end
 
 end