diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-06-23 15:56:04 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-06-23 15:56:04 -0400 |
commit | 32b2d196fc02ca4f9f87574e6da1ffa6c1ea12ab (patch) | |
tree | 5c08087fd98403edb3500ac4399ddece25c667ad /src | |
parent | 1109a4e1c8b10a8f524c1406a4db98eff55b435c (diff) |
Initial implementation of protocols in Settings
Diffstat (limited to 'src')
-rw-r--r-- | src/c/http.c (renamed from src/c/driver.c) | 0 | ||||
-rw-r--r-- | src/compiler.sml | 5 | ||||
-rw-r--r-- | src/scriptcheck.sml | 12 | ||||
-rw-r--r-- | src/settings.sig | 12 | ||||
-rw-r--r-- | src/settings.sml | 23 |
5 files changed, 48 insertions, 4 deletions
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 |