settings.ml 12.2 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
open Printf

(* ------------------------------------------------------------------------- *)
(* Prepare for parsing the command line. *)

type token_type_mode =
  | TokenTypeAndCode   (* produce the definition of the [token] type and code for the parser *)
  | TokenTypeOnly      (* produce the type definition only *)
  | CodeOnly of string (* produce the code only; import token type from specified module *)

let token_type_mode =
  ref TokenTypeAndCode

let tokentypeonly () =
  token_type_mode := TokenTypeOnly

let codeonly m =
  if String.capitalize m <> m then begin
    (* Not using module [Error] to avoid a circular dependency. *)
    fprintf stderr "Error: %s is not a valid Objective Caml module name.\n" m;
    exit 1
  end;
  token_type_mode := CodeOnly m

let version =
  ref false

type construction_mode =
  | ModeCanonical     (* --canonical: canonical Knuth LR(1) automaton *)
  | ModeInclusionOnly (* --no-pager : states are merged when there is an inclusion
31 32
			              relationship *)
  | ModePager         (* normal mode: states are merged as per Pager's criterion *)
33 34
  | ModeLALR          (* --lalr     : states are merged as in an LALR generator,
                                      i.e. as soon as they have the same LR(0) core *)
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131

(* Note that --canonical overrides --no-pager. If both are specified, the result
   is a canonical automaton. *)

let construction_mode =
  ref ModePager

let explain =
  ref false

let base =
  ref ""

let dump =
  ref false

let follow =
  ref false

let graph =
  ref false

let trace =
  ref false

let noprefix =
  ref false

type print_mode =
    | PrintNormal
    | PrintUnitActions
    | PrintUnitActionsUnitTokens

type preprocess_mode =
    | PMNormal                       (* preprocess and continue *)
    | PMOnlyPreprocess of print_mode (* preprocess, print grammar, stop *)

let preprocess_mode =
  ref PMNormal

let recovery =
  ref false

let v () =
  dump := true;
  explain := true

let infer =
  ref false

let inline =
  ref true

type ocamldep_mode =
  | OMNone        (* do not invoke ocamldep *)
  | OMRaw         (* invoke ocamldep and echo its raw output *)
  | OMPostprocess (* invoke ocamldep and postprocess its output *)

let depend =
  ref OMNone

let code_inlining =
  ref true

let comment =
  ref false

let ocamlc =
  ref "ocamlc"

let ocamldep =
  ref "ocamldep"

let logG, logA, logC =
  ref 0, ref 0, ref 0

let timings =
  ref false

let filenames = 
  ref StringSet.empty

let no_stdlib = 
  ref false

let stdlib_path =
  ref Installation.libdir

let insert name = 
  filenames := StringSet.add name !filenames

let interpret =
  ref false

let interpret_show_cst =
  ref false

132 133 134
let interpret_error =
  ref false

135 136 137
let table = 
  ref false

138 139 140
let inspection =
  ref false

141 142 143 144 145 146 147 148 149 150 151 152
let coq = 
  ref false

let coq_no_complete =
  ref false

let coq_no_actions =
  ref false

let strict =
  ref false

153 154 155
let fixedexc =
  ref false

156 157 158 159 160 161 162 163
type suggestion =
  | SuggestNothing
  | SuggestCompFlags
  | SuggestLinkFlags of string (* "cmo" or "cmx" *)

let suggestion =
  ref SuggestNothing

164 165 166 167 168 169 170 171 172
let ignored_unused_tokens =
  ref StringSet.empty

let ignore_unused_token t =
  ignored_unused_tokens := StringSet.add t !ignored_unused_tokens

let ignore_all_unused_tokens =
  ref false

173 174 175
let list_errors =
  ref false

176 177 178 179 180 181
let compile_errors =
  ref None

let set_compile_errors filename =
  compile_errors := Some filename

182 183 184 185 186 187
let compare_errors =
  ref []

let add_compare_errors filename =
  compare_errors := filename :: !compare_errors

188 189 190 191 192 193
let update_errors =
  ref None

let set_update_errors filename =
  update_errors := Some filename

194 195 196 197
let options = Arg.align [
  "--base", Arg.Set_string base, "<basename> Specifies a base name for the output file(s)";
  "--canonical", Arg.Unit (fun () -> construction_mode := ModeCanonical), " Construct a canonical Knuth LR(1) automaton";
  "--comment", Arg.Set comment, " Include comments in the generated code";
198 199
  "--compare-errors", Arg.String add_compare_errors, "<filename> (used twice) Compare two .messages files.";
  "--compile-errors", Arg.String set_compile_errors, "<filename> Compile a .messages file to OCaml code.";
200 201 202
  "--coq", Arg.Set coq, " Generate a formally verified parser, in Coq";
  "--coq-no-complete", Arg.Set coq_no_complete, " Do not generate a proof of completeness";
  "--coq-no-actions", Arg.Set coq_no_actions, " Ignore semantic actions in the Coq output";
203 204
  "--depend", Arg.Unit (fun () -> depend := OMPostprocess), " Invoke ocamldep and display dependencies";
  "--dump", Arg.Set dump, " Describe the automaton in <basename>.automaton";
205
  "--error-recovery", Arg.Set recovery, " (no longer supported)";
206 207
  "--explain", Arg.Set explain, " Explain conflicts in <basename>.conflicts";
  "--external-tokens", Arg.String codeonly, "<module> Import token type definition from <module>";
208
  "--fixed-exception", Arg.Set fixedexc, " Declares Error = Parsing.Parse_error";
209 210 211
  "--follow-construction", Arg.Set follow, " (undocumented)";
  "--graph", Arg.Set graph, " Write grammar's dependency graph to <basename>.dot";
  "--infer", Arg.Set infer, " Invoke ocamlc for ahead of time type inference";
212
  "--inspection", Arg.Set inspection, " Generate the inspection API (requires --table)";
213 214
  "--interpret", Arg.Set interpret, " Interpret the sentences provided on stdin";
  "--interpret-show-cst", Arg.Set interpret_show_cst, " Show a concrete syntax tree upon acceptance";
215
  "--interpret-error", Arg.Set interpret_error, " Interpret one sentence that should end in an error";
216
  "--lalr", Arg.Unit (fun () -> construction_mode := ModeLALR), " Construct an LALR(1) automaton";
217
  "--list-errors", Arg.Set list_errors, " Produce a list of erroneous inputs";
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
  "--log-automaton", Arg.Set_int logA, "<level> Log information about the automaton";
  "--log-code", Arg.Set_int logC, "<level> Log information about the generated code";
  "--log-grammar", Arg.Set_int logG, "<level> Log information about the grammar";
  "--no-code-inlining", Arg.Clear code_inlining, " (undocumented)";
  "--no-inline", Arg.Clear inline, " Ignore the %inline keyword.";
  "--no-pager", Arg.Unit (fun () -> if !construction_mode = ModePager then construction_mode := ModeInclusionOnly), " (undocumented)";
  "--no-prefix", Arg.Set noprefix, " (undocumented)";
  "--no-stdlib", Arg.Set no_stdlib, " Do not load the standard library";
  "--ocamlc", Arg.Set_string ocamlc, "<command> Specifies how ocamlc should be invoked";
  "--ocamldep", Arg.Set_string ocamldep, "<command> Specifies how ocamldep should be invoked";
  "--only-preprocess", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess PrintNormal),
                       " Print grammar and exit";
  "--only-preprocess-u", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess PrintUnitActions),
                         " Print grammar with unit actions and exit";
  "--only-preprocess-uu", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess PrintUnitActionsUnitTokens),
                          " Print grammar with unit actions & tokens and exit";
  "--only-tokens", Arg.Unit tokentypeonly, " Generate token type definition only, no code";
  "--raw-depend", Arg.Unit (fun () -> depend := OMRaw), " Invoke ocamldep and echo its raw output";
  "--stdlib", Arg.Set_string stdlib_path, "<directory> Specify where the standard library lies";
  "--strict", Arg.Set strict, " Warnings about the grammar are errors";
  "--suggest-comp-flags", Arg.Unit (fun () -> suggestion := SuggestCompFlags),
                          " Suggest compilation flags for ocaml{c,opt}";
  "--suggest-link-flags-byte", Arg.Unit (fun () -> suggestion := SuggestLinkFlags "cmo"),
                               " Suggest link flags for ocamlc";
  "--suggest-link-flags-opt", Arg.Unit (fun () -> suggestion := SuggestLinkFlags "cmx"),
                              " Suggest link flags for ocamlopt";
  "--table", Arg.Set table, " Use the table-based back-end";
  "--timings", Arg.Set timings, " Display internal timings";
  "--trace", Arg.Set trace, " Include tracing instructions in the generated code";
