Mercurial > urweb

changeset 577:3d56940120b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Setting a source server-side
author Adam Chlipala <adamc@hcoop.net>
date Tue, 30 Dec 2008 10:49:42 -0500
parents 813f1e78d9d0
children 1e589a60b86f
files include/urweb.h src/c/urweb.c src/cjrize.sml src/jscomp.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml tests/reactive2.ur tests/reactive2.urp
diffstat 11 files changed, 68 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- 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);
--- 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;
--- 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
--- 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) =>
--- 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
--- 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 ")"]
--- 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 _ =>
--- 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' =>
--- 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
--- /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 <xml>TEST</xml>;
+  set x <xml>HI</xml>;
+  return <xml><body>
+    <dyn signal={signal x}/>
+  </body></xml>
--- /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