summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-06-27 10:30:51 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-06-27 10:30:51 -0400
commit35cfed265b313d645c850f1ed24f6e8f937a410c (patch)
treede15c7f60f907eed0f97e57484b7c01697373f9a /src
parent5574caafb5da61e7938eec476975bf82cbf98b97 (diff)
-debug from the command line
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sml2
-rw-r--r--src/main.mlton.sml46
-rw-r--r--src/settings.sig3
-rw-r--r--src/settings.sml4
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