summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-07-23 16:27:04 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2011-07-23 16:27:04 -0400
commit392d8e89996967e8693167afd28eadf96fdcd904 (patch)
tree9d73d1c84b54e94173bbdbb4c602fbf49f857e9f
parent81e7f95451a25669e849f766b814ede3c9336264 (diff)
A few more tweaks to support Clang (including ending use of nested functions)
-rw-r--r--doc/manual.tex6
-rw-r--r--src/cjr_print.sml735
-rw-r--r--src/compiler.sml2
3 files changed, 389 insertions, 354 deletions
diff --git a/doc/manual.tex b/doc/manual.tex
index 7468c0e6..8573c1c1 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -87,14 +87,12 @@ apt-get install emacs-goodies-el
If you don't want to install the Emacs mode, run \texttt{./configure} with the argument \texttt{--without-emacs}.
-Even with the right packages installed, configuration and building might fail to work. After you run \texttt{./configure}, you will see the values of some named environment variables printed. You may need to adjust these values to get proper installation for your system. To change a value, store your preferred alternative in the corresponding UNIX environment variable, before running \texttt{./configure}. For instance, here is how to change the list of extra arguments that the Ur/Web compiler will pass to GCC on every invocation.
+Even with the right packages installed, configuration and building might fail to work. After you run \texttt{./configure}, you will see the values of some named environment variables printed. You may need to adjust these values to get proper installation for your system. To change a value, store your preferred alternative in the corresponding UNIX environment variable, before running \texttt{./configure}. For instance, here is how to change the list of extra arguments that the Ur/Web compiler will pass to GCC on every invocation. Some older GCC versions need this setting to mask a bug in function inlining.
\begin{verbatim}
-GCCARGS=-fnested-functions ./configure
+GCCARGS=-fno-inline ./configure
\end{verbatim}
-Some Mac OS X users have reported needing to use this particular GCCARGS value. Also, some older GCC versions have inlining-related bugs that can be masked (at some cost to output code quality) by adding \texttt{-fno-inline} here.
-
Since the author is still getting a handle on the GNU Autotools that provide the build system, you may need to do some further work to get started, especially in environments with significant differences from Linux (where most testing is done). The variables \texttt{PGHEADER}, \texttt{MSHEADER}, and \texttt{SQHEADER} may be used to set the proper C header files to include for the development libraries of PostgreSQL, MySQL, and SQLite, respectively. To get libpq to link, one OS X user reported setting \texttt{GCCARGS="-I/opt/local/include -L/opt/local/lib/postgresql84"}, after creating a symbolic link with \texttt{ln -s /opt/local/include/postgresql84 /opt/local/include/postgresql}.
The Emacs mode can be set to autoload by adding the following to your \texttt{.emacs} file.
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 340ac9f5..15bbf005 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -523,18 +523,34 @@ fun capitalize s =
else
str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+local
+ val urlHandlers = ref ([] : pp_desc list)
+in
+
+fun addUrlHandler v = urlHandlers := v :: !urlHandlers
+
+fun latestUrlHandlers () =
+ !urlHandlers
+ before urlHandlers := []
+
+fun clearUrlHandlers () = urlHandlers := []
+
+end
+
+val unurlifies = ref IS.empty
+
fun unurlify fromClient env (t, loc) =
let
- fun unurlify' rf t =
+ fun unurlify' request t =
case t of
- TFfi ("Basis", "unit") => string "uw_Basis_unurlifyUnit(ctx, &request)"
+ TFfi ("Basis", "unit") => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")")
| TFfi ("Basis", "string") => string (if fromClient then
- "uw_Basis_unurlifyString_fromClient(ctx, &request)"
+ "uw_Basis_unurlifyString_fromClient(ctx, &" ^ request ^ ")"
else
- "uw_Basis_unurlifyString(ctx, &request)")
- | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, &request)")
+ "uw_Basis_unurlifyString(ctx, &" ^ request ^ ")")
+ | TFfi (m, t) => string ("uw_" ^ ident m ^ "_unurlify" ^ capitalize t ^ "(ctx, &" ^ request ^ ")")
- | TRecord 0 => string "uw_Basis_unurlifyUnit(ctx, &request)"
+ | TRecord 0 => string ("uw_Basis_unurlifyUnit(ctx, &" ^ request ^ ")")
| TRecord i =>
let
val xts = E.lookupStruct env i
@@ -549,7 +565,7 @@ fun unurlify fromClient env (t, loc) =
space,
string "=",
space,
- unurlify' rf (#1 t),
+ unurlify' request (#1 t),
string ";",
newline]) xts),
string "struct",
@@ -583,17 +599,17 @@ fun unurlify fromClient env (t, loc) =
^ x ^ "\"), (enum __uwe_"
^ x ^ "_" ^ Int.toString i ^ ")0)")
| (x', n, to) :: rest =>
- box [string "((!strncmp(request, \"",
+ box [string ("((!strncmp(" ^ request ^ ", \""),
string x',
string "\", ",
string (Int.toString (size x')),
- string ") && (request[",
+ string (") && (" ^ request ^ "["),
string (Int.toString (size x')),
- string "] == 0 || request[",
+ string ("] == 0 || " ^ request ^ "["),
string (Int.toString (size x')),
- string "] == '/')) ? (request += ",
+ string ("] == '/')) ? (" ^ request ^ " += "),
string (Int.toString (size x')),
- string (", (*request == '/' ? ++request : NULL), __uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ")"),
+ string (", (" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : NULL), __uwc_" ^ ident x' ^ "_" ^ Int.toString n ^ ")"),
space,
string ":",
space,
@@ -604,10 +620,10 @@ fun unurlify fromClient env (t, loc) =
end
| TDatatype (Option, i, xncs) =>
- if IS.member (rf, i) then
+ if IS.member (!unurlifies, i) then
box [string "unurlify_",
string (Int.toString i),
- string "()"]
+ string ("(ctx, &" ^ request ^ ")")]
else
let
val (x, _) = E.lookupDatatype env i
@@ -619,114 +635,111 @@ fun unurlify fromClient env (t, loc) =
| [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
(no_arg, has_arg, t)
| _ => raise Fail "CjrPrint: unfooify misclassified Option datatype"
-
- val rf = IS.add (rf, i)
in
- box [string "({",
- space,
- p_typ env t,
- space,
- string "*unurlify_",
- string (Int.toString i),
- string "(void) {",
- newline,
- box [string "return (request[0] == '/' ? ++request : request,",
- newline,
- string "((!strncmp(request, \"",
- string no_arg,
- string "\", ",
- string (Int.toString (size no_arg)),
- string ") && (request[",
- string (Int.toString (size no_arg)),
- string "] == 0 || request[",
- string (Int.toString (size no_arg)),
- string "] == '/')) ? (request",
- space,
- string "+=",
- space,
- string (Int.toString (size no_arg)),
- string ", NULL) : ((!strncmp(request, \"",
- string has_arg,
- string "\", ",
- string (Int.toString (size has_arg)),
- string ") && (request[",
- string (Int.toString (size has_arg)),
- string "] == 0 || request[",
- string (Int.toString (size has_arg)),
- string "] == '/')) ? (request",
- space,
- string "+=",
- space,
- string (Int.toString (size has_arg)),
- string ", (request[0] == '/' ? ++request : NULL), ",
- newline,
-
- if isUnboxable t then
- unurlify' rf (#1 t)
- else
- box [string "({",
- newline,
- p_typ env t,
- space,
- string "*tmp",
- space,
- string "=",
- space,
- string "uw_malloc(ctx, sizeof(",
- p_typ env t,
- string "));",
- newline,
- string "*tmp",
- space,
- string "=",
- space,
- unurlify' rf (#1 t),
- string ";",
- newline,
- string "tmp;",
- newline,
- string "})"],
- string ")",
- newline,
- string ":",
- space,
- string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
- ^ "\"), NULL))));"),
- newline],
- string "}",
- newline,
- newline,
+ unurlifies := IS.add (!unurlifies, i);
+ addUrlHandler (box [string "static",
+ space,
+ p_typ env t,
+ space,
+ string "*unurlify_",
+ string (Int.toString i),
+ string "(uw_context ctx, char **request) {",
+ newline,
+ box [string "return ((*request)[0] == '/' ? ++*request : *request,",
+ newline,
+ string "((!strncmp(*request, \"",
+ string no_arg,
+ string "\", ",
+ string (Int.toString (size no_arg)),
+ string ") && ((*request)[",
+ string (Int.toString (size no_arg)),
+ string "] == 0 || (*request)[",
+ string (Int.toString (size no_arg)),
+ string "] == '/')) ? (*request",
+ space,
+ string "+=",
+ space,
+ string (Int.toString (size no_arg)),
+ string ", NULL) : ((!strncmp(*request, \"",
+ string has_arg,
+ string "\", ",
+ string (Int.toString (size has_arg)),
+ string ") && ((*request)[",
+ string (Int.toString (size has_arg)),
+ string "] == 0 || (*request)[",
+ string (Int.toString (size has_arg)),
+ string "] == '/')) ? (*request",
+ space,
+ string "+=",
+ space,
+ string (Int.toString (size has_arg)),
+ string ", ((*request)[0] == '/' ? ++*request : NULL), ",
+ newline,
+
+ if isUnboxable t then
+ unurlify' "(*request)" (#1 t)
+ else
+ box [string "({",
+ newline,
+ p_typ env t,
+ space,
+ string "*tmp",
+ space,
+ string "=",
+ space,
+ string "uw_malloc(ctx, sizeof(",
+ p_typ env t,
+ string "));",
+ newline,
+ string "*tmp",
+ space,
+ string "=",
+ space,
+ unurlify' "(*request)" (#1 t),
+ string ";",
+ newline,
+ string "tmp;",
+ newline,
+ string "})"],
+ string ")",
+ newline,
+ string ":",
+ space,
+ string ("(uw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x
+ ^ "\"), NULL))));"),
+ newline],
+ string "}",
+ newline,
+ newline]);
- string "unurlify_",
- string (Int.toString i),
- string "();",
- newline,
- string "})"]
+ box [string "unurlify_",
+ string (Int.toString i),
+ string ("(ctx, &" ^ request ^ ")")]
end
| TDatatype (Default, i, _) =>
- if IS.member (rf, i) then
+ if IS.member (!unurlifies, i) then
box [string "unurlify_",
string (Int.toString i),
- string "()"]
+ string ("(ctx, &" ^ request ^ ")")]
else
let
val (x, xncs) = E.lookupDatatype env i
- val rf = IS.add (rf, i)
+ val () = unurlifies := IS.add (!unurlifies, 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, \"",
+ box [string "((!strncmp(*request, \"",
string x',
string "\", ",
string (Int.toString (size x')),
- string ") && (request[",
+ string ") && ((*request)[",
string (Int.toString (size x')),
- string "] == 0 || request[",
+ string "] == 0 || (*request)[",
string (Int.toString (size x')),
string "] == '/')) ? ({",
newline,
@@ -747,14 +760,14 @@ fun unurlify fromClient env (t, loc) =
string ("__uwc_" ^ ident x' ^ "_" ^ Int.toString n),
string ";",
newline,
- string "request",
+ string "*request",
space,
string "+=",
space,
string (Int.toString (size x')),
string ";",
newline,
- string "if (request[0] == '/') ++request;",
+ string "if ((*request)[0] == '/') ++*request;",
newline,
case to of
NONE => box []
@@ -763,7 +776,7 @@ fun unurlify fromClient env (t, loc) =
space,
string "=",
space,
- unurlify' rf t,
+ unurlify' "(*request)" t,
string ";",
newline],
string "tmp;",
@@ -775,111 +788,104 @@ fun unurlify fromClient env (t, loc) =
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,
+ addUrlHandler (box [string "static",
+ space,
+ p_typ env (t, ErrorMsg.dummySpan),
+ space,
+ string "unurlify_",
+ string (Int.toString i),
+ string "(uw_context ctx, char **request) {",
+ newline,
+ box [string "return",
+ space,
+ doEm xncs,
+ string ";",
+ newline],
+ string "}",
+ newline,
+ newline]);
- string "unurlify_",
+ box [string "unurlify_",
string (Int.toString i),
- string "();",
- newline,
- string "})"]
+ string ("(ctx, &" ^ request ^ ")")]
end
| TList (t', i) =>
- if IS.member (rf, i) then
+ if IS.member (!unurlifies, i) then
box [string "unurlify_list_",
string (Int.toString i),
- string "()"]
+ string ("(ctx, &" ^ request ^ ")")]
else
- let
- val rf = IS.add (rf, i)
- in
- box [string "({",
- space,
- p_typ env (t, loc),
- space,
- string "unurlify_list_",
- string (Int.toString i),
- string "(void) {",
- newline,
- box [string "return (request[0] == '/' ? ++request : request,",
- newline,
- string "((!strncmp(request, \"Nil\", 3) && (request[3] == 0 ",
- string "|| request[3] == '/')) ? (request",
- space,
- string "+=",
- space,
- string "3, (*request == '/' ? *request++ = 0 : 0), NULL) : ((!strncmp(request, \"Cons\", 4) && (request[4] == 0 ",
- string "|| request[4] == '/')) ? (request",
- space,
- string "+=",
- space,
- string "4, (request[0] == '/' ? ++request : NULL), ",
- newline,
-
- string "({",
- newline,
- p_typ env (t, loc),
- space,
- string "tmp",
- space,
- string "=",
- space,
- string "uw_malloc(ctx, sizeof(struct __uws_",
- string (Int.toString i),
- string "));",
- newline,
- string "*tmp",
- space,
- string "=",
- space,
- unurlify' rf (TRecord i),
- string ";",
- newline,
- string "tmp;",
- newline,
- string "})",
- string ")",
- newline,
- string ":",
- space,
- string ("(uw_error(ctx, FATAL, \"Error unurlifying list: %s\", request), NULL))));"),
- newline],
- string "}",
- newline,
- newline,
+ (unurlifies := IS.add (!unurlifies, i);
+ addUrlHandler (box [string "static",
+ space,
+ p_typ env (t, loc),
+ space,
+ string "unurlify_list_",
+ string (Int.toString i),
+ string "(uw_context ctx, char **request) {",
+ newline,
+ box [string "return ((*request)[0] == '/' ? ++*request : *request,",
+ newline,
+ string "((!strncmp(*request, \"Nil\", 3) && ((*request)[3] == 0 ",
+ string "|| (*request)[3] == '/')) ? (*request",
+ space,
+ string "+=",
+ space,
+ string "3, (*request == '/' ? *request++ = 0 : 0), NULL) : ((!strncmp(*request, \"Cons\", 4) && ((*request)[4] == 0 ",
+ string "|| (*request)[4] == '/')) ? (*request",
+ space,
+ string "+=",
+ space,
+ string "4, ((*request)[0] == '/' ? ++*request : NULL), ",
+ newline,
+
+ string "({",
+ newline,
+ p_typ env (t, loc),
+ space,
+ string "tmp",
+ space,
+ string "=",
+ space,
+ string "uw_malloc(ctx, sizeof(struct __uws_",
+ string (Int.toString i),
+ string "));",
+ newline,
+ string "*tmp",
+ space,
+ string "=",
+ space,
+ unurlify' "(*request)" (TRecord i),
+ string ";",
+ newline,
+ string "tmp;",
+ newline,
+ string "})",
+ string ")",
+ newline,
+ string ":",
+ space,
+ string ("(uw_error(ctx, FATAL, \"Error unurlifying list: %s\", request), NULL))));"),
+ newline],
+ string "}",
+ newline,
+ newline]);
- string "unurlify_list_",
- string (Int.toString i),
- string "();",
- newline,
- string "})"]
- end
+ box [string "unurlify_list_",
+ string (Int.toString i),
+ string ("(ctx, &" ^ request ^ ")")])
| TOption t =>
- box [string "(request[0] == '/' ? ++request : request, ",
- string "((!strncmp(request, \"None\", 4) ",
- string "&& (request[4] == 0 || request[4] == '/')) ",
- string "? (request += (request[4] == 0 ? 4 : 5), NULL) ",
- string ": ((!strncmp(request, \"Some\", 4) ",
- string "&& request[4] == '/') ",
- string "? (request += 5, ",
+ box [string ("(" ^ request ^ "[0] == '/' ? ++" ^ request ^ " : " ^ request ^ ", "),
+ string ("((!strncmp(" ^ request ^ ", \"None\", 4) "),
+ string ("&& (" ^ request ^ "[4] == 0 || " ^ request ^ "[4] == '/')) "),
+ string ("? (" ^ request ^ " += (" ^ request ^ "[4] == 0 ? 4 : 5), NULL) "),
+ string (": ((!strncmp(" ^ request ^ ", \"Some\", 4) "),
+ string ("&& " ^ request ^ "[4] == '/') "),
+ string ("? (" ^ request ^ " += 5, "),
if isUnboxable t then
- unurlify' rf (#1 t)
+ unurlify' request (#1 t)
else
box [string "({",
newline,
@@ -897,7 +903,7 @@ fun unurlify fromClient env (t, loc) =
space,
string "=",
space,
- unurlify' rf (#1 t),
+ unurlify' request (#1 t),
string ";",
newline,
string "tmp;",
@@ -910,14 +916,17 @@ fun unurlify fromClient env (t, loc) =
| _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
space)
in
- unurlify' IS.empty t
+ unurlify' "request" t
end
val urlify1 = ref 0
+val urlifies = ref IS.empty
+val urlifiesL = ref IS.empty
+
fun urlify env t =
let
- fun urlify' rf rfl level (t as (_, loc)) =
+ fun urlify' level (t as (_, loc)) =
case #1 t of
TFfi ("Basis", "unit") => box []
| TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
@@ -960,7 +969,7 @@ fun urlify env t =
newline]
else
[]),
- urlify' rf rfl (level + 1) t,
+ urlify' (level + 1) t,
string "}",
newline] :: blocks,
true)
@@ -995,10 +1004,12 @@ fun urlify env t =
end
| TDatatype (Option, i, xncs) =>
- if IS.member (rf, i) then
+ if IS.member (!urlifies, i) then
box [string "urlify_",
string (Int.toString i),
- string "(it",
+ string "(ctx,",
+ space,
+ string "it",
string (Int.toString level),
string ");",
newline]
@@ -1013,71 +1024,73 @@ fun urlify env t =
| [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
(no_arg, has_arg, t)
| _ => raise Fail "CjrPrint: urlify misclassified Option datatype"
-
- val rf = IS.add (rf, i)
in
- box [string "({",
- space,
- string "void",
- space,
- string "urlify_",
- string (Int.toString i),
- string "(",
- p_typ env t,
- space,
- if isUnboxable t then
- box []
- else
- string "*",
- string "it0) {",
- newline,
- box [string "if (it0) {",
- newline,
- if isUnboxable t then
- urlify' rf rfl 0 t
- else
- box [p_typ env t,
- space,
- string "it1",
- space,
- string "=",
- space,
- string "*it0;",
- newline,
- string "uw_write(ctx, \"",
- string has_arg,
- string "/\");",
- newline,
- urlify' rf rfl 1 t,
- string ";",
- newline],
- string "} else {",
- box [newline,
- string "uw_write(ctx, \"",
- string no_arg,
- string "\");",
- newline],
- string "}",
- newline],
- string "}",
- newline,
- newline,
+ urlifies := IS.add (!urlifies, i);
+ addUrlHandler (box [string "static",
+ space,
+ string "void",
+ space,
+ string "urlify_",
+ string (Int.toString i),
+ string "(uw_context ctx,",
+ space,
+ p_typ env t,
+ space,
+ if isUnboxable t then
+ box []
+ else
+ string "*",
+ string "it0) {",
+ newline,
+ box [string "if (it0) {",
+ newline,
+ if isUnboxable t then
+ urlify' 0 t
+ else
+ box [p_typ env t,
+ space,
+ string "it1",
+ space,
+ string "=",
+ space,
+ string "*it0;",
+ newline,
+ string "uw_write(ctx, \"",
+ string has_arg,
+ string "/\");",
+ newline,
+ urlify' 1 t,
+ string ";",
+ newline],
+ string "} else {",
+ box [newline,
+ string "uw_write(ctx, \"",
+ string no_arg,
+ string "\");",
+ newline],
+ string "}",
+ newline],
+ string "}",
+ newline,
+ newline]);
- string "urlify_",
+ box [string "urlify_",
string (Int.toString i),
- string "(it",
+ string "(ctx,",
+ space,
+ string "it",
string (Int.toString level),
string ");",
- newline,
- string "});",
newline]
end
| TDatatype (Default, i, _) =>
- if IS.member (rf, i) then
+ if IS.member (!urlifies, i) then
box [string "urlify_",
string (Int.toString i),
- string "(it",
+ string "(ctx,",
+ space,
+ string "it",
string (Int.toString level),
string ");",
newline]
@@ -1085,7 +1098,7 @@ fun urlify env t =
let
val (x, xncs) = E.lookupDatatype env i
- val rf = IS.add (rf, i)
+ val () = urlifies := IS.add (!urlifies, i)
fun doEm xncs =
case xncs of
@@ -1120,7 +1133,7 @@ fun urlify env t =
string x',
string ";",
newline,
- urlify' rf rfl 1 t,
+ urlify' 1 t,
newline],
string "} else {",
newline,
@@ -1129,30 +1142,32 @@ fun urlify env t =
string "}",
newline]
in
- box [string "({",
- space,
- string "void",
- space,
- string "urlify_",
- string (Int.toString i),
- string "(",
- p_typ env t,
- space,
- string "it0) {",
- newline,
- box [doEm xncs,
- newline],
- newline,
- string "}",
- newline,
+ addUrlHandler (box [string "static",
+ space,
+ string "void",
+ space,
+ string "urlify_",
+ string (Int.toString i),
+ string "(uw_context ctx,",
+ space,
+ p_typ env t,
+ space,
+ string "it0) {",
+ newline,
+ box [doEm xncs,
+ newline],
+ newline,
+ string "}",
+ newline,
+ newline]);
- string "urlify_",
+ box [string "urlify_",
string (Int.toString i),
- string "(it",
+ string "(ctx,",
+ space,
+ string "it",
string (Int.toString level),
string ");",
- newline,
- string "});",
newline]
end
@@ -1163,7 +1178,7 @@ fun urlify env t =
if isUnboxable t then
box [string "uw_write(ctx, \"Some/\");",
newline,
- urlify' rf rfl level t]
+ urlify' level t]
else
box [p_typ env t,
space,
@@ -1178,7 +1193,7 @@ fun urlify env t =
newline,
string "uw_write(ctx, \"Some/\");",
newline,
- urlify' rf rfl (level + 1) t,
+ urlify' (level + 1) t,
string ";",
newline],
string "} else {",
@@ -1189,73 +1204,74 @@ fun urlify env t =
newline]
| TList (t, i) =>
- if IS.member (rfl, i) then
+ if IS.member (!urlifiesL, i) then
box [string "urlifyl_",
string (Int.toString i),
- string "(it",
+ string "(ctx,",
+ space,
+ string "it",
string (Int.toString level),
string ");",
newline]
else
- let
- val rfl = IS.add (rfl, i)
- in
- box [string "({",
- space,
- string "void",
- space,
- string "urlifyl_",
- string (Int.toString i),
- string "(struct __uws_",
- string (Int.toString i),
- space,
- string "*it0) {",
- newline,
- box [string "if (it0) {",
- newline,
- p_typ env t,
- space,
- string "it1",
- space,
- string "=",
- space,
- string "it0->__uwf_1;",
- newline,
- string "uw_write(ctx, \"Cons/\");",
- newline,
- urlify' rf rfl 1 t,
- string ";",
- newline,
- string "uw_write(ctx, \"/\");",
- newline,
- string "urlifyl_",
- string (Int.toString i),
- string "(it0->__uwf_2);",
- newline,
- string "} else {",
- newline,
- box [string "uw_write(ctx, \"Nil\");",
- newline],
- string "}",
- newline],
- string "}",
- newline,
- newline,
-
- string "urlifyl_",
- string (Int.toString i),
- string "(it",
- string (Int.toString level),
- string ");",
- newline,
- string "});",
- newline]
- end
+ (urlifiesL := IS.add (!urlifiesL, i);
+ addUrlHandler (box [string "static",
+ space,
+ string "void",
+ space,
+ string "urlifyl_",
+ string (Int.toString i),
+ string "(uw_context ctx,",
+ space,
+ string "struct __uws_",
+ string (Int.toString i),
+ space,
+ string "*it0) {",
+ newline,
+ box [string "if (it0) {",
+ newline,
+ p_typ env t,
+ space,
+ string "it1",
+ space,
+ string "=",
+ space,
+ string "it0->__uwf_1;",
+ newline,
+ string "uw_write(ctx, \"Cons/\");",
+ newline,
+ urlify' 1 t,
+ string ";",
+ newline,
+ string "uw_write(ctx, \"/\");",
+ newline,
+ string "urlifyl_",
+ string (Int.toString i),
+ string "(ctx, it0->__uwf_2);",
+ newline,
+ string "} else {",
+ newline,
+ box [string "uw_write(ctx, \"Nil\");",
+ newline],
+ string "}",
+ newline],
+ string "}",
+ newline,
+ newline]);
+ box [string "urlifyl_",
+ string (Int.toString i),
+ string "(ctx,",
+ space,
+ string "it",
+ string (Int.toString level),
+ string ");",
+ newline])
+
| _ => (ErrorMsg.errorAt loc "Unable to choose a URL encoding function";
space)
in
- urlify' IS.empty IS.empty 0 t
+ urlify' 0 t
end
fun sql_type_in env (tAll as (t, loc)) =
@@ -1338,6 +1354,7 @@ fun p_exp' par env (e, loc) =
string "*tmp",
space,
string "=",
+ space,
p_exp' par env e,
string ";",
newline,
@@ -1404,6 +1421,7 @@ fun p_exp' par env (e, loc) =
string "*tmp",
space,
string "=",
+ space,
p_exp' par env e,
string ";",
newline,
@@ -1563,18 +1581,21 @@ fun p_exp' par env (e, loc) =
foldr (fn ((p, e), body) =>
let
val pm = p_patMatch (env, "disc") p
- val (pb, env) = p_patBind (env, "disc") p
+ val (pb, env') = p_patBind (env, "disc") p
in
box [pm,
space,
string "?",
space,
- box [string "({",
- pb,
- p_exp env e,
- string ";",
- newline,
- string "})"],
+ if E.countERels env' = E.countERels env then
+ p_exp env e
+ else
+ box [string "({",
+ pb,
+ p_exp env' e,
+ string ";",
+ newline,
+ string "})"],
newline,
space,
string ":",
@@ -2225,9 +2246,18 @@ fun sigName fields =
fun p_file env (ds, ps) =
let
+ val () = (clearUrlHandlers ();
+ unurlifies := IS.empty;
+ urlifies := IS.empty;
+ urlifiesL := IS.empty)
+
val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
- (p_decl env d,
- E.declBinds env d))
+ let
+ val d' = p_decl env d
+ in
+ (box (List.revAppend (latestUrlHandlers (), [d'])),
+ E.declBinds env d)
+ end)
env ds
fun flatFields always (t : typ) =
@@ -2740,8 +2770,13 @@ fun p_file env (ds, ps) =
]
end
- val pds' = map p_page ps
-
+ val (pds', handlers) = ListUtil.foldlMap (fn (p, handlers) =>
+ let
+ val p' = p_page p
+ in
+ (p', latestUrlHandlers () @ handlers)
+ end) [] ps
+
val hasDb = ref false
val tables = ref []
val views = ref []
@@ -3013,6 +3048,8 @@ fun p_file env (ds, ps) =
newline,
newline,
+ box (rev handlers),
+
string "static void uw_handle(uw_context ctx, char *request) {",
newline,
string "if (!strcmp(request, \"",
diff --git a/src/compiler.sml b/src/compiler.sml
index 9281ab92..f12bcbfe 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1320,7 +1320,7 @@ fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
else
"-L" ^ Config.lib ^ "/.. -lurweb " ^ #linkDynamic proto
- val compile = Config.ccompiler ^ " " ^ Config.gccArgs ^ " -Wimplicit -Werror -O3 -I " ^ Config.includ
+ val compile = Config.ccompiler ^ " " ^ Config.gccArgs ^ " -Wimplicit -Werror -Wno-unused-value -O3 -I " ^ Config.includ
^ " " ^ #compile proto
^ " -c " ^ escapeFilename cname ^ " -o " ^ escapeFilename oname