changeset 718:f152f215a02c

style declarations
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Apr 2009 10:08:11 -0400
parents e28637743279
children 5c099b1308ae
files lib/ur/basis.urs src/cjr.sml src/cjr_env.sml src/cjr_print.sml src/cjrize.sml src/core.sml src/core_env.sml src/core_print.sml src/core_util.sml src/corify.sml src/elab.sml src/elab_env.sml src/elab_print.sml src/elab_util.sml src/elaborate.sml src/elisp/urweb-mode.el src/expl.sml src/expl_env.sml src/expl_print.sml src/explify.sml src/mono.sml src/mono_env.sml src/mono_print.sml src/mono_shake.sml src/mono_util.sml src/monoize.sml src/prepare.sml src/reduce.sml src/reduce_local.sml src/shake.sml src/source.sml src/source_print.sml src/unnest.sml src/urweb.grm src/urweb.lex tests/style.ur tests/style.urp
diffstat 37 files changed, 177 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Thu Apr 09 16:36:50 2009 -0400
+++ b/lib/ur/basis.urs	Sun Apr 12 10:08:11 2009 -0400
@@ -405,6 +405,9 @@
 
 (** 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 xtr = xml [Body, Tr] [] []
 con xform = xml [Body, Form] [] []
 
+
 (*** HTML details *)
 
 con html = [Html]
--- a/src/cjr.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/cjr.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -110,6 +110,7 @@
        | DPreparedStatements of (string * int) list
 
        | DJavaScript of string
+       | DStyle of string * string list
 
 withtype decl = decl' located
 
--- a/src/cjr_env.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/cjr_env.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -167,6 +167,6 @@
       | DDatabase _ => env
       | DPreparedStatements _ => env
       | DJavaScript _ => env
-
+      | DStyle _ => env
 
 end
--- a/src/cjr_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/cjr_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -2146,6 +2146,17 @@
       | 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
--- a/src/cjrize.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/cjrize.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -556,6 +556,7 @@
         (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
--- a/src/core.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/core.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -134,6 +134,7 @@
        | DSequence of string * int * string
        | DDatabase of string
        | DCookie of string * int * con * string
+       | DStyle of string * int * con * string
 
 withtype decl = decl' located
 
--- a/src/core_env.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/core_env.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -334,6 +334,12 @@
         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
--- a/src/core_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/core_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -586,6 +586,17 @@
                                      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
--- a/src/core_util.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/core_util.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -951,6 +951,10 @@
                 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 @@
                                         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 @@
                           | 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
 
--- a/src/corify.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/corify.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -1002,6 +1002,13 @@
         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 @@
                              | 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, _) =
--- a/src/elab.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elab.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -171,6 +171,7 @@
        | 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
--- a/src/elab_env.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elab_env.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -1434,6 +1434,12 @@
         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
--- a/src/elab_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elab_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -779,6 +779,13 @@
                                      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
--- a/src/elab_util.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elab_util.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -796,6 +796,9 @@
                                                  | 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 @@
                 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 @@
       | 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
--- a/src/elaborate.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elaborate.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -1902,6 +1902,7 @@
 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 @@
       | 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 @@
                     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
--- a/src/elisp/urweb-mode.el	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/elisp/urweb-mode.el	Sun Apr 12 10:08:11 2009 -0400
@@ -136,7 +136,7 @@
 	       "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 @@
     ("\\<\\(\\(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+\\)"
--- a/src/expl.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/expl.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -145,6 +145,7 @@
        | 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
--- a/src/expl_env.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/expl_env.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -319,6 +319,12 @@
         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
--- a/src/expl_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/expl_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -691,6 +691,13 @@
                                      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
--- a/src/explify.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/explify.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -187,6 +187,7 @@
                                                 (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
--- a/src/mono.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/mono.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -127,6 +127,8 @@
 
        | DJavaScript of string
 
+       | DStyle of string * string list
+
 
 withtype decl = decl' located
 
--- a/src/mono_env.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/mono_env.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -111,6 +111,7 @@
       | DSequence _ => env
       | DDatabase _ => env
       | DJavaScript _ => env
+      | DStyle _ => env
 
 fun patBinds env (p, loc) =
     case p of
--- a/src/mono_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/mono_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -440,6 +440,14 @@
                               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
--- a/src/mono_shake.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/mono_shake.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -58,7 +58,8 @@
                                    | ((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 @@
                       | (DTable _, _) => true
                       | (DSequence _, _) => true
                       | (DDatabase _, _) => true
-                      | (DJavaScript _, _) => true) file
+                      | (DJavaScript _, _) => true
+                      | (DStyle _, _) => true) file
     end
 
 end
--- a/src/mono_util.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/mono_util.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -474,6 +474,7 @@
               | 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 @@
                                       | DSequence _ => ctx
                                       | DDatabase _ => ctx
                                       | DJavaScript _ => ctx
+                                      | DStyle _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
                                      fn ds' =>
@@ -603,7 +605,8 @@
                           | DTable _ => count
                           | DSequence _ => count
                           | DDatabase _ => count
-                          | DJavaScript _ => count) 0
+                          | DJavaScript _ => count
+                          | DStyle _ => count) 0
 
 end
 
--- a/src/monoize.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/monoize.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -2705,6 +2705,23 @@
                       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
--- a/src/prepare.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/prepare.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -259,6 +259,7 @@
       | DDatabase _ => (d, sns)
       | DPreparedStatements _ => (d, sns)
       | DJavaScript _ => (d, sns)
+      | DStyle _ => (d, sns)
 
 fun prepare (ds, ps) =
     let
--- a/src/reduce.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/reduce.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -469,6 +469,7 @@
               | 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
--- a/src/reduce_local.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/reduce_local.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -152,6 +152,7 @@
               | DSequence _ => d
               | DDatabase _ => d
               | DCookie _ => d
+              | DStyle _ => d
     in
         map doDecl file
     end
--- a/src/shake.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/shake.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -86,6 +86,8 @@
                                      (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 @@
                       | (DTable _, _) => true
                       | (DSequence _, _) => true
                       | (DDatabase _, _) => true
-                      | (DCookie _, _) => true) file
+                      | (DCookie _, _) => true
+                      | (DStyle _, _) => true) file
     end
 
 end
