changeset 2241:2b1af5dc6dee

Merge.
author Ziv Scully <ziv@mit.edu>
date Sun, 19 Jul 2015 19:05:16 -0700
parents 88cc0f44c940 598a5f781d39
children 200a7ed4343b
files src/c/urweb.c src/cjr_print.sml src/compiler.sml src/monoize.sml src/urweb.lex
diffstat 21 files changed, 165 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGELOG	Sun Jul 19 19:03:11 2015 -0700
+++ b/CHANGELOG	Sun Jul 19 19:05:16 2015 -0700
@@ -1,3 +1,17 @@
+========
+20150520
+========
+
+- Change default behavior of client-side GUI event handlers:
+  By default, events are now passed to handlers on parent DOM nodes as well,
+  just like in normal JavaScript.
+  Call [preventDefault] or [stopPropagation] to tweak that behavior.
+  WARNING: This change may break backward compatibility!
+- URIs specified with 'file' .urp directive are implicitly allowed to be referenced.
+- New HTML tags: <fieldset>, <legend>
+- New urweb-mode Emacs command: 'urweb-close-matching-tag'
+- Bug fixes
+
 ========
 20150412
 ========
--- a/configure.ac	Sun Jul 19 19:03:11 2015 -0700
+++ b/configure.ac	Sun Jul 19 19:05:16 2015 -0700
@@ -1,4 +1,4 @@
-AC_INIT([urweb], [20150412])
+AC_INIT([urweb], [20150520])
 WORKING_VERSION=1
 AC_USE_SYSTEM_EXTENSIONS
 
--- a/doc/manual.tex	Sun Jul 19 19:03:11 2015 -0700
+++ b/doc/manual.tex	Sun Jul 19 19:05:16 2015 -0700
@@ -509,8 +509,8 @@
   &&& \ell & \textrm{constant} \\
   &&& \hat{X} & \textrm{nullary constructor} \\
   &&& \hat{X} \; p & \textrm{unary constructor} \\
-  &&& \{(x = p,)^*\} & \textrm{rigid record pattern} \\
-  &&& \{(x = p,)^+, \ldots\} & \textrm{flexible record pattern} \\
+  &&& \{(X = p,)^*\} & \textrm{rigid record pattern} \\
+  &&& \{(X = p,)^+, \ldots\} & \textrm{flexible record pattern} \\
   &&& p : \tau & \textrm{type annotation} \\
   &&& (p) & \textrm{explicit precedence} \\
   \\
@@ -968,11 +968,11 @@
   & \Gamma \vdash p \leadsto \Gamma'; \overline{[x_i \mapsto \tau'_i]}\tau''
 }$$
 
-$$\infer{\Gamma \vdash \{\overline{x = p}\} \leadsto \Gamma_n; \{\overline{x = \tau}\}}{
+$$\infer{\Gamma \vdash \{\overline{X = p}\} \leadsto \Gamma_n; \{\overline{X = \tau}\}}{
   \Gamma_0 = \Gamma
   & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
 }
-\quad \infer{\Gamma \vdash \{\overline{x = p}, \ldots\} \leadsto \Gamma_n; \$([\overline{x = \tau}] \rc c)}{
+\quad \infer{\Gamma \vdash \{\overline{X = p}, \ldots\} \leadsto \Gamma_n; \$([\overline{X = \tau}] \rc c)}{
   \Gamma_0 = \Gamma
   & \forall i: \Gamma_i \vdash p_i \leadsto \Gamma_{i+1}; \tau_i
 }$$
@@ -1424,7 +1424,7 @@
   \hspace{.1in} \to (\mt{nm} :: \mt{Name} \to \mt{v} :: \mt{K} \to \mt{r} :: \{\mt{K}\} \to [[\mt{nm}] \sim \mt{r}] \Rightarrow \\
   \hspace{.2in} \mt{tf} \; \mt{r} \to \mt{tf} \; ([\mt{nm} = \mt{v}] \rc \mt{r})) \\
   \hspace{.1in} \to \mt{tf} \; [] \\
-  \hspace{.1in} \to \mt{r} :: \{\mt{K}\} \to \mt{folder} \; \mt{r} \to \mt{tf} \; \mt{r}
+  \hspace{.1in} \to \mt{r} ::: \{\mt{K}\} \to \mt{folder} \; \mt{r} \to \mt{tf} \; \mt{r}
 \end{array}$$
 
 For a type-level record $\mt{r}$, a $\mt{folder} \; \mt{r}$ encodes a permutation of $\mt{r}$'s elements.  The $\mt{fold}$ function can be called on a $\mt{folder}$ to iterate over the elements of $\mt{r}$ in that order.  $\mt{fold}$ is parameterized on a type-level function to be used to calculate the type of each intermediate result of folding.  After processing a subset $\mt{r'}$ of $\mt{r}$'s entries, the type of the accumulator should be $\mt{tf} \; \mt{r'}$.  The next two expression arguments to $\mt{fold}$ are the usual step function and initial accumulator, familiar from fold functions over lists.  The final two arguments are the record to fold over and a $\mt{folder}$ for it.
