summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 10:08:11 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 10:08:11 -0400
commit30eeaff2c92fb1d0ba029a7688fc7b547a60c150 (patch)
treea661373caf0683dea44543b9997278159a574d1b /src
parent17cb59d373d1a94731d3730b938776b524d9f81c (diff)
style declarations
Diffstat (limited to 'src')
-rw-r--r--src/cjr.sml1
-rw-r--r--src/cjr_env.sml2
-rw-r--r--src/cjr_print.sml11
-rw-r--r--src/cjrize.sml1
-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.sml13
-rw-r--r--src/corify.sml10
-rw-r--r--src/elab.sml1
-rw-r--r--src/elab_env.sml6
-rw-r--r--src/elab_print.sml7
-rw-r--r--src/elab_util.sml8
-rw-r--r--src/elaborate.sml10
-rw-r--r--src/elisp/urweb-mode.el4
-rw-r--r--src/expl.sml1
-rw-r--r--src/expl_env.sml6
-rw-r--r--src/expl_print.sml7
-rw-r--r--src/explify.sml1
-rw-r--r--src/mono.sml2
-rw-r--r--src/mono_env.sml1
-rw-r--r--src/mono_print.sml8
-rw-r--r--src/mono_shake.sml6
-rw-r--r--src/mono_util.sml5
-rw-r--r--src/monoize.sml17
-rw-r--r--src/prepare.sml1
-rw-r--r--src/reduce.sml1
-rw-r--r--src/reduce_local.sml1
-rw-r--r--src/shake.sml5
-rw-r--r--src/source.sml1
-rw-r--r--src/source_print.sml7
-rw-r--r--src/unnest.sml1
-rw-r--r--src/urweb.grm10
-rw-r--r--src/urweb.lex1
34 files changed, 164 insertions, 10 deletions
diff --git a/src/cjr.sml b/src/cjr.sml
index 33cf07c9..031a14f8 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -110,6 +110,7 @@ datatype decl' =
| DPreparedStatements of (string * int) list
| DJavaScript of string
+ | DStyle of string * string list
withtype decl = decl' located
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index 9921ee48..cb5caee9 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -167,6 +167,6 @@ fun declBinds env (d, loc) =
| DDatabase _ => env
| DPreparedStatements _ => env
| DJavaScript _ => env
-
+ | DStyle _ => env
end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index f86d4928..cabfc77f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2146,6 +2146,17 @@ fun p_decl env (dAll as (d, _) : decl) =
| DJavaScript s => box [string "static char jslib[] = \"",
string (String.toString s),
string "\";"]
+ | DStyle (s, xs) => box [string "/*",
+ space,
+ string "style",
+ space,
+ string s,
+ space,
+ string ":",
+ space,
+ p_list string xs,
+ space,
+ string "*/"]
datatype 'a search =
Found of 'a
diff --git a/src/cjrize.sml b/src/cjrize.sml
index e0341c64..b432cd44 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.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm)
fun cjrize ds =
let
diff --git a/src/core.sml b/src/core.sml
index a8e0de13..bbd1a9b6 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -134,6 +134,7 @@ datatype decl' =
| DSequence of string * int * string
| DDatabase of string
| DCookie of string * int * con * string
+ | DStyle of string * int * con * string
withtype decl = decl' located
diff --git a/src/core_env.sml b/src/core_env.sml
index 95226bb7..01a791a0 100644
--- a/src/core_env.sml
+++ b/src/core_env.sml
@@ -334,6 +334,12 @@ fun declBinds env (d, loc) =
in
pushENamed env x n t NONE s
end
+ | DStyle (x, n, c, s) =>
+ let
+ val t = (CApp ((CFfi ("Basis", "css_class"), 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 ed401d29..caf55adb 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -586,6 +586,17 @@ fun p_decl env (dAll as (d, _) : decl) =
string ":",
space,
p_con env c]
+ | DStyle (x, n, c, s) => box [string "style",
+ 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 320a0326..8ccd520a 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -951,6 +951,10 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} =
S.map2 (mfc ctx c,
fn c' =>
(DCookie (x, n, c', s), loc))
+ | DStyle (x, n, c, s) =>
+ S.map2 (mfc ctx c,
+ fn c' =>
+ (DStyle (x, n, c', s), loc))
and mfvi ctx (x, n, t, e, s) =
S.bind2 (mfc ctx t,
@@ -1088,6 +1092,12 @@ fun mapfoldB (all as {bind, ...}) =
in
bind (ctx, NamedE (x, n, t, NONE, s))
end
+ | DStyle (x, n, c, s) =>
+ let
+ val t = (CApp ((CFfi ("Basis", "css_class"), #2 d'), c), #2 d')
+ in
+ bind (ctx, NamedE (x, n, t, NONE, s))
+ end
in
S.map2 (mff ctx' ds',
fn ds' =>
@@ -1148,7 +1158,8 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
| DTable (_, n, _, _, _, _, _, _) => Int.max (n, count)
| DSequence (_, n, _) => Int.max (n, count)
| DDatabase _ => count
- | DCookie (_, n, _, _) => Int.max (n, count)) 0
+ | DCookie (_, n, _, _) => Int.max (n, count)
+ | DStyle (_, n, _, _) => Int.max (n, count)) 0
end
diff --git a/src/corify.sml b/src/corify.sml
index e3b9a365..1a5bab06 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -1002,6 +1002,13 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
in
([(L'.DCookie (x, n, corifyCon st c, s), loc)], st)
end
+ | L.DStyle (_, x, n, c) =>
+ let
+ val (st, n) = St.bindVal st x n
+ val s = doRestify (mods, x)
+ in
+ ([(L'.DStyle (x, n, corifyCon st c, s), loc)], st)
+ end
and corifyStr mods ((str, _), st) =
case str of
@@ -1057,7 +1064,8 @@ fun maxName ds = foldl (fn ((d, _), n) =>
| L.DTable (_, _, n', _, _, _, _, _) => Int.max (n, n')
| L.DSequence (_, _, n') => Int.max (n, n')
| L.DDatabase _ => n
- | L.DCookie (_, _, n', _) => Int.max (n, n'))
+ | L.DCookie (_, _, n', _) => Int.max (n, n')
+ | L.DStyle (_, _, n', _) => Int.max (n, n'))
0 ds
and maxNameStr (str, _) =
diff --git a/src/elab.sml b/src/elab.sml
index 83a7f929..cabe0a94 100644
--- a/src/elab.sml
+++ b/src/elab.sml
@@ -171,6 +171,7 @@ datatype decl' =
| DClass of string * int * kind * con
| DDatabase of string
| DCookie of int * string * int * con
+ | DStyle of int * string * int * con
and str' =
StrConst of decl list
diff --git a/src/elab_env.sml b/src/elab_env.sml
index 1c3eb62e..828dface 100644
--- a/src/elab_env.sml
+++ b/src/elab_env.sml
@@ -1434,6 +1434,12 @@ fun declBinds env (d, loc) =
in
pushENamedAs env x n t
end
+ | DStyle (tn, x, n, c) =>
+ let
+ val t = (CApp ((CModProj (tn, [], "css_class"), loc), c), loc)
+ in
+ pushENamedAs env x n t
+ end
fun patBinds env (p, loc) =
case p of
diff --git a/src/elab_print.sml b/src/elab_print.sml
index 7eb853af..5028ff44 100644
--- a/src/elab_print.sml
+++ b/src/elab_print.sml
@@ -779,6 +779,13 @@ fun p_decl env (dAll as (d, _) : decl) =
string ":",
space,
p_con env c]
+ | DStyle (_, x, n, c) => box [string "style",
+ space,
+ p_named x n,
+ space,
+ string ":",
+ space,
+ p_con env c]
and p_str env (str, _) =
case str of
diff --git a/src/elab_util.sml b/src/elab_util.sml
index 17e67787..24a92e3f 100644
--- a/src/elab_util.sml
+++ b/src/elab_util.sml
@@ -796,6 +796,9 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
| DDatabase _ => ctx
| DCookie (tn, x, n, c) =>
bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "cookie"), loc),
+ c), loc)))
+ | DStyle (tn, x, n, c) =>
+ bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "css_class"), loc),
c), loc))),
mfd ctx d)) ctx ds,
fn ds' => (StrConst ds', loc))
@@ -911,6 +914,10 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f
S.map2 (mfc ctx c,
fn c' =>
(DCookie (tn, x, n, c'), loc))
+ | DStyle (tn, x, n, c) =>
+ S.map2 (mfc ctx c,
+ fn c' =>
+ (DStyle (tn, x, n, c'), loc))
and mfvi ctx (x, n, c, e) =
S.bind2 (mfc ctx c,
@@ -1050,6 +1057,7 @@ and maxNameDecl (d, _) =
| DSequence (n1, _, n2) => Int.max (n1, n2)
| DDatabase _ => 0
| DCookie (n1, _, n2, _) => Int.max (n1, n2)
+ | DStyle (n1, _, n2, _) => Int.max (n1, n2)
and maxNameStr (str, _) =
case str of
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 21b32f40..922c9c32 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1902,6 +1902,7 @@ val hnormSgn = E.hnormSgn
fun tableOf () = (L'.CModProj (!basis_r, [], "sql_table"), ErrorMsg.dummySpan)
fun sequenceOf () = (L'.CModProj (!basis_r, [], "sql_sequence"), ErrorMsg.dummySpan)
fun cookieOf () = (L'.CModProj (!basis_r, [], "http_cookie"), ErrorMsg.dummySpan)
+fun styleOf () = (L'.CModProj (!basis_r, [], "css_class"), ErrorMsg.dummySpan)
fun dopenConstraints (loc, env, denv) {str, strs} =
case E.lookupStr env str of
@@ -2401,6 +2402,7 @@ and sgiOfDecl (d, loc) =
| L'.DClass (x, n, k, c) => [(L'.SgiClass (x, n, k, c), loc)]
| L'.DDatabase _ => []
| L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)]
+ | L'.DStyle (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (styleOf (), c), loc)), loc)]
and subSgn env sgn1 (sgn2 as (_, loc2)) =
((*prefaces "subSgn" [("sgn1", p_sgn env sgn1),
@@ -3390,6 +3392,14 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) =
checkKind env c' k (L'.KType, loc);
([(L'.DCookie (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs))
end
+ | L.DStyle (x, c) =>
+ let
+ val (c', k, gs') = elabCon (env, denv) c
+ val (env, n) = E.pushENamed env x (L'.CApp (styleOf (), c'), loc)
+ in
+ checkKind env c' k (L'.KRecord (L'.KUnit, loc), loc);
+ ([(L'.DStyle (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs))
+ end
(*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
in
diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el
index 1f2a52be..834c28da 100644
--- a/src/elisp/urweb-mode.el
+++ b/src/elisp/urweb-mode.el
@@ -136,7 +136,7 @@ See doc for the variable `urweb-mode-info'."
"datatype" "else" "end" "extern" "fn" "map"
"fun" "functor" "if" "include"
"of" "open" "let" "in"
- "rec" "sequence" "sig" "signature" "cookie"
+ "rec" "sequence" "sig" "signature" "cookie" "style"
"struct" "structure" "table" "then" "type" "val" "where"
"with"
@@ -225,7 +225,7 @@ See doc for the variable `urweb-mode-info'."
("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
(1 font-lock-keyword-face)
(3 (amAttribute font-lock-type-def-face)))
- ("\\<\\(val\\|table\\|sequence\\|cookie\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
+ ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
(1 font-lock-keyword-face)
(3 (amAttribute font-lock-variable-name-face)))
("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
diff --git a/src/expl.sml b/src/expl.sml
index b9cbdaf1..ed4de953 100644
--- a/src/expl.sml
+++ b/src/expl.sml
@@ -145,6 +145,7 @@ datatype decl' =
| DSequence of int * string * int
| DDatabase of string
| DCookie of int * string * int * con
+ | DStyle of int * string * int * con
and str' =
StrConst of decl list
diff --git a/src/expl_env.sml b/src/expl_env.sml
index 64f4edc4..790c3aa8 100644
--- a/src/expl_env.sml
+++ b/src/expl_env.sml
@@ -319,6 +319,12 @@ fun declBinds env (d, loc) =
in
pushENamed env x n t
end
+ | DStyle (tn, x, n, c) =>
+ let
+ val t = (CApp ((CModProj (tn, [], "css_class"), loc), c), loc)
+ in
+ pushENamed env x n t
+ end
fun sgiBinds env (sgi, loc) =
case sgi of
diff --git a/src/expl_print.sml b/src/expl_print.sml
index 84002c00..c912bd66 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -691,6 +691,13 @@ fun p_decl env (dAll as (d, _) : decl) =
string ":",
space,
p_con env c]
+ | DStyle (_, x, n, c) => box [string "style",
+ space,
+ p_named x n,
+ space,
+ string ":",
+ space,
+ p_con env c]
and p_str env (str, _) =
case str of
diff --git a/src/explify.sml b/src/explify.sml
index 01a57d2e..32983619 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -187,6 +187,7 @@ fun explifyDecl (d, loc : EM.span) =
(L'.KArrow (explifyKind k, (L'.KType, loc)), loc), explifyCon c), loc)
| L.DDatabase s => SOME (L'.DDatabase s, loc)
| L.DCookie (nt, x, n, c) => SOME (L'.DCookie (nt, x, n, explifyCon c), loc)
+ | L.DStyle (nt, x, n, c) => SOME (L'.DStyle (nt, x, n, explifyCon c), loc)
and explifyStr (str, loc) =
case str of
diff --git a/src/mono.sml b/src/mono.sml
index 35db52bd..4723e30a 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -127,6 +127,8 @@ datatype decl' =
| DJavaScript of string
+ | DStyle of string * string list
+
withtype decl = decl' located
diff --git a/src/mono_env.sml b/src/mono_env.sml
index 248567de..df255325 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
+ | DStyle _ => env
fun patBinds env (p, loc) =
case p of
diff --git a/src/mono_print.sml b/src/mono_print.sml
index c75e81ba..3870ce41 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -440,6 +440,14 @@ fun p_decl env (dAll as (d, _) : decl) =
string s,
string ")"]
+ | DStyle (s, xs) => box [string "style",
+ space,
+ string s,
+ space,
+ string ":",
+ space,
+ p_list string xs]
+
fun p_file env file =
let
diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index 343ec728..d2426f9f 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -58,7 +58,8 @@ fun shake file =
| ((DTable _, _), acc) => acc
| ((DSequence _, _), acc) => acc
| ((DDatabase _, _), acc) => acc
- | ((DJavaScript _, _), acc) => acc)
+ | ((DJavaScript _, _), acc) => acc
+ | ((DStyle _, _), acc) => acc)
(IM.empty, IM.empty) file
fun typ (c, s) =
@@ -115,7 +116,8 @@ fun shake file =
| (DTable _, _) => true
| (DSequence _, _) => true
| (DDatabase _, _) => true
- | (DJavaScript _, _) => true) file
+ | (DJavaScript _, _) => true
+ | (DStyle _, _) => true) file
end
end
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 485e64f6..62a2dfe0 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
+ | DStyle _ => S.return2 dAll
and mfvi ctx (x, n, t, e, s) =
S.bind2 (mft t,
@@ -555,6 +556,7 @@ fun mapfoldB (all as {bind, ...}) =
| DSequence _ => ctx
| DDatabase _ => ctx
| DJavaScript _ => ctx
+ | DStyle _ => ctx
in
S.map2 (mff ctx' ds',
fn ds' =>
@@ -603,7 +605,8 @@ val maxName = foldl (fn ((d, _) : decl, count) =>
| DTable _ => count
| DSequence _ => count
| DDatabase _ => count
- | DJavaScript _ => count) 0
+ | DJavaScript _ => count
+ | DStyle _ => count) 0
end
diff --git a/src/monoize.sml b/src/monoize.sml
index bf26fda2..8030b7ba 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2705,6 +2705,23 @@ fun monoDecl (env, fm) (all as (d, loc)) =
fm,
[(L'.DVal (x, n, t', e, s), loc)])
end
+ | L.DStyle (x, n, (L.CRecord (_, xcs), _), s) =>
+ let
+ val xs = map (fn ((L.CName x, _), _) => x
+ | (x, _) => (E.errorAt (#2 x) "Undetermined style component";
+ Print.eprefaces' [("Name", CorePrint.p_con env x)];
+ "")) xcs
+
+ val t = (L.CFfi ("Basis", "string"), loc)
+ val t' = (L'.TFfi ("Basis", "string"), loc)
+ val e = (L'.EPrim (Prim.String s), loc)
+ in
+ SOME (Env.pushENamed env x n t NONE s,
+ fm,
+ [(L'.DStyle (s, xs), loc),
+ (L'.DVal (x, n, t', e, s), loc)])
+ end
+ | L.DStyle _ => poly ()
end
datatype expungable = Client | Channel
diff --git a/src/prepare.sml b/src/prepare.sml
index 258b9dcf..8e31b73d 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)
+ | DStyle _ => (d, sns)
fun prepare (ds, ps) =
let
diff --git a/src/reduce.sml b/src/reduce.sml
index 25cc6274..714b55d7 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -469,6 +469,7 @@ fun reduce file =
| DSequence _ => (d, st)
| DDatabase _ => (d, st)
| DCookie (s, n, c, s') => ((DCookie (s, n, con namedC [] c, s'), loc), st)
+ | DStyle (s, n, c, s') => ((DStyle (s, n, con namedC [] c, s'), loc), st)
val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty) file
in
diff --git a/src/reduce_local.sml b/src/reduce_local.sml
index a49d7115..cf602406 100644
--- a/src/reduce_local.sml
+++ b/src/reduce_local.sml
@@ -152,6 +152,7 @@ fun reduce file =
| DSequence _ => d
| DDatabase _ => d
| DCookie _ => d
+ | DStyle _ => d
in
map doDecl file
end
diff --git a/src/shake.sml b/src/shake.sml
index 378e8276..9c95d6a3 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -86,6 +86,8 @@ fun shake file =
(cdef, IM.insert (edef, n, ([], dummyt, dummye)))
| ((DDatabase _, _), acc) => acc
| ((DCookie (_, n, c, _), _), (cdef, edef)) =>
+ (cdef, IM.insert (edef, n, ([], c, dummye)))
+ | ((DStyle (_, n, c, _), _), (cdef, edef)) =>
(cdef, IM.insert (edef, n, ([], c, dummye))))
(IM.empty, IM.empty) file
@@ -160,7 +162,8 @@ fun shake file =
| (DTable _, _) => true
| (DSequence _, _) => true
| (DDatabase _, _) => true
- | (DCookie _, _) => true) file
+ | (DCookie _, _) => true
+ | (DStyle _, _) => true) file
end
end
diff --git a/src/source.sml b/src/source.sml
index 3bd8e22a..a35c61be 100644
--- a/src/source.sml
+++ b/src/source.sml
@@ -164,6 +164,7 @@ datatype decl' =
| DClass of string * kind * con
| DDatabase of string
| DCookie of string * con
+ | DStyle of string * con
and str' =
StrConst of decl list
diff --git a/src/source_print.sml b/src/source_print.sml
index 94a175ac..bc933d57 100644
--- a/src/source_print.sml
+++ b/src/source_print.sml
@@ -640,6 +640,13 @@ fun p_decl ((d, _) : decl) =
string ":",
space,
p_con c]
+ | DStyle (x, c) => box [string "style",
+ space,
+ string x,
+ space,
+ string ":",
+ space,
+ p_con c]
and p_str (str, _) =
case str of
diff --git a/src/unnest.sml b/src/unnest.sml
index 1d0c2388..c321b34d 100644
--- a/src/unnest.sml
+++ b/src/unnest.sml
@@ -407,6 +407,7 @@ fun unnest file =
| DClass _ => default ()
| DDatabase _ => default ()
| DCookie _ => default ()
+ | DStyle _ => default ()
end
and doStr (all as (str, loc), st) =
diff --git a/src/urweb.grm b/src/urweb.grm
index 7288359a..0d750679 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -194,7 +194,7 @@ datatype prop_kind = Delete | Update
| LET | IN
| STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL
| INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE
- | COOKIE
+ | COOKIE | STYLE
| CASE | IF | THEN | ELSE
| XML_BEGIN of string | XML_END | XML_BEGIN_END of string
@@ -451,6 +451,7 @@ decl : CON SYMBOL cargl2 kopt EQ cexp (let
[(DClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))]
end)
| COOKIE SYMBOL COLON cexp ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))])
+ | STYLE SYMBOL COLON cexp ([(DStyle (SYMBOL, cexp), s (STYLEleft, cexpright))])
kopt : (NONE)
| DCOLON kind (SOME kind)
@@ -707,6 +708,13 @@ sgi : CON SYMBOL DCOLON kind ((SgiConAbs (SYMBOL, kind), s (CONleft,
in
(SgiVal (SYMBOL, t), loc)
end)
+ | STYLE SYMBOL COLON cexp (let
+ val loc = s (STYLEleft, cexpright)
+ val t = (CApp ((CVar (["Basis"], "css_class"), loc),
+ cexp), loc)
+ in
+ (SgiVal (SYMBOL, t), loc)
+ end)
sgis : ([])
| sgi sgis (sgi :: sgis)
diff --git a/src/urweb.lex b/src/urweb.lex
index 4b3eb2af..534d51c6 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -319,6 +319,7 @@ notags = [^<{\n]+;
<INITIAL> "sequence" => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext));
<INITIAL> "class" => (Tokens.CLASS (pos yypos, pos yypos + size yytext));
<INITIAL> "cookie" => (Tokens.COOKIE (pos yypos, pos yypos + size yytext));
+<INITIAL> "style" => (Tokens.STYLE (pos yypos, pos yypos + size yytext));
<INITIAL> "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext));
<INITIAL> "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext));