diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cjr.sml | 1 | ||||
| -rw-r--r-- | src/cjr_env.sml | 1 | ||||
| -rw-r--r-- | src/cjr_print.sml | 7 | ||||
| -rw-r--r-- | src/cjrize.sml | 1 | ||||
| -rw-r--r-- | src/mono.sml | 1 | ||||
| -rw-r--r-- | src/mono_env.sml | 1 | ||||
| -rw-r--r-- | src/mono_print.sml | 3 | ||||
| -rw-r--r-- | src/mono_shake.sml | 2 | ||||
| -rw-r--r-- | src/mono_util.sml | 3 | ||||
| -rw-r--r-- | src/monoize.sml | 3 | ||||
| -rw-r--r-- | src/pathcheck.sml | 29 | ||||
| -rw-r--r-- | src/prepare.sml | 1 |
12 files changed, 46 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) = |