@@ -1861,7 +1861,7 @@
 
 $$\begin{array}{l}
 \mt{val} \; \mt{sql\_subquery} : \mt{tables} ::: \{\{\mt{Type}\}\} \to \mt{agg} ::: \{\{\mt{Type}\}\} \to \mt{exps} ::: \{\mt{Type}\} \to \mt{nm} ::: \mt{Name} \to \mt{t} ::: \mt{Type} \to \mt{nt} ::: \mt{Type} \\
-\hspace{.1in} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_query} \; \mt{tables} \; \mt{agg} \; [\mt{nm} = \mt{t}] \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt}
+\hspace{.1in} \to \mt{nullify} \; \mt{t} \; \mt{nt} \to \mt{sql\_query} \; \mt{tables} \; \mt{agg} \; [] \; [\mt{nm} = \mt{t}] \to \mt{sql\_exp} \; \mt{tables} \; \mt{agg} \; \mt{exps} \; \mt{nt}
 \end{array}$$
 
 There is also an \cd{IF..THEN..ELSE..} construct that is compiled into standard SQL \cd{CASE} expressions.
@@ -1990,7 +1990,7 @@
   \hspace{.1in} \to \$(\mt{map} \; (\mt{sql\_exp} \; [] \; [] \; []) \; \mt{fields}) \to \mt{dml}
 \end{array}$$
 
-An $\mt{UPDATE}$ command is formed from a choice of which table fields to leave alone and which to change, along with an expression to use to compute the new value of each changed field and a $\mt{WHERE}$ clause.  Note that, in the table environment applied to expressions, the table being updated is hardcoded at the name $\mt{T}$.  The parsing extension for $\mt{UPDATE}$ will elaborate all table-free field references to use table variable $\mt{T}$.
+An $\mt{UPDATE}$ command is formed from a choice of which table fields to leave alone and which to change, along with an expression to use to compute the new value of each changed field and a $\mt{WHERE}$ clause.  Note that, in the table environment applied to expressions, the table being updated is hardcoded at the name $\mt{T}$.  The parsing extension for $\mt{UPDATE}$ will elaborate all table-free field references to use constant table name $\mt{T}$.
 $$\begin{array}{l}
   \mt{val} \; \mt{update} : \mt{unchanged} ::: \{\mt{Type}\} \to \mt{changed} :: \{\mt{Type}\} \to [\mt{changed} \sim \mt{unchanged}] \\
   \hspace{.1in} \Rightarrow \$(\mt{map} \; (\mt{sql\_exp} \; [\mt{T} = \mt{changed} \rc \mt{unchanged}] \; [] \; []) \; \mt{changed}) \\
@@ -2287,11 +2287,12 @@
   \textrm{Tables} & T &::=& x & \textrm{table variable, named locally by its own capitalization} \\
   &&& x \; \mt{AS} \; X & \textrm{table variable, with local name} \\
   &&& x \; \mt{AS} \; \{c\} & \textrm{table variable, with computed local name} \\
-  &&& \{\{e\}\} \; \mt{AS} \; t & \textrm{computed table expression, with local name} \\
+  &&& \{\{e\}\} \; \mt{AS} \; X & \textrm{computed table expression, with local name} \\
   &&& \{\{e\}\} \; \mt{AS} \; \{c\} & \textrm{computed table expression, with computed local name} \\
   \textrm{$\mt{FROM}$ items} & F &::=& T \mid \{\{e\}\} \mid F \; J \; \mt{JOIN} \; F \; \mt{ON} \; E \\
   &&& \mid F \; \mt{CROSS} \; \mt{JOIN} \ F \\