247 248
  "--unused-token", Arg.String ignore_unused_token, "<token> Do not warn that <token> is unused";
  "--unused-tokens", Arg.Set ignore_all_unused_tokens, " Do not warn about any unused token";
249
  "--update-errors", Arg.String set_update_errors, "<filename> Update auto-comments in a .messages file";
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
  "--version", Arg.Set version, " Show version number and exit";
  "-b", Arg.Set_string base, "<basename> Synonymous with --base <basename>";
  "-lg", Arg.Set_int logG, " Synonymous with --log-grammar";
  "-la", Arg.Set_int logA, " Synonymous with --log-automaton";
  "-lc", Arg.Set_int logC, " Synonymous with --log-code";
  "-t", Arg.Set table, " Synonymous with --table";
  "-v", Arg.Unit v, " Synonymous with --dump --explain";
]

let usage =
  sprintf "Usage: %s <options> <filenames>" Sys.argv.(0)

(* ------------------------------------------------------------------------- *)
(* Parse the command line. *)

let () =
  Arg.parse options insert usage

(* ------------------------------------------------------------------------- *)
(* If required, print a version number and stop. *)

let () =
  if !version then begin
    printf "menhir, version %s\n" Version.version;
    exit 0
  end

(* ------------------------------------------------------------------------- *)

