Mercurial > urweb

comparison src/cjr_print.sml @ 609:56aaa1941dad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First gimpy RPC
author Adam Chlipala <adamc@hcoop.net>
date Sun, 15 Feb 2009 10:32:50 -0500
parents 330a7de47914
children c41b2abf156b
comparison
equal deleted inserted replaced
608:330a7de47914 609:56aaa1941dad
1844 val (pds, env) = ListUtil.foldlMap (fn (d, env) => 1844 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
1845 (p_decl env d, 1845 (p_decl env d,
1846 E.declBinds env d)) 1846 E.declBinds env d))
1847 env ds 1847 env ds
1848 1848
1849 val fields = foldl (fn ((ek, _, _, ts), fields) => 1849 val fields = foldl (fn ((ek, _, _, ts, _), fields) =>
1850 case ek of 1850 case ek of
1851 Core.Link => fields 1851 Core.Link => fields
1852 | Core.Rpc => fields 1852 | Core.Rpc => fields
1853 | Core.Action => 1853 | Core.Action =>
1854 case List.nth (ts, length ts - 2) of 1854 case List.nth (ts, length ts - 2) of
1965 string "-1;", 1965 string "-1;",
1966 newline, 1966 newline,
1967 string "}"] 1967 string "}"]
1968 end 1968 end
1969 1969
1970 fun p_page (ek, s, n, ts) = 1970 fun p_page (ek, s, n, ts, ran) =
1971 let 1971 let
1972 val (ts, defInputs, inputsVar) = 1972 val (ts, defInputs, inputsVar) =
1973 case ek of 1973 case ek of
1974 Core.Link => (List.take (ts, length ts - 1), string "", string "") 1974 Core.Link => (List.take (ts, length ts - 1), string "", string "")
1975 | Core.Rpc => (List.take (ts, length ts - 1), string "", string "") 1975 | Core.Rpc => (List.take (ts, length ts - 1), string "", string "")
2052 string (Int.toString (size s)), 2052 string (Int.toString (size s)),
2053 string ";", 2053 string ";",
2054 newline, 2054 newline,
2055 string "if (*request == '/') ++request;", 2055 string "if (*request == '/') ++request;",
2056 newline, 2056 newline,
2057 string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");", 2057 box (case ek of
2058 newline, 2058 Core.Rpc => []
2059 string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");", 2059 | _ => [string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");",
2060 newline, 2060 newline,
2061 string "uw_write(ctx, \"<html>\");", 2061 string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");",
2062 newline, 2062 newline,
2063 string "uw_write(ctx, \"<html>\");",
2064 newline]),
2063 box [string "{", 2065 box [string "{",
2064 newline, 2066 newline,
2065 box (ListUtil.mapi (fn (i, t) => box [p_typ env t, 2067 box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
2066 space, 2068 space,
2067 string "arg", 2069 string "arg",
2071 space, 2073 space,
2072 unurlify env t, 2074 unurlify env t,
2073 string ";", 2075 string ";",
2074 newline]) ts), 2076 newline]) ts),
2075 defInputs, 2077 defInputs,
2078 box (case ek of
2079 Core.Rpc => [p_typ env ran,
2080 space,
2081 string "res",
2082 space,
2083 string "=",
2084 space]
2085 | _ => []),
2076 p_enamed env n, 2086 p_enamed env n,
2077 string "(", 2087 string "(",
2078 p_list_sep (box [string ",", space]) 2088 p_list_sep (box [string ",", space])
2079 (fn x => x) 2089 (fn x => x)
2080 (string "ctx" 2090 (string "ctx"
2081 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts), 2091 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
2082 inputsVar, 2092 inputsVar,
2083 string ", uw_unit_v);", 2093 string ", uw_unit_v);",
2084 newline, 2094 newline,
2085 string "uw_write(ctx, \"</html>\");", 2095 box (case ek of
2086 newline, 2096 Core.Rpc => []
2097 | _ => [string "uw_write(ctx, \"</html>\");",
2098 newline]),
2087 string "return;", 2099 string "return;",
2088 newline, 2100 newline,
2089 string "}", 2101 string "}",
2090 newline, 2102 newline,
2091 string "}"] 2103 string "}"]