changeset 857:3d2f6cb6d54a

-debug from the command line
author Adam Chlipala <adamc@hcoop.net>
date Sat, 27 Jun 2009 10:30:51 -0400
parents 86ec89baee01
children 346cf1908a17
files src/compiler.sml src/main.mlton.sml src/settings.sig src/settings.sml
diffstat 4 files changed, 34 insertions(+), 21 deletions(-) [+]
line wrap: on
line diff
--- a/src/compiler.sml	Tue Jun 23 17:59:23 2009 -0400
+++ b/src/compiler.sml	Sat Jun 27 10:30:51 2009 -0400
@@ -333,7 +333,7 @@
                 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 []
--- a/src/main.mlton.sml	Tue Jun 23 17:59:23 2009 -0400
+++ b/src/main.mlton.sml	Sat Jun 27 10:30:51 2009 -0400
@@ -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
--- a/src/settings.sig	Tue Jun 23 17:59:23 2009 -0400
+++ b/src/settings.sig	Sat Jun 27 10:30:51 2009 -0400
@@ -96,4 +96,7 @@
     val setProtocol : string -> unit
     val currentProtocol : unit -> protocol
 
+    val setDebug : bool -> unit
+    val getDebug : unit -> bool
+
 end
--- a/src/settings.sml	Tue Jun 23 17:59:23 2009 -0400
+++ b/src/settings.sml	Sat Jun 27 10:30:51 2009 -0400
@@ -277,4 +277,8 @@
       | SOME p => curProto := p
 fun currentProtocol () = !curProto
 
+val debug = ref false
+fun setDebug b = debug := b
+fun getDebug () = !debug
+
 end