Commit 38ef45d2 authored by POTTIER Francois's avatar POTTIER Francois

Cleanup in [Interpret]. More auxiliary functions.

parent 6ca462ba
(* This module is in charge of handling the [--interpret] option, (* This module is in charge of handling the [--interpret] option,
if it is present. *) if it is present. *)
open Grammar
module I = Invariant (* artificial dependency; ensures that [Invariant] runs first *) module I = Invariant (* artificial dependency; ensures that [Invariant] runs first *)
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
(* A sentence is a pair of an optional non-terminal start symbol and a (* The following definitions are in sync with [SentenceParser]. *)
list of terminal symbols. *)
open Grammar
type terminals = Terminal.t list
type sentence = Nonterminal.t option * terminals
type located_sentence = Positions.positions * sentence
type message = string
(* A run is a series of sentences together with an error message. *)
type run = located_sentence list * message
(* A targeted sentence is a located sentence together with the state
into which it leads. *)
type targeted_sentence = located_sentence * Lr1.node
type sentence = (* A targeted run is a series of targeted sentences together with an error
Nonterminal.t option * Terminal.t list message. *)
type located_sentence = type targeted_run = targeted_sentence list * message
Positions.positions * sentence
(* --------------------------------------------------------------------------- *)
(* Debugging. (* Debugging.
...@@ -202,22 +216,32 @@ let interpret_error sentence = ...@@ -202,22 +216,32 @@ let interpret_error sentence =
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
(* [convert_located_sentence] interprets a (located) sentence, expecting it to (* [target_sentence] interprets a (located) sentence, expecting it to end in
end in an error, and returns the state in which the error is obtained. This an error, computes the state in which the error is obtained, and constructs
is used by [--compile-errors]. *) a targeted sentence. *)
let convert_located_sentence (poss, sentence) = let fail poss msg =
let fail msg =
Error.signal poss (Printf.sprintf Error.signal poss (Printf.sprintf
"This sentence does not end with a syntax error, as desired.\n%s" "This sentence does not end with a syntax error, as desired.\n%s"
msg msg
); );
[] (* dummy result *) [] (* dummy result *)
in
interpret_error_aux poss sentence fail (fun s -> [ (poss, sentence), s ])
let convert_entry (sentences, message) = let target_sentence : located_sentence -> targeted_sentence list =
List.flatten (List.map convert_located_sentence sentences), message fun (poss, sentence) ->
interpret_error_aux poss sentence
(fail poss)
(fun s -> [ (poss, sentence), s ])
let target_run : run -> targeted_run =
fun (sentences, message) ->
List.flatten (List.map target_sentence sentences), message
let target_runs : run list -> targeted_run list =
fun runs ->
let runs = List.map target_run runs in
if Error.errors() then exit 1;
runs
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
...@@ -277,15 +301,11 @@ let () = ...@@ -277,15 +301,11 @@ let () =
(* --------------------------------------------------------------------------- *) (* --------------------------------------------------------------------------- *)
(* If [--compile-errors <filename>] is set, compile the error message (* Reading a [.messages] file. *)
descriptions found in file [filename] down to OCaml code, then stop. *)
let () =
Settings.compile_errors |> Option.iter (fun filename ->
(* Read and segment the file. Each segment is a pair of a string and a let read_messages filename : run list =
lexbuf. *) (* Read and segment the file. *)
let segments = Segment.segment filename in let segments : (string * Lexing.lexbuf) list = Segment.segment filename in
(* Process the segments, two by two. We expect one segment to contain (* Process the segments, two by two. We expect one segment to contain
a non-empty series of sentences, and the next segment to contain a non-empty series of sentences, and the next segment to contain
free-form text. *) free-form text. *)
...@@ -312,15 +332,26 @@ let () = ...@@ -312,15 +332,26 @@ let () =
| sentences -> | sentences ->
loop ((sentences, text) :: accu) segments loop ((sentences, text) :: accu) segments
in in
let entries = loop [] segments in let runs = loop [] segments in
if Error.errors() then exit 1; if Error.errors() then exit 1;
(* Although we try to report several errors, [SentenceLexer.lex] may (* Although we try to report several errors, [SentenceLexer.lex] may
abort the whole process after just one error. This could be improved. *) abort the whole process after just one error. This could be improved. *)
runs
(* --------------------------------------------------------------------------- *)
(* If [--compile-errors <filename>] is set, compile the error message
descriptions found in file [filename] down to OCaml code, then stop. *)
let () =
Settings.compile_errors |> Option.iter (fun filename ->
(* Read the file. *)
let runs = read_messages filename in
(* Convert every sentence to a state number. We signal an error if a (* Convert every sentence to a state number. We signal an error if a
sentence does not end in an error, as expected. *) sentence does not end in an error, as expected. *)
let entries = List.map convert_entry entries in let runs = target_runs runs in
if Error.errors() then exit 1;
(* Build a mapping of states to located sentences. This allows us to (* Build a mapping of states to located sentences. This allows us to
detect if two sentences lead to the same state. *) detect if two sentences lead to the same state. *)
...@@ -337,7 +368,7 @@ let () = ...@@ -337,7 +368,7 @@ let () =
| exception Not_found -> | exception Not_found ->
Lr1.NodeMap.add s sentence2 mapping Lr1.NodeMap.add s sentence2 mapping
) mapping sentences_and_states ) mapping sentences_and_states
) Lr1.NodeMap.empty entries ) Lr1.NodeMap.empty runs
in in
if Error.errors() then exit 1; if Error.errors() then exit 1;
...@@ -371,7 +402,7 @@ let () = ...@@ -371,7 +402,7 @@ let () =
(* Map all these states to this message. *) (* Map all these states to this message. *)
{ branchpat = POr states; { branchpat = POr states;
branchbody = EStringConst message } :: branches branchbody = EStringConst message } :: branches
) [ default ] entries ) [ default ] runs
in in
let messagedef = { let messagedef = {
valpublic = true; valpublic = true;
......
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