Commit 01f4b77d authored by POTTIER Francois's avatar POTTIER Francois

Cleanup: updated [signal], [warning] and [grammar_warning] to also take a format.

parent 1a570d12
open Printf 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. *) (* Global state. *)
...@@ -72,46 +65,39 @@ let logC = ...@@ -72,46 +65,39 @@ let logC =
let errors = let errors =
ref false ref false
let print_positions positions = let display continuation header positions format =
List.iter (fun position -> List.iter (fun position ->
fprintf stderr "%s:\n" (Positions.string_of_pos position) fprintf stderr "%s:\n" (Positions.string_of_pos position)
) positions ) positions;
let printN positions message = (* TEMPORARY *)
print_positions positions;
fprintf stderr "%s\n%!" message
let error_message message =
"Error: " ^ message
let error positions format =
print_positions positions;
Printf.kfprintf Printf.kfprintf
(fun _ -> exit 1) continuation
stderr stderr
("Error: " ^^ format ^^ "\n%!") (header ^^ format ^^ "\n%!")
let errorp v = let error positions format =
error [ Positions.position v ] display
(fun _ -> exit 1)
"Error: "
positions format
let signal positions message = let signal positions format =
printN positions message; display
errors := true (fun _ -> errors := true)
"Error: "
positions format
let warning positions message = let warning positions format =
printN positions (Printf.sprintf "Warning: %s" message) display
(fun _ -> ())
"Warning: "
positions format
let errors () = let errors () =
!errors !errors
(* Certain warnings about the grammar can optionally be treated as errors. let errorp v =
The following function emits a warning or error message, via [warning] or error [ Positions.position v ]
[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 = let grammar_warning =
if Settings.strict then if Settings.strict then signal else warning
signal positions (error_message message)
else
warning positions message
...@@ -34,34 +34,32 @@ val logC: int -> (out_channel -> unit) -> unit ...@@ -34,34 +34,32 @@ val logC: int -> (out_channel -> unit) -> unit
(* [error ps format ...] displays the list of positions [ps], followed with the (* [error ps format ...] displays the list of positions [ps], followed with the
error message [format ...], and exits. The strings "Error: " and "\n" are error message [format ...], and exits. The strings "Error: " and "\n" are
automatically added at the beginning and end of the error message. The automatically added at the beginning and end of the error message. The
message should begin with a lowercase letter. *) message should begin with a lowercase letter and end with a dot. *)
val error: Positions.positions -> ('a, out_channel, unit, 'b) format4 -> 'a val error: Positions.positions -> ('a, out_channel, unit, 'b) format4 -> 'a
(* [errorp v msg] displays the error message [msg], referring to the (* [errorp] is like [error], but uses the position range carried by [v]. *)
position range carried by [v], and exits. *)
val errorp: _ Positions.located -> ('a, out_channel, unit, 'b) format4 -> 'a val errorp: _ Positions.located -> ('a, out_channel, unit, 'b) format4 -> 'a
(* [warning ps msg] displays the warning message [msg], referring to (* [signal] is like [error], except it does not exit immediately. It sets a
the positions [ps]. *) flag which can be tested using [errors]. *)
val warning: Positions.positions -> string -> unit val signal: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* [signal ps msg] displays the error message [msg], referring to the
positions [ps], and does not exit immediately. *)
val signal: Positions.positions -> string -> unit
(* [errors] returns [true] if [signal] was previously called. Together (* [errors] returns [true] if [signal] was previously called. Together
[signal] and [errors] allow reporting multiple errors before aborting. *) [signal] and [errors] allow reporting multiple errors before aborting. *)
val errors: unit -> bool val errors: unit -> bool
(* [warning] is like [signal], except it does not set a flag. *)
val warning: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* Certain warnings about the grammar can optionally be treated as errors. (* Certain warnings about the grammar can optionally be treated as errors.
The following function emits a warning or error message, via [warning] or 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 [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. *) [errors] and stop the program if any errors have been reported. *)
val grammar_warning: Positions.positions -> string -> unit val grammar_warning: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
...@@ -134,7 +134,7 @@ let grammar = ...@@ -134,7 +134,7 @@ let grammar =
in in
if not Settings.infer && inlined && not skipping_parser_generation then if not Settings.infer && inlined && not skipping_parser_generation then
Error.warning [] Error.warning []
"you are using the standard library and/or the %inline keyword. We\n\ "you are using the standard library and/or the %%inline keyword. We\n\
recommend switching on --infer in order to avoid obscure type error messages."; recommend switching on --infer in order to avoid obscure type error messages.";
Time.tick "Inlining"; Time.tick "Inlining";
grammar grammar
......
...@@ -48,7 +48,7 @@ module TokPrecedence = struct ...@@ -48,7 +48,7 @@ module TokPrecedence = struct
() ()
| PrecedenceLevel (_, _, pos1, pos2) -> | PrecedenceLevel (_, _, pos1, pos2) ->
Error.grammar_warning (Positions.two pos1 pos2) Error.grammar_warning (Positions.two pos1 pos2)
(Printf.sprintf "the precedence level assigned to %s is never useful." id) "the precedence level assigned to %s is never useful." id
) Front.grammar.tokens ) Front.grammar.tokens
end end
...@@ -737,7 +737,7 @@ module Production = struct ...@@ -737,7 +737,7 @@ module Production = struct
(* Check whether this %prec declaration was useless. *) (* Check whether this %prec declaration was useless. *)
let pos = Positions.position sym in let pos = Positions.position sym in
if not (Hashtbl.mem ever_useful pos) then begin if not (Hashtbl.mem ever_useful pos) then begin
Error.grammar_warning [pos] "this %prec declaration is never useful."; Error.grammar_warning [pos] "this %%prec declaration is never useful.";
Hashtbl.add ever_useful pos () (* hack: avoid two warnings at the same position *) Hashtbl.add ever_useful pos () (* hack: avoid two warnings at the same position *)
end end
) osym ) osym
...@@ -1116,7 +1116,7 @@ let () = ...@@ -1116,7 +1116,7 @@ let () =
if not (NONEMPTY.nonterminal nt) then if not (NONEMPTY.nonterminal nt) then
Error.grammar_warning Error.grammar_warning
(Nonterminal.positions nt) (Nonterminal.positions nt)
(Printf.sprintf "%s generates the empty language." (Nonterminal.print false nt)); "%s generates the empty language." (Nonterminal.print false nt);
done done
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
......
...@@ -337,16 +337,18 @@ let interpret_error sentence = ...@@ -337,16 +337,18 @@ let interpret_error sentence =
an error, computes the state in which the error is obtained, and constructs an error, computes the state in which the error is obtained, and constructs
a targeted sentence. *) a targeted sentence. *)
let target_sentence signal : located_sentence -> maybe_targeted_sentence = let target_sentence
(signal : Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a)
: located_sentence -> maybe_targeted_sentence =
fun (poss, sentence) -> fun (poss, sentence) ->
(poss, sentence), (poss, sentence),
interpret_error_aux poss sentence interpret_error_aux poss sentence
(* failure: *) (* failure: *)
(fun msg -> (fun msg ->
signal poss (Printf.sprintf signal poss
"This sentence does not end with a syntax error, as it should.\n%s" "this sentence does not end with a syntax error, as it should.\n%s"
msg msg
); ;
None None
) )
(* success: *) (* success: *)
...@@ -537,9 +539,8 @@ let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list) ...@@ -537,9 +539,8 @@ let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
| sentence1, _ -> | sentence1, _ ->
if detect_redundancy then if detect_redundancy then
Error.signal (fst sentence1 @ fst sentence2) Error.signal (fst sentence1 @ fst sentence2)
(Printf.sprintf "these sentences both cause an error in state %d."
"Redundancy: these sentences both cause an error in state %d." (Lr1.number s);
(Lr1.number s));
table table
| exception Not_found -> | exception Not_found ->
Lr1.NodeMap.add s (sentence2, message) table Lr1.NodeMap.add s (sentence2, message) table
...@@ -668,11 +669,10 @@ let () = ...@@ -668,11 +669,10 @@ let () =
(* Check that the domain of [table1] is a subset of the domain of [table2]. *) (* Check that the domain of [table1] is a subset of the domain of [table2]. *)
table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) -> table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) ->
if not (Lr1.NodeMap.mem s table2) then if not (Lr1.NodeMap.mem s table2) then
Error.signal poss1 (Printf.sprintf Error.signal poss1
"This sentence leads to an error in state %d.\n\ "this sentence leads to an error in state %d.\n\
No sentence that leads to this state exists in \"%s\"." No sentence that leads to this state exists in \"%s\"."
(Lr1.number s) filename2 (Lr1.number s) filename2
)
); );
(* Check that [table1] is a subset of [table2], that is, for every state (* Check that [table1] is a subset of [table2], that is, for every state
...@@ -687,11 +687,10 @@ let () = ...@@ -687,11 +687,10 @@ let () =
try try
let (poss2, _), message2 = Lr1.NodeMap.find s table2 in let (poss2, _), message2 = Lr1.NodeMap.find s table2 in
if message1 <> message2 then if message1 <> message2 then
Error.warning (poss1 @ poss2) (Printf.sprintf Error.warning (poss1 @ poss2)
"These sentences lead to an error in state %d.\n\ "these sentences lead to an error in state %d.\n\
The corresponding messages in \"%s\" and \"%s\" differ." The corresponding messages in \"%s\" and \"%s\" differ."
(Lr1.number s) filename1 filename2 (Lr1.number s) filename1 filename2
)
with Not_found -> with Not_found ->
() ()
); );
......
...@@ -269,16 +269,16 @@ let () = ...@@ -269,16 +269,16 @@ let () =
incr count; incr count;
Error.grammar_warning Error.grammar_warning
(Nonterminal.positions nt) (Nonterminal.positions nt)
(Printf.sprintf "symbol %s is never accepted." (Nonterminal.print false nt)) "symbol %s is never accepted." (Nonterminal.print false nt)
| None -> | None ->
incr count; incr count;
Error.grammar_warning Error.grammar_warning
(Production.positions prod) (Production.positions prod)
(Printf.sprintf "production %sis never reduced." (Production.print prod)) "production %sis never reduced." (Production.print prod)
); );
if !count > 0 then if !count > 0 then
Error.grammar_warning [] Error.grammar_warning []
(Printf.sprintf "in total, %d productions are never reduced." !count) "in total, %d productions are never reduced." !count
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
(* From the above information, deduce, for each production, the states that (* From the above information, deduce, for each production, the states that
......
...@@ -892,11 +892,11 @@ let () = ...@@ -892,11 +892,11 @@ let () =
if !shift_reduce = 1 then if !shift_reduce = 1 then
Error.grammar_warning [] "one state has shift/reduce conflicts." Error.grammar_warning [] "one state has shift/reduce conflicts."
else if !shift_reduce > 1 then else if !shift_reduce > 1 then
Error.grammar_warning [] (Printf.sprintf "%d states have shift/reduce conflicts." !shift_reduce); Error.grammar_warning [] "%d states have shift/reduce conflicts." !shift_reduce;
if !reduce_reduce = 1 then if !reduce_reduce = 1 then
Error.grammar_warning [] "one state has reduce/reduce conflicts." Error.grammar_warning [] "one state has reduce/reduce conflicts."
else if !reduce_reduce > 1 then else if !reduce_reduce > 1 then
Error.grammar_warning [] (Printf.sprintf "%d states have reduce/reduce conflicts." !reduce_reduce) Error.grammar_warning [] "%d states have reduce/reduce conflicts." !reduce_reduce
(* There is a global check for errors at the end of [Invariant], so we do (* There is a global check for errors at the end of [Invariant], so we do
not need to check & stop here. *) not need to check & stop here. *)
...@@ -922,11 +922,10 @@ let rec best choice = function ...@@ -922,11 +922,10 @@ let rec best choice = function
2- they are derived, via inlining, from the same production. *) 2- they are derived, via inlining, from the same production. *)
Error.signal Error.signal
(Production.positions choice @ Production.positions prod) (Production.positions choice @ Production.positions prod)
(Printf.sprintf
"do not know how to resolve a reduce/reduce conflict\n\ "do not know how to resolve a reduce/reduce conflict\n\
between the following two productions:\n%s\n%s" between the following two productions:\n%s\n%s"
(Production.print choice) (Production.print choice)
(Production.print prod)); (Production.print prod);
choice (* dummy *) choice (* dummy *)
(* Go ahead. *) (* Go ahead. *)
...@@ -976,11 +975,11 @@ let default_conflict_resolution () = ...@@ -976,11 +975,11 @@ let default_conflict_resolution () =
if !shift_reduce = 1 then if !shift_reduce = 1 then
Error.warning [] "one shift/reduce conflict was arbitrarily resolved." Error.warning [] "one shift/reduce conflict was arbitrarily resolved."
else if !shift_reduce > 1 then else if !shift_reduce > 1 then
Error.warning [] (Printf.sprintf "%d shift/reduce conflicts were arbitrarily resolved." !shift_reduce); Error.warning [] "%d shift/reduce conflicts were arbitrarily resolved." !shift_reduce;
if !reduce_reduce = 1 then if !reduce_reduce = 1 then
Error.warning [] "one reduce/reduce conflict was arbitrarily resolved." Error.warning [] "one reduce/reduce conflict was arbitrarily resolved."
else if !reduce_reduce > 1 then else if !reduce_reduce > 1 then
Error.warning [] (Printf.sprintf "%d reduce/reduce conflicts were arbitrarily resolved." !reduce_reduce); Error.warning [] "%d reduce/reduce conflicts were arbitrarily resolved." !reduce_reduce;
(* Now, ensure that states that have a reduce action at the (* Now, ensure that states that have a reduce action at the
pseudo-token "#" have no other action. *) pseudo-token "#" have no other action. *)
...@@ -1052,7 +1051,7 @@ let default_conflict_resolution () = ...@@ -1052,7 +1051,7 @@ let default_conflict_resolution () =
if !ambiguities = 1 then if !ambiguities = 1 then
Error.grammar_warning [] "one state has an end-of-stream conflict." Error.grammar_warning [] "one state has an end-of-stream conflict."
else if !ambiguities > 1 then else if !ambiguities > 1 then
Error.grammar_warning [] (Printf.sprintf "%d states have an end-of-stream conflict." !ambiguities) Error.grammar_warning [] "%d states have an end-of-stream conflict." !ambiguities
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
(* Extra reductions. 2015/10/19 *) (* Extra reductions. 2015/10/19 *)
...@@ -1134,7 +1133,7 @@ let extra_reductions () = ...@@ -1134,7 +1133,7 @@ let extra_reductions () =
StringSet.iter (fun nt -> StringSet.iter (fun nt ->
if not (StringSet.mem nt !extra_nts) then if not (StringSet.mem nt !extra_nts) then
Error.grammar_warning [] Error.grammar_warning []
(Printf.sprintf "the declaration %%on_error_reduce %s is never useful." nt) "the declaration %%on_error_reduce %s is never useful." nt
) OnErrorReduce.declarations ) OnErrorReduce.declarations
(* ------------------------------------------------------------------------ *) (* ------------------------------------------------------------------------ *)
......
...@@ -64,7 +64,7 @@ let normalize_producers producers = ...@@ -64,7 +64,7 @@ let normalize_producers producers =
let override pos o1 o2 = let override pos o1 o2 =
match o1, o2 with match o1, o2 with
| Some _, Some _ -> | Some _, Some _ ->
Error.signal [ pos ] "This production carries two %prec declarations."; Error.signal [ pos ] "this production carries two %%prec declarations.";
o2 o2
| None, Some _ -> | None, Some _ ->
o2 o2
......
...@@ -734,7 +734,7 @@ let check_parameterized_grammar_is_well_defined grammar = ...@@ -734,7 +734,7 @@ let check_parameterized_grammar_is_well_defined grammar =
if not (StringSet.mem token !used_tokens if not (StringSet.mem token !used_tokens
|| StringSet.mem token Settings.ignored_unused_tokens) then || StringSet.mem token Settings.ignored_unused_tokens) then
Error.warning [p] Error.warning [p]
(Printf.sprintf "the token %s is unused." token) "the token %s is unused." token
) grammar.p_tokens ) grammar.p_tokens
end; end;
......
...@@ -32,9 +32,8 @@ let trim grammar = ...@@ -32,9 +32,8 @@ let trim grammar =
if not (StringSet.mem symbol reachable) then if not (StringSet.mem symbol reachable) then
Error.grammar_warning Error.grammar_warning
rule.positions rule.positions
(Printf.sprintf
"symbol %s is unreachable from any of the start symbol(s)." "symbol %s is unreachable from any of the start symbol(s)."
symbol) symbol
) grammar.rules; ) grammar.rules;
{ grammar with rules = StringMap.restrict reachable grammar.rules } { grammar with rules = StringMap.restrict reachable grammar.rules }
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