Mercurial > urweb

changeset 569:162d5308e34f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Successfully generated a page element from a signal
author Adam Chlipala <adamc@hcoop.net>
date Sat, 20 Dec 2008 16:19:26 -0500
parents 55fc747a67dc
children af0df56ecc2c
files Makefile.in jslib/urweb.js src/c/driver.c src/cjr.sml src/cjr_env.sml src/cjr_print.sml src/cjrize.sml src/config.sig src/config.sml.in src/jscomp.sml src/mono.sml src/mono_env.sml src/mono_print.sml src/mono_shake.sml src/mono_util.sml src/monoize.sml src/prepare.sml
diffstat 17 files changed, 65 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/Makefile.in	Sat Dec 20 15:46:48 2008 -0500
+++ b/Makefile.in	Sat Dec 20 16:19:26 2008 -0500
@@ -5,6 +5,7 @@
 
 LIB_UR   := $(LIB)/ur
 LIB_C    := $(LIB)/c
+LIB_JS    := $(LIB)/js
 
 all: smlnj mlton c
 
@@ -70,6 +71,8 @@
 	cp lib/*.ur $(LIB_UR)/
 	mkdir -p $(LIB_C)
 	cp clib/*.o $(LIB_C)/
+	mkdir -p $(LIB_JS)
+	cp jslib/*.js $(LIB_JS)/
 	mkdir -p $(INCLUDE)
 	cp include/*.h $(INCLUDE)/
 	mkdir -p $(SITELISP)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/jslib/urweb.js	Sat Dec 20 16:19:26 2008 -0500
@@ -0,0 +1,1 @@
+function sreturn(v) { return {v : v} }
--- a/src/c/driver.c	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/c/driver.c	Sat Dec 20 16:19:26 2008 -0500
@@ -193,8 +193,6 @@
         uw_set_headers(ctx, headers);
 
         while (1) {
-          uw_write(ctx, "<html>");
-
           if (uw_db_begin(ctx)) {
             printf("Error running SQL BEGIN\n");
             if (retries_left)
@@ -211,13 +209,10 @@
           }
 
           uw_write_header(ctx, "HTTP/1.1 200 OK\r\n");
-          uw_write_header(ctx, "Content-type: text/html\r\n");
 
           strcpy(path_copy, path);
           fk = uw_begin(ctx, path_copy);
           if (fk == SUCCESS) {
-            uw_write(ctx, "</html>");
-
             if (uw_db_commit(ctx)) {
               fk = FATAL;
 
--- a/src/cjr.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/cjr.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -109,6 +109,8 @@
        | DDatabase of string
        | DPreparedStatements of (string * int) list
 
+       | DJavaScript of string
+
 withtype decl = decl' located
 
 type file = decl list * (Core.export_kind * string * int * typ list) list
--- a/src/cjr_env.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/cjr_env.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -166,6 +166,7 @@
       | DSequence _ => env
       | DDatabase _ => env
       | DPreparedStatements _ => env
+      | DJavaScript _ => env
 
 
 end
--- a/src/cjr_print.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/cjr_print.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -1800,6 +1800,10 @@
              
              string "}"]
 
+      | DJavaScript s => box [string "static char jslib[] = \"",
+                              string (String.toString s),
+                              string "\";"]
+
 datatype 'a search =
          Found of 'a
        | NotFound
@@ -2048,6 +2052,10 @@
                      newline,
                      string "if (*request == '/') ++request;",
                      newline,
+                     string "uw_write_header(ctx, \"Content-type: text/html\\r\\n\");",
+                     newline,
+                     string "uw_write(ctx, \"<html>\");",
+                     newline,
                      box [string "{",
                           newline,
                           box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
@@ -2070,6 +2078,8 @@
                           inputsVar,
                           string ", uw_unit_v);",
                           newline,
+                          string "uw_write(ctx, \"</html>\");",
+                          newline,
                           string "return;",
                           newline,
                           string "}",
@@ -2374,6 +2384,16 @@
              newline,
              string "void uw_handle(uw_context ctx, char *request) {",
              newline,
+             string "if (!strcmp(request, \"/app.js\")) {",
+             newline,
+             box [string "uw_write_header(ctx, \"Content-type: text/javascript\\r\\n\");",
+                  newline,
+                  string "uw_write(ctx, jslib);",
+                  newline,
+                  string "return;",
+                  newline],
+             string "}",
+             newline,
              p_list_sep newline (fn x => x) pds',
              newline,
              string "uw_error(ctx, FATAL, \"Unknown page\");",
--- a/src/cjrize.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/cjrize.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -528,6 +528,7 @@
       | L.DSequence s =>
         (SOME (L'.DSequence s, loc), NONE, sm)
       | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm)
+      | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm)
 
 fun cjrize ds =
     let
--- a/src/config.sig	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/config.sig	Sat Dec 20 16:19:26 2008 -0500
@@ -6,6 +6,7 @@
 
     val libUr : string
     val libC : string
+    val libJs : string
 
     val gccArgs : string
 end
--- a/src/config.sml.in	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/config.sml.in	Sat Dec 20 16:19:26 2008 -0500
@@ -9,6 +9,8 @@
                                  file = "ur"}
 val libC = OS.Path.joinDirFile {dir = lib,
                                 file = "c"}
+val libJs = OS.Path.joinDirFile {dir = lib,
+                                 file = "js"}
 
 val gccArgs = "@GCCARGS@"
 
--- a/src/jscomp.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/jscomp.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -285,7 +285,7 @@
                     in
                         (strcat [str "document.write(",
                                  e,
-                                 str ")"], st)
+                                 str ".v)"], st)
                     end
 
                   | ESeq (e1, e2) =>
@@ -317,9 +317,9 @@
                     let
                         val (e, st) = jsE inner (e, st)
                     in
-                        (strcat [(*str "sreturn(",*)
-                                 e(*,
-                                 str ")"*)],
+                        (strcat [str "sreturn(",
+                                 e,
+                                 str ")"],
                          st)
                     end
             end
@@ -369,8 +369,16 @@
                        {decls = [],
                         script = ""}
                        file
+
+        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
+        fun lines acc =
+            case TextIO.inputLine inf of
+                NONE => String.concat (rev acc)
+              | SOME line => lines (line :: acc)
+        val lines = lines []
     in
-        ds
+        TextIO.closeIn inf;
+        (DJavaScript lines, ErrorMsg.dummySpan) :: ds
     end
 
 end
--- a/src/mono.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/mono.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -118,6 +118,9 @@
        | DSequence of string
        | DDatabase of string
 
+       | DJavaScript of string
+
+
 withtype decl = decl' located
 
 type file = decl list
--- a/src/mono_env.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/mono_env.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -110,6 +110,7 @@
       | DTable _ => env
       | DSequence _ => env
       | DDatabase _ => env
+      | DJavaScript _ => env
 
 fun patBinds env (p, loc) =
     case p of
--- a/src/mono_print.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/mono_print.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -379,6 +379,10 @@
       | DDatabase s => box [string "database",
                             space,
                             string s]
+      | DJavaScript s => box [string "JavaScript(",
+                              string s,
+                              string ")"]
+
                           
 fun p_file env file =
     let
--- a/src/mono_shake.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/mono_shake.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -56,7 +56,8 @@
                                    | ((DExport _, _), acc) => acc
                                    | ((DTable _, _), acc) => acc
                                    | ((DSequence _, _), acc) => acc
-                                   | ((DDatabase _, _), acc) => acc)
+                                   | ((DDatabase _, _), acc) => acc
+                                   | ((DJavaScript _, _), acc) => acc)
                                  (IM.empty, IM.empty) file
 
         fun typ (c, s) =
@@ -112,7 +113,8 @@
                       | (DExport _, _) => true
                       | (DTable _, _) => true
                       | (DSequence _, _) => true
-                      | (DDatabase _, _) => true) file
+                      | (DDatabase _, _) => true
+                      | (DJavaScript _, _) => true) file
     end
 
 end
--- a/src/mono_util.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/mono_util.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -323,6 +323,7 @@
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (EJavaScript (m, e'), loc))
+
               | ESignalReturn e =>
                 S.map2 (mfe ctx e,
                      fn e' =>
@@ -421,6 +422,7 @@
               | DTable _ => S.return2 dAll
               | DSequence _ => S.return2 dAll
               | DDatabase _ => S.return2 dAll
+              | DJavaScript _ => S.return2 dAll
 
         and mfvi ctx (x, n, t, e, s) =
             S.bind2 (mft t,
@@ -501,6 +503,7 @@
                                       | DTable _ => ctx
                                       | DSequence _ => ctx
                                       | DDatabase _ => ctx
+                                      | DJavaScript _ => ctx
                             in
                                 S.map2 (mff ctx' ds',
                                      fn ds' =>
@@ -548,7 +551,8 @@
                           | DExport _ => count
                           | DTable _ => count
                           | DSequence _ => count
-                          | DDatabase _ => count) 0
+                          | DDatabase _ => count
+                          | DJavaScript _ => count) 0
 
 end
 
--- a/src/monoize.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/monoize.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -1844,7 +1844,9 @@
             in
                 case tag of
                     "body" => normal ("body", NONE,
-                                      SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc))
+                                      SOME (L'.EStrcat ((L'.EPrim (Prim.String "<script src=\"/app.js\"></script>"), loc),
+                                                        (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]),
+                                                         loc)), loc))
 
                   | "dyn" =>
                     (case #1 attrs of
--- a/src/prepare.sml	Sat Dec 20 15:46:48 2008 -0500
+++ b/src/prepare.sml	Sat Dec 20 16:19:26 2008 -0500
@@ -258,6 +258,7 @@
       | DSequence _ => (d, sns)
       | DDatabase _ => (d, sns)
       | DPreparedStatements _ => (d, sns)
+      | DJavaScript _ => (d, sns)
 
 fun prepare (ds, ps) =
     let