changeset 646:fb2a0e76dcef

ListEdit demo, minus prose
author Adam Chlipala <adamc@hcoop.net>
date Tue, 10 Mar 2009 12:44:40 -0400
parents 1b571a05874c
children ae374df5ccbd
files demo/listEdit.ur demo/listEdit.urp demo/listEdit.urs lib/js/urweb.js src/elaborate.sml src/jscomp.sml src/monoize.sml
diffstat 7 files changed, 100 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/listEdit.ur	Tue Mar 10 12:44:40 2009 -0400
@@ -0,0 +1,54 @@
+datatype rlist = Nil | Cons of {Data : source string,
+                                NewData : source string,
+                                Tail : source rlist}
+
+fun showString ss =
+    s <- signal ss;
+    return <xml>{[s]}</xml>
+
+fun show rls =
+    v <- signal rls;
+    show' v
+
+and show' rl =
+    case rl of
+        Nil => return <xml/>
+      | Cons {Data = ss, NewData = ss', Tail = rls} => return <xml>
+        <dyn signal={showString ss}/>
+        <button value="Change to:" onclick={s <- get ss'; set ss s}/>
+        <ctextbox source={ss'}/><br/>
+        <dyn signal={show rls}/>
+      </xml>
+
+fun main () =
+    head <- source Nil;
+    tailP <- source head;
+    data <- source "";
+
+    let
+        fun add () =
+            data <- get data;
+            data <- source data;
+            ndata <- source "";
+            tail <- get tailP;
+            tail' <- source Nil;
+
+            let
+                val cons = Cons {Data = data, NewData = ndata, Tail = tail'}
+            in
+                set tail cons;
+                set tailP tail';
+
+                head' <- get head;
+                case head' of
+                    Nil => set head cons
+                  | _ => return ()
+            end
+    in
+        return <xml><body>
+          <ctextbox source={data}/> <button value="Add" onclick={add ()}/><br/>
+          <br/>
+
+          <dyn signal={show head}/>
+        </body></xml>
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/listEdit.urp	Tue Mar 10 12:44:40 2009 -0400
@@ -0,0 +1,2 @@
+
+listEdit
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/listEdit.urs	Tue Mar 10 12:44:40 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page
--- a/lib/js/urweb.js	Tue Mar 10 11:18:01 2009 -0400
+++ b/lib/js/urweb.js	Tue Mar 10 12:44:40 2009 -0400
@@ -59,10 +59,12 @@
 function runScripts(node) {
   var savedScript = thisScript;
 
-  var scripts = node.getElementsByTagName("script");
+  var scripts = node.getElementsByTagName("script"), scriptsCopy = {};
   var len = scripts.length;
+  for (var i = 0; i < len; ++i)
+    scriptsCopy[i] = scripts[i];
   for (var i = 0; i < len; ++i) {
-    thisScript = scripts[i];
+    thisScript = scriptsCopy[i];
     eval(thisScript.textContent);
   }
 
--- a/src/elaborate.sml	Tue Mar 10 11:18:01 2009 -0400
+++ b/src/elaborate.sml	Tue Mar 10 12:44:40 2009 -0400
@@ -704,7 +704,16 @@
                                       (#fields s1, #fields s2)
          (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}),
                                           ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*)
+
          val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2)
+         fun eatMost unifs =
+             case unifs of
+                 (_, r) :: (rest as _ :: _) => (r := SOME (L'.CRecord (k, []), loc);
+                                                eatMost rest)
+               | _ => unifs
+         val unifs1 = eatMost unifs1
+         val unifs2 = eatMost unifs2
+
          val (others1, others2) = eatMatching (consEq env) (#others s1, #others s2)
          (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
                                           ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
@@ -761,7 +770,7 @@
                | _ => (fs1, fs2, others1, others2)
 
          (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
-                                            ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
+                                          ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
 
          val clear = case (fs1, others1, fs2, others2) of
                           ([], [], [], []) => true
--- a/src/jscomp.sml	Tue Mar 10 11:18:01 2009 -0400
+++ b/src/jscomp.sml	Tue Mar 10 12:44:40 2009 -0400
@@ -409,6 +409,12 @@
                       Print.prefaces "Can't unurlify" [("t", MonoPrint.p_typ MonoEnv.empty t)];
                       ("ERROR", st))
 
+        fun padWith (ch, s, len) =
+            if size s < len then
+                padWith (ch, String.str ch ^ s, len - 1)
+            else
+                s
+
         fun jsExp mode skip outer =
             let
                 val len = length outer
@@ -448,7 +454,16 @@
                                                             else
                                                                 "\\074"
                                                           | #"\\" => "\\\\"
-                                                          | ch => String.str ch) s
+                                                          | #"\n" => "\\n"
+                                                          | #"\r" => "\\r"
+                                                          | #"\t" => "\\t"
+                                                          | ch =>
+                                                            if Char.isPrint ch then
+                                                                String.str ch
+                                                            else
+                                                                "\\" ^ padWith (#"0",
+                                                                                Int.fmt StringCvt.OCT (ord ch),
+                                                                                3)) s
                                      ^ "\"")
                               | _ => str (Prim.toString p)
 
@@ -878,6 +893,15 @@
                           | EDml _ => unsupported "DML"
                           | ENextval _ => unsupported "Nextval"
                           | EUnurlify _ => unsupported "EUnurlify"
+                          | EJavaScript (_, e as (EAbs _, _), _) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                            in
+                                (strcat [str "\"cr(\"+ca(",
+                                         e,
+                                         str ")+\")\""],
+                                 st)
+                            end
                           | EJavaScript (_, e, _) =>
                             let
                                 val (e, st) = jsE inner (e, st)
--- a/src/monoize.sml	Tue Mar 10 11:18:01 2009 -0400
+++ b/src/monoize.sml	Tue Mar 10 12:44:40 2009 -0400
@@ -1954,9 +1954,9 @@
                                                  loc)), loc), fm)
                               end
                             | SOME (_, src, _) =>
-                              (strcat [str "<script type=\"text/javascript\">inp(\"input\",",
+                              (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",",
                                        (L'.EJavaScript (L'.Script, src, NONE), loc),
-                                       str ")</script>"],
+                                       str ")</script></span>"],
                                fm))
                        | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                                raise Fail "No name passed to textbox tag"))
@@ -2030,9 +2030,9 @@
                                               str ")"]
                              val sc = setAttrs sc
                          in
-                             (strcat [str "<script type=\"text/javascript\">",
+                             (strcat [str "<span><script type=\"text/javascript\">",
                                       sc,
-                                      str "</script>"],
+                                      str "</script></span>"],
                               fm)
                          end)