diff src/urweb.grm @ 1749:f9e5a8e09cdf

Simplify type of Basis.tag, regarding 'class' attribute; new compatibility parsing of 'class' values given as string literals
author Adam Chlipala <adam@chlipala.net>
date Sun, 06 May 2012 13:07:13 -0400
parents 4a03aa3251cb
children 277480862cef
line wrap: on
line diff
--- a/src/urweb.grm	Sun May 06 12:37:43 2012 -0400
+++ b/src/urweb.grm	Sun May 06 13:07:13 2012 -0400
@@ -246,6 +246,15 @@
       | EDisjointApp e => tnamesOf e
       | _ => []
 
+fun classOut (s, pos) = (EVar ([], String.translate (fn #"-" => "_" | ch => str ch) s, Infer), pos)
+
+fun parseClass s pos =
+    case String.tokens Char.isSpace s of
+        [] => (EVar (["Basis"], "null", Infer), pos)
+      | class :: classes =>
+        foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "classes", Infer), pos), e), pos), classOut (s, pos)), pos))
+                (classOut (class, pos)) classes
+
 %%
 %header (functor UrwebLrValsFn(structure Token : TOKEN))
 
@@ -1521,9 +1530,9 @@
 
                                              val e = (EVar (["Basis"], "tag", Infer), pos)
                                              val eo = case #1 attrs of
-                                                          NONE => (EVar (["Basis"], "None", Infer), pos)
-                                                        | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
-                                                                           e), pos)
+                                                          NONE => (EVar (["Basis"], "null", Infer), pos)
+                                                        | SOME (EPrim (Prim.String s), pos) => parseClass s pos
+                                                        | SOME e => e
                                              val e = (EApp (e, eo), pos)
                                              val eo = case #2 attrs of
                                                           NONE => (EVar (["Basis"], "None", Infer), pos)