Mercurial > urweb

comparison src/cjr_print.sml @ 1114:01b6c7144a44

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Deadlines
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Jan 2010 15:58:34 -0500
parents 7a31e0cf25e9
children 8679ba87cf3c
comparison
equal deleted inserted replaced
1113:40d48a2b78a7 1114:01b6c7144a44
1 (* Copyright (c) 2008-2009, Adam Chlipala 1 (* Copyright (c) 2008-2010, 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 *
1683 string "=", 1683 string "=",
1684 space, 1684 space,
1685 string "acc;", 1685 string "acc;",
1686 newline, 1686 newline,
1687 newline, 1687 newline,
1688
1689 if Settings.getDeadlines () then
1690 box [string "uw_check_deadline(ctx);",
1691 newline]
1692 else
1693 box [],
1694
1688 p_list_sepi (box []) (fn i => 1695 p_list_sepi (box []) (fn i =>
1689 fn (proj, t) => 1696 fn (proj, t) =>
1690 box [string "__uwr_r_", 1697 box [string "__uwr_r_",
1691 string (Int.toString (E.countERels env)), 1698 string (Int.toString (E.countERels env)),
1692 string ".", 1699 string ".",
1932 string "})"] 1939 string "})"]
1933 end 1940 end
1934 1941
1935 and p_exp env = p_exp' false env 1942 and p_exp env = p_exp' false env
1936 1943
1937 fun p_fun env (fx, n, args, ran, e) = 1944 fun p_fun isRec env (fx, n, args, ran, e) =
1938 let 1945 let
1939 val nargs = length args 1946 val nargs = length args
1940 val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args 1947 val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
1941 in 1948 in
1942 box [string "static", 1949 box [string "static",
1952 p_rel env' (nargs - i - 1)]) args), 1959 p_rel env' (nargs - i - 1)]) args),
1953 string ")", 1960 string ")",
1954 space, 1961 space,
1955 string "{", 1962 string "{",
1956 newline, 1963 newline,
1964 if isRec andalso Settings.getDeadlines () then
1965 box [string "uw_check_deadline(ctx);",
1966 newline]
1967 else
1968 box [],
1957 box [string "return(", 1969 box [string "return(",
1958 p_exp env' e, 1970 p_exp env' e,
1959 string ");"], 1971 string ");"],
1960 newline, 1972 newline,
1961 string "}"] 1973 string "}"]
2058 space, 2070 space,
2059 string "=", 2071 string "=",
2060 space, 2072 space,
2061 p_exp env e, 2073 p_exp env e,
2062 string ";"] 2074 string ";"]
2063 | DFun vi => p_fun env vi 2075 | DFun vi => p_fun false env vi
2064 | DFunRec vis => 2076 | DFunRec vis =>
2065 let 2077 let
2066 val env = E.declBinds env dAll 2078 val env = E.declBinds env dAll
2067 in 2079 in
2068 box [p_list_sep newline (fn (fx, n, args, ran, _) => 2080 box [p_list_sep newline (fn (fx, n, args, ran, _) =>
2075 space, 2087 space,
2076 p_list_sep (box [string ",", space]) 2088 p_list_sep (box [string ",", space])
2077 (fn (_, dom) => p_typ env dom) args, 2089 (fn (_, dom) => p_typ env dom) args,
2078 string ");"]) vis, 2090 string ");"]) vis,
2079 newline, 2091 newline,
2080 p_list_sep newline (p_fun env) vis, 2092 p_list_sep newline (p_fun true env) vis,
2081 newline] 2093 newline]
2082 end 2094 end
2083 | DTable (x, _, pk, csts) => box [string "/* SQL table ", 2095 | DTable (x, _, pk, csts) => box [string "/* SQL table ",
2084 string x, 2096 string x,
2085 space, 2097 space,