settings.ml 13.9 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
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

17 18 19 20 21 22 23
let is_uppercase_ascii c =
  c >= 'A' && c <= 'Z'

let is_capitalized_ascii s =
  String.length s > 0 &&
  is_uppercase_ascii s.[0]

24
let codeonly m =
25
  if not (is_capitalized_ascii m) then begin
26
    (* Not using module [Error] to avoid a circular dependency. *)
27
    fprintf stderr "Error: %s is not a valid OCaml module name.\n" m;
28 29 30 31 32 33 34 35 36 37
    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
38
                                      relationship *)
39
  | ModePager         (* normal mode: states are merged as per Pager's criterion *)
40 41
  | ModeLALR          (* --lalr     : states are merged as in an LALR generator,
                                      i.e. as soon as they have the same LR(0) core *)
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

(* 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
72
    | PrintForOCamlyacc
73
    | PrintUnitActions of bool       (* if true, declare unit tokens *)
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

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

POTTIER Francois's avatar
POTTIER Francois committed
121
let filenames =
122 123
  ref StringSet.empty

POTTIER Francois's avatar
POTTIER Francois committed
124
let no_stdlib =
125 126
  ref false

POTTIER Francois's avatar
POTTIER Francois committed
127 128 129 130 131
(* By default, [stdlib_path] is [Installation.libdir], that is, the directory
   that was specified when Menhir was compiled. This is overridden by the
   environment variable $MENHIR_STDLIB, if it is defined, and by the --stdlib
   command line option, if present. *)

132 133 134
let stdlib_path =
  ref Installation.libdir

POTTIER Francois's avatar
POTTIER Francois committed
135 136 137 138 139 140
let () =
  try
    stdlib_path := Sys.getenv "MENHIR_STDLIB"
  with Not_found ->
    ()

POTTIER Francois's avatar
POTTIER Francois committed
141
let insert name =
142 143 144 145 146 147 148 149
  filenames := StringSet.add name !filenames

let interpret =
  ref false

let interpret_show_cst =
  ref false

POTTIER Francois's avatar
POTTIER Francois committed
150 151 152
let interpret_error =
  ref false

POTTIER Francois's avatar
POTTIER Francois committed
153
let table =
154 155
  ref false

156 157 158
let inspection =
  ref false

POTTIER Francois's avatar
POTTIER Francois committed
159
let coq =
160 161 162 163 164 165 166 167 168 169 170
  ref false

let coq_no_complete =
  ref false

let coq_no_actions =
  ref false

let strict =
  ref false

171 172 173
let fixedexc =
  ref false

174 175 176 177
type suggestion =
  | SuggestNothing
  | SuggestCompFlags
  | SuggestLinkFlags of string (* "cmo" or "cmx" *)
178
  | SuggestWhereIsMenhirLibSource
POTTIER Francois's avatar
POTTIER Francois committed
179
  | SuggestUseOcamlfind
180 181 182 183

let suggestion =
  ref SuggestNothing

184 185 186 187 188 189 190 191 192
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

POTTIER Francois's avatar
POTTIER Francois committed
193 194 195
let list_errors =
  ref false

196 197 198 199 200 201
let compile_errors =
  ref None

let set_compile_errors filename =
  compile_errors := Some filename

202 203 204 205 206 207
let compare_errors =
  ref []

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

208 209 210 211 212 213
let update_errors =
  ref None

let set_update_errors filename =
  update_errors := Some filename

POTTIER Francois's avatar
POTTIER Francois committed
214 215 216 217 218 219
let echo_errors =
  ref None

let set_echo_errors filename =
  echo_errors := Some filename

220 221 222
let cmly =
  ref false

223 224 225
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";
226
  "--cmly", Arg.Set cmly, " Write a .cmly file";
227
  "--comment", Arg.Set comment, " Include comments in the generated code";
228 229
  "--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.";
230 231 232
  "--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";
233
  "--depend", Arg.Unit (fun () -> depend := OMPostprocess), " Invoke ocamldep and display dependencies";
234
  "--dump", Arg.Set dump, " Write an .automaton file";
POTTIER Francois's avatar
POTTIER Francois committed
235
  "--echo-errors", Arg.String set_echo_errors, "<filename> Echo the sentences in a .messages file";
236
  "--error-recovery", Arg.Set recovery, " (no longer supported)";
237 238
  "--explain", Arg.Set explain, " Explain conflicts in <basename>.conflicts";
  "--external-tokens", Arg.String codeonly, "<module> Import token type definition from <module>";
239
  "--fixed-exception", Arg.Set fixedexc, " Declares Error = Parsing.Parse_error";
240
  "--follow-construction", Arg.Set follow, " (undocumented)";
241 242 243
  "--graph", Arg.Set graph, " Write a dependency graph to a .dot file";
  "--infer", Arg.Set infer, " Invoke ocamlc to do type inference";
  "--inspection", Arg.Set inspection, " Generate the inspection API";
244 245
  "--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";
246
  "--interpret-error", Arg.Set interpret_error, " Interpret an error sentence";
247
  "--lalr", Arg.Unit (fun () -> construction_mode := ModeLALR), " Construct an LALR(1) automaton";
POTTIER Francois's avatar
POTTIER Francois committed
248
  "--list-errors", Arg.Set list_errors, " Produce a list of erroneous inputs";
249 250 251 252 253 254 255 256 257 258 259 260
  "--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";
261 262
  "--only-preprocess-for-ocamlyacc", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess PrintForOCamlyacc),
                       " Print grammar in ocamlyacc format and exit";
263
  "--only-preprocess-u", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess (PrintUnitActions false)),
