Mercurial > urweb

comparison src/monoize.sml @ 748:5f9b9972e6b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 (