Mercurial > urweb

comparison src/cjr_print.sml @ 402:ebf27030ae3b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Recursive unurlify for Default datatypes
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 15:11:42 -0400
parents ab3177746c78
children ad7e854a518c
comparison
equal deleted inserted replaced
401:cc71fb7e5e54 402:ebf27030ae3b
1511 let 1511 let
1512 val (x, xncs) = E.lookupDatatype env i 1512 val (x, xncs) = E.lookupDatatype env i
1513 1513
1514 fun doEm xncs = 1514 fun doEm xncs =
1515 case xncs of 1515 case xncs of
1516 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), (enum __uwe_" 1516 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
1517 ^ x ^ "\"), (enum __uwe_"
1517 ^ x ^ "_" ^ Int.toString i ^ ")0)") 1518 ^ x ^ "_" ^ Int.toString i ^ ")0)")
1518 | (x', n, to) :: rest => 1519 | (x', n, to) :: rest =>
1519 box [string "((!strncmp(request, \"", 1520 box [string "((!strncmp(request, \"",
1520 string x', 1521 string x',
1521 string "\", ", 1522 string "\", ",
1634 newline, 1635 newline,
1635 string "})"] 1636 string "})"]
1636 end 1637 end
1637 1638
1638 | TDatatype (Default, i, _) => 1639 | TDatatype (Default, i, _) =>
1639 let 1640 if IS.member (rf, i) then
1640 val (x, xncs) = E.lookupDatatype env i 1641 box [string "unurlify_",
1641 1642 string (Int.toString i),
1642 fun doEm xncs = 1643 string "()"]
1643 case xncs of 1644 else
1644 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)") 1645 let
1645 | (x', n, to) :: rest => 1646 val (x, xncs) = E.lookupDatatype env i
1646 box [string "((!strncmp(request, \"", 1647
1647 string x', 1648 val rf = IS.add (rf, i)
1648 string "\", ", 1649
1649 string (Int.toString (size x')), 1650 fun doEm xncs =
1650 string ") && (request[", 1651 case xncs of
1651 string (Int.toString (size x')), 1652 [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
1652 string "] == 0 || request[", 1653 ^ x ^ "\"), NULL)")
1653 string (Int.toString (size x')), 1654 | (x', n, to) :: rest =>
1654 string "] == '/')) ? ({", 1655 box [string "((!strncmp(request, \"",
1655 newline, 1656 string x',
1656 string "struct", 1657 string "\", ",
1657 space, 1658 string (Int.toString (size x')),
1658 string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i), 1659 string ") && (request[",
1659 space, 1660 string (Int.toString (size x')),
1660 string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_", 1661 string "] == 0 || request[",
1661 string x, 1662 string (Int.toString (size x')),
1662 string "_", 1663 string "] == '/')) ? ({",
1663 string (Int.toString i), 1664 newline,
1664 string "));", 1665 string "struct",
1665 newline, 1666 space,
1666 string "tmp->tag", 1667 string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
1667 space, 1668 space,
1668 string "=", 1669 string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
1669 space, 1670 string x,
1670 string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n), 1671 string "_",
1671 string ";", 1672 string (Int.toString i),
1672 newline, 1673 string "));",
1673 string "request", 1674 newline,
1674 space, 1675 string "tmp->tag",
1675 string "+=", 1676 space,
1676 space, 1677 string "=",
1677 string (Int.toString (size x')), 1678 space,
1678 string ";", 1679 string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
1679 newline, 1680 string ";",
1680 string "if (request[0] == '/') ++request;", 1681 newline,
1681 newline, 1682 string "request",
1682 case to of 1683 space,
1683 NONE => box [] 1684 string "+=",
1684 | SOME (t, _) => box [string "tmp->data.uw_", 1685 space,
1685 p_ident x', 1686 string (Int.toString (size x')),
1686 space, 1687 string ";",
1687 string "=", 1688 newline,
1688 space, 1689 string "if (request[0] == '/') ++request;",
1689 unurlify' rf t, 1690 newline,
1690 string ";", 1691 case to of
1691 newline], 1692 NONE => box []
1692 string "tmp;", 1693 | SOME (t, _) => box [string "tmp->data.uw_",
1693 newline, 1694 p_ident x',
1694 string "})", 1695 space,
1695 space, 1696 string "=",
1696 string ":", 1697 space,
1697 space, 1698 unurlify' rf t,
1698 doEm rest, 1699 string ";",
1699 string ")"] 1700 newline],
1700 in 1701 string "tmp;",
1701 doEm xncs 1702 newline,
1702 end 1703 string "})",
1704 space,
1705 string ":",
1706 space,
1707 doEm rest,
1708 string ")"]
1709 in
1710 box [string "({",
1711 space,
1712 p_typ env (t, ErrorMsg.dummySpan),
1713 space,
1714 string "unurlify_",
1715 string (Int.toString i),
1716 string "(void) {",
1717 newline,
1718 box [string "return",
1719 space,
1720 doEm xncs,
1721 string ";",
1722 newline],
1723 string "}",
1724 newline,
1725 newline,
1726
1727 string "unurlify_",
1728 string (Int.toString i),
1729 string "();",
1730 newline,
1731 string "})"]
1732 end
1703 1733
1704 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function"; 1734 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
1705 space) 1735 space)
1706 in 1736 in
1707 unurlify' IS.empty t 1737 unurlify' IS.empty t