summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/ur/basis.urs1
-rw-r--r--src/monoize.sml128
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-27 19:53:14 +0000