summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/cjr.sml1
-rw-r--r--src/cjr_env.sml1
-rw-r--r--src/cjr_print.sml7
-rw-r--r--src/cjrize.sml1
-rw-r--r--src/mono.sml1
-rw-r--r--src/mono_env.sml1
-rw-r--r--src/mono_print.sml3
-rw-r--r--src/mono_shake.sml2
-rw-r--r--src/mono_util.sml3
-rw-r--r--src/monoize.sml3
-rw-r--r--src/pathcheck.sml29
-rw-r--r--src/prepare.sml1
-rw-r--r--tests/badCookie.ur2
-rw-r--r--tests/badCookie.urp3
14 files changed, 51 insertions, 7 deletions
diff --git a/src/cjr.sml b/src/cjr.sml
index 23dfb900..3844ccad 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -110,6 +110,7 @@ datatype decl' =
| DPreparedStatements of (string * int) list
| DJavaScript of string
+ | DCookie of string
| DStyle of string
withtype decl = decl' located
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index cb5caee9..7f02a4e9 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -167,6 +167,7 @@ fun declBinds env (d, loc) =
| DDatabase _ => env
| DPreparedStatements _ => env
| DJavaScript _ => env
+ | DCookie _ => env
| DStyle _ => env
end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 46282410..d6852455 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2146,6 +2146,13 @@ fun p_decl env (dAll as (d, _) : decl) =
| 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 --git a/src/cjrize.sml b/src/cjrize.sml
index b432cd44..5e0f9bdb 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -556,6 +556,7 @@ fun cifyDecl ((d, loc), sm) =
(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 --git a/src/mono.sml b/src/mono.sml
index 4a4cb5da..d60c552c 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -127,6 +127,7 @@ datatype decl' =
| DJavaScript of string
+ | DCookie of string
| DStyle of string
diff --git a/src/mono_env.sml b/src/mono_env.sml
index df255325..b3572fbe 100644
--- a/src/mono_env.sml
+++ b/src/mono_env.sml
@@ -111,6 +111,7 @@ fun declBinds env (d, loc) =
| DSequence _ => env
| DDatabase _ => env
| DJavaScript _ => env
+ | DCookie _ => env
| DStyle _ => env
fun patBinds env (p, loc) =
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a9e68005..7ad8dada 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -440,6 +440,9 @@ fun p_decl env (dAll as (d, _) : decl) =
string s,
string ")"]
+ | DCookie s => box [string "cookie",
+ space,
+ string s]
| DStyle s => box [string "style",
space,
string s]
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index d2426f9f..0060d036 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -59,6 +59,7 @@ fun shake file =
| ((DSequence _, _), acc) => acc
| ((DDatabase _, _), acc) => acc
| ((DJavaScript _, _), acc) => acc
+ | ((DCookie _, _), acc) => acc
| ((DStyle _, _), acc) => acc)
(IM.empty, IM.empty) file
@@ -117,6 +118,7 @@ fun shake file =
| (DSequence _, _) => true
| (DDatabase _, _) => true
| (DJavaScript _, _) => true
+ | (DCookie _, _) => true
| (DStyle _, _) => true) file
end
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 62a2dfe0..238f65d3 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -474,6 +474,7 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} =
| 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 @@ fun mapfoldB (all as {bind, ...}) =
| DSequence _ => ctx
| DDatabase _ => ctx
| DJavaScript _ => ctx
+ | DCookie _ => ctx
| DStyle _ => ctx
in
S.map2 (mff ctx' ds',
@@ -606,6 +608,7 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
| DSequence _ => count
| DDatabase _ => count
| DJavaScript _ => count
+ | DCookie _ => count
| DStyle _ => count) 0
end
diff --git a/src/monoize.sml b/src/monoize.sml
index 3fd4f730..7523f2dd 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2725,7 +2725,8 @@ fun monoDecl (env, fm) (all as (d, loc)) =
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 --git a/src/pathcheck.sml b/src/pathcheck.sml
index 3f4f6be4..a493595d 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -36,21 +36,35 @@ structure SS = BinarySetFn(struct
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 @@ fun checkDecl ((d, loc), (funcs, rels)) =
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 --git a/src/prepare.sml b/src/prepare.sml
index 8e31b73d..e1777b11 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -259,6 +259,7 @@ fun prepDecl (d as (_, loc), sns) =
| DDatabase _ => (d, sns)
| DPreparedStatements _ => (d, sns)
| DJavaScript _ => (d, sns)
+ | DCookie _ => (d, sns)
| DStyle _ => (d, sns)
fun prepare (ds, ps) =
diff --git a/tests/badCookie.ur b/tests/badCookie.ur
new file mode 100644
index 00000000..bd9c38ae
--- /dev/null
+++ b/tests/badCookie.ur
@@ -0,0 +1,2 @@
+cookie x : int
+cookie x : float
diff --git a/tests/badCookie.urp b/tests/badCookie.urp
new file mode 100644
index 00000000..3473be8f
--- /dev/null
+++ b/tests/badCookie.urp
@@ -0,0 +1,3 @@
+debug
+
+badCookie
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 01:52:17 +0000