error.ml 2.1 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 31 32 33 34 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
open Printf

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

(* Global state. *)

let get_initialized_ref ref =
  match !ref with
  | None ->
      assert false
  | Some contents ->
      contents

let filename =
  ref (None : string option)

let filemark =
  ref Mark.none

(* 2011/10/19: do not use [Filename.basename]. The [#] annotations that
   we insert in the [.ml] file must retain their full path. This does
   mean that the [#] annotations depend on how menhir is invoked -- e.g.
   [menhir foo/bar.mly] and [cd foo && menhir bar.mly] will produce
   different files. Nevertheless, this seems useful/reasonable. *)

(* This also influences the type error messages produced by [--infer]. *)

let set_filename name =
  filename := Some name;
  filemark := Mark.fresh()

let get_filename () =
  get_initialized_ref filename

let get_filemark () =
  !filemark

let file_contents =
  ref (None : string option)

let get_file_contents () =
  get_initialized_ref file_contents

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

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

68
let display continuation header positions format =
69 70
  List.iter (fun position -> 
    fprintf stderr "%s:\n" (Positions.string_of_pos position)
71
  ) positions;
72
  Printf.kfprintf
73
    continuation
74
    stderr
75
    (header ^^ format ^^ "\n%!")
76

77 78 79 80 81
let error positions format =
  display
    (fun _ -> exit 1)
    "Error: "
    positions format 
82

83 84 85 86 87
let signal positions format =
  display
    (fun _ -> errors := true)
    "Error: "
    positions format 
88

89 90 91 92 93
let warning positions format =
  display
    (fun _ -> ())
    "Warning: "
    positions format 
94 95 96 97

let errors () =
  !errors

98 99
let errorp v =
  error [ Positions.position v ]
100

101 102
let grammar_warning =
  if Settings.strict then signal else warning
103