Commit 08fcc5fa authored by POTTIER Francois's avatar POTTIER Francois

Clean up the interface of the module [Error].

parent 09459d22
......@@ -97,21 +97,28 @@ let errorp v =
(* Delayed error reports -- where multiple errors can be reported at once. *)
let errors =
type category =
bool ref
let new_category () =
ref false
let signal positions format =
let signal category positions format =
display
(fun _ -> errors := true)
(fun _ -> category := true)
"Error: "
positions format
let errors () =
!errors
let exit () =
if errors() then
let exit_if category =
if !category then
exit 1
let grammar_warning =
if Settings.strict then signal else warning
(* ---------------------------------------------------------------------------- *)
(* Certain warnings about the grammar can optionally be treated as errors. *)
let grammatical_error =
new_category()
let grammar_warning pos =
if Settings.strict then signal grammatical_error pos else warning pos
......@@ -43,23 +43,43 @@ val error: Positions.positions -> ('a, out_channel, unit, 'b) format4 -> 'a
val errorp: _ Positions.located -> ('a, out_channel, unit, 'b) format4 -> 'a
(* [signal] is like [error], except it does not exit immediately. It sets a
flag which can be tested using [errors]. *)
(* [warning] is like [error], except it does not exit. *)
val signal: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
val warning: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* ---------------------------------------------------------------------------- *)
(* [exit()] exits with exit code 1 if [signal] was previously called. Together,
[signal] and [exit] allow reporting multiple errors before aborting. *)
(* Delayed error reports -- where multiple errors can be reported at once. *)
val exit: unit -> unit
(* A category of errors. *)
(* [warning] is like [signal], except it does not set a flag. *)
type category
val warning: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* [new_category()] creates a new category of errors. *)
val new_category: unit -> category
(* [signal category] is like [error], except it does not exit immediately. It
records the fact that an error of this category has occurred. This can be
later detected by [exit_if category]. *)
val signal: category -> Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* [exit_if category] exits with exit code 1 if [signal category] was
previously called. Together, [signal] and [exit_if] allow reporting
multiple errors before aborting. *)
val exit_if: category -> unit
(* ---------------------------------------------------------------------------- *)
(* Certain warnings about the grammar can optionally be treated as errors. *)
val grammatical_error: category
(* 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. *)
(* [grammar_warning] emits a warning or error message, via either [warning] or
[signal grammatical_error]. It does not stop the program; the client must
at some point use [exit_if grammatical_error] and stop the program if any
errors have been reported. *)
val grammar_warning: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
......@@ -383,10 +383,12 @@ let target_run_2 : maybe_targeted_run -> targeted_run =
let target_runs : run list -> targeted_run list =
fun runs ->
let c = Error.new_category() in
let signal = Error.signal c in
(* Interpret all sentences, possibly displaying multiple errors. *)
let runs = List.map (target_run_1 Error.signal) runs in
let runs = List.map (target_run_1 signal) runs in
(* Abort if an error occurred. *)
Error.exit();
Error.exit_if c;
(* Remove the options introduced by the first phase above. *)
let runs = List.map target_run_2 runs in
runs
......@@ -509,6 +511,7 @@ let read_messages filename : run or_comment list =
let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
: (located_sentence * message) Lr1.NodeMap.t =
let c = Error.new_category() in
let table =
List.fold_left (fun table (sentences_and_states, message) ->
List.fold_left (fun table (sentence2, target) ->
......@@ -516,7 +519,7 @@ let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
match Lr1.NodeMap.find s table with
| sentence1, _ ->
if detect_redundancy then
Error.signal (fst sentence1 @ fst sentence2)
Error.signal c (fst sentence1 @ fst sentence2)
"these sentences both cause an error in state %d."
(Lr1.number s);
table
......@@ -525,7 +528,7 @@ let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
) table sentences_and_states
) Lr1.NodeMap.empty runs
in
Error.exit();
Error.exit_if c;
table
(* --------------------------------------------------------------------------- *)
......@@ -688,9 +691,10 @@ let () =
and table2 = message_table false runs2 in
(* Check that the domain of [table1] is a subset of the domain of [table2]. *)
let c = Error.new_category() in
table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) ->
if not (Lr1.NodeMap.mem s table2) then
Error.signal poss1
Error.signal c poss1
"this sentence leads to an error in state %d.\n\
No sentence that leads to this state exists in \"%s\"."
(Lr1.number s) filename2
......@@ -716,7 +720,7 @@ let () =
()
);
Error.exit();
Error.exit_if c;
exit 0
)
......
......@@ -936,7 +936,7 @@ let () =
(* If any fatal error was signaled up to this point, stop now. *)
let () =
Error.exit()
Error.exit_if Error.grammatical_error
(* ------------------------------------------------------------------------ *)
......@@ -1029,7 +1029,7 @@ let rec best choice = function
(* The cause for not knowing which production is best could be:
1- the productions originate in different source files;
2- they are derived, via inlining, from the same production. *)
Error.signal
Error.signal Error.grammatical_error
(Production.positions choice @ Production.positions prod)
"do not know how to resolve a reduce/reduce conflict\n\
between the following two productions:\n%s\n%s"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment