interpret.ml 26.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15 16 17
module I = Invariant (* artificial dependency; ensures that [Invariant] runs first *)

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

18
open Grammar
19 20
open SentenceParserAux

21 22 23 24 25
(* A delimiter. *)

type delimiter =
  string

26
(* An error message. *)
27

28 29
type message =
  string
30

31 32 33
(* A run is a series of sentences or comments,
   followed with a delimiter (at least one blank line; comments),
   followed with an error message. *)
34 35

type run =
36 37 38
  located_sentence or_comment list *
  delimiter *
  message
39

40 41 42 43 44 45 46 47 48
(* A targeted sentence is a located sentence together with the target into
   which it leads. A target tells us which state a sentence leads to, as well
   as which spurious reductions are performed at the end. *)

type target =
  ReferenceInterpreter.target

let target2state (s, _spurious) =
  s
49

50
type maybe_targeted_sentence =
51
  located_sentence * target option
52

53
type targeted_sentence =
54
  located_sentence * target
55 56 57

(* A targeted run is a series of targeted sentences or comments together with
   an error message. *)
58

59
type maybe_targeted_run =
60 61 62
  maybe_targeted_sentence or_comment list *
  delimiter *
  message
63

64
type targeted_run =
65 66 67
  targeted_sentence or_comment list *
  delimiter *
  message
68 69 70 71 72

(* A filtered targeted run is a series of targeted sentences together with an
   error message. (The comments have been filtered out.) *)

type filtered_targeted_run =
73 74
  targeted_sentence list *
  message
75 76

(* --------------------------------------------------------------------------- *)
POTTIER Francois's avatar
POTTIER Francois committed
77

78
(* Display and debugging. *)
79 80 81 82

let print_sentence (nto, terminals) : string =
  let b = Buffer.create 128 in
  Option.iter (fun nt ->
83
    Printf.bprintf b "%s: " (Nonterminal.print false nt)
84 85 86 87 88 89 90
  ) nto;
  List.iter (fun t ->
    Printf.bprintf b "%s " (Terminal.print t)
  ) terminals;
  Printf.bprintf b "\n";
  Buffer.contents b

91 92 93 94 95 96 97 98 99 100 101 102 103 104
(* --------------------------------------------------------------------------- *)

(* [stream] turns a finite list of terminals into a stream of terminals. *)

exception EndOfStream

let stream (toks : Terminal.t list) : unit -> Terminal.t * Lexing.position * Lexing.position =
  let toks = ref toks in
  fun () ->

    let tok =
      match !toks with
      | tok :: more ->

105
          (* Take a token off the list, and return it. *)
106

107 108
          toks := more;
          tok
109 110 111

      | [] ->

112 113
          (* The finite list has been exhausted. Here, two plausible behaviors
             come to mind.
114

115 116 117
             The first behavior consists in raising an exception. In that case,
             we are creating a finite stream, and it is up to the parser to not
             read past its end.
118

119 120 121
             The second behavior consists in returning a designated token. In
             that case, we are creating an infinite, eventually constant,
             stream.
122

123 124 125 126 127 128
             The choice between these two behaviors is somewhat arbitrary;
             furthermore, in the second case, the choice of the designated
             token is arbitrary as well. Here, we adopt the second behavior if
             and only if the grammar has an EOF token, and we use EOF as the
             designated token. Again, this is arbitrary, and could be changed
             in the future. *)
129

130 131 132 133 134
          match Terminal.eof with
          | Some eof ->
              eof
          | None ->
              raise EndOfStream
135 136 137 138 139 140 141 142 143

    in

    (* For now, return dummy positions. *)

    tok, Lexing.dummy_pos, Lexing.dummy_pos

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

144 145 146 147 148 149 150
(* [start sentence] returns the start symbol that we should use to interpret
   the sentence [sentence]. *)

(* If a start symbol was explicitly provided as part of the sentence, we use
   it. Otherwise, we use the grammar's unique start symbol, if there is
   one. *)

151
let start poss ((nto, _) : sentence) : Nonterminal.t =
152 153 154 155 156 157
  match nto with
  | Some nt ->
      nt
  | None ->
      match ProductionMap.is_singleton Lr1.entry with
      | None ->
158
          Error.error poss
159
            "because the grammar has multiple start symbols, each of the\n\
160 161 162 163 164 165 166 167
             sentences provided on the standard input channel must be of the\n\
             form: <start symbol>: <token>*"
      | Some (prod, _) ->
          match Production.classify prod with
          | Some nt ->
              nt
          | None ->
              assert false
