# HG changeset patch # User Adam Chlipala # Date 1229882199 18000 # Node ID ac947e2f29ff6a6f10494f8532b16a0ea518cc8a # Parent 57018f21cd5c04f8155dfd513fbb329fa220bade Trivial use of a source diff -r 57018f21cd5c -r ac947e2f29ff jslib/urweb.js --- a/jslib/urweb.js Sun Dec 21 12:30:57 2008 -0500 +++ b/jslib/urweb.js Sun Dec 21 12:56:39 2008 -0500 @@ -1,3 +1,6 @@ +function sc(v) { return {v : v} } + +function ss(s) { return {v : s.v} } function sr(v) { return {v : v} } function sb(x,y) { return {v : y(x.v).v} } diff -r 57018f21cd5c -r ac947e2f29ff src/c/urweb.c --- a/src/c/urweb.c Sun Dec 21 12:30:57 2008 -0500 +++ b/src/c/urweb.c Sun Dec 21 12:56:39 2008 -0500 @@ -387,12 +387,84 @@ } } -int uw_Basis_new_client_source(uw_context ctx, uw_unit u) { +uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) { + char *r, *s2; + + uw_check_heap(ctx, strlen(s) * 4 + 2); + + r = s2 = ctx->heap_front; + *s2++ = '"'; + + for (; *s; s++) { + char c = *s; + + switch (c) { + case '"': + strcpy(s2, "\\\""); + s2 += 2; + break; + case '\\': + strcpy(s2, "\\\\"); + s2 += 2; + break; + default: + if (isprint(c)) + *s2++ = c; + else { + sprintf(s2, "\\%3o", c); + s2 += 4; + } + } + } + + strcpy(s2, "\""); + ctx->heap_front = s2 + 1; + return r; +} + +uw_Basis_string uw_Basis_jsifyString_ws(uw_context ctx, uw_Basis_string s) { + char *r, *s2; + + uw_check_script(ctx, strlen(s) * 4 + 2); + + r = s2 = ctx->script_front; + *s2++ = '"'; + + for (; *s; s++) { + char c = *s; + + switch (c) { + case '"': + strcpy(s2, "\\\""); + s2 += 2; + break; + case '\\': + strcpy(s2, "\\\\"); + s2 += 2; + break; + default: + if (isprint(c)) + *s2++ = c; + else { + sprintf(s2, "\\%3o", c); + s2 += 4; + } + } + } + + strcpy(s2, "\""); + ctx->script_front = s2 + 1; + return r; +} + +int uw_Basis_new_client_source(uw_context ctx, uw_Basis_string s) { size_t len; uw_check_script(ctx, 8 + INTS_MAX); - sprintf(ctx->script_front, "var e%d=0\n%n", ctx->source_count, &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, ");"); return ctx->source_count++; } @@ -1056,41 +1128,6 @@ return (char *)&true; } -uw_Basis_string uw_Basis_jsifyString(uw_context ctx, uw_Basis_string s) { - char *r, *s2; - - uw_check_heap(ctx, strlen(s) * 4 + 2); - - r = s2 = ctx->heap_front; - *s2++ = '"'; - - for (; *s; s++) { - char c = *s; - - switch (c) { - case '"': - strcpy(s2, "\\\""); - s2 += 2; - break; - case '\\': - strcpy(s2, "\\\\"); - s2 += 2; - break; - default: - if (isprint(c)) - *s2++ = c; - else { - sprintf(s2, "\\%3o", c); - s2 += 4; - } - } - } - - strcpy(s2, "\""); - ctx->heap_front = s2 + 1; - return r; -} - uw_Basis_string uw_Basis_intToString(uw_context ctx, uw_Basis_int n) { int len; char *r; diff -r 57018f21cd5c -r ac947e2f29ff src/cjrize.sml --- a/src/cjrize.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/cjrize.sml Sun Dec 21 12:56:39 2008 -0500 @@ -424,6 +424,7 @@ | L.EJavaScript _ => raise Fail "Cjrize: EJavaScript remains" | L.ESignalReturn _ => raise Fail "Cjrize: ESignalReturn remains" | L.ESignalBind _ => raise Fail "Cjrize: ESignalBind remains" + | L.ESignalSource _ => raise Fail "Cjrize: ESignalSource remains" fun cifyDecl ((d, loc), sm) = case d of diff -r 57018f21cd5c -r ac947e2f29ff src/jscomp.sml --- a/src/jscomp.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/jscomp.sml Sun Dec 21 12:56:39 2008 -0500 @@ -34,7 +34,8 @@ structure U = MonoUtil val funcs = [(("Basis", "alert"), "alert"), - (("Basis", "htmlifyString"), "escape")] + (("Basis", "htmlifyString"), "escape"), + (("Basis", "new_client_source"), "sc")] structure FM = BinaryMapFn(struct type ord_key = string * string @@ -85,6 +86,7 @@ | EJavaScript _ => 0 | ESignalReturn e => varDepth e | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2) + | ESignalSource e => varDepth e fun strcat loc es = case es of @@ -168,7 +170,7 @@ | EFfi k => let val name = case ffi k of - NONE => (EM.errorAt loc "Unsupported FFI identifier in JavaScript"; + NONE => (EM.errorAt loc ("Unsupported FFI identifier " ^ #2 k ^ " in JavaScript"); "ERROR") | SOME s => s in @@ -177,7 +179,7 @@ | EFfiApp (m, x, args) => let val name = case ffi (m, x) of - NONE => (EM.errorAt loc "Unsupported FFI function in JavaScript"; + NONE => (EM.errorAt loc ("Unsupported FFI function " ^ x ^ " in JavaScript"); "ERROR") | SOME s => s in @@ -366,6 +368,15 @@ str ")"], st) end + | ESignalSource e => + let + val (e, st) = jsE inner (e, st) + in + (strcat [str "ss(", + e, + str ")"], + st) + end end in jsE diff -r 57018f21cd5c -r ac947e2f29ff src/mono.sml --- a/src/mono.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/mono.sml Sun Dec 21 12:56:39 2008 -0500 @@ -106,6 +106,7 @@ | ESignalReturn of exp | ESignalBind of exp * exp + | ESignalSource of exp withtype exp = exp' located diff -r 57018f21cd5c -r ac947e2f29ff src/mono_print.sml --- a/src/mono_print.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/mono_print.sml Sun Dec 21 12:56:39 2008 -0500 @@ -285,12 +285,15 @@ | ESignalReturn e => box [string "Return(", p_exp env e, string ")"] - | ESignalBind (e1, e2) => box [string "Return(", + | ESignalBind (e1, e2) => box [string "Bind(", p_exp env e1, string ",", space, p_exp env e2, string ")"] + | ESignalSource e => box [string "Source(", + p_exp env e, + string ")"] and p_exp env = p_exp' false env diff -r 57018f21cd5c -r ac947e2f29ff src/mono_reduce.sml --- a/src/mono_reduce.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/mono_reduce.sml Sun Dec 21 12:56:39 2008 -0500 @@ -78,6 +78,7 @@ | EJavaScript (_, e) => impure e | ESignalReturn e => impure e | ESignalBind (e1, e2) => impure e1 orelse impure e2 + | ESignalSource e => impure e val liftExpInExp = Monoize.liftExpInExp @@ -335,7 +336,7 @@ | EJavaScript (_, e) => summarize d e | ESignalReturn e => summarize d e | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2 - + | ESignalSource e => summarize d e fun exp env e = let diff -r 57018f21cd5c -r ac947e2f29ff src/mono_util.sml --- a/src/mono_util.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/mono_util.sml Sun Dec 21 12:56:39 2008 -0500 @@ -334,6 +334,10 @@ S.map2 (mfe ctx e2, fn e2' => (ESignalBind (e1', e2'), loc))) + | ESignalSource e => + S.map2 (mfe ctx e, + fn e' => + (ESignalSource e', loc)) in mfe end diff -r 57018f21cd5c -r ac947e2f29ff src/monoize.sml --- a/src/monoize.sml Sun Dec 21 12:30:57 2008 -0500 +++ b/src/monoize.sml Sun Dec 21 12:56:39 2008 -0500 @@ -975,7 +975,7 @@ 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'.ERecord [], loc)]), loc)), loc)), + (L'.EFfiApp ("Basis", "new_client_source", [(L'.ERel 1, loc)]), loc)), loc)), loc), fm) end @@ -1003,6 +1003,14 @@ (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), fm) end + | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) => + let + val t = monoType env t + in + ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), (L'.TSignal t, loc), + (L'.ESignalSource (L'.ERel 0, loc), loc)), loc), + fm) + end | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) => let diff -r 57018f21cd5c -r ac947e2f29ff tests/reactive.ur --- a/tests/reactive.ur Sun Dec 21 12:30:57 2008 -0500 +++ b/tests/reactive.ur Sun Dec 21 12:56:39 2008 -0500 @@ -1,4 +1,5 @@ fun main () : transaction page = - x <- source (); - y <- source (); - return Hi! + x <- source TEST; + return + +