diff options
author | 2009-09-08 10:18:19 -0400 | |
---|---|---|
committer | 2009-09-08 10:18:19 -0400 | |
commit | d07c91bf275874a5f6f13af5f338def78eea7ae0 (patch) | |
tree | 700a022259cb238d022c76cb0b6c30fb44985aed /src | |
parent | 815c52605cdba3c95d7e4e6fd3f1eddf0939bc6a (diff) |
dragList almost kinda works
Diffstat (limited to 'src')
-rw-r--r-- | src/c/urweb.c | 40 | ||||
-rw-r--r-- | src/compiler.sig | 4 | ||||
-rw-r--r-- | src/compiler.sml | 6 | ||||
-rw-r--r-- | src/mono_reduce.sml | 86 | ||||
-rw-r--r-- | src/monoize.sml | 10 |
5 files changed, 102 insertions, 44 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c index 068282f2..4160fa81 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1153,17 +1153,7 @@ void uw_write_script(uw_context ctx, uw_Basis_string s) { } const char *uw_Basis_get_script(uw_context ctx, uw_unit u) { - if (ctx->script_header[0] == 0) - return ""; - else if (buf_used(&ctx->script) == 0) - return ctx->script_header; - else { - char *r = uw_malloc(ctx, strlen(ctx->script_header) + 42 + buf_used(&ctx->script)); - sprintf(r, "%s<script type=\"text/javascript\">%s</script>", - ctx->script_header, - ctx->script.start); - return r; - } + return "<sc>"; } uw_Basis_string uw_Basis_maybe_onload(uw_context ctx, uw_Basis_string s) { @@ -2557,6 +2547,34 @@ void uw_commit(uw_context ctx) { for (i = 0; i < ctx->used_transactionals; ++i) ctx->transactionals[i].free(ctx->transactionals[i].data); + + // Splice script data into appropriate part of page + if (ctx->script_header[0] == 0) + ; + else if (buf_used(&ctx->script) == 0) { + size_t len = strlen(ctx->script_header); + char *start = strstr(ctx->page.start, "<sc>"); + if (start) { + buf_check(&ctx->page, buf_used(&ctx->page) - 4 + len); + memmove(start + len, start + 4, buf_used(&ctx->page) - (start - ctx->page.start) - 3); + ctx->page.front += len - 4; + memcpy(start, ctx->script_header, len); + } + } else { + size_t lenH = strlen(ctx->script_header), len = buf_used(&ctx->script); + size_t lenP = lenH + 40 + len; + char *start = strstr(ctx->page.start, "<sc>"); + if (start) { + buf_check(&ctx->page, buf_used(&ctx->page) - 4 + lenP); + memmove(start + lenP, start + 4, buf_used(&ctx->page) - (start - ctx->page.start) - 3); + ctx->page.front += lenP - 4; + memcpy(start, ctx->script_header, lenH); + memcpy(start + lenH, "<script type=\"text/javascript\">", 31); + memcpy(start + lenH + 31, ctx->script.start, len); + memcpy(start + lenH + 31 + len, "</script>", 9); + printf("start=%s\n", start); + } + } } int uw_rollback(uw_context ctx) { diff --git a/src/compiler.sig b/src/compiler.sig index 73605d7c..7ce19580 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -136,6 +136,10 @@ signature COMPILER = sig val toUntangle2 : (string, Mono.file) transform val toMono_reduce2 : (string, Mono.file) transform val toMono_shake2 : (string, Mono.file) transform + val toMono_opt4 : (string, Mono.file) transform + val toFuse2 : (string, Mono.file) transform + val toUntangle3 : (string, Mono.file) transform + val toMono_shake3 : (string, Mono.file) transform val toPathcheck : (string, Mono.file) transform val toCjrize : (string, Cjr.file) transform val toScriptcheck : (string, Cjr.file) transform diff --git a/src/compiler.sml b/src/compiler.sml index b7550fed..05bd53d3 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -854,13 +854,17 @@ val toUntangle2 = transform untangle "untangle2" o toFuse val toMono_reduce2 = transform mono_reduce "mono_reduce2" o toUntangle2 val toMono_shake2 = transform mono_shake "mono_shake2" o toMono_reduce2 +val toMono_opt4 = transform mono_opt "mono_opt4" o toMono_shake2 +val toFuse2 = transform fuse "shake2" o toMono_opt4 +val toUntangle3 = transform untangle "untangle3" o toFuse2 +val toMono_shake3 = transform mono_shake "mono_shake3" o toUntangle3 val pathcheck = { func = (fn file => (PathCheck.check file; file)), print = MonoPrint.p_file MonoEnv.empty } -val toPathcheck = transform pathcheck "pathcheck" o toMono_shake2 +val toPathcheck = transform pathcheck "pathcheck" o toMono_shake3 val cjrize = { func = Cjrize.cjrize, diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 4bbb430d..0820d200 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -35,7 +35,22 @@ structure E = MonoEnv structure U = MonoUtil structure IM = IntBinaryMap - +structure IS = IntBinarySet + + +fun simpleImpure syms = + U.Exp.exists {typ = fn _ => false, + exp = fn EWrite _ => true + | EQuery _ => true + | EDml _ => true + | ENextval _ => true + | EUnurlify _ => true + | EFfiApp (m, x, _) => Settings.isEffectful (m, x) + | EServerCall _ => true + | ERecv _ => true + | ESleep _ => true + | ENamed n => IS.member (syms, n) + | _ => false} fun impure (e, _) = case e of @@ -82,7 +97,6 @@ fun impure (e, _) = | ERecv _ => true | ESleep _ => true - val liftExpInExp = Monoize.liftExpInExp fun multiLift n e = @@ -244,22 +258,33 @@ fun patBinds (p, _) = fun reduce file = let - fun countAbs (e, _) = - case e of - EAbs (_, _, _, e) => 1 + countAbs e - | _ => 0 - - val absCounts = - foldl (fn ((d, _), absCounts) => - case d of - DVal (_, n, _, e, _) => - IM.insert (absCounts, n, countAbs e) - | DValRec vis => - foldl (fn ((_, n, _, e, _), absCounts) => - IM.insert (absCounts, n, countAbs e)) - absCounts vis - | _ => absCounts) - IM.empty file + val (impures, absCounts) = + foldl (fn ((d, _), (impures, absCounts)) => + let + fun countAbs (e, _) = + case e of + EAbs (_, _, _, e) => 1 + countAbs e + | _ => 0 + in + case d of + DVal (_, n, _, e, _) => + (if simpleImpure impures e then + IS.add (impures, n) + else + impures, + IM.insert (absCounts, n, countAbs e)) + | DValRec vis => + (if List.exists (fn (_, _, _, e, _) => simpleImpure impures e) vis then + foldl (fn ((_, n, _, _, _), impures) => + IS.add (impures, n)) impures vis + else + impures, + foldl (fn ((x, n, _, e, _), absCounts) => + IM.insert (absCounts, n, countAbs e)) + absCounts vis) + | _ => (impures, absCounts) + end) + (IS.empty, IM.empty) file fun summarize d (e, _) = let @@ -365,6 +390,10 @@ fun reduce file = s end + val impure = fn e => + simpleImpure impures e andalso impure e + andalso not (List.null (summarize ~1 e)) + fun exp env e = let (*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*) @@ -464,7 +493,7 @@ fun reduce file = if impure e' then e else - EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) + EAbs (x', t', ran, reduceExp env (ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc)) | ELet (x, t, e', b) => let @@ -479,13 +508,15 @@ fun reduce file = end fun trySub () = - case t of - (TFfi ("Basis", "string"), _) => doSub () - | (TSignal _, _) => e - | _ => - case e' of - (ECase _, _) => e - | _ => doSub () + ((*Print.prefaces "trySub" + [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*) + case t of + (TFfi ("Basis", "string"), _) => doSub () + | (TSignal _, _) => e + | _ => + case e' of + (ECase _, _) => e + | _ => doSub ()) in if impure e' then let @@ -495,7 +526,8 @@ fun reduce file = (*val () = Print.prefaces "Try" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), - ("e'", p_events effs_e'), + ("e'", MonoPrint.p_exp env e'), + ("e'_eff", p_events effs_e'), ("b", p_events effs_b)]*) fun does eff = List.exists (fn eff' => eff' = eff) effs_e' diff --git a/src/monoize.sml b/src/monoize.sml index 12112648..063802b3 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2576,13 +2576,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) = NONE => tagStart | SOME extra => (L'.EStrcat (tagStart, extra), loc) - val xml = case extraInner of - NONE => xml - | SOME ei => (L.EFfiApp ("Basis", "strcat", [ei, xml]), loc) - fun normal () = let val (xml, fm) = monoExp (env, st, fm) xml + + val xml = case extraInner of + NONE => xml + | SOME ei => (L'.EStrcat (ei, xml), loc) in ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), (L'.EStrcat (xml, @@ -2646,7 +2646,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = [(L'.ERecord [], loc)]), loc), onload), loc)]), loc), - SOME (L.EFfiApp ("Basis", "get_script", [(L.ERecord [], loc)]), loc)) + SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) end | "dyn" => |