diff options
author | 2008-12-20 16:19:26 -0500 | |
---|---|---|
committer | 2008-12-20 16:19:26 -0500 | |
commit | ec745f90fc97e10948dc32ec4f44aabf5c6908db (patch) | |
tree | 295a6cbc7787518188dbf6c5c2144c32154ab116 | |
parent | 80be553bea33f3d9cb19f399f64eed36017048a3 (diff) |
Successfully generated a page element from a signal
-rw-r--r-- | Makefile.in | 3 | ||||
-rw-r--r-- | jslib/urweb.js | 1 | ||||
-rw-r--r-- | src/c/driver.c | 5 | ||||
-rw-r--r-- | src/cjr.sml | 2 | ||||
-rw-r--r-- | src/cjr_env.sml | 1 | ||||
-rw-r--r-- | src/cjr_print.sml | 20 | ||||
-rw-r--r-- | src/cjrize.sml | 1 | ||||
-rw-r--r-- | src/config.sig | 1 | ||||
-rw-r--r-- | src/config.sml.in | 2 | ||||
-rw-r--r-- | src/jscomp.sml | 18 | ||||
-rw-r--r-- | src/mono.sml | 3 | ||||
-rw-r--r-- | src/mono_env.sml | 1 | ||||
-rw-r--r-- | src/mono_print.sml | 4 | ||||
-rw-r--r-- | src/mono_shake.sml | 6 | ||||
-rw-r--r-- | src/mono_util.sml | 6 | ||||
-rw-r--r-- | src/monoize.sml | 4 | ||||
-rw-r--r-- | src/prepare.sml | 1 |
17 files changed, 65 insertions, 14 deletions
diff --git a/Makefile.in b/Makefile.in index 57a083bd..ed65ceea 100644 --- a/Makefile.in +++ b/Makefile.in @@ -5,6 +5,7 @@ SITELISP := @SITELISP@ LIB_UR := $(LIB)/ur LIB_C := $(LIB)/c +LIB_JS := $(LIB)/js all: smlnj mlton c @@ -70,6 +71,8 @@ install: 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 --git a/jslib/urweb.js b/jslib/urweb.js new file mode 100644 index 00000000..32912e4c --- /dev/null +++ b/jslib/urweb.js @@ -0,0 +1 @@ +function sreturn(v) { return {v : v} } diff --git a/src/c/driver.c b/src/c/driver.c index a25cd743..34e57a6d 100644 --- a/src/c/driver.c +++ b/src/c/driver.c @@ -193,8 +193,6 @@ static void *worker(void *data) { 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 @@ static void *worker(void *data) { } 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; diff --git a/src/cjr.sml b/src/cjr.sml index 84aea54e..43a29a6c 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -109,6 +109,8 @@ datatype decl' = | 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 --git a/src/cjr_env.sml b/src/cjr_env.sml index 49e86140..9921ee48 100644 --- a/src/cjr_env.sml +++ b/src/cjr_env.sml @@ -166,6 +166,7 @@ fun declBinds env (d, loc) = | DSequence _ => env | DDatabase _ => env | DPreparedStatements _ => env + | DJavaScript _ => env end diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 8c3c3d86..06f9f5ca 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1800,6 +1800,10 @@ fun p_decl env (dAll as (d, _) : decl) = string "}"] + | DJavaScript s => box [string "static char jslib[] = \"", + string (String.toString s), + string "\";"] + datatype 'a search = Found of 'a | NotFound @@ -2048,6 +2052,10 @@ fun p_file env (ds, ps) = 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 @@ fun p_file env (ds, ps) = inputsVar, string ", uw_unit_v);", newline, + string "uw_write(ctx, \"</html>\");", + newline, string "return;", newline, string "}", @@ -2374,6 +2384,16 @@ fun p_file env (ds, ps) = 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 --git a/src/cjrize.sml b/src/cjrize.sml index f3c5e5a7..78513ef7 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -528,6 +528,7 @@ fun cifyDecl ((d, loc), sm) = | 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 --git a/src/config.sig b/src/config.sig index 6075482e..90fb72e7 100644 --- a/src/config.sig +++ b/src/config.sig @@ -6,6 +6,7 @@ signature CONFIG = sig val libUr : string val libC : string + val libJs : string val gccArgs : string end diff --git a/src/config.sml.in b/src/config.sml.in index 9e53986b..c7d231d5 100644 --- a/src/config.sml.in +++ b/src/config.sml.in @@ -9,6 +9,8 @@ val libUr = OS.Path.joinDirFile {dir = lib, file = "ur"} val libC = OS.Path.joinDirFile {dir = lib, file = "c"} +val libJs = OS.Path.joinDirFile {dir = lib, + file = "js"} val gccArgs = "@GCCARGS@" diff --git a/src/jscomp.sml b/src/jscomp.sml index b0842c6b..95c18016 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -285,7 +285,7 @@ fun jsExp mode outer = in (strcat [str "document.write(", e, - str ")"], st) + str ".v)"], st) end | ESeq (e1, e2) => @@ -317,9 +317,9 @@ fun jsExp mode outer = 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 @@ fun process file = {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 --git a/src/mono.sml b/src/mono.sml index c6e0ae8a..1a7fde00 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -118,6 +118,9 @@ datatype decl' = | DSequence of string | DDatabase of string + | DJavaScript of string + + withtype decl = decl' located type file = decl list diff --git a/src/mono_env.sml b/src/mono_env.sml index cce4a4c4..248567de 100644 --- a/src/mono_env.sml +++ b/src/mono_env.sml @@ -110,6 +110,7 @@ fun declBinds env (d, loc) = | DTable _ => env | DSequence _ => env | DDatabase _ => env + | DJavaScript _ => env fun patBinds env (p, loc) = case p of diff --git a/src/mono_print.sml b/src/mono_print.sml index 89b6c35b..e44bb74c 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -379,6 +379,10 @@ fun p_decl env (dAll as (d, _) : decl) = | DDatabase s => box [string "database", space, string s] + | DJavaScript s => box [string "JavaScript(", + string s, + string ")"] + fun p_file env file = let diff --git a/src/mono_shake.sml b/src/mono_shake.sml index 6714718a..34bd98be 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -56,7 +56,8 @@ fun shake file = | ((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 @@ fun shake file = | (DExport _, _) => true | (DTable _, _) => true | (DSequence _, _) => true - | (DDatabase _, _) => true) file + | (DDatabase _, _) => true + | (DJavaScript _, _) => true) file end end diff --git a/src/mono_util.sml b/src/mono_util.sml index 553f802e..9788a551 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -323,6 +323,7 @@ fun mapfoldB {typ = fc, exp = fe, bind} = S.map2 (mfe ctx e, fn e' => (EJavaScript (m, e'), loc)) + | ESignalReturn e => S.map2 (mfe ctx e, fn e' => @@ -421,6 +422,7 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} = | 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 @@ fun mapfoldB (all as {bind, ...}) = | DTable _ => ctx | DSequence _ => ctx | DDatabase _ => ctx + | DJavaScript _ => ctx in S.map2 (mff ctx' ds', fn ds' => @@ -548,7 +551,8 @@ val maxName = foldl (fn ((d, _) : decl, count) => | DExport _ => count | DTable _ => count | DSequence _ => count - | DDatabase _ => count) 0 + | DDatabase _ => count + | DJavaScript _ => count) 0 end diff --git a/src/monoize.sml b/src/monoize.sml index 1b7b467d..a0a0df30 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1844,7 +1844,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 diff --git a/src/prepare.sml b/src/prepare.sml index 708bcade..110f6f9a 100644 --- a/src/prepare.sml +++ b/src/prepare.sml @@ -258,6 +258,7 @@ fun prepDecl (d as (_, loc), sns) = | DSequence _ => (d, sns) | DDatabase _ => (d, sns) | DPreparedStatements _ => (d, sns) + | DJavaScript _ => (d, sns) fun prepare (ds, ps) = let |