# HG changeset patch # User Adam Chlipala # Date 1230652182 18000 # Node ID 3d56940120b18d9d480d4bc0f6a10d97eef3145f # Parent 813f1e78d9d087e16b213aaae5e14a7a751d6b43 Setting a source server-side diff -r 813f1e78d9d0 -r 3d56940120b1 include/urweb.h --- a/include/urweb.h Tue Dec 30 09:43:45 2008 -0500 +++ b/include/urweb.h Tue Dec 30 10:49:42 2008 -0500 @@ -36,7 +36,9 @@ void uw_write(uw_context, const char*); -int uw_Basis_new_client_source(uw_context, uw_unit); +uw_Basis_int uw_Basis_new_client_source(uw_context, uw_Basis_string); +uw_unit uw_Basis_set_client_source(uw_context, uw_Basis_int, uw_Basis_string); + char *uw_Basis_get_script(uw_context, uw_unit); char *uw_Basis_htmlifyInt(uw_context, uw_Basis_int); diff -r 813f1e78d9d0 -r 3d56940120b1 src/c/urweb.c --- a/src/c/urweb.c Tue Dec 30 09:43:45 2008 -0500 +++ b/src/c/urweb.c Tue Dec 30 10:49:42 2008 -0500 @@ -363,6 +363,7 @@ ctx->script_front = new_script + (ctx->script_front - ctx->script); ctx->script_back = new_script + next; ctx->script = new_script; + printf("new_script = %p\n", new_script); } } @@ -434,7 +435,7 @@ char c = *s; switch (c) { - case '"': + case '\'': strcpy(s2, "\\\""); s2 += 2; break; @@ -457,18 +458,36 @@ return r; } -int uw_Basis_new_client_source(uw_context ctx, uw_Basis_string s) { - size_t len; +uw_Basis_int uw_Basis_new_client_source(uw_context ctx, uw_Basis_string s) { + int len; + size_t s_len = strlen(s); - uw_check_script(ctx, 8 + INTS_MAX); + uw_check_script(ctx, 12 + INTS_MAX + s_len); sprintf(ctx->script_front, "var s%d=sc(%n", ctx->source_count, &len); ctx->script_front += len; - uw_Basis_jsifyString_ws(ctx, s); - uw_write_script(ctx, ");"); + strcpy(ctx->script_front, s); + ctx->script_front += s_len; + strcpy(ctx->script_front, ");"); + ctx->script_front += 2; return ctx->source_count++; } +uw_unit uw_Basis_set_client_source(uw_context ctx, uw_Basis_int n, uw_Basis_string s) { + int len; + size_t s_len = strlen(s); + + uw_check_script(ctx, 6 + INTS_MAX + s_len); + sprintf(ctx->script_front, "s%d.v=%n", (int)n, &len); + ctx->script_front += len; + strcpy(ctx->script_front, s); + ctx->script_front += s_len; + strcpy(ctx->script_front, ";"); + ctx->script_front++; + + return uw_unit_v; +} + static void uw_check(uw_context ctx, size_t extra) { size_t desired = ctx->page_front - ctx->page + extra, next; char *new_page; diff -r 813f1e78d9d0 -r 3d56940120b1 src/cjrize.sml --- a/src/cjrize.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/cjrize.sml Tue Dec 30 10:49:42 2008 -0500 @@ -120,6 +120,7 @@ in ((L'.TOption t, loc), sm) end + | L.TSource => ((L'.TFfi ("Basis", "int"), loc), sm) | L.TSignal _ => raise Fail "Cjrize: TSignal remains" in cify IM.empty x diff -r 813f1e78d9d0 -r 3d56940120b1 src/jscomp.sml --- a/src/jscomp.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/jscomp.sml Tue Dec 30 10:49:42 2008 -0500 @@ -121,6 +121,13 @@ (str "ERROR", st)) val strcat = strcat loc + + fun quoteExp (t : typ) e = + case #1 t of + TSource => strcat [str "s", + (EFfiApp ("Basis", "htmlifyInt", [e]), loc)] + | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; + str "ERROR") in case #1 e of EPrim (Prim.String s) => @@ -130,6 +137,7 @@ "\\047" else "'" + | #"\"" => "\\\"" | #"<" => if mode = Script then "<" @@ -143,7 +151,11 @@ if n < inner then (str ("uwr" ^ var n), st) else - (str ("uwo" ^ var n), st) + let + val n = n - inner + in + (quoteExp (List.nth (outer, n)) (ERel n, loc), st) + end | ENamed _ => raise Fail "Named" | ECon (_, pc, NONE) => (patCon pc, st) | ECon (_, pc, SOME e) => diff -r 813f1e78d9d0 -r 3d56940120b1 src/mono.sml --- a/src/mono.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/mono.sml Tue Dec 30 10:49:42 2008 -0500 @@ -37,6 +37,7 @@ | TDatatype of int * (datatype_kind * (string * int * typ option) list) ref | TFfi of string * string | TOption of typ + | TSource | TSignal of typ withtype typ = typ' located diff -r 813f1e78d9d0 -r 3d56940120b1 src/mono_print.sml --- a/src/mono_print.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/mono_print.sml Tue Dec 30 10:49:42 2008 -0500 @@ -65,6 +65,7 @@ | TOption t => box [string "option(", p_typ env t, string ")"] + | TSource => string "source" | TSignal t => box [string "signal(", p_typ env t, string ")"] diff -r 813f1e78d9d0 -r 3d56940120b1 src/mono_reduce.sml --- a/src/mono_reduce.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/mono_reduce.sml Tue Dec 30 10:49:42 2008 -0500 @@ -55,6 +55,7 @@ | EFfi _ => false | EFfiApp ("Basis", "set_cookie", _) => true | EFfiApp ("Basis", "new_client_source", _) => true + | EFfiApp ("Basis", "set_client_source", _) => true | EFfiApp _ => false | EApp ((EFfi _, _), _) => false | EApp _ => true @@ -263,6 +264,7 @@ | EFfi _ => [] | EFfiApp ("Basis", "set_cookie", _) => [Unsure] | EFfiApp ("Basis", "new_client_source", _) => [Unsure] + | EFfiApp ("Basis", "set_client_source", _) => [Unsure] | EFfiApp (_, _, es) => List.concat (map (summarize d) es) | EApp ((EFfi _, _), e) => summarize d e | EApp _ => diff -r 813f1e78d9d0 -r 3d56940120b1 src/mono_util.sml --- a/src/mono_util.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/mono_util.sml Tue Dec 30 10:49:42 2008 -0500 @@ -51,6 +51,7 @@ | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2) | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) | (TOption t1, TOption t2) => compare (t1, t2) + | (TSource, TSource) => EQUAL | (TSignal t1, TSignal t2) => compare (t1, t2) | (TFun _, _) => LESS @@ -68,6 +69,9 @@ | (TOption _, _) => LESS | (_, TOption _) => GREATER + | (TSource, _) => LESS + | (_, TSource) => GREATER + and compareFields ((x1, t1), (x2, t2)) = join (String.compare (x1, x2), fn () => compare (t1, t2)) @@ -100,6 +104,7 @@ S.map2 (mft t, fn t' => (TOption t, loc)) + | TSource => S.return2 cAll | TSignal t => S.map2 (mft t, fn t' => diff -r 813f1e78d9d0 -r 3d56940120b1 src/monoize.sml --- a/src/monoize.sml Tue Dec 30 09:43:45 2008 -0500 +++ b/src/monoize.sml Tue Dec 30 10:49:42 2008 -0500 @@ -134,7 +134,7 @@ | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) | L.CApp ((L.CFfi ("Basis", "source"), _), t) => - (L'.TFfi ("Basis", "int"), loc) + (L'.TSource, loc) | L.CApp ((L.CFfi ("Basis", "signal"), _), t) => (L'.TSignal (mt env dtmap t), loc) | L.CApp ((L.CFfi ("Basis", "http_cookie"), _), _) => @@ -973,9 +973,10 @@ let val t = monoType env t in - ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc)), loc), - (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc), - (L'.EFfiApp ("Basis", "new_client_source", [(L'.ERel 1, loc)]), loc)), loc)), + ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc), + (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc), + (L'.EFfiApp ("Basis", "new_client_source", + [(L'.EJavaScript (L'.File, (L'.ERel 1, loc)), loc)]), loc)), loc)), loc), fm) end @@ -983,12 +984,13 @@ let val t = monoType env t in - ((L'.EAbs ("src", (L'.TFfi ("Basis", "int"), loc), + ((L'.EAbs ("src", (L'.TSource, loc), (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc)), loc), (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), (L'.EFfiApp ("Basis", "set_client_source", - [(L'.ERel 2, loc), (L'.ERel 1, loc)]), + [(L'.ERel 2, loc), + (L'.EJavaScript (L'.File, (L'.ERel 1, loc)), loc)]), loc)), loc)), loc)), loc), fm) end diff -r 813f1e78d9d0 -r 3d56940120b1 tests/reactive2.ur --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/reactive2.ur Tue Dec 30 10:49:42 2008 -0500 @@ -0,0 +1,6 @@ +fun main () : transaction page = + x <- source TEST; + set x HI; + return + + diff -r 813f1e78d9d0 -r 3d56940120b1 tests/reactive2.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/reactive2.urp Tue Dec 30 10:49:42 2008 -0500 @@ -0,0 +1,3 @@ +debug + +reactive2