-  &&& \mid (Q) \; \mt{AS} \; t \mid (\{\{e\}\}) \; \mt{AS} \; t \\
+  &&& \mid (Q) \; \mt{AS} \; X \mid (Q) \; \mt{AS} \; \{c\} \\
+  &&& \mid (\{\{e\}\}) \; \mt{AS} \; t \\
   \textrm{Joins} & J &::=& [\mt{INNER}] \\
   &&& \mid [\mt{LEFT} \mid \mt{RIGHT} \mid \mt{FULL}] \; [\mt{OUTER}] \\
   \textrm{SQL expressions} & E &::=& t.f & \textrm{column references} \\
--- a/lib/ur/basis.urs	Sun Jul 19 19:03:11 2015 -0700
+++ b/lib/ur/basis.urs	Sun Jul 19 19:05:16 2015 -0700
@@ -811,21 +811,6 @@
 val title : unit -> tag [Data = data_attr] head [] [] []
 val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] []
 
-val body : unit -> tag [Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
-                       html body [] []
-con bodyTag = fn (attrs :: {Type}) =>
-                 ctx ::: {Unit} ->
-                 [[Body] ~ ctx] =>
-                    unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
-con bodyTagStandalone = fn (attrs :: {Type}) =>
-                           ctx ::: {Unit}
-                           -> [[Body] ~ ctx] =>
-                                 unit -> tag attrs ([Body] ++ ctx) [] [] []
-
-val br : bodyTagStandalone [Data = data_attr, Id = id]
-
-con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
-
 datatype mouseButton = Left | Right | Middle
 
 type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int,
@@ -841,6 +826,24 @@
 con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit)
                         [Onkeydown, Onkeypress, Onkeyup]
 
+val body : unit -> tag ([Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit]
+                            ++ mouseEvents ++ keyEvents)
+                       html body [] []
+
+con bodyTag = fn (attrs :: {Type}) =>
+                 ctx ::: {Unit} ->
+                 [[Body] ~ ctx] =>
+                    unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
+con bodyTagStandalone = fn (attrs :: {Type}) =>
+                           ctx ::: {Unit}
+                           -> [[Body] ~ ctx] =>
+                                 unit -> tag attrs ([Body] ++ ctx) [] [] []
+
+val br : bodyTagStandalone [Data = data_attr, Id = id]
+
+con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit]
+
+
 (* Key arguments are character codes. *)
 con resizeEvents = [Onresize = transaction unit]
 con scrollEvents = [Onscroll = transaction unit]
@@ -848,8 +851,8 @@
 con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents
 con tableEvents = focusEvents ++ mouseEvents ++ keyEvents
 
-con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string] ++ boxEvents
-con tableAttrs = [Data = data_attr, Id = id, Title = string] ++ tableEvents
+con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string, Align = string] ++ boxEvents
+con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents
 
 val span : bodyTag boxAttrs
 val div : bodyTag boxAttrs
@@ -1008,7 +1011,7 @@
 
 con radio = [Body, Radio]
 val radio : formTag (option string) radio [Data = data_attr, Id = id]
-val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] []
+val radioOption : unit -> tag ([Value = string, Checked = bool, Onchange = transaction unit] ++ boxAttrs) radio [] [] []
 
 con select = [Select]
 val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs)
@@ -1028,6 +1031,9 @@
 
 val label : bodyTag ([For = id, Accesskey = string] ++ tableAttrs)
 
+val fieldset : bodyTag boxAttrs
+val legend : bodyTag boxAttrs
+
 
 (*** AJAX-oriented widgets *)
 
--- a/lib/ur/top.ur	Sun Jul 19 19:03:11 2015 -0700
+++ b/lib/ur/top.ur	Sun Jul 19 19:05:16 2015 -0700
@@ -410,3 +410,6 @@
     if x > y then x else y
 fun min [t] ( _ : ord t) (x : t) (y : t) : t =
     if x < y then x else y
+
+fun assert [a] (cond: bool) (msg: string) (loc: string) (x:a): a =
+  if cond then x else error <xml>{txt msg} at {txt loc}</xml>
--- a/lib/ur/top.urs	Sun Jul 19 19:03:11 2015 -0700
+++ b/lib/ur/top.urs	Sun Jul 19 19:05:16 2015 -0700
@@ -290,3 +290,10 @@
 
 val max : t ::: Type -> ord t -> t -> t -> t
 val min : t ::: Type -> ord t -> t -> t -> t
