aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Makefile.in4
-rw-r--r--src/c/http.c (renamed from src/c/driver.c)0
-rw-r--r--src/compiler.sml5
-rw-r--r--src/scriptcheck.sml12
-rw-r--r--src/settings.sig12
-rw-r--r--src/settings.sml23
6 files changed, 51 insertions, 5 deletions
diff --git a/Makefile.in b/Makefile.in
index 9347e96f..d021aad1 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -13,7 +13,9 @@ all: smlnj mlton c
smlnj: src/urweb.cm
mlton: bin/urweb
-c: lib/c/urweb.o lib/c/request.o lib/c/driver.o
+
+OBJS := urweb request http
+c: $(OBJS:%=lib/c/%.o)
clean:
rm -f src/*.mlton.grm.* src/*.mlton.lex.* \
diff --git a/src/c/driver.c b/src/c/http.c
index e8345be2..e8345be2 100644
--- a/src/c/driver.c
+++ b/src/c/http.c
diff --git a/src/compiler.sml b/src/compiler.sml
index c7c2f65e..6126a1a2 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -883,14 +883,13 @@ val toSqlify = transform sqlify "sqlify" o toMono_opt2
fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
let
+ val proto = Settings.currentProtocol ()
val urweb_o = clibFile "urweb.o"
- val request_o = clibFile "request.o"
- val driver_o = clibFile "driver.o"
val compile = "gcc " ^ Config.gccArgs ^ " -Wstrict-prototypes -Werror -O3 -I " ^ Config.includ
^ " -c " ^ cname ^ " -o " ^ oname
val link = "gcc -Werror -O3 -lm -lmhash -pthread " ^ libs ^ " " ^ urweb_o ^ " " ^ oname
- ^ " " ^ request_o ^ " " ^ driver_o ^ " -o " ^ ename
+ ^ " " ^ #link proto ^ " -o " ^ ename
val (compile, link) =
if profile then
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index 834ff1c7..e0b9f855 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -73,6 +73,8 @@ val pushWords = ["rv("]
fun classify (ds, ps) =
let
+ val proto = Settings.currentProtocol ()
+
fun inString {needle, haystack} =
let
val (_, suffix) = Substring.position needle (Substring.full haystack)
@@ -158,10 +160,18 @@ fun classify (ds, ps) =
val (pull_ids, push_ids) = foldl decl (IS.empty, IS.empty) ds
+ val foundBad = ref false
+
val ps = map (fn (ek, x, n, ts, t, _) =>
(ek, x, n, ts, t,
if IS.member (push_ids, n) then
- ServerAndPullAndPush
+ (if not (#supportsPush proto) andalso not (!foundBad) then
+ (foundBad := true;
+ ErrorMsg.error ("This program needs server push, but the current protocol ("
+ ^ #name proto ^ ") doesn't support that."))
+ else
+ ();
+ ServerAndPullAndPush)
else if IS.member (pull_ids, n) then
ServerAndPull
else
diff --git a/src/settings.sig b/src/settings.sig
index dd812ac4..bccb2ef7 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -85,4 +85,16 @@ signature SETTINGS = sig
val getMimeRules : unit -> rule list
val checkMime : string -> bool
+ (* Web protocols that generated programs may speak *)
+ type protocol = {
+ name : string, (* Call it this on the command line *)
+ link : string, (* Pass these linker arguments *)
+ supportsPush : bool (* Is Ur/Web message-passing supported? *)
+ }
+ val addProtocol : protocol -> unit
+ val getProtocol : string -> protocol option
+
+ val setProtocol : protocol -> unit
+ val currentProtocol : unit -> protocol
+
end
diff --git a/src/settings.sml b/src/settings.sml
index 9c7b1175..75c879f7 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -248,4 +248,27 @@ val checkMime = check
(CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"-" orelse ch = #"."))
mime
+
+type protocol = {
+ name : string,
+ link : string,
+ supportsPush : bool
+}
+val protocols = ref ([] : protocol list)
+fun addProtocol p = protocols := p :: !protocols
+fun getProtocol s = List.find (fn p => #name p = s) (!protocols)
+
+fun clibFile s = OS.Path.joinDirFile {dir = Config.libC,
+ file = s}
+
+val http = {name = "http",
+ link = clibFile "request.o" ^ " " ^ clibFile "http.o",
+ supportsPush = true}
+
+val () = addProtocol http
+
+val curProto = ref http
+fun setProtocol p = curProto := p
+fun currentProtocol () = !curProto
+
end