diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-06-27 10:30:51 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-06-27 10:30:51 -0400 |
commit | 35cfed265b313d645c850f1ed24f6e8f937a410c (patch) | |
tree | de15c7f60f907eed0f97e57484b7c01697373f9a /src | |
parent | 5574caafb5da61e7938eec476975bf82cbf98b97 (diff) |
-debug from the command line
Diffstat (limited to 'src')
-rw-r--r-- | src/compiler.sml | 2 | ||||
-rw-r--r-- | src/main.mlton.sml | 46 | ||||
-rw-r--r-- | src/settings.sig | 3 | ||||
-rw-r--r-- | src/settings.sml | 4 |
4 files changed, 34 insertions, 21 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index 6126a1a2..2a53bf08 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -333,7 +333,7 @@ fun parseUrp' fname = val database = ref NONE val exe = ref NONE val sql = ref NONE - val debug = ref false + val debug = ref (Settings.getDebug ()) val profile = ref false val timeout = ref NONE val ffi = ref [] diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 069de100..62fb6509 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -25,42 +25,48 @@ * POSSIBILITY OF SUCH DAMAGE. *) -fun doArgs (args, (timing, demo, sources)) = +val timing = ref false +val sources = ref ([] : string list) +val demo = ref (NONE : (string * bool) option) + +fun doArgs args = case args of - [] => (timing, demo, rev sources) + [] => () | "-demo" :: prefix :: rest => - doArgs (rest, (timing, SOME (prefix, false), sources)) + (demo := SOME (prefix, false); + doArgs rest) | "-guided-demo" :: prefix :: rest => - doArgs (rest, (timing, SOME (prefix, true), sources)) + (demo := SOME (prefix, true); + doArgs rest) | "-protocol" :: name :: rest => (Settings.setProtocol name; - doArgs (rest, (timing, demo, sources))) + doArgs rest) + | "-debug" :: rest => + (Settings.setDebug true; + doArgs rest) + | "-timing" :: rest => + (timing := true; + doArgs rest) | arg :: rest => - let - val acc = - if size arg > 0 andalso String.sub (arg, 0) = #"-" then - case arg of - "-timing" => (true, demo, sources) - | _ => raise Fail ("Unknown option " ^ arg) - else - (timing, demo, arg :: sources) - in - doArgs (rest, acc) - end + (if size arg > 0 andalso String.sub (arg, 0) = #"-" then + raise Fail ("Unknown flag " ^ arg) + else + sources := arg :: !sources; + doArgs rest) -val (timing, demo, sources) = doArgs (CommandLine.arguments (), (false, NONE, [])) +val () = doArgs (CommandLine.arguments ()) val job = - case sources of + case !sources of [file] => file | _ => raise Fail "Zero or multiple job files specified" val () = - case demo of + case !demo of SOME (prefix, guided) => Demo.make {prefix = prefix, dirname = job, guided = guided} | NONE => - if timing then + if !timing then Compiler.time Compiler.toCjrize job else Compiler.compile job diff --git a/src/settings.sig b/src/settings.sig index c4bcf0e1..919fdf42 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -96,4 +96,7 @@ signature SETTINGS = sig val setProtocol : string -> unit val currentProtocol : unit -> protocol + val setDebug : bool -> unit + val getDebug : unit -> bool + end diff --git a/src/settings.sml b/src/settings.sml index e1dcc809..a020f373 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -277,4 +277,8 @@ fun setProtocol name = | SOME p => curProto := p fun currentProtocol () = !curProto +val debug = ref false +fun setDebug b = debug := b +fun getDebug () = !debug + end |