+
+val assert : t ::: Type
+             -> bool   (* Did we avoid something bad? *)
+             -> string (* Explanation of the bad thing *)
+             -> string (* Source location of the bad thing *)
+             -> t      (* Return this value if all went well. *)
+             -> t
--- a/src/c/static.c	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/c/static.c	Sun Jul 19 19:05:16 2015 -0700
@@ -37,7 +37,7 @@
   while (1) {
     fk = uw_begin(ctx, argv[1]);
 
-    if (fk == SUCCESS) {
+    if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
       uw_print(ctx, 1);
       puts("");
       return 0;
--- a/src/c/urweb.c	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/c/urweb.c	Sun Jul 19 19:05:16 2015 -0700
@@ -4235,7 +4235,10 @@
 size_t uw_database_max = SIZE_MAX;
 
 uw_Basis_int uw_Basis_naughtyDebug(uw_context ctx, uw_Basis_string s) {
-  fprintf(stderr, "%s\n", s);
+  if (ctx->loggers->log_debug)
+    ctx->loggers->log_debug(ctx->loggers->logger_data, "%s\n", s);
+  else
+    fprintf(stderr, "%s\n", s);
   return 0;
 }
 
--- a/src/cjr_print.sml	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/cjr_print.sml	Sun Jul 19 19:05:16 2015 -0700
@@ -3672,8 +3672,7 @@
                                                             let
                                                                 val t = sql_type_in env t
                                                             in
-                                                                box [string "uw_",
-                                                                     string (CharVector.map Char.toLower x),
+                                                                box [string (Settings.mangleSql (CharVector.map Char.toLower x)),
                                                                      space,
                                                                      string (#p_sql_type (Settings.currentDbms ()) t),
                                                                      case t of
--- a/src/compiler.sml	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/compiler.sml	Sun Jul 19 19:05:16 2015 -0700
@@ -875,7 +875,8 @@
                                      (case String.fields Char.isSpace arg of
                                           [uri, fname] => (Settings.setFilePath thisPath;
                                                            Settings.addFile {Uri = uri,
-                                                                             LoadFromFilename = fname})
+                                                                             LoadFromFilename = fname};
+                                                           url := {action = Settings.Allow, kind = Settings.Exact, pattern = uri} :: !url)
                                         | _ => ErrorMsg.error "Bad 'file' arguments")
 
                                    | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
--- a/src/core_util.sml	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/core_util.sml	Sun Jul 19 19:05:16 2015 -0700
@@ -203,7 +203,7 @@
       | (_, CConcat _) => GREATER
 
       | (CMap (d1, r1), CMap (d2, r2)) =>
-        join (Kind.compare (d1, r2),
+        join (Kind.compare (d1, d2),
               fn () => Kind.compare (r1, r2))
       | (CMap _, _) => LESS
       | (_, CMap _) => GREATER
@@ -607,15 +607,19 @@
               | ERel _ => S.return2 eAll
               | ENamed _ => S.return2 eAll
               | ECon (dk, pc, cs, NONE) =>
-                S.map2 (ListUtil.mapfold (mfc ctx) cs,
-                        fn cs' =>
-                           (ECon (dk, pc, cs', NONE), loc))
-              | ECon (dk, n, cs, SOME e) =>
-                S.bind2 (mfe ctx e,
-                      fn e' =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
                          S.map2 (ListUtil.mapfold (mfc ctx) cs,
-                                 fn cs' =>
-                                    (ECon (dk, n, cs', SOME e'), loc)))
+                              fn cs' =>
+                                 (ECon (dk, pc', cs', NONE), loc)))
+              | ECon (dk, pc, cs, SOME e) =>
+                S.bind2 (mfpc ctx pc,
+                      fn pc' =>
+                         S.bind2 (mfe ctx e,
+                               fn e' =>
+                                  S.map2 (ListUtil.mapfold (mfc ctx) cs,
+                                       fn cs' =>
+                                          (ECon (dk, pc', cs', SOME e'), loc))))
               | EFfi _ => S.return2 eAll
               | EFfiApp (m, x, es) =>
                 S.map2 (ListUtil.mapfold (mfet ctx) es,
--- a/src/elisp/urweb-defs.el	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/elisp/urweb-defs.el	Sun Jul 19 19:05:16 2015 -0700
@@ -108,7 +108,7 @@
                  "datatype" "type" "open" "include"
                  urweb-module-head-syms
                  "con" "map" "where" "extern" "constraint" "constraints"
-                 "table" "sequence" "class" "cookie" "task" "policy")
+                 "table" "sequence" "class" "cookie" "style" "task" "policy")
   "Symbols starting an sexp.")
 
 ;; (defconst urweb-not-arg-start-re
@@ -135,7 +135,7 @@
      (("case" "datatype" "if" "then" "else"
        "let" "open" "sig" "struct" "type" "val"
        "con" "constraint" "table" "sequence" "class" "cookie"
-       "task" "policy")))))
+       "style" "task" "policy")))))
 
 (defconst urweb-starters-indent-after
   (urweb-syms-re "let" "in" "struct" "sig")
@@ -190,7 +190,7 @@
 	  '("datatype" "fun"
 	    "open" "type" "val" "and"
 	    "con" "constraint" "table" "sequence" "class" "cookie"
-            "task" "policy"))
+            "style" "task" "policy"))
   "The starters of new expressions.")
 
 (defconst urweb-exptrail-syms
--- a/src/elisp/urweb-mode.el	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/elisp/urweb-mode.el	Sun Jul 19 19:05:16 2015 -0700
@@ -179,11 +179,11 @@
         (let ((xml-tag (length (or (match-string 3) "")))
               (ch (match-string 2)))
          (cond
-          ((equal ch ?\{)
+          ((equal ch "{")
            (if (> depth 0)
                (decf depth)
              (setq finished t)))
-          ((equal ch ?\})
+          ((equal ch "}")
            (incf depth))
           ((= xml-tag 3)
            (if (> depth 0)
@@ -194,14 +194,14 @@
           ((= xml-tag 4)
            (incf depth))
 
-          ((equal ch ?-)
+          ((equal ch "-")
            (if (looking-at "->")
                (setq finished (= depth 0))))
 
           ((and (= depth 0)
                 (not (looking-at "<xml")) ;; ignore <xml/>
-                (eq font-lock-tag-face
-                    (get-text-property (point) 'face)))
+                (let ((face (get-text-property (point) 'face)))
+                  (funcall (if (listp face) #'member #'equal) 'font-lock-tag-face face)))
            ;; previous code was highlighted as tag, seems we are in xml
            (progn
              (setq answer t)
@@ -401,6 +401,7 @@
   (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
 
   (local-set-key (kbd "C-c C-c") 'compile)
+  (local-set-key (kbd "C-c /") 'urweb-close-matching-tag)
 
   (urweb-mode-variables))
 
@@ -542,6 +543,16 @@
     (beginning-of-line)
     (current-indentation)))
 
+(defun urweb-close-matching-tag ()
+  "Insert a closing XML tag for whatever tag is open at the point."
+  (interactive)
+  (assert (urweb-in-xml))
+  (save-excursion
+   (urweb-tag-matcher)
+   (re-search-forward "<\\([^ ={/>]+\\)" nil t))
+  (let ((tag (match-string-no-properties 1)))
+    (insert "</" tag ">")))
+
 (defconst urweb-sql-main-starters
   '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE" "FROM" "SELECT1" "WHERE"))
 
--- a/src/monoize.sml	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/monoize.sml	Sun Jul 19 19:05:16 2015 -0700
@@ -2225,6 +2225,19 @@
             let
                 val t = monoType env t
                 val s = (L'.TFfi ("Basis", "string"), loc)
+
+                fun toSqlType (t : L'.typ) =
+                    case #1 t of
+                        L'.TFfi ("Basis", "int") => Settings.Int
+                      | L'.TFfi ("Basis", "float") => Settings.Float
+                      | L'.TFfi ("Basis", "string") => Settings.String
+                      | L'.TFfi ("Basis", "char") => Settings.Char
+                      | L'.TFfi ("Basis", "bool") => Settings.Bool
+                      | L'.TFfi ("Basis", "time") => Settings.Time
+                      | L'.TFfi ("Basis", "blob") => Settings.Blob
+                      | L'.TFfi ("Basis", "channel") => Settings.Channel
+                      | L'.TFfi ("Basis", "client") => Settings.Client
+                      | _ => raise Fail "Monoize/sql_option_prim: invalid SQL type"
             in
                 ((L'.EAbs ("f",
                            (L'.TFun (t, s), loc),
@@ -2234,7 +2247,7 @@
                                      s,
                                      (L'.ECase ((L'.ERel 0, loc),
                                                 [((L'.PNone t, loc),
-                                                  str "NULL"),
+                                                  str (#p_cast (Settings.currentDbms ()) ("NULL", toSqlType t))),
                                                  ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc),
                                                   (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))],
                                                 {disc = (L'.TOption t, loc),
@@ -3413,7 +3426,7 @@
                                                                        strH s',
                                                                        (L'.EStrcat (
                                                                         (L'.EJavaScript (L'.Attribute, e), loc),
-                                                                        strH ");return false'"), loc)),
+                                                                        strH ")'"), loc)),
                                                                        loc)), loc),
                                                          fm)
                                                     end
--- a/src/urweb.grm	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/urweb.grm	Sun Jul 19 19:05:16 2015 -0700
@@ -1624,6 +1624,7 @@
                                                          val e = (EVar (["Basis"], "form", Infer), pos)
                                                          val e = (EApp (e, case #2 tag of
                                                                                NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                                             | SOME (EPrim (Prim.String (_, s)), _) => (EApp ((EVar (["Basis"], "Some", Infer), pos), parseClass s pos), pos)
                                                                              | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
                                                      in
                                                          case #3 tag of
--- a/src/urweb.lex	Sun Jul 19 19:03:11 2015 -0700
+++ b/src/urweb.lex	Sun Jul 19 19:05:16 2015 -0700
@@ -178,11 +178,11 @@
 
 id = [a-z_][A-Za-z0-9_']*;
 xmlid = [A-Za-z][A-Za-z0-9_-]*;
-cid = [A-Z][A-Za-z0-9_]*;
+cid = [A-Z][A-Za-z0-9_']*;
 ws = [\ \t\012\r];
 intconst = [0-9]+;
 realconst = [0-9]+\.[0-9]*;
-hexconst = 0x[0-9A-F]{1,8};
+hexconst = 0x[0-9A-F]+;
 notags = ([^<{\n(]|(\([^\*<{\n]))+;
 xcom = ([^\-]|(-[^\-]))+;
 oint = [0-9][0-9][0-9];
@@ -537,22 +537,34 @@
 
 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
 
-<INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
+<INITIAL> "_LOC_" => (let val strLoc = ErrorMsg.spanToString (ErrorMsg.spanOf
+                                            (pos yypos, pos yypos + size yytext))
+                      in
+                          Tokens.STRING (strLoc, pos yypos, pos yypos + size yytext)
+                      end);
 
 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
 
-<INITIAL> {hexconst}  => (case StringCvt.scanString (Int64.scan StringCvt.HEX) (String.extract (yytext, 2, NONE)) of
+<INITIAL> {hexconst}  => (let val digits = String.extract (yytext, 2, NONE)
+                              val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
+                                      handle Overflow => NONE
+                          in
+                          case v of
                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
                                                            ("Expected hexInt, received: " ^ yytext);
-                                         continue ()));
+                                         continue ())
+                         end);
 
-<INITIAL> {intconst}  => (case Int64.fromString yytext of
+<INITIAL> {intconst}  => (let val v = (Int64.fromString yytext) handle Overflow => NONE
+                          in 
+                          case v of
                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
                                                            ("Expected int, received: " ^ yytext);
-                                         continue ()));
+                                         continue ())
+                         end);
 <INITIAL> {realconst} => (case Real64.fromString yytext of
                             SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
                           | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/align.ur	Sun Jul 19 19:05:16 2015 -0700
@@ -0,0 +1,4 @@
+fun main () : transaction page = return <xml><body>
+  <p align="left">Left</p>
+  <p align="right">Right</p>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/bodyClick.ur	Sun Jul 19 19:05:16 2015 -0700
@@ -0,0 +1,6 @@
+fun main () : transaction page = return <xml>
+  <body onclick={fn _ => alert "You clicked the body."}
+        onkeyup={fn _ => alert "Key"}>
+    <p>Text</p>
+  </body>
+</xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/classy_form.ur	Sun Jul 19 19:05:16 2015 -0700
@@ -0,0 +1,9 @@
+style form_inline
+
+val main : transaction page = return <xml>
+  <body>
+    <form class="form-inline">
+      Problematic?
+    </form>
+  </body>
+</xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nomangle.ur	Sun Jul 19 19:05:16 2015 -0700
@@ -0,0 +1,7 @@
+table foo : { Bar : int, Baz : string }
+  PRIMARY KEY Baz
+
+fun main () : transaction page =
+    rs <- queryX1 (SELECT foo.Bar FROM foo WHERE foo.Baz = 'Hi')
+          (fn r => <xml>{[r.Bar]}</xml>);
+    return <xml><body>{rs}</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nomangle.urp	Sun Jul 19 19:05:16 2015 -0700
@@ -0,0 +1,5 @@
+database dbname=test
+noMangleSql
+sql nomangle.sql
+
+nomangle