diff options
| -rw-r--r-- | src/core.sml | 1 | ||||
| -rw-r--r-- | src/core_env.sml | 6 | ||||
| -rw-r--r-- | src/core_print.sml | 11 | ||||
| -rw-r--r-- | src/core_util.sml | 17 | ||||
| -rw-r--r-- | src/corify.sml | 11 | ||||
| -rw-r--r-- | src/shake.sml | 7 |
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 |