Mercurial > urweb
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 |