diff options
-rw-r--r-- | lib/ur/basis.urs | 1 | ||||
-rw-r--r-- | src/monoize.sml | 128 |
2 files changed, 93 insertions, 36 deletions
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index c75eea1b..8388e107 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -292,6 +292,7 @@ val sql_subset_concat : big1 ::: {{Type}} -> little1 ::: {{Type}} con sql_from_items :: {{Type}} -> {{Type}} -> Type +val sql_from_nil : free ::: {{Type}} -> sql_from_items free [] val sql_from_table : free ::: {{Type}} -> t ::: Type -> fs ::: {Type} -> fieldsOf t fs -> name :: Name -> t -> sql_from_items free [name = fs] diff --git a/src/monoize.sml b/src/monoize.sml index 5aebad63..9799ae95 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1891,8 +1891,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ^ ".uw_" ^ x')) xts)) stables), - sc " FROM ", - gf "From", + (L'.ECase (gf "From", + [((L'.PPrim (Prim.String ""), loc), + sc ""), + ((L'.PVar ("x", s), loc), + strcat [sc " FROM ", + (L'.ERel 0, loc)])], + {disc = s, + result = s}), loc), (L'.ECase (gf "Where", [((L'.PPrim (Prim.String "TRUE"), loc), sc ""), @@ -2048,6 +2054,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.ECApp ((L.EFfi ("Basis", "fieldsOf_view"), _), _) => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.EFfi ("Basis", "sql_from_nil"), _), _) => + ((L'.EPrim (Prim.String ""), loc), fm) | L.ECApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_from_table"), _), _), _), _), _), _), _), _), _), (L.CName name, _)) => @@ -2078,9 +2086,18 @@ fun monoExp (env, st, fm) (all as (e, 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), + (L'.ECase ((L'.ERecord [("1", (L'.ERel 1, loc), s), + ("2", (L'.ERel 0, loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc), + (L'.ERel 0, loc)), + ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc), + (L'.ERel 1, loc)), + ((L'.PWild, loc), + strcat [(L'.ERel 1, loc), + (L'.EPrim (Prim.String ", "), loc), + (L'.ERel 0, loc)])], + {disc = (L'.TRecord [("1", s), ("2", s)], loc), + result = s}), loc)), loc)), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_inner_join"), _), _), _), _), _), _) => @@ -2090,13 +2107,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc), (L'.EAbs ("on", s, s, - strcat [(L'.EPrim (Prim.String "("), loc), - (L'.ERel 2, loc), - (L'.EPrim (Prim.String " JOIN "), loc), - (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), - (L'.ERel 0, loc), - (L'.EPrim (Prim.String ")"), loc)]), loc)), loc)), loc), + (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), + ("2", (L'.ERel 1, loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), loc), s)], loc), + (L'.ERel 1, loc)), + ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc), + (L'.ERel 2, loc)), + ((L'.PWild, loc), + strcat [(L'.EPrim (Prim.String "("), loc), + (L'.ERel 2, loc), + (L'.EPrim (Prim.String " JOIN "), loc), + (L'.ERel 1, loc), + (L'.EPrim (Prim.String " ON "), loc), + (L'.ERel 0, loc), + (L'.EPrim (Prim.String ")"), loc)])], + {disc = (L'.TRecord [("1", s), ("2", s)], loc), + result = s}), loc)), loc)), loc)), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_left_join"), _), _), _), _), _), @@ -2109,14 +2135,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc), (L'.EAbs ("on", s, s, - strcat [(L'.EPrim (Prim.String "("), loc), - (L'.ERel 2, loc), - (L'.EPrim (Prim.String " LEFT JOIN "), loc), - (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), - (L'.ERel 0, loc), - (L'.EPrim (Prim.String ")"), loc)]), - loc)), loc)), loc)), loc), + (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), + ("2", (L'.ERel 1, loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 1, loc)), + ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 2, loc)), + ((L'.PWild, loc), + strcat [(L'.EPrim (Prim.String "("), loc), + (L'.ERel 2, loc), + (L'.EPrim (Prim.String " LEFT JOIN "), loc), + (L'.ERel 1, loc), + (L'.EPrim (Prim.String " ON "), loc), + (L'.ERel 0, loc), + (L'.EPrim (Prim.String ")"), loc)])], + {disc = (L'.TRecord [("1", s), ("2", s)], loc), + result = s}), loc)), loc)), loc)), loc)), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_right_join"), _), (L.CRecord (_, left), _)), @@ -2129,14 +2165,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc), (L'.EAbs ("on", s, s, - strcat [(L'.EPrim (Prim.String "("), loc), - (L'.ERel 2, loc), - (L'.EPrim (Prim.String " RIGHT JOIN "), loc), - (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), - (L'.ERel 0, loc), - (L'.EPrim (Prim.String ")"), loc)]), - loc)), loc)), loc)), loc), + (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), + ("2", (L'.ERel 1, loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 1, loc)), + ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 2, loc)), + ((L'.PWild, loc), + strcat [(L'.EPrim (Prim.String "("), loc), + (L'.ERel 2, loc), + (L'.EPrim (Prim.String " RIGHT JOIN "), loc), + (L'.ERel 1, loc), + (L'.EPrim (Prim.String " ON "), loc), + (L'.ERel 0, loc), + (L'.EPrim (Prim.String ")"), loc)])], + {disc = (L'.TRecord [("1", s), ("2", s)], loc), + result = s}), loc)), loc)), loc)), loc)), loc), fm) end | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sql_full_join"), _), (L.CRecord (_, left), _)), _), @@ -2149,14 +2195,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EAbs ("tab1", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), (L'.EAbs ("tab2", s, (L'.TFun (s, s), loc), (L'.EAbs ("on", s, s, - strcat [(L'.EPrim (Prim.String "("), loc), - (L'.ERel 2, loc), - (L'.EPrim (Prim.String " FULL JOIN "), loc), - (L'.ERel 1, loc), - (L'.EPrim (Prim.String " ON "), loc), - (L'.ERel 0, loc), - (L'.EPrim (Prim.String ")"), loc)]), - loc)), loc)), loc)), loc), + (L'.ECase ((L'.ERecord [("1", (L'.ERel 2, loc), s), + ("2", (L'.ERel 1, loc), s)], loc), + [((L'.PRecord [("1", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 1, loc)), + ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), + loc), s)], loc), + (L'.ERel 2, loc)), + ((L'.PWild, loc), + strcat [(L'.EPrim (Prim.String "("), loc), + (L'.ERel 2, loc), + (L'.EPrim (Prim.String " FULL JOIN "), loc), + (L'.ERel 1, loc), + (L'.EPrim (Prim.String " ON "), loc), + (L'.ERel 0, loc), + (L'.EPrim (Prim.String ")"), loc)])], + {disc = (L'.TRecord [("1", s), ("2", s)], loc), + result = s}), loc)), loc)), loc)), loc)), loc), fm) end |