Mercurial > urweb

comparison src/monoize.sml @ 750:059074c8d2fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
LEFT JOIN
author Adam Chlipala <adamc@hcoop.net>
date Tue, 28 Apr 2009 11:05:28 -0400
parents 16bfd9e244cd
children f95d652086cd
comparison
equal deleted inserted replaced
749:16bfd9e244cd 750:059074c8d2fc
187 187
188 | L.CApp ((L.CFfi ("Basis", "sql_injectable_prim"), _), t) => 188 | L.CApp ((L.CFfi ("Basis", "sql_injectable_prim"), _), t) =>
189 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 189 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
190 | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) => 190 | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) =>
191 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 191 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
192 | L.CApp ((L.CApp ((L.CFfi ("Basis", "nullify"), _), _), _), _) =>
193 (L'.TRecord [], loc)
192 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) => 194 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) =>
193 (L'.TFfi ("Basis", "string"), loc) 195 (L'.TFfi ("Basis", "string"), loc)
194 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) => 196 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_binary"), _), _), _), _), _), _) =>
195 (L'.TFfi ("Basis", "string"), loc) 197 (L'.TFfi ("Basis", "string"), loc)
196 | L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), t) => 198 | L.CApp ((L.CFfi ("Basis", "sql_aggregate"), _), t) =>
579 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc) 581 ("Le", (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], loc)
580 fun ordEx (t, lt, le) = 582 fun ordEx (t, lt, le) =
581 ((L'.ERecord [("Lt", lt, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)), 583 ((L'.ERecord [("Lt", lt, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)),
582 ("Le", le, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))], 584 ("Le", le, (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc))],
583 loc), fm) 585 loc), fm)
586
587 fun outerRec xts =
588 (L'.TRecord (map (fn ((L.CName x, _), (L.CRecord (_, xts), _)) =>
589 (x, (L'.TRecord (map (fn (x', _) => (x, (L'.TRecord [], loc))) xts), loc))
590 | (x, all as (_, loc)) =>
591 (E.errorAt loc "Unsupported record field constructor";
592 Print.eprefaces' [("Name", CorePrint.p_con env x),
593 ("Constructor", CorePrint.p_con env all)];
594 ("", dummyTyp))) xts), loc)
584 in 595 in
585 case e of 596 case e of
586 L.EPrim p => ((L'.EPrim p, loc), fm) 597 L.EPrim p => ((L'.EPrim p, loc), fm)
587 | L.ERel n => ((L'.ERel n, loc), fm) 598 | L.ERel n => ((L'.ERel n, loc), fm)
588 | L.ENamed n => ((L'.ENamed n, loc), fm) 599 | L.ENamed n => ((L'.ENamed n, loc), fm)
1700 {disc = (L'.TOption t, loc), 1711 {disc = (L'.TOption t, loc),
1701 result = s}), loc)), loc)), loc), 1712 result = s}), loc)), loc)), loc),
1702 fm) 1713 fm)
1703 end 1714 end
1704 1715
1716 | L.ECApp ((L.EFfi ("Basis", "nullify_option"), _), _) =>
1717 ((L'.ERecord [], loc), fm)
1718 | L.ECApp ((L.EFfi ("Basis", "nullify_prim"), _), _) =>
1719 ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
1720 (L'.ERecord [], loc)), loc),
1721 fm)
1722
1705 | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) => 1723 | L.ECApp ((L.EFfi ("Basis", "sql_subset"), _), _) =>
1706 ((L'.ERecord [], loc), fm) 1724 ((L'.ERecord [], loc), fm)
1707 | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) => 1725 | L.ECApp ((L.EFfi ("Basis", "sql_subset_all"), _), _) =>
1708 ((L'.ERecord [], loc), fm) 1726 ((L'.ERecord [], loc), fm)
1709 1727
1740 (L'.EPrim (Prim.String " JOIN "), loc), 1758 (L'.EPrim (Prim.String " JOIN "), loc),
1741 (L'.ERel 1, loc), 1759 (L'.ERel 1, loc),
1742 (L'.EPrim (Prim.String " ON "), loc), 1760 (L'.EPrim (Prim.String " ON "), loc),
1743 (L'.ERel 0, loc), 1761 (L'.ERel 0, loc),
1744 (L'.EPrim (Prim.String ")"), loc)]), loc)), loc)), loc), 1762 (L'.EPrim (Prim.String ")"), loc)]), loc)), loc)), loc),
1763 fm)
1764 end
1765 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_left_join"), _), _), _), (L.CRecord (_, right), _)) =>
1766 let
1767 val s = (L'.TFfi ("Basis", "string"), loc)
1768 in
1769 ((L'.EAbs ("_", outerRec right,
1770 (L'.TFun (s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc)), loc),
1771 (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
1772 (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc),
1773 (L'.EAbs ("on", s, s,
1774 strcat [(L'.EPrim (Prim.String "("), loc),
1775 (L'.ERel 2, loc),
1776 (L'.EPrim (Prim.String " LEFT JOIN "), loc),
1777 (L'.ERel 1, loc),
1778 (L'.EPrim (Prim.String " ON "), loc),
1779 (L'.ERel 0, loc),
1780 (L'.EPrim (Prim.String ")"), loc)]),
1781 loc)), loc)), loc)), loc),
1745 fm) 1782 fm)
1746 end 1783 end
1747 1784
1748 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) => 1785 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_order_by_Nil"), _), _), _), _) =>
1749 ((L'.EPrim (Prim.String ""), loc), fm) 1786 ((L'.EPrim (Prim.String ""), loc), fm)