Mercurial > urweb
comparison src/cjr_print.sml @ 1391:59c8a19bfb22
Infer more regions, for sequencing constructs
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 13 Jan 2011 13:02:45 -0500 |
parents | 86d23010ea74 |
children | 7d963b8019e6 |
comparison
equal
deleted
inserted
replaced
1390:65fbb250b875 | 1391:59c8a19bfb22 |
---|---|
1 (* Copyright (c) 2008-2010, Adam Chlipala | 1 (* Copyright (c) 2008-2011, Adam Chlipala |
2 * All rights reserved. | 2 * All rights reserved. |
3 * | 3 * |
4 * Redistribution and use in source and binary forms, with or without | 4 * Redistribution and use in source and binary forms, with or without |
5 * modification, are permitted provided that the following conditions are met: | 5 * modification, are permitted provided that the following conditions are met: |
6 * | 6 * |
1316 | TFfi ("Basis", "client") => Client | 1316 | TFfi ("Basis", "client") => Client |
1317 | TOption t' => Nullable (sql_type_in env t') | 1317 | TOption t' => Nullable (sql_type_in env t') |
1318 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type"; | 1318 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type"; |
1319 Print.eprefaces' [("Type", p_typ env tAll)]; | 1319 Print.eprefaces' [("Type", p_typ env tAll)]; |
1320 Int) | 1320 Int) |
1321 | |
1322 fun potentiallyFancy (e, _) = | |
1323 case e of | |
1324 EPrim _ => false | |
1325 | ERel _ => false | |
1326 | ENamed _ => false | |
1327 | ECon (_, _, NONE) => false | |
1328 | ECon (_, _, SOME e) => potentiallyFancy e | |
1329 | ENone _ => false | |
1330 | ESome (_, e) => potentiallyFancy e | |
1331 | EFfi _ => false | |
1332 | EFfiApp _ => true | |
1333 | EApp _ => true | |
1334 | EUnop (_, e) => potentiallyFancy e | |
1335 | EBinop (_, e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2 | |
1336 | ERecord (_, xes) => List.exists (potentiallyFancy o #2) xes | |
1337 | EField (e, _) => potentiallyFancy e | |
1338 | ECase (e, pes, _) => potentiallyFancy e orelse List.exists (potentiallyFancy o #2) pes | |
1339 | EError _ => false | |
1340 | EReturnBlob _ => false | |
1341 | ERedirect _ => false | |
1342 | EWrite e => potentiallyFancy e | |
1343 | ESeq (e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2 | |
1344 | ELet (_, _, e1, e2) => potentiallyFancy e1 orelse potentiallyFancy e2 | |
1345 | EQuery _ => true | |
1346 | EDml {dml = e, ...} => potentiallyFancy e | |
1347 | ENextval {seq = e, ...} => potentiallyFancy e | |
1348 | ESetval {seq = e1, count = e2} => potentiallyFancy e1 orelse potentiallyFancy e2 | |
1349 | EUnurlify _ => true | |
1321 | 1350 |
1322 fun p_exp' par env (e, loc) = | 1351 fun p_exp' par env (e, loc) = |
1323 case e of | 1352 case e of |
1324 EPrim p => Prim.p_t_GCC p | 1353 EPrim p => Prim.p_t_GCC p |
1325 | ERel n => p_rel env n | 1354 | ERel n => p_rel env n |
1632 | 1661 |
1633 | EWrite e => box [string "(uw_write(ctx, ", | 1662 | EWrite e => box [string "(uw_write(ctx, ", |
1634 p_exp env e, | 1663 p_exp env e, |
1635 string "), uw_unit_v)"] | 1664 string "), uw_unit_v)"] |
1636 | 1665 |
1637 | ESeq (e1, e2) => box [string "(", | 1666 | ESeq (e1, e2) => |
1638 p_exp env e1, | 1667 let |
1639 string ",", | 1668 val useRegion = potentiallyFancy e1 |
1640 space, | 1669 in |
1641 p_exp env e2, | 1670 box [string "(", |
1642 string ")"] | 1671 if useRegion then |
1643 | ELet (x, t, e1, e2) => box [string "({", | 1672 box [string "uw_begin_region(ctx),", |
1644 newline, | 1673 space] |
1645 p_typ env t, | 1674 else |
1646 space, | 1675 box [], |
1647 string "__uwr_", | 1676 p_exp env e1, |
1648 p_ident x, | 1677 string ",", |
1649 string "_", | 1678 space, |
1650 string (Int.toString (E.countERels env)), | 1679 if useRegion then |
1651 space, | 1680 box [string "uw_end_region(ctx),", |
1652 string "=", | 1681 space] |
1653 space, | 1682 else |
1654 p_exp env e1, | 1683 box [], |
1655 string ";", | 1684 p_exp env e2, |
1656 newline, | 1685 string ")"] |
1657 p_exp (E.pushERel env x t) e2, | 1686 end |
1658 string ";", | 1687 | ELet (x, t, e1, e2) => |
1659 newline, | 1688 let |
1660 string "})"] | 1689 val useRegion = notLeaky env false t andalso potentiallyFancy e1 |
1690 in | |
1691 box [string "({", | |
1692 newline, | |
1693 p_typ env t, | |
1694 space, | |
1695 string "__uwr_", | |
1696 p_ident x, | |
1697 string "_", | |
1698 string (Int.toString (E.countERels env)), | |
1699 space, | |
1700 string "=", | |
1701 space, | |
1702 if useRegion then | |
1703 box [string "(uw_begin_region(ctx),", | |
1704 space] | |
1705 else | |
1706 box [], | |
1707 p_exp env e1, | |
1708 if useRegion then | |
1709 string ")" | |
1710 else | |
1711 box [], | |
1712 string ";", | |
1713 newline, | |
1714 if useRegion then | |
1715 box [string "uw_end_region(ctx);", | |
1716 newline] | |
1717 else | |
1718 box [], | |
1719 p_exp (E.pushERel env x t) e2, | |
1720 string ";", | |
1721 newline, | |
1722 string "})"] | |
1723 end | |
1661 | 1724 |
1662 | EQuery {exps, tables, rnum, state, query, body, initial, prepared} => | 1725 | EQuery {exps, tables, rnum, state, query, body, initial, prepared} => |
1663 let | 1726 let |
1664 val exps = map (fn (x, t) => ("__uwf_" ^ ident x, t)) exps | 1727 val exps = map (fn (x, t) => ("__uwf_" ^ ident x, t)) exps |
1665 val tables = ListUtil.mapConcat (fn (x, xts) => | 1728 val tables = ListUtil.mapConcat (fn (x, xts) => |