From 30eeaff2c92fb1d0ba029a7688fc7b547a60c150 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 12 Apr 2009 10:08:11 -0400 Subject: style declarations --- lib/ur/basis.urs | 4 ++++ src/cjr.sml | 1 + src/cjr_env.sml | 2 +- src/cjr_print.sml | 11 +++++++++++ src/cjrize.sml | 1 + src/core.sml | 1 + src/core_env.sml | 6 ++++++ src/core_print.sml | 11 +++++++++++ src/core_util.sml | 13 ++++++++++++- src/corify.sml | 10 +++++++++- src/elab.sml | 1 + src/elab_env.sml | 6 ++++++ src/elab_print.sml | 7 +++++++ src/elab_util.sml | 8 ++++++++ src/elaborate.sml | 10 ++++++++++ src/elisp/urweb-mode.el | 4 ++-- src/expl.sml | 1 + src/expl_env.sml | 6 ++++++ src/expl_print.sml | 7 +++++++ src/explify.sml | 1 + src/mono.sml | 2 ++ src/mono_env.sml | 1 + src/mono_print.sml | 8 ++++++++ src/mono_shake.sml | 6 ++++-- src/mono_util.sml | 5 ++++- src/monoize.sml | 17 +++++++++++++++++ src/prepare.sml | 1 + src/reduce.sml | 1 + src/reduce_local.sml | 1 + src/shake.sml | 5 ++++- src/source.sml | 1 + src/source_print.sml | 7 +++++++ src/unnest.sml | 1 + src/urweb.grm | 10 +++++++++- src/urweb.lex | 1 + tests/style.ur | 6 ++++++ tests/style.urp | 3 +++ 37 files changed, 177 insertions(+), 10 deletions(-) create mode 100644 tests/style.ur create mode 100644 tests/style.urp diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index f2f378ee..9eeb4891 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -405,6 +405,9 @@ val nextval : sql_sequence -> transaction int (** XML *) +con css_class :: {Unit} -> Type +(* The argument lists categories of properties that this class could set usefully. *) + con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type @@ -440,6 +443,7 @@ con xbody = xml [Body] [] [] con xtr = xml [Body, Tr] [] [] con xform = xml [Body, Form] [] [] + (*** HTML details *) con html = [Html] 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]+; "sequence" => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext)); "class" => (Tokens.CLASS (pos yypos, pos yypos + size yytext)); "cookie" => (Tokens.COOKIE (pos yypos, pos yypos + size yytext)); + "style" => (Tokens.STYLE (pos yypos, pos yypos + size yytext)); "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext)); "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext)); diff --git a/tests/style.ur b/tests/style.ur new file mode 100644 index 00000000..f622ecfd --- /dev/null +++ b/tests/style.ur @@ -0,0 +1,6 @@ +style q : [] +style r : [Table, List] + +fun main () : transaction page = return + Hi. + diff --git a/tests/style.urp b/tests/style.urp new file mode 100644 index 00000000..fdb25a8b --- /dev/null +++ b/tests/style.urp @@ -0,0 +1,3 @@ +debug + +style -- cgit v1.2.3