168

169
(* --------------------------------------------------------------------------- *)
170

171
(* [interpret] interprets a sentence. *)
172

173
let interpret ((_, toks) as sentence) : unit =
174

175
  let nt = start [] sentence in
176 177 178 179 180 181 182 183 184 185 186 187

  (* Run the reference interpreter. This can produce a concrete syntax tree
     ([Some cst]), fail with a parser error ([None]), or fail with a lexer error
     ([EndOfStream]). *)

  (* In either case, we produce just one line of output, so it should be clear
     to the user which outcomes correspond to which sentences (should multiple
     sentences be supplied). *)

  begin try
    match
      MenhirLib.Convert.Simplified.traditional2revised
188 189
        (ReferenceInterpreter.interpret Settings.trace nt)
        (stream toks)
190 191 192 193
    with

    | Some cst ->

194
        (* Success. *)
195

196 197 198 199 200
        Printf.printf "ACCEPT";
        if Settings.interpret_show_cst then begin
          print_newline();
          Cst.show stdout cst
        end
201 202 203

    | None ->

204
        (* Parser failure. *)
205

206
        Printf.printf "REJECT"
207 208 209 210

  with EndOfStream ->

    (* Lexer failure. *)
211

212 213 214 215 216 217 218
    Printf.printf "OVERSHOOT"

  end;
  print_newline()

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

219 220
(* [interpret_error_aux] interprets a sentence, expecting it to end in an
   error. Failure or success is reported via two continuations. *)
221

222
let interpret_error_aux log poss ((_, terminals) as sentence) fail succeed =
223
  let nt = start poss sentence in
224
  let open ReferenceInterpreter in
225
  match check_error_path log nt terminals with
226
  | OInputReadPastEnd ->
227
      fail "no syntax error occurs."
228
  | OInputNotFullyConsumed ->
229
      fail "a syntax error occurs before the last token is reached."
230
  | OUnexpectedAccept ->
231
      fail "no syntax error occurs; in fact, this input is accepted."
232 233
  | OK target ->
      succeed nt terminals target
234 235 236 237 238 239 240 241 242 243

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

(* This default error message is produced by [--list-errors] when it creates a
   [.messages] file, and is recognized by [--compare-errors] when it compares
   two such files. *)

let default_message =
  "<YOUR SYNTAX ERROR MESSAGE HERE>\n"

244
(* [print_messages_auto] displays just the sentence and the auto-generated
245
   comments. [otarget] may be [None], in which case the auto-generated comment
246 247
   is just a warning that this sentence does not end in an error. *)

248
let print_messages_auto (nt, sentence, otarget) : unit =
249 250
  (* Print the sentence, followed with auto-generated comments. *)
  print_string (print_sentence (Some nt, sentence));
251
  match (otarget : target option) with