--- a/src/source.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/source.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -164,6 +164,7 @@
        | DClass of string * kind * con
        | DDatabase of string
        | DCookie of string * con
+       | DStyle of string * con
 
      and str' =
          StrConst of decl list
--- a/src/source_print.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/source_print.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -640,6 +640,13 @@
                                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
--- a/src/unnest.sml	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/unnest.sml	Sun Apr 12 10:08:11 2009 -0400
@@ -407,6 +407,7 @@
                   | DClass _ => default ()
                   | DDatabase _ => default ()
                   | DCookie _ => default ()
+                  | DStyle _ => default ()
             end
 
         and doStr (all as (str, loc), st) =
--- a/src/urweb.grm	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/urweb.grm	Sun Apr 12 10:08:11 2009 -0400
@@ -194,7 +194,7 @@
  | 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 @@
                                              [(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 @@
                                          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)
--- a/src/urweb.lex	Thu Apr 09 16:36:50 2009 -0400
+++ b/src/urweb.lex	Sun Apr 12 10:08:11 2009 -0400
@@ -319,6 +319,7 @@
 <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));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/style.ur	Sun Apr 12 10:08:11 2009 -0400
@@ -0,0 +1,6 @@
+style q : []
+style r : [Table, List]
+
+fun main () : transaction page = return <xml><body>
+  Hi.
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/style.urp	Sun Apr 12 10:08:11 2009 -0400
@@ -0,0 +1,3 @@
+debug
+
+style