Commit 4899065a authored by POTTIER Francois's avatar POTTIER Francois

New module [InputFile], so [Error] now deals with errors only.

parent 1ffe2cf1
(* ---------------------------------------------------------------------------- *)
(* The identity of the current input file. *)
(* 2011/10/19: do not use [Filename.basename]. The [#] annotations that
we insert in the [.ml] file must retain their full path. This does
mean that the [#] annotations depend on how menhir is invoked -- e.g.
[menhir foo/bar.mly] and [cd foo && menhir bar.mly] will produce
different files. Nevertheless, this seems useful/reasonable. *)
(* This also influences the type error messages produced by [--infer]. *)
(* 2016/08/25: in principle, the order in which file names appear on the
command line (when there are several of them) does not matter. It is
however used in [UnparameterizedPrinter] (see the problem description
there). For this reason, we define a type [input_file] which includes
the file's name as well as its index on the command line. *)
type input_file = {
input_file_name: string;
input_file_index: int
}
let builtin_input_file = {
input_file_name = "<builtin>";
input_file_index = -1
}
let dummy_input_file = {
input_file_name = "<dummy>";
input_file_index = 0
}
let same_input_file file1 file2 =
file1.input_file_index = file2.input_file_index
(* could also use physical equality [file1 == file2] *)
let compare_input_files file1 file2 =
Pervasives.compare file1.input_file_index file2.input_file_index
(* Ideally, this function should NOT be used, as it reflects the
order of the input files on the command line. As of 2016/08/25,
it is used by [UnparameterizedPrinter], for lack of a better
solution. *)
let current_input_file =
ref dummy_input_file
(* This declares that a new file is being processed. *)
let new_input_file name : unit =
current_input_file := {
input_file_name = name;
input_file_index = !current_input_file.input_file_index + 1
}
let get_input_file () : input_file =
assert (!current_input_file != dummy_input_file);
!current_input_file
let get_input_file_name () : string =
(get_input_file()).input_file_name
(* ---------------------------------------------------------------------------- *)
(* The contents of the current input file. *)
let get_initialized_ref ref =
match !ref with
| None ->
assert false
| Some contents ->
contents
let file_contents =
ref (None : string option)
let get_file_contents () =
get_initialized_ref file_contents
let with_file_contents contents f =
file_contents := Some contents;
let result = f() in
file_contents := None; (* avoid memory leak *)
result
(* This module keeps track of which input file is currently being read. It
defines a type [input_file] of input files, which is used to record the
origin of certain elements (productions, declarations, etc.). *)
(* ---------------------------------------------------------------------------- *)
(* The identity of the current input file. *)
type input_file
(* [new_input_file filename] must be called when a new input file is about
to be read. *)
val new_input_file: string -> unit
(* [get_input_file()] indicates which input file is currently being read.
[get_input_file_name()] is the name of this file. *)
val get_input_file: unit -> input_file
val get_input_file_name: unit -> string
(* This fictitious "built-in" input file is used as the origin of the start
productions. This technical detail is probably irrelevant entirely. *)
val builtin_input_file: input_file
(* This equality test for input files is used (for instance) when determining
which of two productions has greater priority. *)
val same_input_file: input_file -> input_file -> bool
(* This ordering between input files reflects their ordering on the command
line. Ideally, it should NOT be used. *)
val compare_input_files: input_file -> input_file -> int
(* ---------------------------------------------------------------------------- *)
(* The contents of the current input file. *)
(* [with_file_contents contents f] records that the contents of the current
input file is [contents] while the action [f] runs. The function [f] can
then call [get_file_contents()] to retrieve [contents]. *)
val with_file_contents: string -> (unit -> 'a) -> 'a
val get_file_contents: unit -> string
......@@ -2,80 +2,6 @@ open Printf
(* ---------------------------------------------------------------------------- *)
(* Global state. *)
let get_initialized_ref ref =
match !ref with
| None ->
assert false
| Some contents ->
contents
(* 2011/10/19: do not use [Filename.basename]. The [#] annotations that
we insert in the [.ml] file must retain their full path. This does
mean that the [#] annotations depend on how menhir is invoked -- e.g.
[menhir foo/bar.mly] and [cd foo && menhir bar.mly] will produce
different files. Nevertheless, this seems useful/reasonable. *)
(* This also influences the type error messages produced by [--infer]. *)
(* 2016/08/25: in principle, the order in which file names appear on the
command line (when there are several of them) does not matter. It is
however used in [UnparameterizedPrinter] (see the problem description
there). For this reason, we define a type [input_file] which includes
the file's name as well as its index on the command line. *)
type input_file = {
input_file_name: string;
input_file_index: int
}
let builtin_input_file = {
input_file_name = "<builtin>";
input_file_index = -1
}
let dummy_input_file = {
input_file_name = "<dummy>";
input_file_index = 0
}
let same_input_file file1 file2 =
file1.input_file_index = file2.input_file_index
(* could also use physical equality [file1 == file2] *)
let compare_input_files file1 file2 =
Pervasives.compare file1.input_file_index file2.input_file_index
(* Ideally, this function should NOT be used, as it reflects the
order of the input files on the command line. As of 2016/08/25,
it is used by [UnparameterizedPrinter], for lack of a better
solution. *)
let current_input_file =
ref dummy_input_file
(* This declares that a new file is being processed. *)
let new_input_file name : unit =
current_input_file := {
input_file_name = name;
input_file_index = !current_input_file.input_file_index + 1
}
let get_input_file () : input_file =
assert (!current_input_file != dummy_input_file);
!current_input_file
let get_input_file_name () : string =
(get_input_file()).input_file_name
let file_contents =
ref (None : string option)
let get_file_contents () =
get_initialized_ref file_contents
(* ---------------------------------------------------------------------------- *)
(* Logging and log levels. *)
let log kind verbosity msg =
......
(* This module helps report errors and maintains some information
about the source file that is being read. *)
(* ---------------------------------------------------------------------------- *)
(* Call [set_filename] before lexing and parsing in order to inform
the module [Error] about the name of the file that is being
examined. *)
(* TEMPORARY limiter ou supprimer ou commenter cette interface stateful *)
val new_input_file: string -> unit
val get_input_file_name: unit -> string
type input_file
val builtin_input_file: input_file
val same_input_file: input_file -> input_file -> bool
val compare_input_files: input_file -> input_file -> int
val get_input_file: unit -> input_file
val file_contents: string option ref
val get_file_contents: unit -> string
(* This module helps report errors. *)
(* ---------------------------------------------------------------------------- *)
......
......@@ -10,19 +10,18 @@ let load_partial_grammar filename =
Error.error []
"argument file names should end in %s. \"%s\" is not accepted."
validExt filename;
Error.new_input_file filename;
InputFile.new_input_file filename;
try
let contents = IO.read_whole_file filename in
Error.file_contents := Some contents;
InputFile.with_file_contents contents (fun () ->
let open Lexing in
let lexbuf = Lexing.from_string contents in
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };
let grammar =
{ (Driver.grammar Lexer.main lexbuf) with Syntax.pg_filename = filename }
in
Error.file_contents := None;
grammar
(* the grammar: *)
{ (Driver.grammar Lexer.main lexbuf)
with Syntax.pg_filename = filename }
)
with Sys_error msg ->
Error.error [] "%s" msg
......
......@@ -582,7 +582,7 @@ module Production = struct
(* The start productions receive a level that pretends that they
originate in a fictitious "builtin" file. So, a reduce/reduce
conflict that involves a start production will not be solved. *)
let dummy = ProductionLevel (Error.builtin_input_file, 0) in
let dummy = ProductionLevel (InputFile.builtin_input_file, 0) in
Array.make n dummy
let (_ : int) = StringMap.fold (fun nonterminal { branches = branches } k ->
......@@ -1369,7 +1369,7 @@ module Precedence = struct
| _, UndefinedPrecedence ->
Ic
| PrecedenceLevel (m1, l1, _, _), PrecedenceLevel (m2, l2, _, _) ->
if not (Error.same_input_file m1 m2) then
if not (InputFile.same_input_file m1 m2) then
Ic
else
if l1 > l2 then
......@@ -1382,7 +1382,7 @@ module Precedence = struct
let production_order p1 p2 =
match p1, p2 with
| ProductionLevel (m1, l1), ProductionLevel (m2, l2) ->
if not (Error.same_input_file m1 m2) then
if not (InputFile.same_input_file m1 m2) then
Ic
else
if l1 > l2 then
......
......@@ -32,7 +32,7 @@ let savestart lexbuf f =
(* Extracts a chunk out of the source file. *)
let chunk ofs1 ofs2 =
let contents = Error.get_file_contents() in
let contents = InputFile.get_file_contents() in
let len = ofs2 - ofs1 in
String.sub contents ofs1 len
......@@ -243,7 +243,7 @@ let mk_stretch pos1 pos2 parenthesize monsters =
(String.make (pos1.pos_cnum - pos1.pos_bol) ' ') ^ content
in
Stretch.({
stretch_filename = Error.get_input_file_name();
stretch_filename = InputFile.get_input_file_name();
stretch_linenum = pos1.pos_lnum;
stretch_linecount = pos2.pos_lnum - pos1.pos_lnum;
stretch_content = content;
......
......@@ -5,13 +5,13 @@ let new_precedence_level =
let c = ref 0 in
fun pos1 pos2 ->
incr c;
PrecedenceLevel (Error.get_input_file (), !c, pos1, pos2)
PrecedenceLevel (InputFile.get_input_file (), !c, pos1, pos2)
let new_production_level =
let c = ref 0 in
fun () ->
incr c;
ProductionLevel (Error.get_input_file (), !c)
ProductionLevel (InputFile.get_input_file (), !c)
let new_on_error_reduce_level =
new_production_level
......
......@@ -58,7 +58,7 @@ type precedence_level =
value of type [input_file] is used to record an item's origin. The
positions allow locating certain warnings. *)
| PrecedenceLevel of Error.input_file * int * Lexing.position * Lexing.position
| PrecedenceLevel of InputFile.input_file * int * Lexing.position * Lexing.position
type token_properties =
{
......@@ -84,7 +84,7 @@ type branch_prec_annotation =
which production appears first in the grammar. See [ParserAux]. *)
type branch_production_level =
| ProductionLevel of Error.input_file * int
| ProductionLevel of InputFile.input_file * int
(* ------------------------------------------------------------------------ *)
......
......@@ -24,7 +24,7 @@ let rec insert_in_partitions item m = function
| [] ->
[ (m, [ item ]) ]
| (m', items) :: partitions when Error.same_input_file m m' ->
| (m', items) :: partitions when InputFile.same_input_file m m' ->
(m', item :: items) :: partitions
| t :: partitions ->
......@@ -173,7 +173,7 @@ let branches_order r r' =
let branch_order b b' =
match b.branch_production_level, b'.branch_production_level with
| ProductionLevel (m, l), ProductionLevel (m', l') ->
compare_pairs Error.compare_input_files Pervasives.compare (m, l) (m', l')
compare_pairs InputFile.compare_input_files Pervasives.compare (m, l) (m', l')
in
(* TEMPORARY I don't think we need a lexicographic ordering here *)
let rec lexical_order bs bs' =
......
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