Mercurial > urweb

comparison src/monoize.sml @ 338:e976b187d73a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
SQL sequences
author Adam Chlipala <adamc@hcoop.net>
date Sun, 14 Sep 2008 11:02:18 -0400
parents e457d8972ff1
children ca98644af384
comparison
equal deleted inserted replaced
337:18d5affa790d 338:e976b187d73a
103 (L'.TFfi ("Basis", "string"), loc) 103 (L'.TFfi ("Basis", "string"), loc)
104 104
105 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 105 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
106 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 106 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
107 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) => 107 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) =>
108 (L'.TFfi ("Basis", "string"), loc)
109 | L.CFfi ("Basis", "sql_sequence") =>
108 (L'.TFfi ("Basis", "string"), loc) 110 (L'.TFfi ("Basis", "string"), loc)
109 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) => 111 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) =>
110 (L'.TFfi ("Basis", "string"), loc) 112 (L'.TFfi ("Basis", "string"), loc)
111 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) => 113 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query1"), _), _), _), _), _), _) =>
112 (L'.TFfi ("Basis", "string"), loc) 114 (L'.TFfi ("Basis", "string"), loc)
1149 fm) 1151 fm)
1150 1152
1151 | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm) 1153 | L.EFfi ("Basis", "sql_asc") => ((L'.EPrim (Prim.String ""), loc), fm)
1152 | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm) 1154 | L.EFfi ("Basis", "sql_desc") => ((L'.EPrim (Prim.String " DESC"), loc), fm)
1153 1155
1156 | L.EFfiApp ("Basis", "nextval", [e]) =>
1157 let
1158 val un = (L'.TRecord [], loc)
1159 val int = (L'.TFfi ("Basis", "int"), loc)
1160 val (e, fm) = monoExp (env, st, fm) e
1161 in
1162 ((L'.EAbs ("_", un, int,
1163 (L'.ENextval (liftExpInExp 0 e), loc)), loc),
1164 fm)
1165 end
1166
1154 | L.EApp ( 1167 | L.EApp (
1155 (L.ECApp ( 1168 (L.ECApp (
1156 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), 1169 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
1157 _), _), 1170 _), _),
1158 se) => 1171 se) =>
1616 fm, 1629 fm,
1617 [(L'.DTable (s, xts), loc), 1630 [(L'.DTable (s, xts), loc),
1618 (L'.DVal (x, n, t', e, s), loc)]) 1631 (L'.DVal (x, n, t', e, s), loc)])
1619 end 1632 end
1620 | L.DTable _ => poly () 1633 | L.DTable _ => poly ()
1634 | L.DSequence (x, n, s) =>
1635 let
1636 val t = (L.CFfi ("Basis", "string"), loc)
1637 val t' = (L'.TFfi ("Basis", "string"), loc)
1638 val s = "uw_" ^ s
1639 val e = (L'.EPrim (Prim.String s), loc)
1640 in
1641 SOME (Env.pushENamed env x n t NONE s,
1642 fm,
1643 [(L'.DSequence s, loc),
1644 (L'.DVal (x, n, t', e, s), loc)])
1645 end
1621 | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)]) 1646 | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)])
1622 end 1647 end
1623 1648
1624 fun monoize env ds = 1649 fun monoize env ds =
1625 let 1650 let