# HG changeset patch # User Adam Chlipala # Date 1229807966 18000 # Node ID 162d5308e34fe8f3ed03eff83aad9be985a4f0a8 # Parent 55fc747a67dc2dedc93b07151e919ee069071e9f Successfully generated a page element from a signal diff -r 55fc747a67dc -r 162d5308e34f Makefile.in --- 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) diff -r 55fc747a67dc -r 162d5308e34f jslib/urweb.js --- /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} } diff -r 55fc747a67dc -r 162d5308e34f src/c/driver.c --- 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, ""); - 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, ""); - if (uw_db_commit(ctx)) { fk = FATAL; diff -r 55fc747a67dc -r 162d5308e34f src/cjr.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/cjr_env.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/cjr_print.sml --- 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, \"\");", + 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, \"\");", + 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\");", diff -r 55fc747a67dc -r 162d5308e34f src/cjrize.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/config.sig --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/config.sml.in --- 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@" diff -r 55fc747a67dc -r 162d5308e34f src/jscomp.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/mono.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/mono_env.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/mono_print.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/mono_shake.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/mono_util.sml --- 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 diff -r 55fc747a67dc -r 162d5308e34f src/monoize.sml --- 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 ""), loc), + (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), + loc)), loc)) | "dyn" => (case #1 attrs of diff -r 55fc747a67dc -r 162d5308e34f src/prepare.sml --- 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