interpret.ml 27.3 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
module I = Invariant (* artificial dependency *)
module D = Default   (* artificial dependency *)
16 17 18

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

19
open Grammar
20 21
open SentenceParserAux

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

type delimiter =
  string

27
(* An error message. *)
28

29 30
type message =
  string
31

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

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

41 42 43 44 45 46 47 48 49
(* 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
50

51
type maybe_targeted_sentence =
52
  located_sentence * target option
53

54
type targeted_sentence =
55
  located_sentence * target
56 57 58

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

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

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

(* 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 =
74 75
  targeted_sentence list *
  message
76 77

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

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

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

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

(* [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 ->

107
          (* Take a token off the list, and return it. *)
108

109 110
          toks := more;
          tok
111 112 113

      | [] ->

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

117 118 119
             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.
120

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

125 126 127 128 129 130
             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. *)
131

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

    in

    (* For now, return dummy positions. *)

    tok, Lexing.dummy_pos, Lexing.dummy_pos

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

146 147 148 149 150 151 152
(* [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. *)

153
let start poss ((nto, _) : sentence) : Nonterminal.t =
154 155 156 157 158 159
  match nto with
  | Some nt ->
      nt
  | None ->
      match ProductionMap.is_singleton Lr1.entry with
      | None ->
160
          Error.error poss
161
            "because the grammar has multiple start symbols, each of the\n\
162 163 164 165 166 167 168 169
             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
170

171
(* --------------------------------------------------------------------------- *)
172

173
(* [interpret] interprets a sentence. *)
174

175
let interpret ((_, toks) as sentence) : unit =
176

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

  (* 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
190 191
        (ReferenceInterpreter.interpret Settings.trace nt)
        (stream toks)
192 193 194 195
    with

    | Some cst ->

196
        (* Success. *)
197

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

    | None ->

206
        (* Parser failure. *)
207

208
        Printf.printf "REJECT"
209 210 211 212

  with EndOfStream ->

    (* Lexer failure. *)
213

214 215 216 217 218 219 220
    Printf.printf "OVERSHOOT"

  end;
  print_newline()

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

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

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

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

(* 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"

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

250
let print_messages_auto (nt, sentence, otarget) : unit =
251 252
  (* Print the sentence, followed with auto-generated comments. *)
  print_string (print_sentence (Some nt, sentence));
253
  match (otarget : target option) with
254 255 256 257 258 259
  | None ->
      Printf.printf
        "##\n\
         ## WARNING: This sentence does NOT end with a syntax error, as it should.\n\
         ##\n"
  | Some (s', spurious) ->
260
      Printf.printf
261 262 263 264
        "##\n\
         ## Ends in an error in state: %d.\n\
         ##\n\
         %s##\n"
265 266 267 268
        (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'))
269
      ;
270 271
      Printf.printf
        "## The known suffix of the stack is as follows:\n\
272
         ##%s\n\
273 274 275
         ##\n"
        (Invariant.print (Invariant.stack s'))
      ;
276 277 278 279 280 281 282
      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"
        ;
283
        List.iter (fun (s, prod) ->
284
          Printf.printf
285 286
            "## In state %d, spurious reduction of production %s\n"
            (Lr1.number s)
287 288 289 290
            (Production.print prod)
        ) spurious;
        Printf.printf "##\n"
      end
291

292
(* [print_messages_item] displays one data item. The item is of the form [nt,
293 294 295 296
   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. *)
297

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

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

306 307 308 309 310
(* [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
311
  | Thing (sentences_or_comments, delimiter, message) ->
312 313 314 315 316 317 318 319 320 321
      (* 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;
322 323 324 325 326 327 328
      (* 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]. *)
329
  | Comment comments ->
330
      (* Must begin with a blank line. *)
331
      print_string comments
332

333
(* --------------------------------------------------------------------------- *)
334

335 336 337 338 339
(* [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 =
340
  Error.error [] "%s" msg
341

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

let interpret_error sentence =
347
  interpret_error_aux Settings.trace [] sentence fail succeed
348 349 350

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

351 352 353 354
(* [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. *)

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

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

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

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

397
(* --------------------------------------------------------------------------- *)
398

399 400 401 402 403 404
(* [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. *)
405 406

let filter_run : targeted_run -> filtered_targeted_run =
407
  fun (sentences, _, message) ->
408
    filter_things sentences, message
409 410 411

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

412 413
(* [setup()] returns a function [read] which reads one sentence from the
   standard input channel. *)
414

415
let setup () : unit -> sentence option =
416

417 418 419
  let open Lexing in
  let lexbuf = from_channel stdin in
  lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = "(stdin)" };
420

421 422
  let read () =
    try
423
      SentenceParser.optional_sentence SentenceLexer.lex lexbuf
424
    with Parsing.Parse_error ->
425
      Error.error (Positions.lexbuf lexbuf) "ill-formed input sentence."
426
  in
427

428 429 430 431
  read

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

432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456
(* 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

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

457 458
(* Reading a [.messages] file. *)

459 460 461 462 463 464
(* 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
465
  (* Read and segment the file. *)
466
  let segments : (tag * string * Lexing.lexbuf) list = segment filename in
467 468 469 470 471 472 473
  (* 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
474 475 476
    | (Whitespace, comments, _) :: segments ->
         loop (Comment comments :: accu) segments
    | (Segment, _, lexbuf) :: segments ->
477
        (* Read a series of located sentences. *)
478 479
        match SentenceParser.entry SentenceLexer.lex lexbuf with
        | exception Parsing.Parse_error ->
480
            Error.error
POTTIER Francois's avatar
POTTIER Francois committed
481
              [Positions.cpos lexbuf]
482
              "ill-formed sentence."
483
        | sentences ->
484 485 486
            (* In principle, we should now find a segment of whitespace
               followed with a segment of text. By construction, the two
               kinds of segments alternate. *)
487
            match segments with
488 489
            | (Whitespace, comments, _) ::
              (Segment, message, _) ::
490
              segments ->
491 492
                let run : run = sentences, comments, message in
                loop (Thing run :: accu) segments
493 494 495 496
            | []
            | [ _ ] ->
                Error.error
                  (Positions.one (Lexing.lexeme_end_p lexbuf))
497
                  "missing a final message. I may be desynchronized."
498 499 500 501 502
            | (Segment, _, _) :: _
            | (Whitespace, _, _) :: (Whitespace, _, _) :: _ ->
                (* Should not happen, thanks to the alternation between the
                   two kinds of segments. *)
                assert false
503
  in
504
  stats (loop [] segments)
505 506 507

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

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

512
let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
513
  : (located_sentence * message) Lr1.NodeMap.t =
514

515
  let c = Error.new_category() in
516
  let table =
517
    List.fold_left (fun table (sentences_and_states, message) ->
518 519
      List.fold_left (fun table (sentence2, target) ->
        let s = target2state target in
520
        match Lr1.NodeMap.find s table with
521
        | sentence1, _ ->
522
            if detect_redundancy then
523
              Error.signal c (fst sentence1 @ fst sentence2)
524 525
                   "these sentences both cause an error in state %d."
                   (Lr1.number s);
526 527
            table
        | exception Not_found ->
528
            Lr1.NodeMap.add s (sentence2, message) table
529 530 531
      ) table sentences_and_states
    ) Lr1.NodeMap.empty runs
  in
532
  Error.exit_if c;
533 534 535 536 537 538 539 540
  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. *)

541
let compile_runs filename (runs : filtered_targeted_run list) : unit =
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558

  (* 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. *)
559 560
      let states = List.map (fun (_, target) ->
        let s = target2state target in
561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591
        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

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

592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607
(* The rest of this file is the function [run], internally written as a functor
   [Run] for syntactic convenience. *)

module Run (X : sig end) = struct

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

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

(* 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
608
    Printf.printf "Ready!\n%!";
609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635
    while true do
      match read() with
      | None ->
          exit 0
      | Some sentence ->
          interpret sentence
    done

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

(* 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 *)

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

636 637 638 639 640
(* 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 ->
641

642
    (* Read the file. *)
643 644 645
    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
646

647 648
    (* Convert every sentence to a state number. We signal an error if a
       sentence does not end in an error, as expected. *)
649
    let runs : targeted_run list = target_runs runs in
650

651 652
    (* Remove comments within the runs. *)
    let runs : filtered_targeted_run list = List.map filter_run runs in
653

654 655
    (* Build a mapping of states to located sentences. This allows us to
       detect if two sentences lead to the same state. *)
656
    let _ = message_table true runs in
657

658 659 660 661 662 663
    (* 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
664

665 666 667
    (* 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]. *)
668
    compile_runs filename runs;
669

670 671 672
    exit 0
  )

673 674 675 676 677 678 679 680 681 682 683 684 685
(* --------------------------------------------------------------------------- *)

(* 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
686 687
    let runs1 = filter_things runs1
    and runs2 = filter_things runs2 in
688 689
    let runs1 = target_runs runs1
    and runs2 = target_runs runs2 in (* here, it would be OK to ignore errors *)
690 691
    let runs1 = List.map filter_run runs1
    and runs2 = List.map filter_run runs2 in
692 693
    let table1 = message_table false runs1
    and table2 = message_table false runs2 in
694

695
    (* Check that the domain of [table1] is a subset of the domain of [table2]. *)
696
    let c = Error.new_category() in
697 698
    table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) ->
      if not (Lr1.NodeMap.mem s table2) then
699
        Error.signal c poss1
700
          "this sentence leads to an error in state %d.\n\
701 702 703 704 705 706
           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]
707 708 709 710 711
       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. *)
712
    table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), message1) ->
713 714 715 716
      if message1 <> default_message then
        try
          let (poss2, _), message2 = Lr1.NodeMap.find s table2 in
          if message1 <> message2 then
717 718
            Error.warning (poss1 @ poss2)
              "these sentences lead to an error in state %d.\n\
719 720 721 722
               The corresponding messages in \"%s\" and \"%s\" differ."
              (Lr1.number s) filename1 filename2
        with Not_found ->
          ()
723 724
    );

725
    Error.exit_if c;
726 727 728 729
    exit 0

  )

730 731 732 733 734 735 736 737 738 739 740
(* --------------------------------------------------------------------------- *)

(* 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. *)
741
    let runs : run or_comment list = read_messages filename in
742 743 744

    (* Convert every sentence to a state number. Warn, but do not
       fail, if a sentence does not end in an error, as it should. *)
745 746 747
    let runs : maybe_targeted_run or_comment list =
      List.map (or_comment_map (target_run_1 Error.warning)) runs
    in
748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764

    (* 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
765 766 767 768 769
(* --------------------------------------------------------------------------- *)

(* 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
770 771 772 773 774
(* 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
775 776 777 778 779 780 781 782 783 784 785 786
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
787
    )) runs;
POTTIER Francois's avatar
POTTIER Francois committed
788

POTTIER Francois's avatar
POTTIER Francois committed
789
    exit 0
POTTIER Francois's avatar
POTTIER Francois committed
790
  )
791 792 793 794 795 796 797 798 799 800

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

(* End of the functor [Run]. *)

end

let run () =
  let module R = Run(struct end) in
  ()