Commit abb1f3ad authored by POTTIER Francois's avatar POTTIER Francois

Cleanup: modified [Error.error] to directly take a format as an argument.

parent 06a7f399
......@@ -71,10 +71,9 @@ let start =
let () =
if Terminal.n > 256 then
Error.error [] (Printf.sprintf
Error.error []
"--list-errors supports at most 256 terminal symbols.\n\
The grammar has %d terminal symbols." Terminal.n
)
(* ------------------------------------------------------------------------ *)
......@@ -555,11 +554,11 @@ let mkfact position (word : W.word) lookahead =
else
"Please report this error to Menhir's developers."
in
Error.error [] (Printf.sprintf
"Internal error: a hardwired limit was exceeded.\n\
Error.error []
"an internal limit was exceeded.\n\
Sys.word_size = %d. Position = %d. Word = %d.\n\
%s%!"
Sys.word_size position word advice)
Sys.word_size position word advice
let mkfact p w l =
let fact = mkfact p w l in
......
......@@ -64,14 +64,14 @@ module Run (T: sig end) = struct
begin
Nonterminal.iterx (fun nonterminal ->
match Nonterminal.ocamltype nonterminal with
| None -> Error.error [] (sprintf "I don't know the type of non-terminal %s"
(Nonterminal.print false nonterminal))
| None -> Error.error [] "I don't know the type of the nonterminal symbol %s."
(Nonterminal.print false nonterminal)
| Some _ -> ());
Production.iterx (fun prod ->
let act = Production.action prod in
if Action.(has_syntaxerror act || has_leftstart act || has_leftend act) then
Error.error [] ("$syntaxerror, $start, $end are not "^
"supported by the coq back-end"))
Error.error [] "$syntaxerror, $start, $end are not supported by the Coq back-end."
)
end;
Production.iterx (fun prod ->
......@@ -79,12 +79,12 @@ module Run (T: sig end) = struct
match symb with
| Symbol.T t ->
if t = Terminal.error then
Error.error [] "The coq back-end does not support error"
Error.error [] "the Coq back-end does not support the error token."
| _ -> ())
(Production.rhs prod));
if Front.grammar.UnparameterizedSyntax.parameters <> [] then
Error.error [] "The coq back-end does not support %parameter"
Error.error [] "the Coq back-end does not support %%parameter."
(* Optimized because if we extract some constants to the right caml term,
the ocaml inlining+constant unfolding replaces that by the actual constant *)
......
......@@ -72,21 +72,31 @@ let logC =
let errors =
ref false
let printN positions message =
let print_positions positions =
List.iter (fun 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 message =
let old_error positions message = (* TEMPORARY *)
printN positions (error_message message);
exit 1
let error positions format =
print_positions positions;
Printf.kfprintf
(fun _ -> exit 1)
stderr
("Error: " ^^ format ^^ "\n%!")
let errorp v message =
error [ Positions.position v ] message
old_error [ Positions.position v ] message
let signal positions message =
printN positions message;
......
......@@ -31,10 +31,12 @@ val logC: int -> (out_channel -> unit) -> unit
(* Errors and warnings. *)
(* [error ps msg] displays the error message [msg], referring to the
positions [ps], and exits. *)
(* [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. *)
val error: Positions.positions -> string -> 'a
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. *)
......
......@@ -40,7 +40,7 @@ let fail lexbuf checkpoint =
(* Hack: remove the final newline, because [Error.error] adds one. *)
let message = String.sub message 0 (String.length message - 1) in
(* Display our message and die. *)
Error.error (Positions.lexbuf lexbuf) message
Error.error (Positions.lexbuf lexbuf) "syntax error.\n%s" message
| _ ->
(* This cannot happen. *)
assert false
......
......@@ -7,9 +7,9 @@
let load_partial_grammar filename =
let validExt = if Settings.coq then ".vy" else ".mly" in
if not (Filename.check_suffix filename validExt) then
Error.error [] (Printf.sprintf
Error.error []
"argument file names should end in %s. \"%s\" is not accepted."
validExt filename);
validExt filename;
Error.set_filename filename;
try
......@@ -25,7 +25,7 @@ let load_partial_grammar filename =
grammar
with Sys_error msg ->
Error.error [] msg
Error.error [] "%s" msg
(* ------------------------------------------------------------------------- *)
......
......@@ -1105,11 +1105,11 @@ let () =
if not (NONEMPTY.nonterminal nt) then
Error.error
(Nonterminal.positions nt)
(Printf.sprintf "%s generates the empty language." (Nonterminal.print false nt));
"%s generates the empty language." (Nonterminal.print false nt);
if TerminalSet.is_empty (FIRST.nonterminal nt) then
Error.error
(Nonterminal.positions nt)
(Printf.sprintf "%s generates the language {epsilon}." (Nonterminal.print false nt))
"%s generates the language {epsilon}." (Nonterminal.print false nt)
) Front.grammar.start_symbols;
(* If a nonterminal symbol generates the empty language, issue a warning. *)
for nt = Nonterminal.start to Nonterminal.n - 1 do
......
......@@ -257,7 +257,7 @@ let depend grammar =
Lexdep.main lexbuf
with Lexdep.Error msg ->
(* Echo the error message, followed with ocamldep's output. *)
Error.error [] (msg ^ output)
Error.error [] "%s" (msg ^ output)
in
(* Look for the line that concerns the [.cmo] target, and echo a
......
......@@ -143,7 +143,7 @@ let start poss ((nto, _) : sentence) : Nonterminal.t =
match ProductionMap.is_singleton Lr1.entry with
| None ->
Error.error poss
"Because the grammar has multiple start symbols, each of the\n\
"because the grammar has multiple start symbols, each of the\n\
sentences provided on the standard input channel must be of the\n\
form: <start symbol>: <token>*"
| Some (prod, _) ->
......@@ -211,11 +211,11 @@ let interpret_error_aux poss ((_, terminals) as sentence) fail succeed =
let open ReferenceInterpreter in
match check_error_path nt terminals with
| OInputReadPastEnd ->
fail "No syntax error occurs."
fail "no syntax error occurs."
| OInputNotFullyConsumed ->
fail "A syntax error occurs before the last token is reached."
fail "a syntax error occurs before the last token is reached."
| OUnexpectedAccept ->
fail "No syntax error occurs; in fact, this input is accepted."
fail "no syntax error occurs; in fact, this input is accepted."
| OK target ->
succeed nt terminals target
......@@ -322,7 +322,7 @@ let write_run : maybe_targeted_run or_comment -> unit =
used by [--interpret-error]. *)
let fail msg =
Error.error [] msg
Error.error [] "%s" msg
let succeed nt terminals target =
print_messages_item (nt, terminals, target);
......@@ -403,7 +403,7 @@ let setup () : unit -> sentence option =
try
SentenceParser.optional_sentence SentenceLexer.lex lexbuf
with Parsing.Parse_error ->
Error.error (Positions.lexbuf lexbuf) "Ill-formed input sentence."
Error.error (Positions.lexbuf lexbuf) "ill-formed input sentence."
in
read
......@@ -496,7 +496,7 @@ let read_messages filename : run or_comment list =
| exception Parsing.Parse_error ->
Error.error
(Positions.one (Lexing.lexeme_start_p lexbuf))
"Ill-formed sentence."
"ill-formed sentence."
| sentences ->
(* In principle, we should now find a segment of whitespace
followed with a segment of text. By construction, the two
......@@ -511,7 +511,7 @@ let read_messages filename : run or_comment list =
| [ _ ] ->
Error.error
(Positions.one (Lexing.lexeme_end_p lexbuf))
"Syntax error: missing a final message. I may be desynchronized."
"missing a final message. I may be desynchronized."
| (Segment, _, _) :: _
| (Whitespace, _, _) :: (Whitespace, _, _) :: _ ->
(* Should not happen, thanks to the alternation between the
......
......@@ -266,9 +266,9 @@ module Closure (L : Lookahead.S) = struct
let names = String.concat "\n" (List.map print items) in
Error.error
positions
(Printf.sprintf "the grammar is ambiguous.\n\
The following items participate in an epsilon-cycle:\n\
%s" names)
"the grammar is ambiguous.\n\
The following items participate in an epsilon-cycle:\n\
%s" names
let () =
P.iter (fun node ->
......
......@@ -40,21 +40,19 @@
(* Check that only allowed indices are used in semantic actions. *)
let check_producers_indices allowed_producers pkeywords =
List.iter (function
| { value = Keyword.PDollar idx; position } ->
| { value = Keyword.PDollar idx; position } ->
if idx - 1 >= Array.length allowed_producers then
Error.error [position] begin
Printf.sprintf "$%d refers to a nonexistent symbol." idx
end
Error.error [position]
"$%d refers to a nonexistent symbol." idx
else begin match allowed_producers.(idx - 1) with
| None ->
()
| Some x ->
Error.error [position] begin
Printf.sprintf "please do not say: $%d. Instead, say: %s." idx x
end
end
| _ ->
()
| None ->
()
| Some x ->
Error.error [position]
"please do not say: $%d. Instead, say: %s." idx x
end
| _ ->
()
) pkeywords
(* In-place transformation of keywords. We turn our keywords into
......@@ -101,7 +99,7 @@
| [] ->
()
| { value = _; position = pos } :: _ ->
Error.error [pos] "A Menhir keyword cannot be used in an OCaml header."
Error.error [pos] "a Menhir keyword cannot be used in an OCaml header."
(* Creates a stretch. *)
......@@ -252,13 +250,13 @@
];
table
(* A short-hand. *)
(* Short-hands. *)
let error1 pos msg =
Error.error (Positions.one pos) msg
let error1 pos =
Error.error (Positions.one pos)
let error2 lexbuf msg =
Error.error (Positions.two lexbuf.lex_start_p lexbuf.lex_curr_p) msg
let error2 lexbuf =
Error.error (Positions.two lexbuf.lex_start_p lexbuf.lex_curr_p)
}
......
......@@ -163,7 +163,7 @@ let inline grammar =
| BeingExpanded ->
Error.error
r.positions
(Printf.sprintf "there is a cycle in the definition of %s." k)
"there is a cycle in the definition of %s." k
| Expanded r ->
r)
with Not_found ->
......@@ -178,7 +178,7 @@ let inline grammar =
(fun _ r ->
if r.inline_flag then
Error.error r.positions
(Printf.sprintf "%%inline is not supported by the coq back-end"))
"%%inline is not supported by the Coq back-end.")
grammar.rules
in
......
......@@ -63,12 +63,11 @@ let nonterminalgadtdef grammar =
"The indexed type of nonterminal symbols (mock!).",
[]
| Settings.OMNone ->
Error.error [] (Printf.sprintf "\
Error.error [] "\
the type of the nonterminal symbol %s is unknown.\n\
When --inspection is set, the type of every nonterminal symbol must be known.\n\
Please use --infer or specify the type of every symbol via %%type declarations."
nt
)
in
[
......
......@@ -206,29 +206,26 @@ let check positions env k expected_type =
UnificationError (t1, t2) ->
Error.error
positions
(Printf.sprintf
"How is this symbol parameterized?\n\
"how is this symbol parameterized?\n\
It is used at sorts %s and %s.\n\
The sort %s is not compatible with the sort %s."
(string_of_var inference_var) (string_of_var checking_var)
(string_of_nt_type t1) (string_of_nt_type t2))
(string_of_nt_type t1) (string_of_nt_type t2)
| BadArityError (n1, n2) ->
Error.error
positions
(Printf.sprintf
"does this symbol expect %d or %d arguments?"
(min n1 n2) (max n1 n2))
(min n1 n2) (max n1 n2)
| OccursError (x, y) ->
Error.error
positions
(Printf.sprintf
"How is this symbol parameterized?\n\
"how is this symbol parameterized?\n\
It is used at sorts %s and %s.\n\
The sort %s cannot be unified with the sort %s."
(string_of_var inference_var) (string_of_var checking_var)
(string_of_var x) (string_of_var y))
(string_of_var x) (string_of_var y)
......@@ -396,10 +393,9 @@ let check_grammar p_grammar =
in the component. *)
if marked_components.(repr) <> parameters_len then
Error.error positions
(Printf.sprintf
"Mutually recursive definitions must have the same parameters.\n\
"mutually recursive definitions must have the same parameters.\n\
This is not the case for %s and %s."
(name repr) iname)
(name repr) iname
in
(* In each production rule, the parameterized non terminal
......@@ -422,13 +418,12 @@ let check_grammar p_grammar =
if not (actual_parameters_as_formal actuals params)
then
Error.error [ symbol.position ]
(Printf.sprintf
"Mutually recursive definitions must have the same \
"mutually recursive definitions must have the same \
parameters.\n\
This is not the case for %s."
(let name1, name2 = (name idx), (name i) in
if name1 <> name2 then name1 ^ " and "^ name2
else name1))
else name1)
with _ -> ())
symbols) (branches i)
in
......@@ -486,7 +481,7 @@ let expand p_grammar =
let normalized_name = Misc.normalize name in
if StringSet.mem normalized_name !names then
Error.error []
(Printf.sprintf "internal name clash over %s" normalized_name);
"internal name clash over %s" normalized_name;
names := StringSet.add normalized_name !names;
name
in
......@@ -601,9 +596,8 @@ let expand p_grammar =
let mangled = mangle nt in
if StringMap.mem mangled accu then
Error.error [Positions.position (Parameters.with_pos nt)]
(Printf.sprintf
"There are multiple %%type declarations for nonterminal %s."
mangled);
"there are multiple %%type declarations for nonterminal %s."
mangled;
StringMap.add mangled (Positions.value ty) accu
in
......@@ -617,9 +611,8 @@ let expand p_grammar =
let mangled = mangle nt in
if StringSet.mem mangled accu then
Error.error [Positions.position (Parameters.with_pos nt)]
(Printf.sprintf
"There are multiple %%on_error_reduce declarations for nonterminal %s."
mangled);
"there are multiple %%on_error_reduce declarations for nonterminal %s."
mangled;
StringSet.add mangled accu
in
......@@ -638,8 +631,8 @@ let expand p_grammar =
(* If [k] is a start symbol then it cannot be parameterized. *)
if prule.pr_parameters <> [] && StringSet.mem k start_symbols then
Error.error []
(Printf.sprintf "The start symbol `%s' cannot be parameterized."
k);
"the start symbol %s cannot be parameterized."
k;
(* Entry points are the closed non terminals. *)
if prule.pr_parameters = [] then
......
......@@ -41,7 +41,7 @@ let check_production_group right_hand_sides =
(IdSet.diff ids' ids))
in
Error.error [Positions.position id]
"Two productions that share a semantic action must define\n\
"two productions that share a semantic action must define\n\
exactly the same identifiers."
with Not_found ->
()
......
......@@ -120,7 +120,7 @@ let join_declaration filename (grammar : grammar) decl =
if token_properties.tk_associativity <> UndefinedAssoc then
Error.error
[ decl.position; token_properties.tk_position ]
(Printf.sprintf "there are multiple precedence declarations for token %s." terminal);
"there are multiple precedence declarations for token %s." terminal;
(* Record the new declaration. *)
......@@ -312,17 +312,15 @@ let store_symbol (symbols : symbol_table) symbol kind =
| (PublicNonTerminal p | PrivateNonTerminal p),
(PublicNonTerminal p' | PrivateNonTerminal p') ->
Error.error [ p; p']
(Printf.sprintf
"the nonterminal symbol %s is multiply defined."
symbol)
symbol
(* The symbol is known to be a token but declared as a non terminal.*)
| (Token tkp, (PrivateNonTerminal p | PublicNonTerminal p))
| ((PrivateNonTerminal p | PublicNonTerminal p), Token tkp) ->
Error.error [ p; tkp.tk_position ]
(Printf.sprintf
"The identifier %s is a reference to a token."
symbol)
"the identifier %s is a reference to a token."
symbol
(* We do not gain any piece of information. *)
| _, DontKnow _ | Token _, Token _ ->
......@@ -344,16 +342,15 @@ let store_used_symbol position tokens symbols symbol =
let non_terminal_is_not_reserved symbol positions =
if symbol = "error" then
Error.error positions
(Printf.sprintf "%s is reserved and thus cannot be used \
as a non-terminal symbol." symbol)
"%s is reserved and thus cannot be used \
as a non-terminal symbol." symbol
let non_terminal_is_not_a_token tokens symbol positions =
try
let tkp = StringMap.find symbol tokens in
Error.error (positions @ [ tkp.tk_position ])
(Printf.sprintf
"The identifier %s is a reference to a token."
symbol)
"the identifier %s is a reference to a token."
symbol
with Not_found -> ()
let store_public_nonterminal tokens symbols symbol positions =
......@@ -492,7 +489,7 @@ let merge_rules symbols pgs =
(iter_on_only_used_symbols
(fun k pos -> if not (StringSet.mem k public_symbols) then
Error.error [ pos ]
(Printf.sprintf "%s is undefined." k)))
"%s is undefined." k))
symbols
in
(* Detect private symbol clashes and rename them if necessary. *)
......@@ -544,12 +541,11 @@ let merge_rules symbols pgs =
(* The arity of the parameterized symbols must be constant.*)
if ra <> ra' then
Error.error positions
(Printf.sprintf "symbol %s is defined with arities %d and %d."
r.pr_nt ra ra')
"the symbol %s is defined with arities %d and %d."
r.pr_nt ra ra'
else if r.pr_inline_flag <> r'.pr_inline_flag then
Error.error positions
(Printf.sprintf
"not all definitions of %s are marked %%inline." r.pr_nt)
"not all definitions of %s are marked %%inline." r.pr_nt
else
(* We combine the different branches. The parameters
could have different names, we rename them with
......@@ -610,14 +606,12 @@ let check_parameterized_grammar_is_well_defined grammar =
StringMap.iter
(fun nonterminal p ->
if not (StringMap.mem nonterminal grammar.p_rules) then
Error.error [p] (Printf.sprintf "the start symbol %s is undefined."
nonterminal);
Error.error [p] "the start symbol %s is undefined." nonterminal;
if not (List.exists (function
| ParameterVar { value = id }, _ -> id = nonterminal
| _ -> false) grammar.p_types) then
Error.error [p]
(Printf.sprintf
"the type of the start symbol %s is unspecified." nonterminal);
"the type of the start symbol %s is unspecified." nonterminal;
) grammar.p_start_symbols;
let parameter_head_symb = function
......@@ -657,7 +651,7 @@ let check_parameterized_grammar_is_well_defined grammar =
|| StringMap.mem s grammar.p_tokens
|| List.mem s prule.pr_parameters
|| List.mem s reserved) then
Error.error [ p ] (Printf.sprintf "%s is undefined." s)
Error.error [ p ] "%s is undefined." s
in
StringMap.iter
(fun k prule -> List.iter
......@@ -676,9 +670,8 @@ let check_parameterized_grammar_is_well_defined grammar =
(* Check the producer id is unique. *)
if StringSet.mem id.value already_seen then
Error.error [ id.position ]
(Printf.sprintf
"there are multiple producers named %s in this sequence."
id.value);
id.value;
StringSet.add id.value already_seen
in
......@@ -727,8 +720,7 @@ let check_parameterized_grammar_is_well_defined grammar =
if (prule.pr_inline_flag
&& StringMap.mem k grammar.p_start_symbols) then
Error.error prule.pr_positions
(Printf.sprintf
"%s cannot be both a start symbol and inlined." k);
"%s cannot be both a start symbol and inlined." k;
) grammar.p_rules;
......
......@@ -9,8 +9,8 @@
(* A short-hand. *)
let error2 lexbuf msg =
Error.error (Positions.two lexbuf.lex_start_p lexbuf.lex_curr_p) msg
let error2 lexbuf =
Error.error (Positions.two lexbuf.lex_start_p lexbuf.lex_curr_p)
}
......@@ -39,9 +39,9 @@ rule lex = parse
if StringSet.mem lid Front.grammar.UnparameterizedSyntax.start_symbols then
NONTERMINAL (nt, lexbuf.lex_start_p, lexbuf.lex_curr_p)
else
error2 lexbuf (Printf.sprintf "\"%s\" is not a start symbol." lid)
error2 lexbuf "\"%s\" is not a start symbol." lid
with Not_found ->
error2 lexbuf (Printf.sprintf "\"%s\" is not a known non-terminal symbol." lid)
error2 lexbuf "\"%s\" is not a known non-terminal symbol." lid
}
(* An identifier that begins with an uppercase letter is considered a
terminal symbol. *)
......@@ -49,7 +49,7 @@ rule lex = parse
{ try
TERMINAL (Terminal.lookup uid, lexbuf.lex_start_p, lexbuf.lex_curr_p)
with Not_found ->
error2 lexbuf (Printf.sprintf "\"%s\" is not a known terminal symbol." uid)
error2 lexbuf "\"%s\" is not a known terminal symbol." uid
}
(* Whitespace is ignored. *)
| whitespace
......
......@@ -11,5 +11,5 @@ let grammar lexer lexbuf =
try
Parser.grammar lexer lexbuf
with Parsing.Parse_error ->
Error.error (Positions.lexbuf lexbuf) "Syntax error."
Error.error (Positions.lexbuf lexbuf) "syntax error."
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