Mercurial > urweb

comparison src/cjr_print.sml @ 1391:59c8a19bfb22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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) =>