From 35cfed265b313d645c850f1ed24f6e8f937a410c Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 27 Jun 2009 10:30:51 -0400
Subject: -debug from the command line

---
 src/compiler.sml   |  2 +-
 src/main.mlton.sml | 46 ++++++++++++++++++++++++++--------------------
 src/settings.sig   |  3 +++
 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
-- 
cgit v1.2.3