Mercurial > urweb
changeset 891:8f2159040bbb
More command-line options
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 18 Jul 2009 11:01:48 -0400 |
| parents | 034eeb099564 |
| children | e04af9641067 |
| files | src/cjr_print.sml src/compiler.sml src/demo.sml src/main.mlton.sml src/settings.sig src/settings.sml |
| diffstat | 6 files changed, 51 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Sat Jul 18 10:27:32 2009 -0400 +++ b/src/cjr_print.sml Sat Jul 18 11:01:48 2009 -0400 @@ -2659,7 +2659,9 @@ views = !views, sequences = !sequences} else - box [string "void uw_db_init(uw_context ctx) { };", + box [string "void uw_client_init(void) { };", + newline, + string "void uw_db_init(uw_context ctx) { };", newline, string "int uw_db_begin(uw_context ctx) { return 0; };", newline,
--- a/src/compiler.sml Sat Jul 18 10:27:32 2009 -0400 +++ b/src/compiler.sml Sat Jul 18 11:01:48 2009 -0400 @@ -332,9 +332,9 @@ end val prefix = ref NONE - val database = ref NONE - val exe = ref NONE - val sql = ref NONE + val database = ref (Settings.getDbstring ()) + val exe = ref (Settings.getExe ()) + val sql = ref (Settings.getSql ()) val debug = ref (Settings.getDebug ()) val profile = ref false val timeout = ref NONE @@ -398,7 +398,7 @@ fun merge (old : job, new : job) = { prefix = #prefix old, - database = #database old, + database = mergeO (fn (old, _) => old) (#database old, #database new), exe = #exe old, sql = #sql old, debug = #debug old orelse #debug new, @@ -490,19 +490,16 @@ prefix := SOME arg) | "database" => (case !database of - NONE => () - | SOME _ => ErrorMsg.error "Duplicate 'database' directive"; - database := SOME arg) + NONE => database := SOME arg + | SOME _ => ()) | "exe" => (case !exe of - NONE => () - | SOME _ => ErrorMsg.error "Duplicate 'exe' directive"; - exe := SOME (relify arg)) + NONE => exe := SOME (relify arg) + | SOME _ => ()) | "sql" => (case !sql of - NONE => () - | SOME _ => ErrorMsg.error "Duplicate 'sql' directive"; - sql := SOME (relify arg)) + NONE => sql := SOME (relify arg) + | SOME _ => ()) | "debug" => debug := true | "profile" => profile := true | "timeout" =>
--- a/src/demo.sml Sat Jul 18 10:27:32 2009 -0400 +++ b/src/demo.sml Sat Jul 18 11:01:48 2009 -0400 @@ -88,10 +88,14 @@ else files @ [file]) (#sources combined) (#sources urp), - exe = OS.Path.joinDirFile {dir = dirname, - file = "demo.exe"}, - sql = SOME (OS.Path.joinDirFile {dir = dirname, - file = "demo.sql"}), + exe = case Settings.getExe () of + NONE => OS.Path.joinDirFile {dir = dirname, + file = "demo.exe"} + | SOME s => s, + sql = SOME (case Settings.getSql () of + NONE => OS.Path.joinDirFile {dir = dirname, + file = "demo.sql"} + | SOME s => s), debug = Settings.getDebug (), timeout = Int.max (#timeout combined, #timeout urp), profile = false,
--- a/src/main.mlton.sml Sat Jul 18 10:27:32 2009 -0400 +++ b/src/main.mlton.sml Sat Jul 18 11:01:48 2009 -0400 @@ -41,6 +41,9 @@ | "-protocol" :: name :: rest => (Settings.setProtocol name; doArgs rest) + | "-db" :: s :: rest => + (Settings.setDbstring (SOME s); + doArgs rest) | "-dbms" :: name :: rest => (Settings.setDbms name; doArgs rest) @@ -50,6 +53,12 @@ | "-timing" :: rest => (timing := true; doArgs rest) + | "-output" :: s :: rest => + (Settings.setExe (SOME s); + doArgs rest) + | "-sql" :: s :: rest => + (Settings.setSql (SOME s); + doArgs rest) | arg :: rest => (if size arg > 0 andalso String.sub (arg, 0) = #"-" then raise Fail ("Unknown flag " ^ arg)
--- a/src/settings.sig Sat Jul 18 10:27:32 2009 -0400 +++ b/src/settings.sig Sat Jul 18 11:01:48 2009 -0400 @@ -163,4 +163,13 @@ val setDbms : string -> unit val currentDbms : unit -> dbms + val setDbstring : string option -> unit + val getDbstring : unit -> string option + + val setExe : string option -> unit + val getExe : unit -> string option + + val setSql : string option -> unit + val getSql : unit -> string option + end
--- a/src/settings.sml Sat Jul 18 10:27:32 2009 -0400 +++ b/src/settings.sml Sat Jul 18 11:01:48 2009 -0400 @@ -380,4 +380,16 @@ | SOME db => curDb := db fun currentDbms () = !curDb +val dbstring = ref (NONE : string option) +fun setDbstring so = dbstring := so +fun getDbstring () = !dbstring + +val exe = ref (NONE : string option) +fun setExe so = exe := so +fun getExe () = !exe + +val sql = ref (NONE : string option) +fun setSql so = sql := so +fun getSql () = !sql + end