Mercurial > urweb
diff src/cjr_print.sml @ 1347:b106ca8200b1
postBody type
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 18 Dec 2010 10:56:31 -0500 |
parents | 4dd5d23bace2 |
children | 8a169fc0838b |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu Dec 16 18:40:49 2010 -0500 +++ b/src/cjr_print.sml Sat Dec 18 10:56:31 2010 -0500 @@ -2246,22 +2246,21 @@ val fields = foldl (fn ((ek, _, _, ts, _, _, _), fields) => case ek of - Link => fields - | Rpc _ => fields - | Action eff => - case List.nth (ts, length ts - 2) of - (TRecord i, loc) => - let - val xts = E.lookupStruct env i - val extra = case eff of - ReadCookieWrite => [sigName xts] - | _ => [] - in - case flatFields extra (TRecord i, loc) of - NONE => raise Fail "CjrPrint: flatFields impossible" - | SOME fields' => List.revAppend (fields', fields) - end - | _ => raise Fail "CjrPrint: Last argument of action isn't record") + Action eff => + (case List.nth (ts, length ts - 2) of + (TRecord i, loc) => + let + val xts = E.lookupStruct env i + val extra = case eff of + ReadCookieWrite => [sigName xts] + | _ => [] + in + case flatFields extra (TRecord i, loc) of + NONE => raise Fail "CjrPrint: flatFields impossible" + | SOME fields' => List.revAppend (fields', fields) + end + | _ => raise Fail "CjrPrint: Last argument of action isn't record") + | _ => fields) [] ps val fields = foldl (fn (xts, fields) => @@ -2544,49 +2543,49 @@ let val (ts, defInputs, inputsVar, fields) = case ek of - Core.Link => (List.take (ts, length ts - 1), string "", string "", NONE) - | Core.Rpc _ => (List.take (ts, length ts - 1), string "", string "", NONE) - | Core.Action _ => - case List.nth (ts, length ts - 2) of - (TRecord i, _) => - let - val xts = E.lookupStruct env i - in - (List.take (ts, length ts - 2), - box [box (map (fn (x, t) => box [p_typ env t, - space, - string "uw_input_", - p_ident x, - string ";", - newline]) xts), - newline, - box (map getInput xts), - string "struct __uws_", - string (Int.toString i), - space, - string "uw_inputs", - space, - string "= {", - newline, - box (map (fn (x, _) => box [string "uw_input_", - p_ident x, - string ",", - newline]) xts), - string "};", - newline], - box [string ",", - space, - string "uw_inputs"], - SOME xts) - end + Core.Action _ => + (case List.nth (ts, length ts - 2) of + (TRecord i, _) => + let + val xts = E.lookupStruct env i + in + (List.take (ts, length ts - 2), + box [box (map (fn (x, t) => box [p_typ env t, + space, + string "uw_input_", + p_ident x, + string ";", + newline]) xts), + newline, + box (map getInput xts), + string "struct __uws_", + string (Int.toString i), + space, + string "uw_inputs", + space, + string "= {", + newline, + box (map (fn (x, _) => box [string "uw_input_", + p_ident x, + string ",", + newline]) xts), + string "};", + newline], + box [string ",", + space, + string "uw_inputs"], + SOME xts) + end - | _ => raise Fail "CjrPrint: Last argument to an action isn't a record" + | _ => raise Fail "CjrPrint: Last argument to an action isn't a record") + | _ => (List.take (ts, length ts - 1), string "", string "", NONE) fun couldWrite ek = case ek of Link => false | Action ef => ef = ReadCookieWrite | Rpc ef => ef = ReadCookieWrite + | Extern ef => ef = ReadCookieWrite val s = case Settings.getUrlPrefix () of @@ -2693,7 +2692,9 @@ space, string "=", space, - unurlify false env t, + case #1 t of + TFfi ("Basis", "postBody") => string "uw_getPostBody(ctx)" + | _ => unurlify false env t, string ";", newline]) ts), defInputs,