diff options
| -rw-r--r-- | src/cjr_print.sml | 4 | ||||
| -rw-r--r-- | src/compiler.sml | 23 | ||||
| -rw-r--r-- | src/demo.sml | 12 | ||||
| -rw-r--r-- | src/main.mlton.sml | 9 | ||||
| -rw-r--r-- | src/settings.sig | 9 | ||||
| -rw-r--r-- | src/settings.sml | 12 |
6 files changed, 51 insertions, 18 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 4121bf5e..eccd60c2 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2659,7 +2659,9 @@ fun p_file env (ds, ps) = 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, diff --git a/src/compiler.sml b/src/compiler.sml index 03454638..622b0e62 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -332,9 +332,9 @@ fun parseUrp' fname = 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 parseUrp' fname = 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 @@ fun parseUrp' fname = 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" => diff --git a/src/demo.sml b/src/demo.sml index b8323993..ebdf4e40 100644 --- a/src/demo.sml +++ b/src/demo.sml @@ -88,10 +88,14 @@ fun make {prefix, dirname, guided} = 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, diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 7498bb5e..b2d49438 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -41,6 +41,9 @@ fun doArgs args = | "-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 @@ fun doArgs args = | "-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) diff --git a/src/settings.sig b/src/settings.sig index 3e8a14ac..1da58193 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -163,4 +163,13 @@ signature SETTINGS = sig 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 diff --git a/src/settings.sml b/src/settings.sml index c28e1102..c7e68960 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -380,4 +380,16 @@ fun setDbms s = | 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 |