comparison src/main.mlton.sml @ 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 03e7f111fe99
comparison
equal deleted inserted replaced
856:86ec89baee01 857:3d2f6cb6d54a
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25 * POSSIBILITY OF SUCH DAMAGE. 25 * POSSIBILITY OF SUCH DAMAGE.
26 *) 26 *)
27 27
28 fun doArgs (args, (timing, demo, sources)) = 28 val timing = ref false
29 val sources = ref ([] : string list)
30 val demo = ref (NONE : (string * bool) option)
31
32 fun doArgs args =
29 case args of 33 case args of
30 [] => (timing, demo, rev sources) 34 [] => ()
31 | "-demo" :: prefix :: rest => 35 | "-demo" :: prefix :: rest =>
32 doArgs (rest, (timing, SOME (prefix, false), sources)) 36 (demo := SOME (prefix, false);
37 doArgs rest)
33 | "-guided-demo" :: prefix :: rest => 38 | "-guided-demo" :: prefix :: rest =>
34 doArgs (rest, (timing, SOME (prefix, true), sources)) 39 (demo := SOME (prefix, true);
40 doArgs rest)
35 | "-protocol" :: name :: rest => 41 | "-protocol" :: name :: rest =>
36 (Settings.setProtocol name; 42 (Settings.setProtocol name;
37 doArgs (rest, (timing, demo, sources))) 43 doArgs rest)
44 | "-debug" :: rest =>
45 (Settings.setDebug true;
46 doArgs rest)
47 | "-timing" :: rest =>
48 (timing := true;
49 doArgs rest)
38 | arg :: rest => 50 | arg :: rest =>
39 let 51 (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
40 val acc = 52 raise Fail ("Unknown flag " ^ arg)
41 if size arg > 0 andalso String.sub (arg, 0) = #"-" then 53 else
42 case arg of 54 sources := arg :: !sources;
43 "-timing" => (true, demo, sources) 55 doArgs rest)
44 | _ => raise Fail ("Unknown option " ^ arg)
45 else
46 (timing, demo, arg :: sources)
47 in
48 doArgs (rest, acc)
49 end
50 56
51 val (timing, demo, sources) = doArgs (CommandLine.arguments (), (false, NONE, [])) 57 val () = doArgs (CommandLine.arguments ())
52 58
53 val job = 59 val job =
54 case sources of 60 case !sources of
55 [file] => file 61 [file] => file
56 | _ => raise Fail "Zero or multiple job files specified" 62 | _ => raise Fail "Zero or multiple job files specified"
57 63
58 val () = 64 val () =
59 case demo of 65 case !demo of
60 SOME (prefix, guided) => 66 SOME (prefix, guided) =>
61 Demo.make {prefix = prefix, dirname = job, guided = guided} 67 Demo.make {prefix = prefix, dirname = job, guided = guided}
62 | NONE => 68 | NONE =>
63 if timing then 69 if !timing then
64 Compiler.time Compiler.toCjrize job 70 Compiler.time Compiler.toCjrize job
65 else 71 else
66 Compiler.compile job 72 Compiler.compile job