252 253 254 255 256 257
  | None ->
      Printf.printf
        "##\n\
         ## WARNING: This sentence does NOT end with a syntax error, as it should.\n\
         ##\n"
  | Some (s', spurious) ->
258
      Printf.printf
259 260 261 262
        "##\n\
         ## Ends in an error in state: %d.\n\
         ##\n\
         %s##\n"
263 264 265 266
        (Lr1.number s')
        (* [Lr0.print] or [Lr0.print_closure] could be used here. The latter
           could sometimes be helpful, but is usually intolerably verbose. *)
        (Lr0.print "## " (Lr1.state s'))
267
      ;
268 269 270 271 272 273
      Printf.printf
        "## The known suffix of the stack is as follows:\n\
         ## %s\n\
         ##\n"
        (Invariant.print (Invariant.stack s'))
      ;
274 275 276 277 278 279 280
      if spurious <> [] then begin
        Printf.printf
          "## WARNING: This example involves spurious reductions.\n\
           ## This implies that, although the LR(1) items shown above provide an\n\
           ## accurate view of the past (what has been recognized so far), they\n\
           ## may provide an INCOMPLETE view of the future (what was expected next).\n"
        ;
281
        List.iter (fun (s, prod) ->
282
          Printf.printf
283 284
            "## In state %d, spurious reduction of production %s\n"
            (Lr1.number s)
285 286 287 288
            (Production.print prod)
        ) spurious;
        Printf.printf "##\n"
      end
289

290
(* [print_messages_item] displays one data item. The item is of the form [nt,
291 292 293 294
   sentence, target], which means that beginning at the start symbol [nt], the
   sentence [sentence] ends in an error in the target state given by [target].
   [target] also contains information about which spurious reductions are
   performed at the end. The display obeys the [.messages] file format. *)
295

296
let print_messages_item (nt, sentence, target) : unit =
297
  (* Print the sentence, followed with auto-generated comments. *)
298
  print_messages_auto (nt, sentence, Some target);
299 300 301 302 303
  (* Then, print a proposed error message, between two blank lines. *)
  Printf.printf "\n%s\n" default_message

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

304 305 306 307 308
(* [write_run run] writes a run into a new [.messages] file. Manually-written
   comments are preserved. New auto-generated comments are produced. *)

let write_run : maybe_targeted_run or_comment -> unit =
  function
309
  | Thing (sentences_or_comments, delimiter, message) ->
310 311 312 313 314 315 316 317 318 319
      (* First, print every sentence and human comment. *)
      List.iter (fun sentence_or_comment ->
        match sentence_or_comment with
        | Thing ((poss, ((_, toks) as sentence)), target) ->
            let nt = start poss sentence in
            (* Every sentence is followed with newly generated auto-comments. *)
            print_messages_auto (nt, toks, target)
        | Comment c ->
            print_string c
      ) sentences_or_comments;
320 321 322 323 324 325 326
      (* Then, print the delimiter, which must begin with a blank line
         and may include comments. *)
      print_string delimiter;
      (* Then, print the error message. *)
      print_string message
      (* No need for another blank line. It will be printed as part of a
         separate [Comment]. *)
327
  | Comment comments ->
328
      (* Must begin with a blank line. *)
329
      print_string comments
330

331
(* --------------------------------------------------------------------------- *)
332

333 334 335 336 337
(* [interpret_error] interprets a sentence, expecting it to end in an error.
   Failure or success is reported on the standard output channel. This is
   used by [--interpret-error]. *)

let fail msg =
338
  Error.error [] "%s" msg
339

340 341
let succeed nt terminals target =
  print_messages_item (nt, terminals, target);
342 343 344
  exit 0

let interpret_error sentence =
345
  interpret_error_aux Settings.trace [] sentence fail succeed
346 347 348

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

349 350 351 352
(* [target_sentence] interprets a (located) sentence, expecting it to end in
   an error, computes the state in which the error is obtained, and constructs
   a targeted sentence. *)

353 354 355
let target_sentence
    (signal : Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a)
  : located_sentence -> maybe_targeted_sentence =
356
  fun (poss, sentence) ->
357
    (poss, sentence),
358
    interpret_error_aux false poss sentence
359 360
      (* failure: *)
      (fun msg ->
361 362
        signal poss
          "this sentence does not end with a syntax error, as it should.\n%s"
363
          msg
364
        ;
365 366 367
        None
      )
      (* success: *)
368
      (fun _nt _terminals target -> Some target)
369 370

let target_run_1 signal : run -> maybe_targeted_run =
371 372 373 374
  fun (sentences, delimiter, message) ->
    List.map (or_comment_map (target_sentence signal)) sentences,
    delimiter,
    message
375

376
let target_run_2 : maybe_targeted_run -> targeted_run =
377
  fun (sentences, delimiter, message) ->
378
    let aux (x, y) = (x, Misc.unSome y) in
379 380 381
    List.map (or_comment_map aux) sentences,
    delimiter,
    message
382 383 384

let target_runs : run list -> targeted_run list =
  fun runs ->
385
    (* Interpret all sentences, possibly displaying multiple errors. *)
386
    let runs = List.map (target_run_1 Error.signal) runs in
387
    (* Abort if an error occurred. *)
388
    if Error.errors() then exit 1;
389 390
    (* Remove the options introduced by the first phase above. *)
    let runs = List.map target_run_2 runs in
391
    runs
392

393
(* --------------------------------------------------------------------------- *)
394

395 396 397 398 399 400
(* [filter_things] filters out the comments in a list of things or comments. *)

let filter_things : 'a or_comment list -> 'a list =
  fun things -> List.flatten (List.map unThing things)

(* [filter_run] filters out the comments within a run. *)
401 402

let filter_run : targeted_run -> filtered_targeted_run =
403
  fun (sentences, _, message) ->
404
    filter_things sentences, message
405 406 407

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

408 409
(* [setup()] returns a function [read] which reads one sentence from the
   standard input channel. *)
410

411
let setup () : unit -> sentence option =
412

413 414 415
  let open Lexing in
  let lexbuf = from_channel stdin in
  lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = "(stdin)" };
416

417 418
  let read () =
    try
419
      SentenceParser.optional_sentence SentenceLexer.lex lexbuf
420
    with Parsing.Parse_error ->
421
      Error.error (Positions.lexbuf lexbuf) "ill-formed input sentence."
422
  in
423

424 425 426 427 428 429
  read

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

(* If [--interpret] is set, interpret the sentences found on the standard
   input channel, then stop, without generating a parser. *)
430

431 432 433 434 435 436 437
(* We read a series of sentences from the standard input channel. To allow
   interactive use, we interpret each sentence as soon as it is read. *)

let () =
  if Settings.interpret then
    let read = setup() in
    while true do
438 439
      match read() with
      | None ->
440
          exit 0
441
      | Some sentence ->
442
          interpret sentence
443
    done
444

445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
(* --------------------------------------------------------------------------- *)

(* If [--interpret-error] is set, interpret one sentence found on the standard
   input channel, then stop, without generating a parser. *)

(* We read just one sentence, confirm that this sentence ends in an error, and
   (if that is the case) display the number of the state that is reached. *)

let () =
  if Settings.interpret_error then
    let read = setup() in
    match read() with
    | None ->
      exit 1 (* abnormal: no input *)
    | Some sentence ->
        interpret_error sentence (* never returns *)
461

462 463
(* --------------------------------------------------------------------------- *)

464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488
(* Display an informational message about the contents of a [.messages] file.  *)

let stats (runs : run or_comment list) =
  (* [s] counts the sample input sentences. [m] counts the error messages. *)
  let s = ref 0
  and m = ref 0 in
  List.iter (function
  | Thing (sentences, _, _) ->
      incr m;
      List.iter (function
      | Thing _ ->
          incr s
      | Comment _ ->
          ()
      ) sentences
  | Comment _ ->
      ()
  ) runs;
  Printf.eprintf
    "Read %d sample input sentences and %d error messages.\n%!"
    !s !m;
  runs

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

489 490
(* Reading a [.messages] file. *)

491 492 493 494 495 496
(* Our life is slightly complicated by the fact that the whitespace between
   two runs can contain comments, which we wish to preserve when performing
   [--update-errors]. *)

let read_messages filename : run or_comment list =
  let open Segment in
497
  (* Read and segment the file. *)
498
  let segments : (tag * string * Lexing.lexbuf) list = segment filename in
499 500 501 502 503 504 505
  (* Process the segments, two by two. We expect one segment to contain
     a non-empty series of sentences, and the next segment to contain
     free-form text. *)
  let rec loop accu segments =
    match segments with
    | [] ->
        List.rev accu
506 507 508
    | (Whitespace, comments, _) :: segments ->
         loop (Comment comments :: accu) segments
    | (Segment, _, lexbuf) :: segments ->
509
        (* Read a series of located sentences. *)
510 511
        match SentenceParser.entry SentenceLexer.lex lexbuf with
        | exception Parsing.Parse_error ->
512
            Error.error
POTTIER Francois's avatar
POTTIER Francois committed
513
              [Positions.cpos lexbuf]
514
              "ill-formed sentence."
515
        | sentences ->
516 517 518
            (* In principle, we should now find a segment of whitespace
               followed with a segment of text. By construction, the two
               kinds of segments alternate. *)
519
            match segments with
520 521
            | (Whitespace, comments, _) ::
              (Segment, message, _) ::
522
              segments ->
523 524
                let run : run = sentences, comments, message in
                loop (Thing run :: accu) segments
525 526 527 528
            | []
            | [ _ ] ->
                Error.error
                  (Positions.one (Lexing.lexeme_end_p lexbuf))
529
                  "missing a final message. I may be desynchronized."
530 531 532 533 534
            | (Segment, _, _) :: _
            | (Whitespace, _, _) :: (Whitespace, _, _) :: _ ->
                (* Should not happen, thanks to the alternation between the
                   two kinds of segments. *)
                assert false
535
  in
536
  stats (loop [] segments)
537 538 539

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

540
(* [message_table] converts a list of targeted runs to a table (a mapping) of
541 542
   states to located sentences and messages. Optionally, it can detect that
   two sentences lead to the same state, and report an error. *)
543

544
let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
545
  : (located_sentence * message) Lr1.NodeMap.t =
546 547

  let table =
548
    List.fold_left (fun table (sentences_and_states, message) ->
549 550
      List.fold_left (fun table (sentence2, target) ->
        let s = target2state target in
551
        match Lr1.NodeMap.find s table with
552
        | sentence1, _ ->
553 554
            if detect_redundancy then
              Error.signal (fst sentence1 @ fst sentence2)
555 556
                   "these sentences both cause an error in state %d."
                   (Lr1.number s);
557 558
            table
        | exception Not_found ->
559
            Lr1.NodeMap.add s (sentence2, message) table
560 561 562 563 564 565 566 567 568 569 570 571
      ) table sentences_and_states
    ) Lr1.NodeMap.empty runs
  in
  if Error.errors() then exit 1;
  table

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

(* [compile_runs] converts a list of targeted runs to OCaml code that encodes
   a mapping of state numbers to error messages. The code is sent to the
   standard output channel. *)

572
let compile_runs filename (runs : filtered_targeted_run list) : unit =
573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589

  (* We wish to produce a function that maps a state number to a message.
     By convention, we call this function [message]. *)

  let name = "message" in

  let open IL in
  let open CodeBits in
  let default = {
    branchpat  = PWildcard;
    branchbody = eraisenotfound
  (* The default branch raises an exception, which can be caught by
     the user, who can then produce a generic error message. *)
  } in
  let branches =
    List.fold_left (fun branches (sentences_and_states, message) ->
      (* Create an or-pattern for these states. *)
590 591
      let states = List.map (fun (_, target) ->
        let s = target2state target in
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
        pint (Lr1.number s)
      ) sentences_and_states in
      (* Map all these states to this message. *)
      { branchpat = POr states;
        branchbody = EStringConst message } :: branches
    ) [ default ] runs
  in
  let messagedef = {
    valpublic = true;
    valpat = PVar name;
    valval = EFun ([ PVar "s" ], EMatch (EVar "s", branches))
  } in
  let program = [
    SIComment (Printf.sprintf
      "This file was auto-generated based on \"%s\"." filename);
    SIComment (Printf.sprintf
      "Please note that the function [%s] can raise [Not_found]." name);
    SIValDefs (false,
      [ messagedef ]);
  ] in

  (* Write this program to the standard output channel. *)

  let module P = Printer.Make (struct
    let f = stdout
    let locate_stretches = None
  end) in
  P.program program

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

623 624 625 626 627
(* If [--compile-errors <filename>] is set, compile the error message
   descriptions found in file [filename] down to OCaml code, then stop. *)

let () =
  Settings.compile_errors |> Option.iter (fun filename ->
628

629
    (* Read the file. *)
630 631 632
    let runs : run or_comment list = read_messages filename in
    (* Drop the comments in between two runs. *)
    let runs : run list = filter_things runs in
633

634 635
    (* Convert every sentence to a state number. We signal an error if a
       sentence does not end in an error, as expected. *)
636
    let runs : targeted_run list = target_runs runs in
637

638 639
    (* Remove comments within the runs. *)
    let runs : filtered_targeted_run list = List.map filter_run runs in
640

641 642
    (* Build a mapping of states to located sentences. This allows us to
       detect if two sentences lead to the same state. *)
643
    let _ = message_table true runs in
644

645 646 647 648 649 650
    (* In principle, we would like to check whether this set of sentences is
       complete (i.e., covers all states where an error can arise), but this
       may be costly -- it requires running [LRijkstra]. Instead, we offer a
       separate facility for comparing two [.messages] files, one of which can
       be produced via [--list-errors]. This can be used to ensure
       completeness. *)
POTTIER Francois's avatar
POTTIER Francois committed
651

652 653 654
    (* Now, compile this information down to OCaml code. We wish to
       produce a function that maps a state number to a message. By
       convention, we call this function [message]. *)
655
    compile_runs filename runs;
656

657 658 659
    exit 0
  )

660 661 662 663 664 665 666 667 668 669 670 671 672
(* --------------------------------------------------------------------------- *)

(* If two [--compare-errors <filename>] directives are provided, compare the
   two message descriptions files, and stop. We wish to make sure that every
   state that appears on the left-hand side appears on the right-hand side as
   well. *)

let () =
  Settings.compare_errors |> Option.iter (fun (filename1, filename2) ->

    (* Read and convert both files, as above. *)
    let runs1 = read_messages filename1
    and runs2 = read_messages filename2 in
673 674
    let runs1 = filter_things runs1
    and runs2 = filter_things runs2 in
675 676
    let runs1 = target_runs runs1
    and runs2 = target_runs runs2 in (* here, it would be OK to ignore errors *)
677 678
    let runs1 = List.map filter_run runs1
    and runs2 = List.map filter_run runs2 in
679 680
    let table1 = message_table false runs1
    and table2 = message_table false runs2 in
681

682 683 684
    (* Check that the domain of [table1] is a subset of the domain of [table2]. *)
    table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) ->
      if not (Lr1.NodeMap.mem s table2) then
685 686
        Error.signal poss1
          "this sentence leads to an error in state %d.\n\
687 688 689 690 691 692
           No sentence that leads to this state exists in \"%s\"."
          (Lr1.number s) filename2
    );

    (* Check that [table1] is a subset of [table2], that is, for every state
       [s] in the domain of [table1], [s] is mapped by [table1] and [table2]
693 694 695 696 697
       to the same error message. As an exception, if the message found in
       [table1] is the default message, then no comparison takes place. This
       allows using [--list-errors] and [--compare-errors] in conjunction to
       ensure that a [.messages] file is complete, without seeing warnings
       about different messages. *)
698
    table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), message1) ->
699 700 701 702
      if message1 <> default_message then
        try
          let (poss2, _), message2 = Lr1.NodeMap.find s table2 in
          if message1 <> message2 then
703 704
            Error.warning (poss1 @ poss2)
              "these sentences lead to an error in state %d.\n\
705 706 707 708
               The corresponding messages in \"%s\" and \"%s\" differ."
              (Lr1.number s) filename1 filename2
        with Not_found ->
          ()
709 710 711 712 713 714 715
    );

    if Error.errors() then exit 1;
    exit 0

  )

