Mercurial > urweb

comparison src/cjr_print.sml @ 731:e0dd85ea58e1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Label exported symbols by effect-ness; factor out some common datatypes
author Adam Chlipala <adamc@hcoop.net>
date Thu, 16 Apr 2009 14:49:25 -0400
parents 4c5796512edc
children f2a2be93331c
comparison
equal deleted inserted replaced
730:1b1047992ecf 731:e0dd85ea58e1
2206 env ds 2206 env ds
2207 2207
2208 val fields = foldl (fn ((ek, _, _, ts, _, _), fields) => 2208 val fields = foldl (fn ((ek, _, _, ts, _, _), fields) =>
2209 case ek of 2209 case ek of
2210 Core.Link => fields 2210 Core.Link => fields
2211 | Core.Rpc => fields 2211 | Core.Rpc _ => fields
2212 | Core.Action => 2212 | Core.Action _ =>
2213 case List.nth (ts, length ts - 2) of 2213 case List.nth (ts, length ts - 2) of
2214 (TRecord i, _) => 2214 (TRecord i, _) =>
2215 let 2215 let
2216 val xts = E.lookupStruct env i 2216 val xts = E.lookupStruct env i
2217 val xtsSet = SS.addList (SS.empty, map #1 xts) 2217 val xtsSet = SS.addList (SS.empty, map #1 xts)
2329 fun p_page (ek, s, n, ts, ran, side) = 2329 fun p_page (ek, s, n, ts, ran, side) =
2330 let 2330 let
2331 val (ts, defInputs, inputsVar) = 2331 val (ts, defInputs, inputsVar) =
2332 case ek of 2332 case ek of
2333 Core.Link => (List.take (ts, length ts - 1), string "", string "") 2333 Core.Link => (List.take (ts, length ts - 1), string "", string "")
2334 | Core.Rpc => (List.take (ts, length ts - 1), string "", string "") 2334 | Core.Rpc _ => (List.take (ts, length ts - 1), string "", string "")
2335 | Core.Action => 2335 | Core.Action _ =>
2336 case List.nth (ts, length ts - 2) of 2336 case List.nth (ts, length ts - 2) of
2337 (TRecord i, _) => 2337 (TRecord i, _) =>
2338 let 2338 let
2339 val xts = E.lookupStruct env i 2339 val xts = E.lookupStruct env i
2340 in 2340 in
2412 string ";", 2412 string ";",
2413 newline, 2413 newline,
2414 string "if (*request == '/') ++request;", 2414 string "if (*request == '/') ++request;",
2415 newline, 2415 newline,
2416 box (case ek of 2416 box (case ek of
2417 Core.Rpc => [string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");", 2417 Core.Rpc _ => [string "uw_write_header(ctx, \"Content-type: text/plain\\r\\n\");",
2418 newline] 2418 newline]
2419 | _ => [string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");", 2419 | _ => [string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");",
2420 newline, 2420 newline,
2421 string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");", 2421 string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");",
2422 newline, 2422 newline,
2423 string "uw_write(ctx, \"<html>\");", 2423 string "uw_write(ctx, \"<html>\");",
2455 unurlify env t, 2455 unurlify env t,
2456 string ";", 2456 string ";",
2457 newline]) ts), 2457 newline]) ts),
2458 defInputs, 2458 defInputs,
2459 box (case ek of 2459 box (case ek of
2460 Core.Rpc => [p_typ env ran, 2460 Core.Rpc _ => [p_typ env ran,
2461 space, 2461 space,
2462 string "it0", 2462 string "it0",
2463 space, 2463 space,
2464 string "=", 2464 string "=",
2465 space] 2465 space]
2466 | _ => []), 2466 | _ => []),
2467 p_enamed env n, 2467 p_enamed env n,
2468 string "(", 2468 string "(",
2469 p_list_sep (box [string ",", space]) 2469 p_list_sep (box [string ",", space])
2470 (fn x => x) 2470 (fn x => x)
2472 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts), 2472 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
2473 inputsVar, 2473 inputsVar,
2474 string ", uw_unit_v);", 2474 string ", uw_unit_v);",
2475 newline, 2475 newline,
2476 box (case ek of 2476 box (case ek of
2477 Core.Rpc => [urlify env ran] 2477 Core.Rpc _ => [urlify env ran]
2478 | _ => [string "uw_write(ctx, \"</html>\");", 2478 | _ => [string "uw_write(ctx, \"</html>\");",
2479 newline]), 2479 newline]),
2480 string "return;", 2480 string "return;",
2481 newline, 2481 newline,
2482 string "}", 2482 string "}",