264
                         " Print grammar with unit actions and exit";
265
  "--only-preprocess-uu", Arg.Unit (fun () -> preprocess_mode := PMOnlyPreprocess (PrintUnitActions true)),
266
                          " Print grammar with unit actions & tokens";
267 268 269 270 271 272 273 274 275 276
  "--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";
277 278
  "--suggest-menhirLib", Arg.Unit (fun () -> suggestion := SuggestWhereIsMenhirLibSource),
                         " Suggest where is MenhirLib";
POTTIER Francois's avatar
POTTIER Francois committed
279
  "--suggest-ocamlfind", Arg.Unit (fun () -> suggestion := SuggestUseOcamlfind),
280
                         " Show if Menhir was installed using ocamlfind";
281 282
  "--table", Arg.Set table, " Use the table-based back-end";
  "--timings", Arg.Set timings, " Display internal timings";
283
  "--trace", Arg.Set trace, " Generate tracing instructions";
284 285
  "--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";
286
  "--update-errors", Arg.String set_update_errors, "<filename> Update auto-comments in a .messages file";
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
  "--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
317
   OCaml compilers. If required, do so and stop. *)
318 319 320 321 322 323 324 325 326 327 328 329 330 331 332

(* 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
333 334 335 336
        if Installation.ocamlfind then
          printf "-package menhirLib\n%!"
        else
          printf "-I %s\n%!" Installation.libdir;
337 338 339
      exit 0
  | SuggestLinkFlags extension ->
      if !table then
340 341 342 343
        if Installation.ocamlfind then
          printf "-linkpkg\n%!"
        else
          printf "menhirLib.%s\n%!" extension;
344
      exit 0
345 346 347 348 349 350 351
  | SuggestWhereIsMenhirLibSource ->
      if Installation.ocamlfind then
        let _ = Sys.command "ocamlfind query menhirLib" in
        ()
      else
        printf "%s\n%!" Installation.libdir;
      exit 0
POTTIER Francois's avatar
POTTIER Francois committed
352 353 354
  | SuggestUseOcamlfind ->
      printf "%b\n" Installation.ocamlfind;
      exit 0
355 356 357 358

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

POTTIER Francois's avatar
POTTIER Francois committed
359
let stdlib_filename =
360 361 362 363 364 365 366 367 368
  !stdlib_path ^ "/standard.mly"

let filenames =
  StringSet.elements !filenames

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

POTTIER Francois's avatar
POTTIER Francois committed
379
let filenames =
380 381
  if !no_stdlib || !coq then
    filenames
POTTIER Francois's avatar
POTTIER Francois committed
382
  else
383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405
    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

406 407 408 409 410
let () =
  if !recovery then begin
    fprintf stderr "Error: --error-recovery mode is no longer supported.\n";
    exit 1
  end
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450

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

POTTIER Francois's avatar
POTTIER Francois committed
451 452 453
let interpret_error =
  !interpret_error

POTTIER Francois's avatar
POTTIER Francois committed
454
let table =
455 456
  !table

457 458 459 460 461 462 463 464 465
let inspection =
  !inspection

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

POTTIER Francois's avatar
POTTIER Francois committed
466
let coq =
467 468 469 470 471 472 473 474 475 476 477
  !coq

let coq_no_complete =
  !coq_no_complete

let coq_no_actions =
  !coq_no_actions

let strict =
  !strict

478 479 480
let fixedexc =
  !fixedexc

481 482 483 484 485
let ignored_unused_tokens =
  !ignored_unused_tokens

let ignore_all_unused_tokens =
  !ignore_all_unused_tokens
486

POTTIER Francois's avatar
POTTIER Francois committed
487 488
let list_errors =
  !list_errors
489 490 491

let compile_errors =
  !compile_errors
492 493 494 495 496 497 498 499 500 501 502 503 504

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

505 506 507
let update_errors =
  !update_errors

POTTIER Francois's avatar
POTTIER Francois committed
508 509
let echo_errors =
  !echo_errors
510 511 512

let cmly =
  !cmly