summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--jslib/urweb.js3
-rw-r--r--src/c/urweb.c111
-rw-r--r--src/cjrize.sml1
-rw-r--r--src/jscomp.sml17
-rw-r--r--src/mono.sml1
-rw-r--r--src/mono_print.sml5
-rw-r--r--src/mono_reduce.sml3
-rw-r--r--src/mono_util.sml4
-rw-r--r--src/monoize.sml10
-rw-r--r--tests/reactive.ur7
10 files changed, 116 insertions, 46 deletions
diff --git a/jslib/urweb.js b/jslib/urweb.js
index f552b26b..eab67626 100644
--- a/jslib/urweb.js
+++ b/jslib/urweb.js
@@ -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 --git a/src/c/urweb.c b/src/c/urweb.c
index 64cdb81e..11b99f4c 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -387,12 +387,84 @@ char *uw_Basis_get_script(uw_context ctx, uw_unit u) {
}
}
-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 @@ char *uw_Basis_ensqlBool(uw_Basis_bool b) {
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 --git a/src/cjrize.sml b/src/cjrize.sml
index a46c725e..a9c51826 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -424,6 +424,7 @@ fun cifyExp (eAll as (e, loc), sm) =
| 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 --git a/src/jscomp.sml b/src/jscomp.sml
index c38056e8..f7ef6927 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -34,7 +34,8 @@ structure E = MonoEnv
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 @@ fun varDepth (e, _) =
| 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 @@ fun jsExp mode outer =
| 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 @@ fun jsExp mode outer =
| 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 @@ fun jsExp mode outer =
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 --git a/src/mono.sml b/src/mono.sml
index 54b77550..ae9a06c7 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -106,6 +106,7 @@ datatype exp' =
| ESignalReturn of exp
| ESignalBind of exp * exp
+ | ESignalSource of exp
withtype exp = exp' located
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 608fe269..b3c0a568 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -285,12 +285,15 @@ fun p_exp' par env (e, _) =
| 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 --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 841e034e..a6777db5 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -78,6 +78,7 @@ fun impure (e, _) =
| 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 @@ fun reduce file =
| 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 --git a/src/mono_util.sml b/src/mono_util.sml
index a85443d7..b14e3ac9 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -334,6 +334,10 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
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 --git a/src/monoize.sml b/src/monoize.sml
index 30bd5daa..d3d20e7c 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -975,7 +975,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 --git a/tests/reactive.ur b/tests/reactive.ur
index cb49541f..95839c7d 100644
--- a/tests/reactive.ur
+++ b/tests/reactive.ur
@@ -1,4 +1,5 @@
fun main () : transaction page =
- x <- source ();
- y <- source ();
- return <xml><body>Hi!</body></xml>
+ x <- source <xml>TEST</xml>;
+ return <xml><body>
+ <dyn signal={signal x}/>
+ </body></xml>
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 01:45:58 +0000