Mercurial > urweb

comparison src/cjr_print.sml @ 1347:b106ca8200b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
postBody type
author Adam Chlipala <adam@chlipala.net>
date Sat, 18 Dec 2010 10:56:31 -0500
parents 4dd5d23bace2
children 8a169fc0838b
comparison
equal deleted inserted replaced
1346:faad7d01b200 1347:b106ca8200b1
2244 end 2244 end
2245 | _ => NONE 2245 | _ => NONE
2246 2246
2247 val fields = foldl (fn ((ek, _, _, ts, _, _, _), fields) => 2247 val fields = foldl (fn ((ek, _, _, ts, _, _, _), fields) =>
2248 case ek of 2248 case ek of
2249 Link => fields 2249 Action eff =>
2250 | Rpc _ => fields 2250 (case List.nth (ts, length ts - 2) of
2251 | Action eff => 2251 (TRecord i, loc) =>
2252 case List.nth (ts, length ts - 2) of 2252 let
2253 (TRecord i, loc) => 2253 val xts = E.lookupStruct env i
2254 let 2254 val extra = case eff of
2255 val xts = E.lookupStruct env i 2255 ReadCookieWrite => [sigName xts]
2256 val extra = case eff of 2256 | _ => []
2257 ReadCookieWrite => [sigName xts] 2257 in
2258 | _ => [] 2258 case flatFields extra (TRecord i, loc) of
2259 in 2259 NONE => raise Fail "CjrPrint: flatFields impossible"
2260 case flatFields extra (TRecord i, loc) of 2260 | SOME fields' => List.revAppend (fields', fields)
2261 NONE => raise Fail "CjrPrint: flatFields impossible" 2261 end
2262 | SOME fields' => List.revAppend (fields', fields) 2262 | _ => raise Fail "CjrPrint: Last argument of action isn't record")
2263 end 2263 | _ => fields)
2264 | _ => raise Fail "CjrPrint: Last argument of action isn't record")
2265 [] ps 2264 [] ps
2266 2265
2267 val fields = foldl (fn (xts, fields) => 2266 val fields = foldl (fn (xts, fields) =>
2268 let 2267 let
2269 val xtsSet = SS.addList (SS.empty, xts) 2268 val xtsSet = SS.addList (SS.empty, xts)
2542 2541
2543 fun p_page (ek, s, n, ts, ran, side, tellSig) = 2542 fun p_page (ek, s, n, ts, ran, side, tellSig) =
2544 let 2543 let
2545 val (ts, defInputs, inputsVar, fields) = 2544 val (ts, defInputs, inputsVar, fields) =
2546 case ek of 2545 case ek of
2547 Core.Link => (List.take (ts, length ts - 1), string "", string "", NONE) 2546 Core.Action _ =>
2548 | Core.Rpc _ => (List.take (ts, length ts - 1), string "", string "", NONE) 2547 (case List.nth (ts, length ts - 2) of
2549 | Core.Action _ => 2548 (TRecord i, _) =>
2550 case List.nth (ts, length ts - 2) of 2549 let
2551 (TRecord i, _) => 2550 val xts = E.lookupStruct env i
2552 let 2551 in
2553 val xts = E.lookupStruct env i 2552 (List.take (ts, length ts - 2),
2554 in 2553 box [box (map (fn (x, t) => box [p_typ env t,
2555 (List.take (ts, length ts - 2), 2554 space,
2556 box [box (map (fn (x, t) => box [p_typ env t, 2555 string "uw_input_",
2557 space, 2556 p_ident x,
2558 string "uw_input_", 2557 string ";",
2559 p_ident x, 2558 newline]) xts),
2560 string ";", 2559 newline,
2561 newline]) xts), 2560 box (map getInput xts),
2562 newline, 2561 string "struct __uws_",
2563 box (map getInput xts), 2562 string (Int.toString i),
2564 string "struct __uws_", 2563 space,
2565 string (Int.toString i), 2564 string "uw_inputs",
2566 space, 2565 space,
2567 string "uw_inputs", 2566 string "= {",
2568 space, 2567 newline,
2569 string "= {", 2568 box (map (fn (x, _) => box [string "uw_input_",
2570 newline, 2569 p_ident x,
2571 box (map (fn (x, _) => box [string "uw_input_", 2570 string ",",
2572 p_ident x, 2571 newline]) xts),
2573 string ",", 2572 string "};",
2574 newline]) xts), 2573 newline],
2575 string "};", 2574 box [string ",",
2576 newline], 2575 space,
2577 box [string ",", 2576 string "uw_inputs"],
2578 space, 2577 SOME xts)
2579 string "uw_inputs"], 2578 end
2580 SOME xts) 2579
2581 end 2580 | _ => raise Fail "CjrPrint: Last argument to an action isn't a record")
2582 2581 | _ => (List.take (ts, length ts - 1), string "", string "", NONE)
2583 | _ => raise Fail "CjrPrint: Last argument to an action isn't a record"
2584 2582
2585 fun couldWrite ek = 2583 fun couldWrite ek =
2586 case ek of 2584 case ek of
2587 Link => false 2585 Link => false
2588 | Action ef => ef = ReadCookieWrite 2586 | Action ef => ef = ReadCookieWrite
2589 | Rpc ef => ef = ReadCookieWrite 2587 | Rpc ef => ef = ReadCookieWrite
2588 | Extern ef => ef = ReadCookieWrite
2590 2589
2591 val s = 2590 val s =
2592 case Settings.getUrlPrefix () of 2591 case Settings.getUrlPrefix () of
2593 "" => s 2592 "" => s
2594 | "/" => s 2593 | "/" => s
2691 string "arg", 2690 string "arg",
2692 string (Int.toString i), 2691 string (Int.toString i),
2693 space, 2692 space,
2694 string "=", 2693 string "=",
2695 space, 2694 space,
2696 unurlify false env t, 2695 case #1 t of
2696 TFfi ("Basis", "postBody") => string "uw_getPostBody(ctx)"
2697 | _ => unurlify false env t,
2697 string ";", 2698 string ";",
2698 newline]) ts), 2699 newline]) ts),
2699 defInputs, 2700 defInputs,
2700 box (case ek of 2701 box (case ek of
2701 Core.Rpc _ => [p_typ env ran, 2702 Core.Rpc _ => [p_typ env ran,