(* Menhir is able to suggest compile and link flags to be passed to the
   Objective Caml compilers. If required, do so and stop. *)

(* If [--table] is not passed, no flags are necessary. If [--table] is
   passed, then [MenhirLib] needs to be visible (at compile time) and
   linked in (at link time). This is done either via [ocamlfind], if
   it was available at installation time, or manually. *)

(* The compilation flags are in fact meant to be used both at compile-
   and link-time. *)

let () =
  match !suggestion with
  | SuggestNothing ->
      ()
  | SuggestCompFlags ->
      if !table then
	if Installation.ocamlfind then
	  printf "-package menhirLib\n%!"
	else
	  printf "-I %s\n%!" Installation.libdir;
      exit 0
  | SuggestLinkFlags extension ->
      if !table then
	if Installation.ocamlfind then
	  printf "-linkpkg\n%!"
	else
	  printf "menhirLib.%s\n%!" extension;
      exit 0

(* ------------------------------------------------------------------------- *)
(* Export the settings. *)

let stdlib_filename = 
  !stdlib_path ^ "/standard.mly"

let filenames =
  StringSet.elements !filenames

let base =
  if !base = "" then
    match filenames with
    | [] ->
	fprintf stderr "%s\n" usage;
	exit 1
    | [ filename ] ->
	Filename.chop_suffix filename (if !coq then ".vy" else ".mly")
    | _ ->
	fprintf stderr "Error: you must specify --base when providing multiple input files.\n";
	exit 1
  else
    !base

let filenames = 
  if !no_stdlib || !coq then
    filenames
  else 
    stdlib_filename :: filenames

let token_type_mode =
  !token_type_mode

let construction_mode =
  !construction_mode

let explain =
  !explain

let dump =
  !dump

let follow =
  !follow

let graph =
  !graph

let trace =
  !trace

359 360 361 362 363
let () =
  if !recovery then begin
    fprintf stderr "Error: --error-recovery mode is no longer supported.\n";
    exit 1
  end
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403

let noprefix =
  !noprefix

let infer =
  !infer

let code_inlining =
  !code_inlining

let depend =
  !depend

let inline =
  !inline

let comment =
  !comment

let preprocess_mode =
  !preprocess_mode

let ocamlc =
  !ocamlc

let ocamldep =
  !ocamldep

let logG, logA, logC =
  !logG, !logA, !logC

let timings =
  !timings

let interpret =
  !interpret

let interpret_show_cst =
  !interpret_show_cst

404 405 406
let interpret_error =
  !interpret_error

407 408 409
let table = 
  !table

410 411 412 413 414 415 416 417 418
let inspection =
  !inspection

let () =
  if inspection && not table then begin
    fprintf stderr "Error: --inspection requires --table.\n";
    exit 1
  end

419 420 421 422 423 424 425 426 427 428 429 430
let coq = 
  !coq

let coq_no_complete =
  !coq_no_complete

let coq_no_actions =
  !coq_no_actions

let strict =
  !strict

431 432 433
let fixedexc =
  !fixedexc

434 435 436 437 438
let ignored_unused_tokens =
  !ignored_unused_tokens

let ignore_all_unused_tokens =
  !ignore_all_unused_tokens
439

440 441
let list_errors =
  !list_errors
442 443 444

let compile_errors =
  !compile_errors
445 446 447 448 449 450 451 452 453 454 455 456 457

let compare_errors =
  match !compare_errors with
  | [] ->
      None
  | [ filename2; filename1 ] -> (* LIFO *)
      Some (filename1, filename2)
  | _ ->
      eprintf
        "To compare two .messages files, please use:\n\
         --compare-errors <filename1> --compare-errors <filename2>.\n";
      exit 1

458 459 460
let update_errors =
  !update_errors