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
(* 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. *)
......@@ -72,46 +65,39 @@ let logC =
let errors =
ref false
let print_positions positions =
let display continuation header positions format =
List.iter (fun position ->
fprintf stderr "%s:\n" (Positions.string_of_pos position)
) 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;
) positions;
Printf.kfprintf
(fun _ -> exit 1)
continuation
stderr
("Error: " ^^ format ^^ "\n%!")
(header ^^ format ^^ "\n%!")
let errorp v =
error [ Positions.position v ]
let error positions format =
display
(fun _ -> exit 1)
"Error: "
positions format
let signal positions message =
printN positions message;
errors := true
let signal positions format =
display
(fun _ -> errors := true)
"Error: "
positions format
let warning positions message =
printN positions (Printf.sprintf "Warning: %s" message)
let warning positions format =
display
(fun _ -> ())
"Warning: "
positions format
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 errorp v =
error [ Positions.position v ]
let grammar_warning positions message =
if Settings.strict then
signal positions (error_message message)
else
warning positions message
let grammar_warning =
if Settings.strict then signal else warning
......@@ -34,34 +34,32 @@ val logC: int -> (out_channel -> unit) -> unit
(* [error ps format ...] displays the list of positions [ps], followed with the
error message [format ...], and exits. The strings "Error: " and "\n" are
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
(* [errorp v msg] displays the error message [msg], referring to the
position range carried by [v], and exits. *)
(* [errorp] is like [error], but uses the position range carried by [v]. *)
val errorp: _ Positions.located -> ('a, out_channel, unit, 'b) format4 -> 'a
(* [warning ps msg] displays the warning message [msg], referring to
the positions [ps]. *)
(* [signal] is like [error], except it does not exit immediately. It sets a
flag which can be tested using [errors]. *)
val warning: Positions.positions -> string -> unit
(* [signal ps msg] displays the error message [msg], referring to the
positions [ps], and does not exit immediately. *)
val signal: Positions.positions -> string -> unit
val signal: Positions.positions -> ('a, out_channel, unit, unit) format4 -> 'a
(* [errors] returns [true] if [signal] was previously called. Together
[signal] and [errors] allow reporting multiple errors before aborting. *)
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.
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. *)
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 =
in
if not Settings.infer && inlined && not skipping_parser_generation then
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.";
Time.tick "Inlining";
grammar
......
......@@ -48,7 +48,7 @@ module TokPrecedence = struct
()
| PrecedenceLevel (_, _, 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
end
......@@ -737,7 +737,7 @@ module Production = struct
(* Check whether this %prec declaration was useless. *)
let pos = Positions.position sym in
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 *)
end
) osym
......@@ -1116,7 +1116,7 @@ let () =
if not (NONEMPTY.nonterminal nt) then
Error.grammar_warning
(Nonterminal.positions nt)
(Printf.sprintf "%s generates the empty language." (Nonterminal.print false nt));
"%s generates the empty language." (Nonterminal.print false nt);
done
(* ------------------------------------------------------------------------ *)
......
......@@ -337,16 +337,18 @@ let interpret_error sentence =
an error, computes the state in which the error is obtained, and constructs
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) ->
(poss, sentence),
interpret_error_aux poss sentence
(* failure: *)
(fun msg ->
signal poss (Printf.sprintf
"This sentence does not end with a syntax error, as it should.\n%s"
signal poss
"this sentence does not end with a syntax error, as it should.\n%s"
msg
);
;
None
)
(* success: *)
......@@ -537,9 +539,8 @@ let message_table (detect_redundancy : bool) (runs : filtered_targeted_run list)
| sentence1, _ ->
if detect_redundancy then
Error.signal (fst sentence1 @ fst sentence2)
(Printf.sprintf
"Redundancy: these sentences both cause an error in state %d."
(Lr1.number s));
"these sentences both cause an error in state %d."
(Lr1.number s);
table
| exception Not_found ->
Lr1.NodeMap.add s (sentence2, message) table
......@@ -668,11 +669,10 @@ let () =
(* Check that the domain of [table1] is a subset of the domain of [table2]. *)
table1 |> Lr1.NodeMap.iter (fun s ((poss1, _), _) ->
if not (Lr1.NodeMap.mem s table2) then
Error.signal poss1 (Printf.sprintf
"This sentence leads to an error in state %d.\n\
Error.signal 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
)
);
(* Check that [table1] is a subset of [table2], that is, for every state
......@@ -687,11 +687,10 @@ let () =
try
let (poss2, _), message2 = Lr1.NodeMap.find s table2 in
if message1 <> message2 then
Error.warning (poss1 @ poss2) (Printf.sprintf
"These sentences lead to an error in state %d.\n\
Error.warning (poss1 @ poss2)
"these sentences lead to an error in state %d.\n\
The corresponding messages in \"%s\" and \"%s\" differ."
(Lr1.number s) filename1 filename2
)
with Not_found ->
()
);
......
......@@ -269,16 +269,16 @@ let () =
incr count;
Error.grammar_warning
(Nonterminal.positions nt)
(Printf.sprintf "symbol %s is never accepted." (Nonterminal.print false nt))
"symbol %s is never accepted." (Nonterminal.print false nt)
| None ->
incr count;
Error.grammar_warning
(Production.positions prod)
(Printf.sprintf "production %sis never reduced." (Production.print prod))
"production %sis never reduced." (Production.print prod)
);
if !count > 0 then
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
......
......@@ -892,11 +892,11 @@ let () =
if !shift_reduce = 1 then
Error.grammar_warning [] "one state has shift/reduce conflicts."
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
Error.grammar_warning [] "one state has reduce/reduce conflicts."
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
not need to check & stop here. *)
......@@ -922,11 +922,10 @@ let rec best choice = function
2- they are derived, via inlining, from the same production. *)
Error.signal
(Production.positions choice @ Production.positions prod)
(Printf.sprintf
"do not know how to resolve a reduce/reduce conflict\n\
between the following two productions:\n%s\n%s"
(Production.print choice)
(Production.print prod));
(Production.print prod);
choice (* dummy *)
(* Go ahead. *)
......@@ -976,11 +975,11 @@ let default_conflict_resolution () =
if !shift_reduce = 1 then
Error.warning [] "one shift/reduce conflict was arbitrarily resolved."
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
Error.warning [] "one reduce/reduce conflict was arbitrarily resolved."
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
pseudo-token "#" have no other action. *)
......@@ -1052,7 +1051,7 @@ let default_conflict_resolution () =
if !ambiguities = 1 then
Error.grammar_warning [] "one state has an end-of-stream conflict."
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 *)
......@@ -1134,7 +1133,7 @@ let extra_reductions () =
StringSet.iter (fun nt ->
if not (StringSet.mem nt !extra_nts) then
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
(* ------------------------------------------------------------------------ *)
......
......@@ -64,7 +64,7 @@ let normalize_producers producers =
let override pos o1 o2 =
match o1, o2 with
| Some _, Some _ ->
Error.signal [ pos ] "This production carries two %prec declarations.";
Error.signal [ pos ] "this production carries two %%prec declarations.";
o2
| None, Some _ ->
o2
......
......@@ -734,7 +734,7 @@ let check_parameterized_grammar_is_well_defined grammar =
if not (StringSet.mem token !used_tokens
|| StringSet.mem token Settings.ignored_unused_tokens) then
Error.warning [p]
(Printf.sprintf "the token %s is unused." token)
"the token %s is unused." token
) grammar.p_tokens
end;
......
......@@ -32,9 +32,8 @@ let trim grammar =
if not (StringSet.mem symbol reachable) then
Error.grammar_warning
rule.positions
(Printf.sprintf
"symbol %s is unreachable from any of the start symbol(s)."
symbol)
symbol
) 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