716 717 718 719 720 721 722 723 724 725 726
(* --------------------------------------------------------------------------- *)

(* If [--update-errors <filename>] is set, update the error message
   descriptions found in file [filename]. The idea is to re-generate
   the auto-comments, which are marked with ##, while leaving the
   rest untouched. *)

let () =
  Settings.update_errors |> Option.iter (fun filename ->

    (* Read the file. *)
727
    let runs : run or_comment list = read_messages filename in
728 729 730

    (* Convert every sentence to a state number. Warn, but do not
       fail, if a sentence does not end in an error, as it should. *)
731 732 733
    let runs : maybe_targeted_run or_comment list =
      List.map (or_comment_map (target_run_1 Error.warning)) runs
    in
734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750

    (* We might wish to detect if two sentences lead to the same state. We
       might also wish to detect if this set of sentences is incomplete,
       and complete it automatically. However, the first task is carried
       out by [--compile-errors] already, and the second task is carried
       out by [--list-errors] and [--compare-errors] together. For now,
       let's try and keep things as simple as possible. The task of
       [--update-errors] should be to update the auto-generated comments,
       without failing, and without adding or removing sentences. *)

    (* Now, write a new [.messages] to the standard output channel, with
       new auto-generated comments. *)
    List.iter write_run runs;

    exit 0
  )

