summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2010-12-18 10:56:31 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2010-12-18 10:56:31 -0500
commitc71de1db0cf31466bfc5fe7e96021e5d3cba6979 (patch)
tree294baafc0fd3480fdce266c71f27090164d2114c /src/cjr_print.sml
parentf08b20b1ecc66389fc6a829cf3819b3b38b07c48 (diff)
postBody type
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml107
1 files changed, 54 insertions, 53 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index df11737e..fbbbc548 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2246,22 +2246,21 @@ fun p_file env (ds, ps) =
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 @@ fun p_file env (ds, ps) =
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 @@ fun p_file env (ds, ps) =
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,