diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-09-09 08:00:45 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-09 08:00:45 -0400 |
commit | 2b5e957c78d47ae6d66ee2f70435b827d1644a4f (patch) | |
tree | fc23a2be12e6d03e8be7f8754278784feaf45839 | |
parent | 9c09f789905d7b93b5f77084d76428d73bf5631a (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.c | 6 | ||||
-rw-r--r-- | src/mono_reduce.sml | 12 |
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 |