diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/monoize.sml | 35 | ||||
| -rw-r--r-- | src/urweb.grm | 35 |
2 files changed, 52 insertions, 18 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 780f6923..8d8f07d4 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -151,6 +151,8 @@ fun monoType env = (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _) => + (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) => @@ -1530,12 +1532,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val un = (L'.TRecord [], loc) fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc) - val tables = List.mapPartial - (fn (x, (L.CTuple [y, _], _)) => SOME (x, y) - | _ => (E.errorAt loc "Bad sql_query1 tables pair"; - NONE)) - tables - fun doTables tables = let val tables = map (fn ((L.CName x, _), xts) => @@ -1568,7 +1564,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps in ((L'.EAbs ("r", - (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)), + (L'.TRecord [("From", s), ("Where", s), ("GroupBy", un), ("Having", s), @@ -1588,8 +1584,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = sc (x ^ ".uw_" ^ x')) xts)) stables), sc " FROM ", - strcatComma (map (fn (x, _) => strcat [(L'.EField (gf "From", x), loc), - sc (" AS " ^ x)]) tables), + gf "From", (L'.ECase (gf "Where", [((L'.PPrim (Prim.String "TRUE"), loc), sc ""), @@ -1712,6 +1707,28 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _), _), _), _), + (L.CName name, _)) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("tab", s, s, + strcat [(L'.ERel 0, loc), + (L'.EPrim (Prim.String (" AS " ^ name)), loc)]), loc), + fm) + end + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("tab1", s, (L'.TFun (s, s), loc), + (L'.EAbs ("tab2", s, s, + strcat [(L'.ERel 1, loc), + (L'.EPrim (Prim.String ", "), loc), + (L'.ERel 0, loc)]), loc)), loc), + fm) + end + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => ((L'.EPrim (Prim.String ""), loc), fm) | L.ECApp ( diff --git a/src/urweb.grm b/src/urweb.grm index be67ea7b..21030b4d 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -304,12 +304,13 @@ datatype attr = Class of exp | Normal of con * exp | query of exp | query1 of exp - | tables of (con * exp) list + | tables of con list * exp | tname of con | tnameW of con * con | tnames of (con * con) * (con * con) list | tnames' of (con * con) * (con * con) list | table of con * exp + | table' of con * exp | tident of con | fident of con | seli of select_item @@ -1356,15 +1357,15 @@ query1 : SELECT select FROM tables wopt gopt hopt val (sel, exps) = case select of - Star => (map (fn (nm, _) => + Star => (map (fn nm => (nm, (CTuple [(CWild (KRecord (KType, loc), loc), loc), (CRecord [], loc)], - loc))) tables, + loc))) (#1 tables), []) | Items sis => let - val tabs = map (fn (nm, _) => (nm, (CRecord [], loc))) tables + val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables) val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis in (map (fn (nm, c) => (nm, @@ -1383,8 +1384,8 @@ query1 : SELECT select FROM tables wopt gopt hopt loc), loc)), loc) | SOME gis => let - val tabs = map (fn (nm, _) => - (nm, (CRecord [], loc))) tables + val tabs = map (fn nm => + (nm, (CRecord [], loc))) (#1 tables) val tabs = foldl (amend_group loc) tabs gis val tabs = map (fn (nm, c) => @@ -1400,7 +1401,7 @@ query1 : SELECT select FROM tables wopt gopt hopt val e = (EVar (["Basis"], "sql_query1", Infer), loc) val re = (ERecord [((CName "From", loc), - (ERecord tables, loc)), + #2 tables), ((CName "Where", loc), wopt), ((CName "GroupBy", loc), @@ -1421,8 +1422,16 @@ query1 : SELECT select FROM tables wopt gopt hopt | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right))) | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right))) -tables : table ([table]) - | table COMMA tables (table :: tables) +tables : table' ([#1 table'], #2 table') + | table' COMMA tables (let + val loc = s (table'left, tablesright) + + val e = (EVar (["Basis"], "sql_from_comma", Infer), loc) + val e = (EApp (e, #2 table'), loc) + in + (#1 table' :: #1 tables, + (EApp (e, #2 tables), loc)) + end) tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) | LBRACE cexp RBRACE (cexp) @@ -1432,6 +1441,14 @@ table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLle | SYMBOL AS tname (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))) | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp) +table' : table (let + val loc = s (tableleft, tableright) + val e = (EVar (["Basis"], "sql_from_table", Infer), loc) + val e = (ECApp (e, #1 table), loc) + in + (#1 table, (EApp (e, #2 table), loc)) + end) + tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)) | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) | LBRACE LBRACE cexp RBRACE RBRACE (cexp) |