error.ml 2.67 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 68 69 70 71 72 73 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
open Printf

(* TEMPORARY Vrifier que les messages d'erreur sont standardiss au
   maximum, localiss au maximum. Supprimer autant de fonctions que
   possible dans ce module. *)

(* TEMPORARY reprendre compl`etement implementation et interface
   de ce module *)

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

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

let printN positions message = 
  List.iter (fun position -> 
    fprintf stderr "%s:\n" (Positions.string_of_pos position)
  ) positions;
  fprintf stderr "%s\n%!" message

let error_message message =
  "Error: " ^ message

let error positions message =
  printN positions (error_message message);
  exit 1

let errorp v message =
  error [ Positions.position v ] message

let signal positions message =
  printN positions message;
  errors := true

let warning positions message =
  printN positions (Printf.sprintf "Warning: %s" message)

let errors () =
  !errors

(* Certain warnings about the grammar can optionally be treated as errors.
   The following function emits a warning or error message, via [warning] or
   [signal]. It does not stop the program; the client must at some point call
   [errors] and stop the program if any errors have been reported. *)

let grammar_warning positions message =
  if Settings.strict then
    signal positions (error_message message)
  else
    warning positions message