summaryrefslogtreecommitdiff
path: root/src/cjr_print.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-10-21 15:11:42 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-10-21 15:11:42 -0400
commita3418cf924752accf2f68fc2673da2a661276ae5 (patch)
tree13d980071b5e6d9402189836c87e1302b3f0acd9 /src/cjr_print.sml
parent5e4a0f3fbfb025c17488b5f066988ee1da030825 (diff)
Recursive unurlify for Default datatypes
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r--src/cjr_print.sml158
1 files changed, 94 insertions, 64 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index bfe6414f..f2af999b 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1513,7 +1513,8 @@ fun p_file env (ds, ps) =
fun doEm xncs =
case xncs of
- [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), (enum __uwe_"
+ [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
+ ^ x ^ "\"), (enum __uwe_"
^ x ^ "_" ^ Int.toString i ^ ")0)")
| (x', n, to) :: rest =>
box [string "((!strncmp(request, \"",
@@ -1636,70 +1637,99 @@ fun p_file env (ds, ps) =
end
| TDatatype (Default, i, _) =>
- let
- val (x, xncs) = E.lookupDatatype env i
+ if IS.member (rf, i) then
+ box [string "unurlify_",
+ string (Int.toString i),
+ string "()"]
+ else
+ let
+ val (x, xncs) = E.lookupDatatype env i
- fun doEm xncs =
- case xncs of
- [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)")
- | (x', n, to) :: rest =>
- box [string "((!strncmp(request, \"",
- string x',
- string "\", ",
- string (Int.toString (size x')),
- string ") && (request[",
- string (Int.toString (size x')),
- string "] == 0 || request[",
- string (Int.toString (size x')),
- string "] == '/')) ? ({",
- newline,
- string "struct",
- space,
- string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
- space,
- string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
- string x,
- string "_",
- string (Int.toString i),
- string "));",
- newline,
- string "tmp->tag",
- space,
- string "=",
- space,
- string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
- string ";",
- newline,
- string "request",
- space,
- string "+=",
- space,
- string (Int.toString (size x')),
- string ";",
- newline,
- string "if (request[0] == '/') ++request;",
- newline,
- case to of
- NONE => box []
- | SOME (t, _) => box [string "tmp->data.uw_",
- p_ident x',
- space,
- string "=",
- space,
- unurlify' rf t,
- string ";",
- newline],
- string "tmp;",
- newline,
- string "})",
- space,
- string ":",
- space,
- doEm rest,
- string ")"]
- in
- doEm xncs
- end
+ val rf = IS.add (rf, i)
+
+ fun doEm xncs =
+ case xncs of
+ [] => string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype "
+ ^ x ^ "\"), NULL)")
+ | (x', n, to) :: rest =>
+ box [string "((!strncmp(request, \"",
+ string x',
+ string "\", ",
+ string (Int.toString (size x')),
+ string ") && (request[",
+ string (Int.toString (size x')),
+ string "] == 0 || request[",
+ string (Int.toString (size x')),
+ string "] == '/')) ? ({",
+ newline,
+ string "struct",
+ space,
+ string ("__uwd_" ^ ident x ^ "_" ^ Int.toString i),
+ space,
+ string "*tmp = uw_malloc(ctx, sizeof(struct __uwd_",
+ string x,
+ string "_",
+ string (Int.toString i),
+ string "));",
+ newline,
+ string "tmp->tag",
+ space,
+ string "=",
+ space,
+ string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
+ string ";",
+ newline,
+ string "request",
+ space,
+ string "+=",
+ space,
+ string (Int.toString (size x')),
+ string ";",
+ newline,
+ string "if (request[0] == '/') ++request;",
+ newline,
+ case to of
+ NONE => box []
+ | SOME (t, _) => box [string "tmp->data.uw_",
+ p_ident x',
+ space,
+ string "=",
+ space,
+ unurlify' rf t,
+ string ";",
+ newline],
+ string "tmp;",
+ newline,
+ string "})",
+ space,
+ string ":",
+ space,
+ doEm rest,
+ string ")"]
+ in
+ box [string "({",
+ space,
+ p_typ env (t, ErrorMsg.dummySpan),
+ space,
+ string "unurlify_",
+ string (Int.toString i),
+ string "(void) {",
+ newline,
+ box [string "return",
+ space,
+ doEm xncs,
+ string ";",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "unurlify_",
+ string (Int.toString i),
+ string "();",
+ newline,
+ string "})"]
+ end
| _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
space)