Mercurial > urweb
diff src/urweb.grm @ 2211:ef766ef6e242
Merge.
| author | Ziv Scully <ziv@mit.edu> |
|---|---|
| date | Sat, 13 Sep 2014 19:16:07 -0400 |
| parents | 4d64af730e35 |
| children | fde864eacd47 |
line wrap: on
line diff
--- a/src/urweb.grm Sat May 31 22:23:25 2014 -0400 +++ b/src/urweb.grm Sat Sep 13 19:16:07 2014 -0400 @@ -225,7 +225,7 @@ datatype prop_kind = Delete | Update -datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * exp +datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * string * exp fun patType loc (p : pat) = case #1 p of @@ -282,11 +282,11 @@ in (EApp ((EVar (["Basis"], "css_url", Infer), pos), (EApp ((EVar (["Basis"], "bless", Infer), pos), - (EPrim (Prim.String s), pos)), pos)), pos) + (EPrim (Prim.String (Prim.Normal, s)), pos)), pos)), pos) end else (EApp ((EVar (["Basis"], "atom", Infer), pos), - (EPrim (Prim.String s), pos)), pos) + (EPrim (Prim.String (Prim.Normal, s)), pos)), pos) fun parseProperty s pos = let @@ -294,11 +294,11 @@ in if Substring.isEmpty after then (ErrorMsg.errorAt pos ("Invalid CSS property syntax: " ^ s); - (EPrim (Prim.String ""), pos)) + (EPrim (Prim.String (Prim.Normal, "")), pos)) else foldl (fn (value, e) => (EApp ((EApp ((EVar (["Basis"], "value", Infer), pos), e), pos), parseValue value pos), pos)) (EApp ((EVar (["Basis"], "property", Infer), pos), - (EPrim (Prim.String (Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos) + (EPrim (Prim.String (Prim.Normal, Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos) (String.tokens Char.isSpace (Substring.string (Substring.slice (after, 1, NONE)))) end @@ -486,7 +486,7 @@ | rpat of (string * pat) list * bool | ptuple of pat list - | attrs of exp option * exp option * exp option * exp option * (string * exp) list * (con * exp) list + | attrs of exp option * exp option * exp option * exp option * (string * string * exp) list * (con * exp) list | attr of attr | attrv of exp @@ -1152,8 +1152,8 @@ | eapps BANG (EDisjointApp eapps, s (eappsleft, BANGright)) eexp : eapps (case #1 eapps of - EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String s), loc)) => parseClass s loc - | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String s), loc)) => parseStyle s loc + EApp ((EVar ([], "CLASS", _), _), (EPrim (Prim.String (_, s)), loc)) => parseClass s loc + | EApp ((EVar ([], "STYLE", _), _), (EPrim (Prim.String (_, s)), loc)) => parseStyle s loc | _ => eapps) | FN eargs DARROW eexp (let val loc = s (FNleft, eexpright) @@ -1347,7 +1347,7 @@ | INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) - | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | CHAR (EPrim (Prim.Char CHAR), s (CHARleft, CHARright)) | path DOT idents (let @@ -1396,7 +1396,7 @@ else ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; (EApp ((EVar (["Basis"], "cdata", Infer), loc), - (EPrim (Prim.String ""), loc)), + (EPrim (Prim.String (Prim.Html, "")), loc)), loc) end) | XML_BEGIN_END (let @@ -1407,7 +1407,7 @@ else ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; (EApp ((EVar (["Basis"], "cdata", Infer), loc), - (EPrim (Prim.String ""), loc)), + (EPrim (Prim.String (Prim.Html, "")), loc)), loc) end) @@ -1456,6 +1456,7 @@ | UNDER (EWild, s (UNDERleft, UNDERright)) | LET edecls IN eexp END (ELet (edecls, eexp), s (LETleft, ENDright)) + | LET eexp WHERE edecls END (ELet (edecls, eexp), s (LETleft, ENDright)) | LBRACK RBRACK (EVar (["Basis"], "Nil", Infer), s (LBRACKleft, RBRACKright)) @@ -1510,7 +1511,7 @@ | UNDER (PWild, s (UNDERleft, UNDERright)) | INT (PPrim (Prim.Int INT), s (INTleft, INTright)) | MINUS INT (PPrim (Prim.Int (~INT)), s (MINUSleft, INTright)) - | STRING (PPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (PPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | CHAR (PPrim (Prim.Char CHAR), s (CHARleft, CHARright)) | LPAREN pat RPAREN (pat) | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright)) @@ -1546,11 +1547,11 @@ xmlOpt : xml (xml) | (EApp ((EVar (["Basis"], "cdata", Infer), dummy), - (EPrim (Prim.String ""), dummy)), + (EPrim (Prim.String (Prim.Html, "")), dummy)), dummy) xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)), - (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), + (EPrim (Prim.String (Prim.Html, NOTAGS)), s (NOTAGSleft, NOTAGSright))), s (NOTAGSleft, NOTAGSright)) | tag DIVIDE GT (let val pos = s (tagleft, GTright) @@ -1567,7 +1568,7 @@ (EVar (["Basis"], "cdata", Infer), pos) val cdata = (EApp (cdata, - (EPrim (Prim.String ""), pos)), + (EPrim (Prim.String (Prim.Html, "")), pos)), pos) in (EApp (#4 tag, cdata), pos) @@ -1628,7 +1629,7 @@ val e = (EVar (["Basis"], "tag", Infer), pos) val eo = case #1 attrs of NONE => (EVar (["Basis"], "null", Infer), pos) - | SOME (EPrim (Prim.String s), pos) => parseClass s 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 @@ -1638,7 +1639,7 @@ val e = (EApp (e, eo), pos) val eo = case #3 attrs of NONE => (EVar (["Basis"], "noStyle", Infer), pos) - | SOME (EPrim (Prim.String s), pos) => parseStyle s pos + | SOME (EPrim (Prim.String (_, s)), pos) => parseStyle s pos | SOME e => e val e = (EApp (e, eo), pos) val eo = case #4 attrs of @@ -1651,10 +1652,11 @@ [] => #6 attrs | data :: datas => let - fun doOne (name, value) = + fun doOne (kind, name, value) = let val e = (EVar (["Basis"], "data_attr", Infer), pos) - val e = (EApp (e, (EPrim (Prim.String name), pos)), pos) + val e = (EApp (e, (EVar (["Basis"], kind ^ "_kind", Infer), pos)), pos) + val e = (EApp (e, (EPrim (Prim.String (Prim.Normal, name)), pos)), pos) in (EApp (e, value), pos) end @@ -1724,7 +1726,9 @@ | "dynStyle" => DynStyle attrv | _ => if String.isPrefix "data-" SYMBOL then - Data (String.extract (SYMBOL, 5, NONE), attrv) + Data ("data", String.extract (SYMBOL, 5, NONE), attrv) + else if String.isPrefix "aria-" SYMBOL then + Data ("aria", String.extract (SYMBOL, 5, NONE), attrv) else let val sym = makeAttr SYMBOL @@ -1746,7 +1750,7 @@ attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) - | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) + | STRING (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright)) | LBRACE eexp RBRACE (eexp) query : query1 obopt lopt ofopt (let @@ -1980,6 +1984,14 @@ in ([tname], (EApp (e, query), loc)) end) + | LPAREN LBRACE LBRACE eexp RBRACE RBRACE RPAREN AS tname (let + val loc = s (LPARENleft, RPARENright) + + val e = (EVar (["Basis"], "sql_from_query", Infer), loc) + val e = (ECApp (e, tname), loc) + in + ([tname], (EApp (e, eexp), loc)) + end) | LPAREN fitem RPAREN (fitem) tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) @@ -2026,7 +2038,7 @@ s (INTleft, INTright))) | FLOAT (sql_inject (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))) - | STRING (sql_inject (EPrim (Prim.String STRING), + | STRING (sql_inject (EPrim (Prim.String (Prim.Normal, STRING)), s (STRINGleft, STRINGright))) | CURRENT_TIMESTAMP (sql_nfunc ("current_timestamp", s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))