Mercurial > urweb

annotate src/main.mlton.sml @ 1473:d40066b38710

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle spaces in filenames passed to GCC (caught by Zachary Tatlock)
author Adam Chlipala <adam@chlipala.net>
date Wed, 15 Jun 2011 09:52:06 -0400
parents 79557535b843
children 9cb923efea4d
rev   line source
adamc@1126 1 (* Copyright (c) 2008-2010, Adam Chlipala
adamc@0 2 * All rights reserved.
adamc@0 3 *
adamc@0 4 * Redistribution and use in source and binary forms, with or without
adamc@0 5 * modification, are permitted provided that the following conditions are met:
adamc@0 6 *
adamc@0 7 * - Redistributions of source code must retain the above copyright notice,
adamc@0 8 * this list of conditions and the following disclaimer.
adamc@0 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@0 10 * this list of conditions and the following disclaimer in the documentation
adamc@0 11 * and/or other materials provided with the distribution.
adamc@0 12 * - The names of contributors may not be used to endorse or promote products
adamc@0 13 * derived from this software without specific prior written permission.
adamc@0 14 *
adamc@0 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@0 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@0 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@0 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@0 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@0 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@0 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@0 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@0 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@0 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@0 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@0 26 *)
adamc@0 27
adamc@857 28 val timing = ref false
adamc@1086 29 val tc = ref false
adamc@857 30 val sources = ref ([] : string list)
adamc@857 31 val demo = ref (NONE : (string * bool) option)
adamc@1170 32 val css = ref false
adamc@857 33
adamc@857 34 fun doArgs args =
adamc@208 35 case args of
adamc@857 36 [] => ()
adamc@1170 37 | "-css" :: rest =>
adamc@1170 38 (css := true;
adamc@1170 39 doArgs rest)
adamc@384 40 | "-demo" :: prefix :: rest =>
adamc@857 41 (demo := SOME (prefix, false);
adamc@857 42 doArgs rest)
adamc@501 43 | "-guided-demo" :: prefix :: rest =>
adamc@857 44 (demo := SOME (prefix, true);
adamc@857 45 doArgs rest)
adamc@856 46 | "-protocol" :: name :: rest =>
adamc@856 47 (Settings.setProtocol name;
adamc@857 48 doArgs rest)
adam@1335 49 | "-prefix" :: prefix :: rest =>
adam@1335 50 (Settings.setUrlPrefix prefix;
adam@1335 51 doArgs rest)
adamc@891 52 | "-db" :: s :: rest =>
adamc@891 53 (Settings.setDbstring (SOME s);
adamc@891 54 doArgs rest)
adamc@866 55 | "-dbms" :: name :: rest =>
adamc@866 56 (Settings.setDbms name;
adamc@866 57 doArgs rest)
adamc@857 58 | "-debug" :: rest =>
adamc@857 59 (Settings.setDebug true;
adamc@857 60 doArgs rest)
adamc@1178 61 | "-verbose" :: rest =>
adamc@1178 62 (Compiler.debug := true;
adamc@1178 63 doArgs rest)
adamc@857 64 | "-timing" :: rest =>
adamc@857 65 (timing := true;
adamc@857 66 doArgs rest)
adamc@1086 67 | "-tc" :: rest =>
adamc@1086 68 (tc := true;
adamc@1086 69 doArgs rest)
adamc@891 70 | "-output" :: s :: rest =>
adamc@891 71 (Settings.setExe (SOME s);
adamc@891 72 doArgs rest)
adamc@891 73 | "-sql" :: s :: rest =>
adamc@891 74 (Settings.setSql (SOME s);
adamc@891 75 doArgs rest)
adamc@1095 76 | "-static" :: rest =>
adamc@1095 77 (Settings.setStaticLinking true;
adamc@1095 78 doArgs rest)
adamc@1126 79 | "-path" :: name :: path :: rest =>
adamc@1126 80 (Compiler.addPath (name, path);
adamc@1126 81 doArgs rest)
adamc@1126 82 | "-root" :: name :: root :: rest =>
adamc@1126 83 (Compiler.addModuleRoot (root, name);
adamc@1126 84 doArgs rest)
adamc@1164 85 | "-sigfile" :: name :: rest =>
adamc@1164 86 (Settings.setSigFile (SOME name);
adamc@1164 87 doArgs rest)
adamc@1235 88 | "-iflow" :: rest =>
adamc@1235 89 (Compiler.doIflow := true;
adamc@1235 90 doArgs rest)
adamc@1266 91 | "-moduleOf" :: fname :: _ =>
adamc@1266 92 (print (Compiler.moduleOf fname ^ "\n");
adamc@1266 93 OS.Process.exit OS.Process.success)
adam@1301 94 | "-noEmacs" :: rest =>
adam@1301 95 (Demo.noEmacs := true;
adam@1301 96 doArgs rest)
adam@1307 97 | "-limit" :: class :: num :: rest =>
adam@1307 98 (case Int.fromString num of
adam@1307 99 NONE => raise Fail ("Invalid limit number '" ^ num ^ "'")
adam@1307 100 | SOME n =>
adam@1307 101 if n < 0 then
adam@1307 102 raise Fail ("Invalid limit number '" ^ num ^ "'")
adam@1307 103 else
adam@1307 104 Settings.addLimit (class, n);
adam@1307 105 doArgs rest)
adamc@208 106 | arg :: rest =>
adamc@857 107 (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
adamc@857 108 raise Fail ("Unknown flag " ^ arg)
adamc@857 109 else
adamc@857 110 sources := arg :: !sources;
adamc@857 111 doArgs rest)
adamc@208 112
adamc@857 113 val () = doArgs (CommandLine.arguments ())
adamc@208 114
adamc@279 115 val job =
adamc@857 116 case !sources of
adamc@279 117 [file] => file
adamc@378 118 | _ => raise Fail "Zero or multiple job files specified"
adamc@279 119
adamc@208 120 val () =
adamc@1170 121 case (!css, !demo) of
adamc@1170 122 (true, _) =>
adamc@1170 123 (case Compiler.run Compiler.toCss job of
adamc@1170 124 NONE => OS.Process.exit OS.Process.failure
adamc@1170 125 | SOME {Overall = ov, Classes = cl} =>
adamc@1170 126 (app (print o Css.inheritableToString) ov;
adamc@1170 127 print "\n";
adamc@1170 128 app (fn (x, (ins, ots)) =>
adamc@1170 129 (print x;
adamc@1170 130 print " ";
adamc@1170 131 app (print o Css.inheritableToString) ins;
adamc@1170 132 app (print o Css.othersToString) ots;
adamc@1170 133 print "\n")) cl))
adamc@1170 134 | (_, SOME (prefix, guided)) =>
adamc@501 135 Demo.make {prefix = prefix, dirname = job, guided = guided}
adamc@1170 136 | _ =>
adamc@1086 137 if !tc then
adamc@1086 138 (Compiler.check Compiler.toElaborate job;
adamc@1086 139 if ErrorMsg.anyErrors () then
adamc@1086 140 OS.Process.exit OS.Process.failure
adamc@1086 141 else
adamc@1086 142 ())
adamc@1086 143 else if !timing then
adamc@384 144 Compiler.time Compiler.toCjrize job
adamc@384 145 else
adamc@1045 146 Compiler.compiler job