# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1239898041 14400
# Node ID 4c5796512edc00533841f4e9842776fae833d846
# Parent  12ec14a6be0ba9b97c79e9a8987fd7583bb7d2fb
Catching duplicate cookie and style paths

diff -r 12ec14a6be0b -r 4c5796512edc src/cjr.sml
--- a/src/cjr.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/cjr.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -110,6 +110,7 @@
        | DPreparedStatements of (string * int) list
 
        | DJavaScript of string
+       | DCookie of string
        | DStyle of string
 
 withtype decl = decl' located
diff -r 12ec14a6be0b -r 4c5796512edc src/cjr_env.sml
--- a/src/cjr_env.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/cjr_env.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -167,6 +167,7 @@
       | DDatabase _ => env
       | DPreparedStatements _ => env
       | DJavaScript _ => env
+      | DCookie _ => env
       | DStyle _ => env
 
 end
diff -r 12ec14a6be0b -r 4c5796512edc src/cjr_print.sml
--- a/src/cjr_print.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/cjr_print.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -2146,6 +2146,13 @@
       | DJavaScript s => box [string "static char jslib[] = \"",
                               string (String.toString s),
                               string "\";"]
+      | DCookie s => box [string "/*",
+                          space,
+                          string "cookie",
+                          space,
+                          string s,
+                          space,
+                          string "*/"]
       | DStyle s => box [string "/*",
                          space,
                          string "style",
diff -r 12ec14a6be0b -r 4c5796512edc src/cjrize.sml
--- a/src/cjrize.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/cjrize.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -556,6 +556,7 @@
         (SOME (L'.DSequence s, loc), NONE, sm)
       | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm)
       | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm)
+      | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm)
       | L.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm)
 
 fun cjrize ds =
diff -r 12ec14a6be0b -r 4c5796512edc src/mono.sml
--- a/src/mono.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/mono.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -127,6 +127,7 @@
 
        | DJavaScript of string
 
+       | DCookie of string
        | DStyle of string
 
 
diff -r 12ec14a6be0b -r 4c5796512edc src/mono_env.sml
--- a/src/mono_env.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/mono_env.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -111,6 +111,7 @@
       | DSequence _ => env
       | DDatabase _ => env
       | DJavaScript _ => env
+      | DCookie _ => env
       | DStyle _ => env
 
 fun patBinds env (p, loc) =
diff -r 12ec14a6be0b -r 4c5796512edc src/mono_print.sml
--- a/src/mono_print.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/mono_print.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -440,6 +440,9 @@
                               string s,
                               string ")"]
 
+      | DCookie s => box [string "cookie",
+                          space,
+                          string s]
       | DStyle s => box [string "style",
                          space,
                          string s]
diff -r 12ec14a6be0b -r 4c5796512edc src/mono_shake.sml
--- a/src/mono_shake.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/mono_shake.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -59,6 +59,7 @@
                                    | ((DSequence _, _), acc) => acc
                                    | ((DDatabase _, _), acc) => acc
                                    | ((DJavaScript _, _), acc) => acc
+                                   | ((DCookie _, _), acc) => acc
                                    | ((DStyle _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
@@ -117,6 +118,7 @@
                       | (DSequence _, _) => true
                       | (DDatabase _, _) => true
                       | (DJavaScript _, _) => true
+                      | (DCookie _, _) => true
                       | (DStyle _, _) => true) file
     end
 
diff -r 12ec14a6be0b -r 4c5796512edc src/mono_util.sml
--- a/src/mono_util.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/mono_util.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -474,6 +474,7 @@
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
               | DJavaScript _ => S.return2 dAll
+              | DCookie _ => S.return2 dAll
               | DStyle _ => S.return2 dAll
 
         and mfvi ctx (x, n, t, e, s) =
@@ -556,6 +557,7 @@
                                       | DSequence _ => ctx
                                       | DDatabase _ => ctx
                                       | DJavaScript _ => ctx
+                                      | DCookie _ => ctx
                                       | DStyle _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
@@ -606,6 +608,7 @@
                           | DSequence _ => count
                           | DDatabase _ => count
                           | DJavaScript _ => count
+                          | DCookie _ => count
                           | DStyle _ => count) 0
 
 end
diff -r 12ec14a6be0b -r 4c5796512edc src/monoize.sml
--- a/src/monoize.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/monoize.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -2725,7 +2725,8 @@
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
-                      [(L'.DVal (x, n, t', e, s), loc)])
+                      [(L'.DCookie s, loc),
+                       (L'.DVal (x, n, t', e, s), loc)])
             end
           | L.DStyle (x, n, s) =>
             let
diff -r 12ec14a6be0b -r 4c5796512edc src/pathcheck.sml
--- a/src/pathcheck.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/pathcheck.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -36,21 +36,35 @@
                            val compare = String.compare
                            end)
 
-fun checkDecl ((d, loc), (funcs, rels)) =
+fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) =
     let
         fun doFunc s =
             (if SS.member (funcs, s) then
                  E.errorAt loc ("Duplicate function path " ^ s)
              else
                  ();
-             (SS.add (funcs, s), rels))
+             (SS.add (funcs, s), rels, cookies, styles))
 
         fun doRel s =
             (if SS.member (rels, s) then
                  E.errorAt loc ("Duplicate table/sequence path " ^ s)
              else
                  ();
-             (funcs, SS.add (rels, s)))
+             (funcs, SS.add (rels, s), cookies, styles))
+
+        fun doCookie s =
+            (if SS.member (cookies, s) then
+                 E.errorAt loc ("Duplicate cookie path " ^ s)
+             else
+                 ();
+             (funcs, rels, SS.add (cookies, s), styles))
+
+        fun doStyle s =
+            (if SS.member (styles, s) then
+                 E.errorAt loc ("Duplicate style path " ^ s)
+             else
+                 ();
+             (funcs, rels, cookies, SS.add (styles, s)))
     in
         case d of
             DExport (_, s, _, _, _) => doFunc s
@@ -86,13 +100,16 @@
                                    SS.add (rels, s')
                                end
             in
-                (funcs, constraints (ce, rels))
+                (funcs, constraints (ce, rels), cookies, styles)
             end
           | DSequence s => doRel s
 
-          | _ => (funcs, rels)
+          | DCookie s => doCookie s
+          | DStyle s => doStyle s
+
+          | _ => (funcs, rels, cookies, styles)
     end
 
-fun check ds = ignore (foldl checkDecl (SS.empty, SS.empty) ds)
+fun check ds = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds)
 
 end
diff -r 12ec14a6be0b -r 4c5796512edc src/prepare.sml
--- a/src/prepare.sml	Thu Apr 16 12:00:44 2009 -0400
+++ b/src/prepare.sml	Thu Apr 16 12:07:21 2009 -0400
@@ -259,6 +259,7 @@
       | DDatabase _ => (d, sns)
       | DPreparedStatements _ => (d, sns)
       | DJavaScript _ => (d, sns)
+      | DCookie _ => (d, sns)
       | DStyle _ => (d, sns)
 
 fun prepare (ds, ps) =
diff -r 12ec14a6be0b -r 4c5796512edc tests/badCookie.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/badCookie.ur	Thu Apr 16 12:07:21 2009 -0400
@@ -0,0 +1,2 @@
+cookie x : int
+cookie x : float
diff -r 12ec14a6be0b -r 4c5796512edc tests/badCookie.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/badCookie.urp	Thu Apr 16 12:07:21 2009 -0400
@@ -0,0 +1,3 @@
+debug
+
+badCookie