Mercurial > urweb
comparison src/monoize.sml @ 748:5f9b9972e6b8
Switch to using sql_from_items
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 28 Apr 2009 09:45:17 -0400 |
parents | 2c7244c066f1 |
children | 16bfd9e244cd |
comparison
equal
deleted
inserted
replaced
747:e42f08f96eb5 | 748:5f9b9972e6b8 |
---|---|
148 | L.CFfi ("Basis", "sql_sequence") => | 148 | L.CFfi ("Basis", "sql_sequence") => |
149 (L'.TFfi ("Basis", "string"), loc) | 149 (L'.TFfi ("Basis", "string"), loc) |
150 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) => | 150 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) => |
151 (L'.TFfi ("Basis", "string"), loc) | 151 (L'.TFfi ("Basis", "string"), loc) |
152 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) => | 152 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) => |
153 (L'.TFfi ("Basis", "string"), loc) | |
154 | L.CApp ((L.CFfi ("Basis", "sql_from_items"), _), _) => | |
153 (L'.TFfi ("Basis", "string"), loc) | 155 (L'.TFfi ("Basis", "string"), loc) |
154 | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) => | 156 | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_exp"), _), _), _), _), _), _), _), _) => |
155 (L'.TFfi ("Basis", "string"), loc) | 157 (L'.TFfi ("Basis", "string"), loc) |
156 | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) => | 158 | L.CApp ((L.CApp ((L.CFfi ("Basis", "primary_key"), _), _), _), _) => |
157 (L'.TFfi ("Basis", "string"), loc) | 159 (L'.TFfi ("Basis", "string"), loc) |
1528 fun sc s = (L'.EPrim (Prim.String s), loc) | 1530 fun sc s = (L'.EPrim (Prim.String s), loc) |
1529 val s = (L'.TFfi ("Basis", "string"), loc) | 1531 val s = (L'.TFfi ("Basis", "string"), loc) |
1530 val un = (L'.TRecord [], loc) | 1532 val un = (L'.TRecord [], loc) |
1531 fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc) | 1533 fun gf s = (L'.EField ((L'.ERel 0, loc), s), loc) |
1532 | 1534 |
1533 val tables = List.mapPartial | |
1534 (fn (x, (L.CTuple [y, _], _)) => SOME (x, y) | |
1535 | _ => (E.errorAt loc "Bad sql_query1 tables pair"; | |
1536 NONE)) | |
1537 tables | |
1538 | |
1539 fun doTables tables = | 1535 fun doTables tables = |
1540 let | 1536 let |
1541 val tables = map (fn ((L.CName x, _), xts) => | 1537 val tables = map (fn ((L.CName x, _), xts) => |
1542 (case monoType env (L.TRecord xts, loc) of | 1538 (case monoType env (L.TRecord xts, loc) of |
1543 (L'.TRecord xts, _) => SOME (x, xts) | 1539 (L'.TRecord xts, _) => SOME (x, xts) |
1566 let | 1562 let |
1567 val sexps = ListMergeSort.sort | 1563 val sexps = ListMergeSort.sort |
1568 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps | 1564 (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) sexps |
1569 in | 1565 in |
1570 ((L'.EAbs ("r", | 1566 ((L'.EAbs ("r", |
1571 (L'.TRecord [("From", (L'.TRecord (map (fn (x, _) => (x, s)) tables), loc)), | 1567 (L'.TRecord [("From", s), |
1572 ("Where", s), | 1568 ("Where", s), |
1573 ("GroupBy", un), | 1569 ("GroupBy", un), |
1574 ("Having", s), | 1570 ("Having", s), |
1575 ("SelectFields", un), | 1571 ("SelectFields", un), |
1576 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))], | 1572 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))], |
1586 strcatComma | 1582 strcatComma |
1587 (map (fn (x', _) => | 1583 (map (fn (x', _) => |
1588 sc (x ^ ".uw_" ^ x')) | 1584 sc (x ^ ".uw_" ^ x')) |
1589 xts)) stables), | 1585 xts)) stables), |
1590 sc " FROM ", | 1586 sc " FROM ", |
1591 strcatComma (map (fn (x, _) => strcat [(L'.EField (gf "From", x), loc), | 1587 gf "From", |
1592 sc (" AS " ^ x)]) tables), | |
1593 (L'.ECase (gf "Where", | 1588 (L'.ECase (gf "Where", |
1594 [((L'.PPrim (Prim.String "TRUE"), loc), | 1589 [((L'.PPrim (Prim.String "TRUE"), loc), |
1595 sc ""), | 1590 sc ""), |
1596 ((L'.PWild, loc), | 1591 ((L'.PWild, loc), |
1597 strcat [sc " WHERE ", gf "Where"])], | 1592 strcat [sc " WHERE ", gf "Where"])], |
1709 | 1704 |
1710 | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) => | 1705 | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) => |
1711 ((L'.ERecord [], loc), fm) | 1706 ((L'.ERecord [], loc), fm) |
1712 | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) => | 1707 | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) => |
1713 ((L'.ERecord [], loc), fm) | 1708 ((L'.ERecord [], loc), fm) |
1709 | |
1710 | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _), _), _), _), | |
1711 (L.CName name, _)) => | |
1712 let | |
1713 val s = (L'.TFfi ("Basis", "string"), loc) | |
1714 in | |
1715 ((L'.EAbs ("tab", s, s, | |
1716 strcat [(L'.ERel 0, loc), | |
1717 (L'.EPrim (Prim.String (" AS " ^ name)), loc)]), loc), | |
1718 fm) | |
1719 end | |
1720 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_comma"), _), _), _), _) => | |
1721 let | |
1722 val s = (L'.TFfi ("Basis", "string"), loc) | |
1723 in | |
1724 ((L'.EAbs ("tab1", s, (L'.TFun (s, s), loc), | |
1725 (L'.EAbs ("tab2", s, s, | |
1726 strcat [(L'.ERel 1, loc), | |
1727 (L'.EPrim (Prim.String ", "), loc), | |
1728 (L'.ERel 0, loc)]), loc)), loc), | |
1729 fm) | |
1730 end | |
1714 | 1731 |
1715 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => | 1732 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => |
1716 ((L'.EPrim (Prim.String ""), loc), fm) | 1733 ((L'.EPrim (Prim.String ""), loc), fm) |
1717 | L.ECApp ( | 1734 | L.ECApp ( |
1718 (L.ECApp ( | 1735 (L.ECApp ( |