summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-09 08:00:45 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-09 08:00:45 -0400
commit2b5e957c78d47ae6d66ee2f70435b827d1644a4f (patch)
treefc23a2be12e6d03e8be7f8754278784feaf45839
parent9c09f789905d7b93b5f77084d76428d73bf5631a (diff)
Don't replace <sc> in blob returns; optimize more 'option' pattern matches; detect more opportunities for 'let' inlining
-rw-r--r--src/c/urweb.c6
-rw-r--r--src/mono_reduce.sml12
2 files changed, 14 insertions, 4 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 8566609b..651cef17 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -346,6 +346,7 @@ struct uw_context {
void *get_header_data;
buf outHeaders, page, heap, script;
+ int returning_blob;
input *inputs, *subinputs, *cur_container;
size_t n_subinputs, used_subinputs;
@@ -386,6 +387,7 @@ uw_context uw_init() {
buf_init(&ctx->outHeaders, 0);
buf_init(&ctx->page, 0);
+ ctx->returning_blob = 0;
buf_init(&ctx->heap, 0);
buf_init(&ctx->script, 1);
ctx->script.start[0] = 0;
@@ -458,6 +460,7 @@ void uw_reset_keep_error_message(uw_context ctx) {
buf_reset(&ctx->script);
ctx->script.start[0] = 0;
buf_reset(&ctx->page);
+ ctx->returning_blob = 0;
buf_reset(&ctx->heap);
ctx->regions = NULL;
ctx->cleanup_front = ctx->cleanup;
@@ -2549,7 +2552,7 @@ void uw_commit(uw_context ctx) {
ctx->transactionals[i].free(ctx->transactionals[i].data);
// Splice script data into appropriate part of page
- if (ctx->script_header[0] == 0)
+ if (ctx->returning_blob || ctx->script_header[0] == 0)
;
else if (buf_used(&ctx->script) == 0) {
size_t len = strlen(ctx->script_header);
@@ -2776,6 +2779,7 @@ __attribute__((noreturn)) void uw_return_blob(uw_context ctx, uw_Basis_blob b, u
cleanup *cl;
int len;
+ ctx->returning_blob = 1;
buf_reset(&ctx->outHeaders);
buf_reset(&ctx->page);
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 58dd2a23..c552db17 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -237,7 +237,9 @@ fun match (env, p : pat, e : exp) =
end
| (PNone _, ENone _) => Yes env
+ | (PNone _, ESome _) => No
| (PSome (_, p), ESome (_, e)) => match (env, p, e)
+ | (PSome _, ENone _) => No
| _ => Maybe
@@ -543,7 +545,7 @@ fun reduce file =
val effs_b = summarize 0 b
(*val () = Print.prefaces "Try"
- [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),
+ [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
("e'", MonoPrint.p_exp env e'),
("e'_eff", p_events effs_e'),
("b", p_events effs_b)]*)
@@ -574,8 +576,12 @@ fun reduce file =
("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
("effs_e'", Print.p_list p_event effs_e'),
("effs_b", Print.p_list p_event effs_b)];*)
- if List.null effs_e' orelse (List.all (fn eff => eff <> Unsure) effs_e'
- andalso verifyCompatible effs_b) then
+ if List.null effs_e'
+ orelse (List.all (fn eff => eff <> Unsure) effs_e'
+ andalso verifyCompatible effs_b)
+ orelse (case effs_b of
+ UseRel :: effs => List.all verifyUnused effs
+ | _ => false) then
trySub ()
else
e