error.ml 2.06 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 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
open Printf

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

(* Logging and log levels. *)

let log kind verbosity msg =
  if kind >= verbosity then
    Printf.fprintf stderr "%t%!" msg

let logG =
  log Settings.logG

let logA =
  log Settings.logA

let logC =
  log Settings.logC

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

(* Errors and warnings. *)

let errors =
  ref false

40
let display continuation header positions format =
41
  List.iter (fun position ->
42
    fprintf stderr "%s:\n" (Positions.string_of_pos position)
43
  ) positions;
44
  Printf.kfprintf
45
    continuation
46
    stderr
47
    (header ^^ format ^^ "\n%!")
48

49 50 51 52
let error positions format =
  display
    (fun _ -> exit 1)
    "Error: "
53
    positions format
54

55 56 57 58
let signal positions format =
  display
    (fun _ -> errors := true)
    "Error: "
59
    positions format
60

61 62 63 64
let warning positions format =
  display
    (fun _ -> ())
    "Warning: "
65
    positions format
66 67 68 69

let errors () =
  !errors

70 71
let errorp v =
  error [ Positions.position v ]
72

73 74
let grammar_warning =
  if Settings.strict then signal else warning