summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c/driver.c5
-rw-r--r--src/cjr.sml2
-rw-r--r--src/cjr_env.sml1
-rw-r--r--src/cjr_print.sml20
-rw-r--r--src/cjrize.sml1
-rw-r--r--src/config.sig1
-rw-r--r--src/config.sml.in2
-rw-r--r--src/jscomp.sml18
-rw-r--r--src/mono.sml3
-rw-r--r--src/mono_env.sml1
-rw-r--r--src/mono_print.sml4
-rw-r--r--src/mono_shake.sml6
-rw-r--r--src/mono_util.sml6
-rw-r--r--src/monoize.sml4
-rw-r--r--src/prepare.sml1
15 files changed, 61 insertions, 14 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 02:12:35 +0000