POTTIER Francois's avatar
POTTIER Francois committed
751 752 753 754 755
(* --------------------------------------------------------------------------- *)

(* If [--echo-errors <filename>] is set, echo the error sentences found in file
   [filename]. Do not echo the error messages or the comments. *)

POTTIER Francois's avatar
POTTIER Francois committed
756 757 758 759 760
(* In principle, we should able to run this command without even giving an .mly
   file name on the command line, and without building the automaton. This is
   not possible at the moment, because our code is organized in too rigid a
   manner. *)

POTTIER Francois's avatar
POTTIER Francois committed
761 762 763 764 765 766 767 768 769 770 771 772
let () =
  Settings.echo_errors |> Option.iter (fun filename ->

    (* Read the file. *)
    let runs : run or_comment list = read_messages filename in

    (* Echo. *)
    List.iter (or_comment_iter (fun run ->
      let (sentences : located_sentence or_comment list), _, _ = run in
      List.iter (or_comment_iter (fun (_, sentence) ->
        print_string (print_sentence sentence)
      )) sentences
POTTIER Francois's avatar
POTTIER Francois committed
773
    )) runs;
POTTIER Francois's avatar
POTTIER Francois committed
774

POTTIER Francois's avatar
POTTIER Francois committed
775
    exit 0
POTTIER Francois's avatar
POTTIER Francois committed
776 777
  )