summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/core.sml1
-rw-r--r--src/core_env.sml6
-rw-r--r--src/core_print.sml11
-rw-r--r--src/core_util.sml17
-rw-r--r--src/corify.sml11
-rw-r--r--src/shake.sml7
6 files changed, 47 insertions, 6 deletions
diff --git a/src/core.sml b/src/core.sml
index 0b81e50e..1a181a68 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -120,6 +120,7 @@ datatype decl' =
| 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 --git a/src/core_env.sml b/src/core_env.sml
index 0faf5aab..07162606 100644
--- a/src/core_env.sml
+++ b/src/core_env.sml
@@ -257,6 +257,12 @@ fun declBinds env (d, loc) =
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 --git a/src/core_print.sml b/src/core_print.sml
index cd31487e..7de31568 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -504,6 +504,17 @@ fun p_decl env (dAll as (d, _) : decl) =
| 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 --git a/src/core_util.sml b/src/core_util.sml
index 2450562f..7e1440a1 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -656,10 +656,14 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
| 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 @@ fun mapfoldB (all as {bind, ...}) =
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 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
| 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 --git a/src/corify.sml b/src/corify.sml
index 8b72f9f8..2b90a8f0 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -981,6 +981,14 @@ fun corifyDecl mods ((d, loc : EM.span), st) =
| 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 @@ fun maxName ds = foldl (fn ((d, _), n) =>
| 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 --git a/src/shake.sml b/src/shake.sml
index 4ebd1b0b..e062743d 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -68,7 +68,9 @@ fun shake file =
(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 @@ fun shake file =
| (DExport _, _) => true
| (DTable _, _) => true
| (DSequence _, _) => true
- | (DDatabase _, _) => true) file
+ | (DDatabase _, _) => true
+ | (DCookie _, _) => true) file
end
end