Mercurial > urweb

comparison src/monoize.sml @ 678:5ff1ff38e2db

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Preliminary work supporting channels in databases
author Adam Chlipala <adamc@hcoop.net>
date Thu, 26 Mar 2009 16:22:34 -0400
parents e0c186464612
children 44f23712020d
comparison
equal deleted inserted replaced
677:81573f62d6c3 678:5ff1ff38e2db
162 (L'.TFfi ("Basis", "string"), loc) 162 (L'.TFfi ("Basis", "string"), loc)
163 | L.CFfi ("Basis", "sql_offset") => 163 | L.CFfi ("Basis", "sql_offset") =>
164 (L'.TFfi ("Basis", "string"), loc) 164 (L'.TFfi ("Basis", "string"), loc)
165 165
166 | L.CApp ((L.CFfi ("Basis", "sql_injectable_prim"), _), t) => 166 | L.CApp ((L.CFfi ("Basis", "sql_injectable_prim"), _), t) =>
167 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
168 | L.CApp ((L.CFfi ("Basis", "sql_injectable_nullable"), _), t) =>
167 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 169 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
168 | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) => 170 | L.CApp ((L.CFfi ("Basis", "sql_injectable"), _), t) =>
169 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 171 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
170 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) => 172 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_unary"), _), _), _), _) =>
171 (L'.TFfi ("Basis", "string"), loc) 173 (L'.TFfi ("Basis", "string"), loc)
1423 fm) 1425 fm)
1424 | L.EFfi ("Basis", "sql_time") => 1426 | L.EFfi ("Basis", "sql_time") =>
1425 ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc), 1427 ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc),
1426 (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc), 1428 (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc),
1427 fm) 1429 fm)
1430 | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) =>
1431 ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc),
1432 (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc),
1433 fm)
1428 | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) => 1434 | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) =>
1429 let 1435 let
1430 val t = monoType env t 1436 val t = monoType env t
1431 val tf = (L'.TFun (t, (L'.TFfi ("Basis", "string"), loc)), loc) 1437 val tf = (L'.TFun (t, (L'.TFfi ("Basis", "string"), loc)), loc)
1432 in 1438 in
1433 ((L'.EAbs ("f", tf, tf, (L'.ERel 0, loc)), loc), 1439 ((L'.EAbs ("f", tf, tf, (L'.ERel 0, loc)), loc),
1434 fm) 1440 fm)
1435 end 1441 end
1436 | L.ECApp ((L.EFfi ("Basis", "sql_option_prim"), _), t) => 1442 | L.ECApp ((L.EFfi ("Basis", "sql_option_prim"), _), t) =>
1443 let
1444 val t = monoType env t
1445 val s = (L'.TFfi ("Basis", "string"), loc)
1446 in
1447 ((L'.EAbs ("f",
1448 (L'.TFun (t, s), loc),
1449 (L'.TFun ((L'.TOption t, loc), s), loc),
1450 (L'.EAbs ("x",
1451 (L'.TOption t, loc),
1452 s,
1453 (L'.ECase ((L'.ERel 0, loc),
1454 [((L'.PNone t, loc),
1455 (L'.EPrim (Prim.String "NULL"), loc)),
1456 ((L'.PSome (t, (L'.PVar ("y", t), loc)), loc),
1457 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc))],
1458 {disc = (L'.TOption t, loc),
1459 result = s}), loc)), loc)), loc),
1460 fm)
1461 end
1462 | L.ECApp ((L.EFfi ("Basis", "sql_nullable"), _), t) =>
1437 let 1463 let
1438 val t = monoType env t 1464 val t = monoType env t
1439 val s = (L'.TFfi ("Basis", "string"), loc) 1465 val s = (L'.TFfi ("Basis", "string"), loc)
1440 in 1466 in
1441 ((L'.EAbs ("f", 1467 ((L'.EAbs ("f",