mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 09:53:36 +00:00
Code Issues Projects Releases Wiki Activity
Files
f9c185e5e802d2d338783fc4ec2a435fccac5d21
mercury/compiler/parse_module.m
Zoltan Somogyi 191eb9eb64 Make --generate-dependencies-ints more practical. 
scripts/Mmake.rules:
    Add a rule for the pattern target %.depend_ints which invokes mmc
    with --generate-dependencies-ints, just as %.depend invokes mmc
    with --generate-dependencies.

    Document the reason why this addition requires yet more code duplication.

scripts/Mmake.vars.in:
    Add the make variable definitions needed by the new code in Mmake.rules.

compiler/mercury_compile_main.m:
    Make it practical to use --generate-dependencies-ints in a multi-directory
    project like the Mercury implementation, in which some directories
    may use --generate-dependencies-ints as the target of "mmake depend",
    while other directories, which come earlier in the build process,
    still do "mmake depend" using just --generate-dependencies.
    In such cases, mmc --generate-dependencies-ints in the later directory
    may fail to generate .int0, .int or .int2 files simply because
    the .int3 file of a module they import (from an earlier directory
    in which "mmake depend" uses just --generate-dependencies) hasn't been
    made yet. (This is what would happen if someone executed "mmake depend"
    at the top level in a freshly checked out workspace.)

    The practical fix is to simply report this fix using an error message
    that still allows the compiler to exit with an exit status that
    indicates success.

    Most of the rest of this diff is there to make this possible.

compiler/error_spec.m:
    Add a new phase, phase_find_files, that specifically indicates
    that we couldn't read a file because we couldn't find it.
    Give it a string argument naming the file, to allow mercury_compile_main.m
    to replace several error_specs that each report not being able to find
    one file with a single error_spec that reports not being able to find
    many files.

    Add a utility function for use by mercury_compile_main.m to construct
    that error message.

    Add another new phase, phase_make_int, that indicates a problem
    we discovered in the code of a Mercury source file while trying
    to decide what should got into one of the that module's interface files.

compiler/parse_error.m:
    Here also use separate function symbols in the fatal_module_read_error
    type for the situations "couldn't find a file" and "couldn't read a file".

    Update the predicates constructing error_specs to handle this distinction
    (which the callers make using the new function symbol in the above type).

compiler/compile_target_code.m:
compiler/error_util.m:
compiler/grab_modules.m:
compiler/options_file.m:
compiler/parse_module.m:
compiler/read_modules.m:
compiler/recompilation.check.m:
compiler/write_module_interface_files.m:
    Conform to the changes above.

compiler/options.m:
    Add a way to detect the presence of this diff in an installed compiler.
2023-10-15 13:10:40 +11:00

1817 lines
83 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------e
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------e
% Copyright (C) 1993-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: parse_module.m.
% Main author of original version: fjh.
% Main author of current version: zs.
%
% This module defines the top level predicates for parsing Mercury programs.
%
% The main predicates of this module, actually_read_module_{src,int,opt},
% read in and parse the contents of source files, interface files and
% optimization files respectively.
%
% The original design of this module represented all three kinds of files
% as simple lists of items. The design of the items themselves was made
% considerably more complex than is necessary for the compiler, because
% one objective was to preserve as much information about the source code
% as possible, to allow tools such as prettyprinters to reconstruct the
% source code as closely as possible. (For example, this is why each item
% has a sequence number.) The only information that was designed to be lost
% was the stripping of comments, whitespace and redundant parenthesization,
% the standardization of the spellings of the names of operators (such as
% rewriting "\+" to "not"), and the expansion of DCG clauses.
%
% We have not found a need for such prettyprinters in more than twenty years,
% so the original concern for minimizing the differences between the source
% code and the AST, which was Fergus's argument for keeping the AST a simple
% item list, has been shown to be irrelevant.
%
% We therefore now use a representation for the parse tree that is more suited
% to the needs of the compiler itself, even though it is more complex
% that a simple list of items. Part of this complexity is that source files,
% interface files and optimization files have different parse trees,
% and we accordingly have different predicates for creating those parse trees.
% The main predicates for reading these three kinds of files are
%
% - read_parse_tree_src,
% - read_parse_tree_int, and
% - read_parse_tree_opt.
%
% Each of these kinds of files has its grammar describing the structure
% its items should follow. The predicates parsing parts of those structures
% each have a comment before them specifying what part of the relevant file
% kind they are designed to parse. The grammar is simplest for opt files, and
% next simplest for int files, so the order of those predicates in this module
% is read_parse_tree_opt, read_parse_tree_int, and then read_parse_tree_src.
%
% Our parsing process has four stages instead of the usual two.
%
% The usual stages are:
% lexical analysis: chars -> tokens
% parsing: tokens -> structured parse tree
%
% Our stages are:
% lexical analysis: chars -> tokens
% parsing stage 1: tokens -> terms
% parsing stage 2: terms -> items and markers
% parsing stage 3: items and markers -> structured parse tree
%
% An item represents a clause or a declaration. A marker represents
% a declaration that affects the structure of the parse tree, usually by
% controlling what section or what (sub)module the following items belong to.
%
% We never materialize the intermediate representations (a token list,
% a term list or an item/marker list) all at once. Instead, we read in the
% contents of the relevant file one term at a time, and convert that
% to an item or marker before reading in the next term.
%
% Some predicates, when they parse a term, discover that it represents an
% item or marker that it is not their job to handle. In such cases, they
% return it to their caller, for the next step in the caller to process.
%
%---------------------------------------------------------------------------%
:- module parse_tree.parse_module.
:- interface.
:- import_module libs.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.timestamp.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.find_module.
:- import_module parse_tree.parse_error.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
:- import_module io.
:- import_module list.
:- import_module maybe.
%---------------------------------------------------------------------------%
% peek_at_file(DefaultModuleName, DefaultExpectationContexts,
% SourceFileName, ModuleName, Specs, !IO):
%
% When looking for a module, we sometimes want to see what the file says
% about what Mercury module is stored in it. So we read the first thing
% in it, and see whether it is a module declaration. If it is, return
% the name of the module as ModuleName. If it isn't, return
% DefaultModuleName as ModuleName.
% XXX ITEM_LIST In the latter case, we should return an error indication.
%
:- pred peek_at_file(io.text_input_stream::in,
module_name::in, list(prog_context)::in, file_name::in,
module_name::out, list(error_spec)::out, io::di, io::uo) is det.
% actually_read_module_src(Globals, FileNameAndStream,
% DefaultModuleName, DefaultExpectationContexts,
% ReadModuleAndTimestamps, MaybeModuleTimestampRes,
% ParseTree, Errors, !IO):
%
% Read a Mercury source program from FileNameAndStream.
% Close the stream when the reading is done. Return the parse tree
% of that module in ParseTree (which may be a dummy if the file
% couldn't be opened), and an indication of the errors found
% in Specs and Errors.
%
% For the meaning of ReadModuleAndTimestamps and MaybeModuleTimestampRes,
% read the comments on read_module_src in read_modules.m.
% XXX ITEM_LIST Move actually_read_module_{src,int,opt} to read_modules.m.
%
:- pred actually_read_module_src(globals::in, path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
maybe(parse_tree_src)::out, read_module_errors::out,
io::di, io::uo) is det.
% actually_read_module_intN(Globals, FileNameAndStream,
% DefaultModuleName, DefaultExpectationContexts,
% ReadModuleAndTimestamps, MaybeModuleTimestampRes,
% ParseTree, Errors, !IO):
%
% Analogous to actually_read_module_src, but opens the specified kind
% of interface file for DefaultModuleName.
%
:- pred actually_read_module_int0(globals::in, path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
maybe(parse_tree_int0)::out, read_module_errors::out,
io::di, io::uo) is det.
:- pred actually_read_module_int1(globals::in, path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
maybe(parse_tree_int1)::out, read_module_errors::out,
io::di, io::uo) is det.
:- pred actually_read_module_int2(globals::in, path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
maybe(parse_tree_int2)::out, read_module_errors::out,
io::di, io::uo) is det.
:- pred actually_read_module_int3(globals::in, path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
maybe(parse_tree_int3)::out, read_module_errors::out,
io::di, io::uo) is det.
% actually_read_module_{plain,trans}_opt(Globals, FileNameAndStream,
% DefaultModuleName, ParseTree, Errors, !IO):
%
% Analogous to actually_read_module_src, but opens the specified kind
% of optimization file for DefaultModuleName.
%
:- pred actually_read_module_plain_opt(globals::in, path_name_and_stream::in,
module_name::in, maybe(parse_tree_plain_opt)::out, read_module_errors::out,
io::di, io::uo) is det.
:- pred actually_read_module_trans_opt(globals::in, path_name_and_stream::in,
module_name::in, maybe(parse_tree_trans_opt)::out, read_module_errors::out,
io::di, io::uo) is det.
:- type maybe_require_module_decl
---> dont_require_module_decl
; require_module_decl.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module parse_tree.convert_parse_tree.
:- import_module parse_tree.file_kind.
:- import_module parse_tree.item_util.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.parse_item.
:- import_module parse_tree.parse_types.
:- import_module recompilation.
:- import_module bool.
:- import_module cord.
:- import_module counter.
:- import_module int.
:- import_module io.file.
:- import_module mercury_term_lexer.
:- import_module mercury_term_parser.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module term_context.
:- import_module varset.
:- type missing_section_start_warning
---> have_not_given_missing_section_start_warning
; have_given_missing_section_start_warning.
%---------------------------------------------------------------------------%
peek_at_file(FileStream, DefaultModuleName, DefaultExpectationContexts,
SourceFileName0, ModuleName, Specs, !IO) :-
io.read_file_as_string_and_num_code_units(FileStream, MaybeResult, !IO),
(
MaybeResult = ok2(FileString, FileStringLen),
counter.init(1, SeqNumCounter0),
LineContext0 = line_context(1, 0),
LinePosn0 = line_posn(0),
read_first_module_decl(FileString, FileStringLen,
dont_require_module_decl, DefaultModuleName,
DefaultExpectationContexts, ModuleDeclPresent,
may_change_source_file_name, SourceFileName0, _SourceFileName,
SeqNumCounter0, _SeqNumCounter,
LineContext0, _LineContext, LinePosn0, _LinePosn),
(
ModuleDeclPresent = no_module_decl_present(_MaybeLookAhead,
_Context, _NoModuleSpec),
ModuleName = DefaultModuleName
;
ModuleDeclPresent = wrong_module_decl_present(ModuleName,
_ModuleNameContext, _WrongSpec)
;
ModuleDeclPresent = right_module_decl_present(ModuleName,
_ModuleNameContext)
),
Specs = []
;
MaybeResult = error2(_PartialFileString, _FileStringLen, ErrorCode),
ModuleName = DefaultModuleName,
io.error_message(ErrorCode, ErrorMsg0),
ErrorMsg = "I/O error: " ++ ErrorMsg0,
io_error_to_error_spec(phase_read_files, ErrorMsg, Spec, !IO),
Specs = [Spec]
).
%---------------------------------------------------------------------------%
actually_read_module_src(_Globals, FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
MaybeParseTree, Errors, !IO) :-
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
read_parse_tree_src, MaybeParseTree, Errors, !IO).
%---------------------------------------------------------------------------%
actually_read_module_int0(Globals, FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
MaybeParseTreeInt0, Errors, !IO) :-
IntFileKind = ifk_int0,
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
read_parse_tree_int(IntFileKind), MaybeInitParseTreeInt, Errors0, !IO),
(
MaybeInitParseTreeInt = yes(InitParseTreeInt),
check_convert_parse_tree_int_to_int0(InitParseTreeInt, ParseTreeInt0,
[], ConvertSpecs),
MaybeParseTreeInt0 = yes(ParseTreeInt0),
maybe_add_convert_specs(Globals, ConvertSpecs, Errors0, Errors)
;
MaybeInitParseTreeInt = no,
MaybeParseTreeInt0 = no,
Errors = Errors0
).
actually_read_module_int1(Globals, FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
MaybeParseTreeInt1, Errors, !IO) :-
IntFileKind = ifk_int1,
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
read_parse_tree_int(IntFileKind), MaybeInitParseTreeInt, Errors0, !IO),
(
MaybeInitParseTreeInt = yes(InitParseTreeInt),
check_convert_parse_tree_int_to_int1(InitParseTreeInt, ParseTreeInt1,
[], ConvertSpecs),
MaybeParseTreeInt1 = yes(ParseTreeInt1),
maybe_add_convert_specs(Globals, ConvertSpecs, Errors0, Errors)
;
MaybeInitParseTreeInt = no,
MaybeParseTreeInt1 = no,
Errors = Errors0
).
actually_read_module_int2(Globals, FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
MaybeParseTreeInt2, Errors, !IO) :-
IntFileKind = ifk_int2,
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
read_parse_tree_int(IntFileKind), MaybeInitParseTreeInt, Errors0, !IO),
(
MaybeInitParseTreeInt = yes(InitParseTreeInt),
check_convert_parse_tree_int_to_int2(InitParseTreeInt, ParseTreeInt2,
[], ConvertSpecs),
MaybeParseTreeInt2 = yes(ParseTreeInt2),
maybe_add_convert_specs(Globals, ConvertSpecs, Errors0, Errors)
;
MaybeInitParseTreeInt = no,
MaybeParseTreeInt2 = no,
Errors = Errors0
).
actually_read_module_int3(Globals, FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
MaybeParseTreeInt3, Errors, !IO) :-
IntFileKind = ifk_int3,
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
read_parse_tree_int(IntFileKind), MaybeInitParseTreeInt, Errors0, !IO),
(
MaybeInitParseTreeInt = yes(InitParseTreeInt),
check_convert_parse_tree_int_to_int3(InitParseTreeInt, ParseTreeInt3,
[], ConvertSpecs),
MaybeParseTreeInt3 = yes(ParseTreeInt3),
maybe_add_convert_specs(Globals, ConvertSpecs, Errors0, Errors)
;
MaybeInitParseTreeInt = no,
MaybeParseTreeInt3 = no,
Errors = Errors0
).
:- pred maybe_add_convert_specs(globals::in, list(error_spec)::in,
read_module_errors::in, read_module_errors::out) is det.
maybe_add_convert_specs(Globals, ConvertSpecs, !Errors) :-
globals.lookup_bool_option(Globals, halt_at_invalid_interface,
HaltAtInvalidInterface),
(
HaltAtInvalidInterface = no
;
HaltAtInvalidInterface = yes,
add_any_nec_errors(ConvertSpecs, !Errors)
).
%---------------------------------------------------------------------------%
actually_read_module_plain_opt(_Globals, FileNameAndStream, DefaultModuleName,
MaybeParseTreePlainOpt, Errors, !IO) :-
DefaultExpectationContexts = [],
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
always_read_module(dont_return_timestamp), _,
read_parse_tree_opt(ofk_opt), MaybeParseTreeOpt, Errors0, !IO),
(
MaybeParseTreeOpt = yes(ParseTreeOpt),
check_convert_parse_tree_opt_to_plain_opt(ParseTreeOpt,
ParseTreePlainOpt, [], ConvertSpecs),
MaybeParseTreePlainOpt = yes(ParseTreePlainOpt),
add_any_nec_errors(ConvertSpecs, Errors0, Errors)
;
MaybeParseTreeOpt = no,
MaybeParseTreePlainOpt = no,
Errors = Errors0
).
actually_read_module_trans_opt(_Globals, FileNameAndStream, DefaultModuleName,
MaybeParseTreeTransOpt, Errors, !IO) :-
DefaultExpectationContexts = [],
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
always_read_module(dont_return_timestamp), _,
read_parse_tree_opt(ofk_trans_opt), MaybeParseTreeOpt, Errors0, !IO),
(
MaybeParseTreeOpt = yes(ParseTreeOpt),
check_convert_parse_tree_opt_to_trans_opt(ParseTreeOpt,
ParseTreeTransOpt, [], ConvertSpecs),
MaybeParseTreeTransOpt = yes(ParseTreeTransOpt),
add_any_nec_errors(ConvertSpecs, Errors0, Errors)
;
MaybeParseTreeOpt = no,
MaybeParseTreeTransOpt = no,
Errors = Errors0
).
%---------------------------------------------------------------------------%
:- pred report_module_has_unexpected_name(file_name::in,
module_name::in, list(prog_context)::in,
module_name::in, maybe(term.context)::in, error_spec::out) is det.
report_module_has_unexpected_name(FileName, ExpectedName, ExpectationContexts,
ActualName, MaybeActualContext, Spec) :-
( if
MaybeActualContext = yes(ActualContext),
not term_context.is_dummy_context(ActualContext)
then
MaybeContext = MaybeActualContext
else
MaybeContext = maybe.no
),
MainPieces = [words("Error: file"), quote(FileName),
words("contains the wrong module."),
words("Expected module"), qual_sym_name(ExpectedName), suffix(","),
words("found module"), qual_sym_name(ActualName), suffix("."), nl],
MainMsg = error_msg(MaybeContext, always_treat_as_first, 0,
[always(MainPieces)]),
list.sort_and_remove_dups(ExpectationContexts, SortedExpectationContexts0),
list.delete_all(SortedExpectationContexts0, dummy_context,
SortedExpectationContexts),
list.map(expectation_context_to_msg, SortedExpectationContexts, SubMsgs),
% We make the warning conditional on the warn_wrong_module_name option.
% This option is turned on by default, and it is turned off automatically
% by the compiler only in situations where it clearly makes sense to do so
% (in handle_options.m and options.m). If it is turned off manually
% by the user, he/she presumably has a good reason.
%
% Despite the option name having the "warn_" prefix,
% the severity is an error. The severity is deliberate.
% XXX The option should be renamed, but there is no obvious
% non-misleading name.
Spec = conditional_spec($pred, warn_wrong_module_name, yes,
severity_error, phase_module_name, [MainMsg | SubMsgs]).
:- pred expectation_context_to_msg(prog_context::in, error_msg::out) is det.
expectation_context_to_msg(Context, SubMsg) :-
SubPieces = [words("The expected name is specified here."), nl],
SubMsg = simplest_msg(Context, SubPieces).
%---------------------%
:- type read_parse_tree(PT) ==
pred(file_name, string, int, line_context, line_posn, module_name,
list(prog_context), maybe(PT), read_module_errors).
:- inst read_parse_tree
== (pred(in, in, in, in, in, in, in, out, out) is det).
:- type make_dummy_parse_tree(PT) == pred(module_name, PT).
:- inst make_dummy_parse_tree == (pred(in, out) is det).
%---------------------------------------------------------------------------%
% This predicate implements all three of actually_read_module_{src,int,opt}
% through the polymorphism provided by the ReadParseTree (sometimes the
% MakeDummyParseTree) higher order variables. All the actual parsing
% takes place inside ReadParseTree, which will be one of
% read_parse_tree_src, read_parse_tree_int and read_parse_tree_src.
%
:- pred do_actually_read_module(path_name_and_stream::in,
module_name::in, list(prog_context)::in,
read_module_and_timestamps::in, maybe(io.res(timestamp))::out,
read_parse_tree(PT)::in(read_parse_tree), maybe(PT)::out,
read_module_errors::out, io::di, io::uo) is det.
do_actually_read_module(FileNameAndStream,
DefaultModuleName, DefaultExpectationContexts,
ReadModuleAndTimestamps, MaybeModuleTimestampRes,
ReadParseTree, MaybeParseTree, Errors, !IO) :-
FileNameAndStream = path_name_and_stream(_FilePathName, FileStream),
io.input_stream_name(FileStream, FileStreamName, !IO),
(
( ReadModuleAndTimestamps = always_read_module(do_return_timestamp)
; ReadModuleAndTimestamps = dont_read_module_if_match(_)
),
io.file.file_modification_time(FileStreamName, TimestampResult, !IO),
(
TimestampResult = ok(Timestamp),
MaybeModuleTimestampRes =
yes(ok(time_t_to_timestamp(Timestamp)))
;
TimestampResult = error(IOError),
MaybeModuleTimestampRes = yes(error(IOError))
)
;
ReadModuleAndTimestamps = always_read_module(dont_return_timestamp),
MaybeModuleTimestampRes = no
),
( if
ReadModuleAndTimestamps = dont_read_module_if_match(OldTimestamp),
MaybeModuleTimestampRes = yes(ok(OldTimestamp))
then
% XXX Currently smart recompilation won't work
% if ModuleName \= DefaultModuleName.
% In that case, smart recompilation will be disabled
% and actually_read_module should never be passed an old timestamp.
MaybeParseTree = no,
Errors = init_read_module_errors
else
io.read_file_as_string_and_num_code_units(FileStream,
MaybeResult, !IO),
(
MaybeResult = ok2(FileString, NumCodeUnits),
FileStringLen = string.length(FileString),
( if NumCodeUnits = FileStringLen then
true
else
Msg = string.format(
"NumCodeUnits = %d, FileStringLen = %d\n<<<\n%s>>>\n",
[i(NumCodeUnits), i(FileStringLen), s(FileString)]),
unexpected($pred, Msg)
),
LineContext0 = line_context(1, 0),
LinePosn0 = line_posn(0),
ReadParseTree(FileStreamName, FileString, FileStringLen,
LineContext0, LinePosn0,
DefaultModuleName, DefaultExpectationContexts,
MaybeParseTree, Errors)
;
MaybeResult = error2(_PartialStr, _PartialLen, ErrorCode),
MaybeParseTree = no,
io.error_message(ErrorCode, ErrorMsg0),
ErrorMsg = "I/O error: " ++ ErrorMsg0,
io_error_to_read_module_errors(frme_could_not_read_file,
phase_read_files, ErrorMsg, Errors, !IO)
)
),
% XXX This should be moved next to the code that opens FileStream,
% in one of our ancestors.
io.close_input(FileStream, !IO).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% This part of the module parses optimization files.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% opt: STARTHERE module_start, item* ENDHERE
%
%---------------------------------------------------------------------------%
% Read an optimization file (.opt or .trans_opt) from standard input.
%
:- pred read_parse_tree_opt(opt_file_kind::in, file_name::in,
string::in, int::in, line_context::in, line_posn::in,
module_name::in, list(prog_context)::in, maybe(parse_tree_opt)::out,
read_module_errors::out) is det.
read_parse_tree_opt(OptFileKind, SourceFileName0,
FileString, FileStringLen, !.LineContext, !.LinePosn,
DefaultModuleName, DefaultExpectationContexts,
MaybeParseTree, !:Errors) :-
read_module_header(FileString, FileStringLen,
DefaultModuleName, DefaultExpectationContexts, SourceFileName0,
MaybeModuleHeader, SeqNumCounter1, !LineContext, !LinePosn),
(
MaybeModuleHeader = no_valid_module_header(!:Errors),
MaybeParseTree = no
;
MaybeModuleHeader = valid_module_header(ModuleName, ModuleNameContext),
% XXX We should allow the update of SourceFileName.
read_item_sequence(FileString, FileStringLen, ModuleName,
no_lookahead, FinalLookAhead,
cord.init, InclsCord, cord.init, AvailsCord,
cord.init, FIMsCord, cord.init, ItemsCord,
SourceFileName0, SourceFileName, SeqNumCounter1, SeqNumCounter,
init_read_module_errors, !:Errors, !LineContext, !LinePosn),
check_for_unexpected_item_at_end(SourceFileName, FileString,
FileStringLen, ModuleName, fk_opt(OptFileKind), FinalLookAhead,
SeqNumCounter, !Errors, !.LineContext, !.LinePosn),
expect(cord.is_empty(InclsCord), $pred, "Incls != []"),
Avails = cord.list(AvailsCord),
avail_imports_uses(Avails, Imports, Uses),
expect(unify(Imports, []), $pred, "Imports != []"),
FIMs = cord.list(FIMsCord),
Items = cord.list(ItemsCord),
ParseTree = parse_tree_opt(ModuleName, OptFileKind, ModuleNameContext,
Uses, FIMs, Items),
MaybeParseTree = yes(ParseTree)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% This part of the module parses interface files.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% int: STARTHERE module_start, vns? section, section? ENDHERE
%
% section: interface_marker, item*
% implementation_marker, item*
%
%---------------------------------------------------------------------------%
% Read an interface file (.int0, .int3, .int2 or .int).
%
:- pred read_parse_tree_int(int_file_kind::in, file_name::in,
string::in, int::in, line_context::in, line_posn::in,
module_name::in, list(prog_context)::in, maybe(parse_tree_int)::out,
read_module_errors::out) is det.
read_parse_tree_int(IntFileKind, SourceFileName,
FileString, FileStringLen, !.LineContext, !.LinePosn,
DefaultModuleName, DefaultExpectationContexts,
MaybeParseTreeInt, !:Errors) :-
some [!SeqNumCounter, !LookAhead] (
read_module_header(FileString, FileStringLen,
DefaultModuleName, DefaultExpectationContexts, SourceFileName,
MaybeModuleHeader, !:SeqNumCounter, !LineContext, !LinePosn),
(
MaybeModuleHeader = no_valid_module_header(!:Errors),
MaybeParseTreeInt = no
;
MaybeModuleHeader =
valid_module_header(ModuleName, ModuleNameContext),
!:LookAhead = no_lookahead,
read_any_version_number_item(FileString, FileStringLen,
ModuleName, SourceFileName, !LookAhead, VersionNumbersResult,
!SeqNumCounter, !LineContext, !LinePosn),
(
VersionNumbersResult = vnr_error(Spec, Error),
!:Errors = init_read_module_errors,
add_nonfatal_error(Error, [Spec], !Errors),
MaybeParseTreeInt = no
;
VersionNumbersResult = vnr_ok(MaybeVersionNumbers),
read_parse_tree_int_sections(FileString, FileStringLen,
ModuleName, ModuleNameContext, IntFileKind,
SourceFileName, MaybeVersionNumbers,
!LookAhead, MaybeParseTreeInt, !SeqNumCounter,
!:Errors, !LineContext, !LinePosn),
check_for_unexpected_item_at_end(SourceFileName,
FileString, FileStringLen, ModuleName, fk_int(IntFileKind),
!.LookAhead, !.SeqNumCounter, !Errors,
!.LineContext, !.LinePosn)
)
)
).
:- type version_number_result
---> vnr_ok(maybe_version_numbers)
; vnr_error(error_spec, nonfatal_read_module_error).
:- pred read_any_version_number_item(string::in, int::in,
module_name::in, file_name::in, maybe_lookahead::in, maybe_lookahead::out,
version_number_result::out, counter::in, counter::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_any_version_number_item(FileString, FileStringLen,
ModuleName, SourceFileName, InitLookAhead, FinalLookAhead,
VersionNumberResult, !SeqNumCounter, !LineContext, !LinePosn) :-
get_next_item_or_marker(SourceFileName, FileString, FileStringLen,
InitLookAhead, ModuleName, ReadIOMResult,
!SeqNumCounter, !LineContext, !LinePosn),
(
ReadIOMResult = read_iom_eof,
% If we have found end-of-file, then we are done.
FinalLookAhead = no_lookahead,
VersionNumberResult = vnr_ok(no_version_numbers)
;
ReadIOMResult = read_iom_parse_term_error(ItemSpec),
% We used to continue looking for a version number in this situation,
% but (a) given that version numbers are put into .intN files
% by automatic processes, *any* error detected in them renders
% the entire contents of the file suspect, and (b) when we are
% expecting a section marker but find read_iom_parse_term_error,
% we don't continue looking.
FinalLookAhead = no_lookahead,
VersionNumberResult = vnr_error(ItemSpec, rme_could_not_read_term)
;
ReadIOMResult = read_iom_parse_item_errors(_, _, _),
% Ignore the errors; our caller will compute them again,
% and record them, if and when it parses FinalLookAhead again.
FinalLookAhead = lookahead(ReadIOMResult),
VersionNumberResult = vnr_ok(no_version_numbers)
;
ReadIOMResult = read_iom_ok(_IOMVarSet, _IOMTerm, IOM),
% If the term we have read in is a version number item, return it.
% If the term is anything else, leave it in the input to be handled
% later.
(
IOM = iom_marker_version_numbers(VN),
FinalLookAhead = no_lookahead,
VersionNumberResult = vnr_ok(version_numbers(VN))
;
( IOM = iom_marker_module_start(_, _, _)
; IOM = iom_marker_module_end(_, _, _)
; IOM = iom_marker_src_file(_)
; IOM = iom_marker_section(_, _, _)
; IOM = iom_marker_include(_)
; IOM = iom_marker_avail(_)
; IOM = iom_marker_fim(_)
; IOM = iom_item(_)
; IOM = iom_item_and_error_specs(_, _)
% The reasoning for read_iom_parse_item_errors also applies
% to iom_item_and_specs.
; IOM = iom_handled_no_error
; IOM = iom_handled_error(_)
),
FinalLookAhead = lookahead(ReadIOMResult),
VersionNumberResult = vnr_ok(no_version_numbers)
)
).
%---------------------------------------------------------------------------%
%
% int: module_start, vns? STARTHERE int_section, int_section? ENDHERE
%
%---------------------------------------------------------------------------%
% XXX ITEM_LIST We should return *either* a ParseTreeInt *or* some errors,
% but *not* both.
%
:- pred read_parse_tree_int_sections(string::in, int::in,
module_name::in, prog_context::in, int_file_kind::in, file_name::in,
maybe_version_numbers::in, maybe_lookahead::in, maybe_lookahead::out,
maybe(parse_tree_int)::out, counter::in, counter::out,
read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_parse_tree_int_sections(FileString, FileStringLen,
ModuleName, ModuleNameContext, IntFileKind, SourceFileName,
MaybeVersionNumbers, !LookAhead, MaybeParseTreeInt, !SeqNumCounter,
!:Errors, !LineContext, !LinePosn) :-
read_parse_tree_int_section(FileString, FileStringLen,
ModuleName, SourceFileName, "interface", !LookAhead,
MaybeFirstRawItemBlock, !SeqNumCounter,
init_read_module_errors, !:Errors, !LineContext, !LinePosn),
(
MaybeFirstRawItemBlock = no,
% Ignore MaybeVersionNumbers if the interface is empty,
% since there are no items whose version numbers we may be
% interested in.
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind,
ModuleNameContext, no_version_numbers,
[], [], [], [], [], [], [], []),
MaybeParseTreeInt = yes(ParseTreeInt)
;
MaybeFirstRawItemBlock = yes({FirstRawItemBlock, _}),
FirstRawItemBlock = item_block(_, FirstSectionKind,
FirstIncls, FirstAvails, FirstFIMs, FirstItems),
(
FirstSectionKind = ms_interface,
read_parse_tree_int_section(FileString, FileStringLen,
ModuleName, SourceFileName, "implementation", !LookAhead,
MaybeSecondRawItemBlock, !SeqNumCounter, !Errors,
!LineContext, !LinePosn),
(
MaybeSecondRawItemBlock = no,
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind,
ModuleNameContext, MaybeVersionNumbers,
FirstIncls, [], FirstAvails, [],
FirstFIMs, [], FirstItems, []),
MaybeParseTreeInt = yes(ParseTreeInt)
;
MaybeSecondRawItemBlock =
yes({SecondRawItemBlock, SectionContext}),
SecondRawItemBlock = item_block(_, SecondSectionKind,
SecondIncls, SecondAvails, SecondFIMs, SecondItems),
(
SecondSectionKind = ms_interface,
Pieces = [words("Error: an interface file"),
words("should not have two consecutive"),
words("interface sections."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, SectionContext, Pieces),
add_nonfatal_error(rme_nec, [Spec], !Errors),
MaybeParseTreeInt = no
;
SecondSectionKind = ms_implementation,
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind,
ModuleNameContext, MaybeVersionNumbers,
FirstIncls, SecondIncls, FirstAvails, SecondAvails,
FirstFIMs, SecondFIMs, FirstItems, SecondItems),
MaybeParseTreeInt = yes(ParseTreeInt)
)
)
;
FirstSectionKind = ms_implementation,
% This should not happen, but I (zs) cannot come up
% with a convincing argument for *why*.
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind,
ModuleNameContext, MaybeVersionNumbers,
[], FirstIncls, [], FirstAvails,
[], FirstFIMs, [], FirstItems),
MaybeParseTreeInt = yes(ParseTreeInt)
)
).
%---------------------------------------------------------------------------%
%
% int_section:
% STARTHERE interface_marker, item* ENDHERE
% STARTHERE implementation_marker, item* ENDHERE
%
%---------------------------------------------------------------------------%
:- pred read_parse_tree_int_section(string::in, int::in,
module_name::in, file_name::in, string::in,
maybe_lookahead::in, maybe_lookahead::out,
maybe({raw_item_block, prog_context})::out,
counter::in, counter::out, read_module_errors::in, read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_parse_tree_int_section(FileString, FileStringLen,
ModuleName, SourceFileName, ExpectedSectionKindStr,
InitLookAhead, FinalLookAhead, MaybeRawItemBlock,
!SeqNumCounter, !Errors, !LineContext, !LinePosn) :-
get_next_item_or_marker(SourceFileName, FileString, FileStringLen,
InitLookAhead, ModuleName, ReadIOMResult, !SeqNumCounter,
!LineContext, !LinePosn),
(
(
ReadIOMResult = read_iom_eof
;
ReadIOMResult = read_iom_parse_term_error(ItemSpec),
add_nonfatal_error(rme_could_not_read_term, [ItemSpec], !Errors)
;
ReadIOMResult = read_iom_parse_item_errors(_IOMVarSet, _IOMTerm,
ItemSpecs),
add_nonfatal_error(rme_could_not_parse_item, ItemSpecs, !Errors)
),
MaybeRawItemBlock = no,
FinalLookAhead = no_lookahead
;
ReadIOMResult = read_iom_ok(_IOMVarSet, IOMTerm, IOM),
(
IOM = iom_marker_section(SectionKind, SectionContext,
_SectionSeqNum),
read_item_sequence(FileString, FileStringLen,
ModuleName, no_lookahead, FinalLookAhead,
cord.init, InclsCord, cord.init, AvailsCord,
cord.init, FIMsCord, cord.init, ItemsCord,
SourceFileName, _UpdatedSourceFileName,
!SeqNumCounter, !Errors, !LineContext, !LinePosn),
RawItemBlock = item_block(ModuleName, SectionKind,
cord.list(InclsCord), cord.list(AvailsCord),
cord.list(FIMsCord), cord.list(ItemsCord)),
MaybeRawItemBlock = yes({RawItemBlock, SectionContext})
;
( IOM = iom_marker_src_file(_)
; IOM = iom_marker_module_start(_, _, _)
; IOM = iom_marker_module_end(_, _, _)
; IOM = iom_marker_version_numbers(_)
; IOM = iom_marker_include(_)
; IOM = iom_marker_avail(_)
; IOM = iom_marker_fim(_)
; IOM = iom_item(_)
% The fact that IOM is not a section marker trumps any error_specs
% in iom_item_and_error_specs, and in iom_handled_error.
; IOM = iom_item_and_error_specs(_, _)
; IOM = iom_handled_no_error
; IOM = iom_handled_error(_)
),
Context = get_term_context(IOMTerm),
IOMPieces = iom_desc_pieces(IOM),
Pieces = [words("Error: expected the start of an"),
words(ExpectedSectionKindStr), words("section, got")] ++
IOMPieces ++ [suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, Context, Pieces),
add_nonfatal_error(rme_nec, [Spec], !Errors),
FinalLookAhead = lookahead(ReadIOMResult),
MaybeRawItemBlock = no
)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% This part of the module parses source files.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% src: STARTHERE module_start, component*, (module_end | epsilon) ENDHERE
%
% component: (interface_marker | epsilon), item*
% (implementation_marker | epsilon), item*
% module_start, component*, (module_end | epsilon)
%
% The marker that starts a component may be missing if the previous components
% were (one or more) nested submodules, and before those nested submodules,
% there was an interface or implementation section. That previous section
% may have started with an explicit section marker, or it may have been
% preceded by other nested submodules, and identified as an interface or
% implementation section by the preceding section, and so on.
%
% A submodule may have its final end_module marker missing if there is nothing
% following it: no item, no marker, only the implicit EOF.
%
%---------------------------------------------------------------------------%
:- pred read_parse_tree_src(file_name::in, string::in, int::in,
line_context::in, line_posn::in, module_name::in, list(prog_context)::in,
maybe(parse_tree_src)::out, read_module_errors::out) is det.
read_parse_tree_src(!.SourceFileName, FileString, FileStringLen,
!.LineContext, !.LinePosn,
DefaultModuleName, DefaultExpectationContexts,
MaybeParseTree, !:Errors) :-
some [!SeqNumCounter] (
!:Errors = init_read_module_errors,
counter.init(1, !:SeqNumCounter),
% We handle the first module declaration specially. Read the
% documentation on read_first_module_decl for the reason.
read_first_module_decl(FileString, FileStringLen,
dont_require_module_decl, DefaultModuleName,
DefaultExpectationContexts, ModuleDeclPresent,
may_change_source_file_name, !SourceFileName,
!SeqNumCounter, !LineContext, !LinePosn),
(
ModuleDeclPresent = no_module_decl_present(InitLookAhead,
InitLookAheadContext, NoModuleSpec),
add_nonfatal_error(rme_no_module_decl_at_start, [NoModuleSpec],
!Errors),
% Reparse the first term, this time treating it as occuring within
% the scope of the implicit `:- module' decl rather than in the
% root module.
ModuleName = DefaultModuleName,
ModuleNameContext = InitLookAheadContext
;
% XXX ITEM_LIST wrong_module_decl_present and
% right_module_decl_present do the same thing.
ModuleDeclPresent = wrong_module_decl_present(ModuleName,
ModuleNameContext, WrongSpec),
add_nonfatal_error(rme_unexpected_module_name, [WrongSpec],
!Errors),
InitLookAhead = no_lookahead
;
ModuleDeclPresent =
right_module_decl_present(ModuleName, ModuleNameContext),
InitLookAhead = no_lookahead
),
ContainingModules = [],
MaybePrevSection = no,
read_parse_tree_src_components(FileString, FileStringLen,
ModuleName, ContainingModules, MaybePrevSection,
have_not_given_missing_section_start_warning,
InitLookAhead, FinalLookAhead, cord.init, ModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn),
check_for_unexpected_item_at_end(!.SourceFileName, FileString,
FileStringLen, ModuleName, fk_src, FinalLookAhead, !.SeqNumCounter,
!Errors, !.LineContext, !.LinePosn),
ParseTree = parse_tree_src(ModuleName, ModuleNameContext,
ModuleComponents),
MaybeParseTree = yes(ParseTree)
).
%---------------------------------------------------------------------------%
%
% src: module_start, STARTHERE component*, (module_end | epsilon) ENDHERE
%
% component: (interface_marker | epsilon), item*
% (implementation_marker | epsilon), item*
% module_start, STARTHERE component*, (module_end | epsilon) ENDHERE
%
%---------------------------------------------------------------------------%
:- pred read_parse_tree_src_components(string::in, int::in,
module_name::in, list(module_name)::in,
maybe(pair(module_section, prog_context))::in,
missing_section_start_warning::in,
maybe_lookahead::in, maybe_lookahead::out,
cord(module_component)::in, cord(module_component)::out,
file_name::in, file_name::out, counter::in, counter::out,
read_module_errors::in, read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules,
MaybePrevSection, !.MissingStartSectionWarning,
InitLookAhead, FinalLookAhead, !ModuleComponents, !SourceFileName,
!SeqNumCounter, !Errors, !LineContext, !LinePosn) :-
get_next_item_or_marker(!.SourceFileName, FileString, FileStringLen,
InitLookAhead, CurModuleName, ReadIOMResult, !SeqNumCounter,
!LineContext, !LinePosn),
(
ReadIOMResult = read_iom_eof,
% If we have found end-of-file, then we are done.
FinalLookAhead = no_lookahead
;
ReadIOMResult = read_iom_parse_term_error(ItemSpec),
add_nonfatal_error(rme_could_not_read_term, [ItemSpec], !Errors),
% Continue looking for a section marker.
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules,
MaybePrevSection, !.MissingStartSectionWarning,
no_lookahead, FinalLookAhead, !ModuleComponents, !SourceFileName,
!SeqNumCounter, !Errors, !LineContext, !LinePosn)
;
ReadIOMResult = read_iom_parse_item_errors(_IOMVarSet, IOMTerm,
_Specs),
% Generate an error for the missing section marker.
% Leave the term in the lookahead, but otherwise handle the term
% as it were an unexpected but perfectly parseable term, i.e. follow
% the pattern of the iom_item case below.
Context = get_term_context(IOMTerm),
generate_missing_start_section_warning_src(CurModuleName,
Context, !.MissingStartSectionWarning, _MissingStartSectionWarning,
!Errors),
SectionKind = ms_implementation,
SectionContext = dummy_context,
ItemSeqInitLookAhead = lookahead(ReadIOMResult),
read_item_sequence(FileString, FileStringLen, CurModuleName,
ItemSeqInitLookAhead, ItemSeqFinalLookAhead,
cord.init, InclsCord, cord.init, AvailsCord,
cord.init, FIMsCord, cord.init, ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn),
add_section_component(CurModuleName, SectionKind, SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord, !ModuleComponents),
% We have read in one component; recurse to read in other components.
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules,
yes(SectionKind - SectionContext),
have_not_given_missing_section_start_warning,
ItemSeqFinalLookAhead, FinalLookAhead, !ModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn)
;
ReadIOMResult = read_iom_ok(_IOMVarSet, IOMTerm, IOM),
(
IOM = iom_marker_src_file(!:SourceFileName),
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules, MaybePrevSection,
!.MissingStartSectionWarning, no_lookahead, FinalLookAhead,
!ModuleComponents, !SourceFileName, !SeqNumCounter,
!Errors, !LineContext, !LinePosn)
;
IOM = iom_marker_version_numbers(_),
Pieces = [words("Error: unexpected version_numbers record"),
words("in source file."), nl],
Spec = simplest_spec($pred, severity_error, phase_read_files,
get_term_context(IOMTerm), Pieces),
add_nonfatal_error(rme_nec, [Spec], !Errors),
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules, MaybePrevSection,
!.MissingStartSectionWarning, no_lookahead, FinalLookAhead,
!ModuleComponents, !SourceFileName, !SeqNumCounter,
!Errors, !LineContext, !LinePosn)
;
IOM = iom_marker_module_start(RawStartModuleName, StartContext,
_StartSeqNum),
(
RawStartModuleName = unqualified(RawBaseName),
StartModuleName = qualified(CurModuleName, RawBaseName)
;
RawStartModuleName = qualified(RawModuleName, RawBaseName),
( if
partial_sym_name_matches_full(RawModuleName, CurModuleName)
then
StartModuleName = qualified(CurModuleName, RawBaseName)
else
Pieces = [words("Error: module qualification of"),
words("nested submodule"),
qual_sym_name(RawStartModuleName),
words("does not match the then-current module,"),
qual_sym_name(CurModuleName), suffix("."), nl],
Spec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, StartContext, Pieces),
add_nonfatal_error(rme_nec, [Spec], !Errors),
% Recover partially by ignoring the bad module
% qualification. The recovery is only partial because
% an end_module marker that matches the incorrect module
% name will get another error message about the
% `:- end_module' not matching the `:- module' declaration,
% which will be at least a bit misleading.
StartModuleName = qualified(CurModuleName, RawBaseName)
)
),
read_parse_tree_src_submodule(FileString, FileStringLen,
ContainingModules, MaybePrevSection, CurModuleName,
StartModuleName, StartContext,
no_lookahead, SubModuleFinalLookAhead, !ModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn),
% We have read in one component; recurse to read in others.
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules, MaybePrevSection,
!.MissingStartSectionWarning,
SubModuleFinalLookAhead, FinalLookAhead, !ModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn)
;
( IOM = iom_marker_section(_, _, _)
; IOM = iom_marker_include(_)
; IOM = iom_marker_avail(_)
; IOM = iom_marker_fim(_)
; IOM = iom_item(_)
; IOM = iom_item_and_error_specs(_, _)
; IOM = iom_handled_no_error
; IOM = iom_handled_error(_)
),
(
IOM = iom_marker_section(SectionKind, SectionContext,
_SectionSeqNum),
ItemSeqInitLookAhead = no_lookahead
;
(
( IOM = iom_marker_include(_)
; IOM = iom_marker_avail(_)
; IOM = iom_marker_fim(_)
; IOM = iom_item(_)
; IOM = iom_handled_no_error
)
;
IOM = iom_handled_error(ItemSpecs),
add_nonfatal_error(rme_nec, ItemSpecs, !Errors)
;
IOM = iom_item_and_error_specs(_, ItemSpecs),
add_nonfatal_error(rme_nec, ItemSpecs, !Errors)
),
(
MaybePrevSection = yes(SectionKind - SectionContext)
% When a nested module occurs in a section, the section
% continues after the nested module without the need
% for a new section declaration.
;
MaybePrevSection = no,
Context = get_term_context(IOMTerm),
generate_missing_start_section_warning_src(CurModuleName,
Context, !.MissingStartSectionWarning,
_MissingStartSectionWarning, !Errors),
% The following code is duplicated in the case for
% read_iom_parse_item_errors above.
SectionKind = ms_implementation,
SectionContext = dummy_context
),
ItemSeqInitLookAhead = lookahead(ReadIOMResult)
),
% The following code is duplicated in the case for
% read_iom_parse_item_errors above.
read_item_sequence(FileString, FileStringLen, CurModuleName,
ItemSeqInitLookAhead, ItemSeqFinalLookAhead,
cord.init, InclsCord, cord.init, AvailsCord,
cord.init, FIMsCord, cord.init, ItemsCord, !SourceFileName,
!SeqNumCounter, !Errors, !LineContext, !LinePosn),
add_section_component(CurModuleName, SectionKind, SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord, !ModuleComponents),
% We have read in one component; recurse to read in other
% components.
read_parse_tree_src_components(FileString, FileStringLen,
CurModuleName, ContainingModules,
yes(SectionKind - SectionContext),
have_not_given_missing_section_start_warning,
ItemSeqFinalLookAhead, FinalLookAhead, !ModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn)
;
IOM = iom_marker_module_end(EndedModuleName, EndContext,
_EndSeqNum),
handle_module_end_marker(CurModuleName, ContainingModules,
ReadIOMResult, EndedModuleName, EndContext, FinalLookAhead,
!Errors)
)
).
:- pred add_section_component(module_name::in, module_section::in,
prog_context::in, cord(item_include)::in, cord(item_avail)::in,
cord(item_fim)::in, cord(item)::in,
cord(module_component)::in, cord(module_component)::out) is det.
add_section_component(ModuleName, SectionKind, SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord, !ModuleComponents) :-
( if
cord.is_empty(InclsCord),
cord.is_empty(AvailsCord),
cord.is_empty(FIMsCord),
cord.is_empty(ItemsCord)
then
true
else
Component = mc_section(ModuleName, SectionKind, SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord),
!:ModuleComponents = cord.snoc(!.ModuleComponents, Component)
).
:- pred generate_missing_start_section_warning_src(module_name::in,
prog_context::in,
missing_section_start_warning::in, missing_section_start_warning::out,
read_module_errors::in, read_module_errors::out) is det.
generate_missing_start_section_warning_src(CurModuleName,
Context, !MissingStartSectionWarning, !Errors) :-
(
!.MissingStartSectionWarning =
have_not_given_missing_section_start_warning,
!:MissingStartSectionWarning =
have_given_missing_section_start_warning,
Pieces = [invis_order_default_start(1, ""),
words("Error: module"),
qual_sym_name(CurModuleName), words("should start with"),
words("either an"), decl("interface"), words("or an"),
decl("implementation"), words("declaration."), nl,
words("The following assumes that"),
words("the missing declaration is an"),
decl("implementation"), words("declaration."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
Context, Pieces),
add_nonfatal_error(rme_no_section_decl_at_start, [Spec], !Errors)
;
!.MissingStartSectionWarning =
have_given_missing_section_start_warning
% Do not generate duplicate warnings.
).
:- pred read_parse_tree_src_submodule(string::in, int::in,
list(module_name)::in, maybe(pair(module_section, prog_context))::in,
module_name::in, module_name::in, prog_context::in,
maybe_lookahead::in, maybe_lookahead::out,
cord(module_component)::in, cord(module_component)::out,
file_name::in, file_name::out, counter::in, counter::out,
read_module_errors::in, read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_parse_tree_src_submodule(FileString, FileStringLen, ContainingModules,
MaybePrevSection, ContainingModuleName, StartModuleName, StartContext,
InitLookAhead, FinalLookAhead, !ModuleComponents, !SourceFileName,
!SeqNumCounter, !Errors, !LineContext, !LinePosn) :-
(
MaybePrevSection = yes(SectionKind - SectionContext)
;
MaybePrevSection = no,
NoSectionPieces = [words("Error: nested submodule"),
qual_sym_name(StartModuleName), words("should be preceded by"),
words("either an"), decl("interface"), words("or an"),
decl("implementation"), words("declaration."), nl,
words("The following assumes that"),
words("the missing declaration is an"),
decl("interface"), words("declaration."), nl],
NoSectionSpec = simplest_spec($pred, severity_error,
phase_term_to_parse_tree, StartContext, NoSectionPieces),
% XXX ITEM_LIST Should this be a situation-specific rme_X value?
add_nonfatal_error(rme_no_section_decl_at_start, [NoSectionSpec],
!Errors),
SectionKind = ms_interface,
SectionContext = dummy_context
),
NestedContainingModules = [StartModuleName | ContainingModules],
NestedMaybePrevSection = no,
read_parse_tree_src_components(FileString, FileStringLen, StartModuleName,
NestedContainingModules, NestedMaybePrevSection,
have_not_given_missing_section_start_warning,
InitLookAhead, FinalLookAhead, cord.init, NestedModuleComponents,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn),
SubModuleParseTreeSrc = parse_tree_src(StartModuleName, StartContext,
NestedModuleComponents),
Component = mc_nested_submodule(ContainingModuleName, SectionKind,
SectionContext, SubModuleParseTreeSrc),
!:ModuleComponents = cord.snoc(!.ModuleComponents, Component).
:- pred handle_module_end_marker(module_name::in, list(module_name)::in,
read_iom_result::in, module_name::in, prog_context::in,
maybe_lookahead::out, read_module_errors::in, read_module_errors::out)
is det.
handle_module_end_marker(CurModuleName, ContainingModules, ReadIOMResult,
EndedModuleName, EndContext, FinalLookAhead, !Errors) :-
( if CurModuleName = EndedModuleName then
FinalLookAhead = no_lookahead
else if partial_sym_name_matches_full(EndedModuleName, CurModuleName) then
% XXX ITEM_LIST Should this be an error? Warning?
FinalLookAhead = no_lookahead
else if is_for_containing_module(EndedModuleName, ContainingModules) then
Pieces = [words("Error: missing"), decl("end_module"),
words("declaration for"), qual_sym_name(CurModuleName),
suffix("."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
EndContext, Pieces),
add_fatal_error(frme_bad_module_end, [Spec], !Errors),
FinalLookAhead = lookahead(ReadIOMResult)
else
Pieces = [words("Error: this"), decl("end_module"),
words("declaration for"), qual_sym_name(EndedModuleName),
words("is not for the module at whose end it appears,"),
words("which is"), qual_sym_name(CurModuleName), suffix("."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
EndContext, Pieces),
add_fatal_error(frme_bad_module_end, [Spec], !Errors),
% Eat the bad end_module declaration.
FinalLookAhead = no_lookahead
).
:- pred is_for_containing_module(module_name::in, list(module_name)::in)
is semidet.
is_for_containing_module(EndedModuleName,
[ContainingModule | ContainingModules]) :-
( if partial_sym_name_matches_full(EndedModuleName, ContainingModule) then
true
else
is_for_containing_module(EndedModuleName, ContainingModules)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% This part of the module contains utility predicates.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type maybe_module_header
---> no_valid_module_header(
% A complete description of the errors involved.
read_module_errors
)
; valid_module_header(
% The name in the ":- module" decl, and its context.
module_name,
prog_context
).
:- pred read_module_header(string::in, int::in,
module_name::in, list(prog_context)::in, file_name::in,
maybe_module_header::out, counter::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_module_header(FileString, FileStringLen,
DefaultModuleName, DefaultExpectationContexts, SourceFileName,
MaybeModuleHeader, !:SeqNumCounter,
!LineContext, !LinePosn) :-
counter.init(1, !:SeqNumCounter),
read_first_module_decl(FileString, FileStringLen, require_module_decl,
DefaultModuleName, DefaultExpectationContexts, ModuleDeclPresent,
may_not_change_source_file_name, SourceFileName, _SourceFileName,
!SeqNumCounter, !LineContext, !LinePosn),
(
ModuleDeclPresent = no_module_decl_present(_MaybeLookAhead, _Context,
NoModuleSpec),
Errors0 = init_read_module_errors,
add_nonfatal_error(rme_no_module_decl_at_start,
[NoModuleSpec], Errors0, Errors),
MaybeModuleHeader = no_valid_module_header(Errors)
;
ModuleDeclPresent = wrong_module_decl_present(ModuleName,
ModuleNameContext, WrongModuleSpec),
NoModuleSpec = report_wrong_module_start(ModuleNameContext,
DefaultModuleName, ModuleName),
Errors0 = init_read_module_errors,
add_nonfatal_error(rme_no_module_decl_at_start,
[NoModuleSpec], Errors0, Errors1),
add_nonfatal_error(rme_unexpected_module_name,
[WrongModuleSpec], Errors1, Errors),
MaybeModuleHeader = no_valid_module_header(Errors)
;
ModuleDeclPresent =
right_module_decl_present(ModuleName, ModuleNameContext),
MaybeModuleHeader = valid_module_header(ModuleName, ModuleNameContext)
).
:- type maybe_module_decl_present
---> no_module_decl_present(
% Any lookahead left from the input. This lookahead is needed
% ONLY to allow us to continue parsing .m files after
% a missing initial ":- module" decl.
maybe_lookahead,
% The context of the term that is there instead of the module
% declaration. Will contain term.context_init if there is
% no such term.
prog_context,
% A message for the error. The error category is
% always rme_no_module_decl_at_start.
error_spec
)
; wrong_module_decl_present(
% The name in the ":- module" decl, and its context.
module_name,
prog_context,
% A message for the error, which may be conditional.
% The category is always rme_unexpected_module_name.
error_spec
)
; right_module_decl_present(
% The name in the ":- module" decl, and its context.
module_name,
prog_context
).
% Files written by users may contain source_file pragmas, which change
% the parser's notion of the current filename. For these, callers should
% therefore pass may_change_source_file_name. On the other hand, files
% automatically generated by the compiler (.int* and .*opt files)
% never contain source_file pragmas. For these, callers should pass
% may_not_change_source_file_name, which calls for any occurrence of
% a source_file pragma to be treated as the error it is.
%
:- type may_change_source_file_name
---> may_not_change_source_file_name
; may_change_source_file_name.
% We used to have to jump through a few hoops when reading the first item,
% to allow us to recover from a missing initial `:- module' declaration.
%
% We used to solve this dilemma by first parsing the first item
% in the root scope, and then if it turns out to not be a `:- module'
% declaration, we used special code to reparse it in the default module
% scope. We now also reparse it in the default module context, but
% using the general lookahead mechanism that the rest of the parser
% also uses.
%
% XXX ITEM_LIST SHOULD we recover from a missing initial `:- module'
% declaration? The reason is that in order to parse an item, we need
% to know which module it is defined in (because we do some module
% qualification and checking of module qualifiers at parse time),
% but the initial `:- module' declaration and the declaration
% that follows it occur in different scopes, so we need to know
% what it is that we are parsing before we can parse it!
%
:- pred read_first_module_decl(string::in, int::in,
maybe_require_module_decl::in, module_name::in, list(prog_context)::in,
maybe_module_decl_present::out, may_change_source_file_name::in,
file_name::in, file_name::out, counter::in, counter::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_first_module_decl(FileString, FileStringLen, RequireModuleDecl,
DefaultModuleName, DefaultExpectationContexts,
ModuleDeclPresent, MayChangeSourceFileName, !SourceFileName,
!SeqNumCounter, !LineContext, !LinePosn) :-
% Parse the first term, treating it as occurring within the scope
% of the special "root" module (so that any `:- module' declaration
% is taken to be a non-nested module unless explicitly qualified).
mercury_term_parser.read_term_from_linestr(!.SourceFileName,
FileString, FileStringLen, !LineContext, !LinePosn, FirstReadTerm),
read_term_to_iom_result(DefaultModuleName, !.SourceFileName,
FirstReadTerm, MaybeFirstIOM, !SeqNumCounter),
(
MaybeFirstIOM = read_iom_ok(_FirstVarSet, FirstTerm, FirstIOM),
(
FirstIOM = iom_marker_src_file(!:SourceFileName),
(
MayChangeSourceFileName = may_not_change_source_file_name,
FirstLookAhead = lookahead(MaybeFirstIOM),
FirstContext = get_term_context(FirstTerm),
ModuleDeclPresent = no_module_decl_present(FirstLookAhead,
FirstContext, report_missing_module_start(FirstContext))
;
MayChangeSourceFileName = may_change_source_file_name,
% Apply and then skip `pragma source_file' decls, by calling
% ourselves recursively with the new source file name.
read_first_module_decl(FileString, FileStringLen,
RequireModuleDecl, DefaultModuleName,
DefaultExpectationContexts, ModuleDeclPresent,
MayChangeSourceFileName, !SourceFileName,
!SeqNumCounter, !LineContext, !LinePosn)
)
;
FirstIOM = iom_marker_module_start(StartModuleName,
ModuleNameContext, _ModuleNameSeqNum),
% The first term is a `:- module' decl, as expected.
% Check whether it matches the expected module name.
% If it doesn't, report a (conditionally enabled) error.
( if DefaultModuleName = StartModuleName then
ModuleDeclPresent = right_module_decl_present(StartModuleName,
ModuleNameContext)
else
report_module_has_unexpected_name(!.SourceFileName,
DefaultModuleName, DefaultExpectationContexts,
StartModuleName, yes(ModuleNameContext), NameSpec),
ModuleDeclPresent = wrong_module_decl_present(StartModuleName,
ModuleNameContext, NameSpec)
)
;
( FirstIOM = iom_marker_module_end(_, _, _)
; FirstIOM = iom_marker_version_numbers(_)
; FirstIOM = iom_marker_section(_, _, _)
; FirstIOM = iom_marker_include(_)
; FirstIOM = iom_marker_avail(_)
; FirstIOM = iom_marker_fim(_)
; FirstIOM = iom_item(_)
% Ignore the error_specs.
; FirstIOM = iom_item_and_error_specs(_, _)
; FirstIOM = iom_handled_no_error
% Ignore the error_specs.
; FirstIOM = iom_handled_error(_)
),
FirstLookAhead = lookahead(MaybeFirstIOM),
FirstContext = get_term_context(FirstTerm),
ModuleDeclPresent = no_module_decl_present(FirstLookAhead,
get_term_context(FirstTerm),
report_missing_module_start(FirstContext))
)
;
MaybeFirstIOM = read_iom_parse_item_errors(_, FirstTerm, _),
LookAhead = lookahead(MaybeFirstIOM),
FirstContext = get_term_context(FirstTerm),
ModuleDeclPresent = no_module_decl_present(LookAhead,
get_term_context(FirstTerm),
report_missing_module_start(FirstContext))
;
( MaybeFirstIOM = read_iom_eof
; MaybeFirstIOM = read_iom_parse_term_error(_)
),
FirstContext = term_context.context_init(!.SourceFileName, 1),
ModuleDeclPresent = no_module_decl_present(no_lookahead,
dummy_context, report_missing_module_start(FirstContext))
% XXX ITEM_LIST Should report "stop processing".
).
%---------------------------------------------------------------------------%
% Read a sequence of items, until we find a marker that indicates
% a change in section or module. If and when we find such a marker,
% we stop reading, and return the term of that marker as the final
% lookahead.
%
% We use the standard two level loop to avoid running out of stack
% on long item sequences in grades that do not allow tail recursion.
%
:- pred read_item_sequence(string::in, int::in, module_name::in,
maybe_lookahead::in, maybe_lookahead::out,
cord(item_include)::in, cord(item_include)::out,
cord(item_avail)::in, cord(item_avail)::out,
cord(item_fim)::in, cord(item_fim)::out,
cord(item)::in, cord(item)::out,
file_name::in, file_name::out, counter::in, counter::out,
read_module_errors::in, read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_item_sequence(FileString, FileStringLen, ModuleName,
InitLookAhead, FinalLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn) :-
get_next_item_or_marker(!.SourceFileName, FileString, FileStringLen,
InitLookAhead, ModuleName, ReadIOMResult,
!SeqNumCounter, !LineContext, !LinePosn),
read_item_sequence_inner(FileString, FileStringLen, ModuleName,
1024, NumItemsLeft, ReadIOMResult, MidLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn),
( if NumItemsLeft = 0 then
read_item_sequence(FileString, FileStringLen, ModuleName,
MidLookAhead, FinalLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn)
else
FinalLookAhead = MidLookAhead
).
:- pred read_item_sequence_inner(string::in, int::in,
module_name::in, int::in, int::out,
read_iom_result::in, maybe_lookahead::out,
cord(item_include)::in, cord(item_include)::out,
cord(item_avail)::in, cord(item_avail)::out,
cord(item_fim)::in, cord(item_fim)::out,
cord(item)::in, cord(item)::out, file_name::in, file_name::out,
counter::in, counter::out, read_module_errors::in, read_module_errors::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_item_sequence_inner(FileString, FileStringLen, ModuleName,
!NumItemsLeft, ReadIOMResult, FinalLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors, !LineContext, !LinePosn) :-
( if !.NumItemsLeft =< 0 then
FinalLookAhead = lookahead(ReadIOMResult)
else
(
ReadIOMResult = read_iom_eof,
FinalLookAhead = no_lookahead
;
(
ReadIOMResult = read_iom_parse_term_error(ItemSpec),
add_nonfatal_error(rme_could_not_read_term, [ItemSpec],
!Errors)
;
ReadIOMResult = read_iom_parse_item_errors(_, _, ItemSpecs),
add_nonfatal_error(rme_could_not_parse_item, ItemSpecs,
!Errors)
),
read_next_item_or_marker(!.SourceFileName,
FileString, FileStringLen, ModuleName, NextReadIOMResult,
!SeqNumCounter, !LineContext, !LinePosn),
read_item_sequence_inner(FileString, FileStringLen, ModuleName,
!NumItemsLeft, NextReadIOMResult, FinalLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn)
;
ReadIOMResult = read_iom_ok(_IOMVarSet, IOMTerm, IOM),
!:NumItemsLeft = !.NumItemsLeft - 1,
(
( IOM = iom_marker_module_start(_, _, _)
; IOM = iom_marker_module_end(_, _, _)
; IOM = iom_marker_section(_, _, _)
),
FinalLookAhead = lookahead(ReadIOMResult)
;
(
IOM = iom_marker_src_file(!:SourceFileName)
;
IOM = iom_marker_version_numbers(_),
Pieces = [words("Error: version number records"),
words("should not appear anywhere except in"),
words("automatically generated interface files."), nl],
Spec = simplest_spec($pred, severity_error,
phase_read_files, get_term_context(IOMTerm), Pieces),
add_nonfatal_error(rme_nec, [Spec], !Errors)
;
IOM = iom_marker_include(Incls),
Incls = one_or_more(HeadIncl, TailIncls),
!:InclsCord = !.InclsCord ++
cord.from_list([HeadIncl | TailIncls])
;
IOM = iom_marker_avail(Avails),
Avails = one_or_more(HeadAvail, TailAvails),
!:AvailsCord = !.AvailsCord ++
cord.from_list([HeadAvail | TailAvails])
;
IOM = iom_marker_fim(FIM),
!:FIMsCord = cord.snoc(!.FIMsCord, FIM)
;
IOM = iom_item(Item),
!:ItemsCord = cord.snoc(!.ItemsCord, Item)
;
IOM = iom_item_and_error_specs(Item, ItemSpecs),
!:ItemsCord = cord.snoc(!.ItemsCord, Item),
add_nonfatal_error(rme_nec, ItemSpecs, !Errors)
;
IOM = iom_handled_no_error
;
IOM = iom_handled_error(HandledSpecs),
add_nonfatal_error(rme_nec, HandledSpecs, !Errors)
),
read_next_item_or_marker(!.SourceFileName,
FileString, FileStringLen, ModuleName, NextReadIOMResult,
!SeqNumCounter, !LineContext, !LinePosn),
read_item_sequence_inner(FileString, FileStringLen, ModuleName,
!NumItemsLeft, NextReadIOMResult, FinalLookAhead,
!InclsCord, !AvailsCord, !FIMsCord, !ItemsCord,
!SourceFileName, !SeqNumCounter, !Errors,
!LineContext, !LinePosn)
)
)
).
%---------------------------------------------------------------------------%
:- type maybe_lookahead
---> no_lookahead
; lookahead(read_iom_result).
:- pred get_next_item_or_marker(file_name::in, string::in, int::in,
maybe_lookahead::in, module_name::in, read_iom_result::out,
counter::in, counter::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
get_next_item_or_marker(FileName, FileString, FileStringLen, InitLookAhead,
ModuleName, ReadIOMResult, !SeqNumCounter, !LineContext, !LinePosn) :-
(
InitLookAhead = no_lookahead,
read_next_item_or_marker(FileName, FileString, FileStringLen,
ModuleName, ReadIOMResult, !SeqNumCounter,
!LineContext, !LinePosn)
;
InitLookAhead = lookahead(ReadIOMResult)
).
:- pred read_next_item_or_marker(file_name::in, string::in, int::in,
module_name::in, read_iom_result::out, counter::in, counter::out,
line_context::in, line_context::out, line_posn::in, line_posn::out) is det.
read_next_item_or_marker(FileName, FileString, FileStringLen, ModuleName,
ReadIOMResult, !SeqNumCounter, !LineContext, !LinePosn) :-
mercury_term_parser.read_term_from_linestr(FileName,
FileString, FileStringLen, !LineContext, !LinePosn, ReadTermResult),
read_term_to_iom_result(ModuleName, FileName, ReadTermResult,
ReadIOMResult, !SeqNumCounter).
%---------------------------------------------------------------------------%
:- type read_iom_result
---> read_iom_eof
% We have reached end-of-file.
; read_iom_parse_term_error(error_spec)
% The call to mercury_term_parser.read_term_from_linestr
% has failed, which means that what we found in the file string
% is not a valid term.
; read_iom_parse_item_errors(varset, term, list(error_spec))
% We have successfully read a term from the file string,
% but could not parse it as an item or marker.
% The error category is implicitly rme_could_not_parse_item.
; read_iom_ok(varset, term, item_or_marker).
% We have successfully read a term from the file string,
% and parsed it as an item or marker.
:- pred read_term_to_iom_result(module_name::in, string::in, read_term::in,
read_iom_result::out, counter::in, counter::out) is det.
read_term_to_iom_result(ModuleName, FileName, ReadTermResult, ReadIOMResult,
!SeqNumCounter) :-
% XXX ITEM_LIST Should add a prefix to eof, error, and term
% in library/term_io.m?
(
ReadTermResult = eof,
ReadIOMResult = read_iom_eof
;
ReadTermResult = error(ErrorMsg, LineNumber),
Context = term_context.context_init(FileName, LineNumber),
% XXX Do we need to add an "Error:" prefix?
Pieces = [words(ErrorMsg), suffix("."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
Context, Pieces),
ReadIOMResult = read_iom_parse_term_error(Spec)
;
ReadTermResult = term(VarSet, Term),
counter.allocate(SeqNum, !SeqNumCounter),
parse_item_or_marker(ModuleName, VarSet, Term, item_seq_num(SeqNum),
MaybeItemOrMarker),
(
MaybeItemOrMarker = ok1(ItemOrMarker),
ReadIOMResult = read_iom_ok(VarSet, Term, ItemOrMarker)
;
MaybeItemOrMarker = error1(Specs),
ReadIOMResult = read_iom_parse_item_errors(VarSet, Term, Specs)
)
).
%---------------------------------------------------------------------------%
:- func report_missing_module_start(prog_context) = error_spec.
report_missing_module_start(FirstContext) = Spec :-
Pieces = [invis_order_default_start(0, ""),
words("Error: module must start with a"),
decl("module"), words("declaration."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
FirstContext, Pieces).
:- func report_wrong_module_start(prog_context, module_name, module_name)
= error_spec.
report_wrong_module_start(FirstContext, Expected, Actual) = Spec :-
Pieces = [words("Error: module starts with the wrong"),
decl("module"), words("declaration."), nl,
words("Expected module"), qual_sym_name(Expected), suffix(","),
words("found module"), qual_sym_name(Actual), suffix("."), nl],
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
FirstContext, Pieces).
% The predicate that reads in source file handles all items and markers
% it reads in, and stops only at an end_module declaration that matches
% the name of the top level module in the file. If FileKind is
% fk_src, we look for any items after this end_module marker.
%
% The predicates that read in interface and optimization files
% handle only the items they expect in those files, since their contents
% should be automatically generated by mmc itself, stopping (and returning
% as lookahead) at items that don't fit the expected structure of those
% files. If FileKind is fk_int or fk_opt, we look for any such unexpected
% items.
%
:- pred check_for_unexpected_item_at_end(file_name::in, string::in, int::in,
module_name::in, file_kind::in,
maybe_lookahead::in, counter::in,
read_module_errors::in, read_module_errors::out,
line_context::in, line_posn::in) is det.
check_for_unexpected_item_at_end(SourceFileName, FileString, FileStringLen,
ModuleName, FileKind, FinalLookAhead, SeqNumCounter0,
!Errors, !.LineContext, !.LinePosn) :-
get_next_item_or_marker(SourceFileName, FileString, FileStringLen,
FinalLookAhead, ModuleName, IOMResult,
SeqNumCounter0, _SeqNumCounter, !.LineContext, _, !.LinePosn, _),
(
IOMResult = read_iom_eof
;
IOMResult = read_iom_parse_term_error(ItemSpec),
add_nonfatal_error(rme_could_not_read_term, [ItemSpec], !Errors)
;
IOMResult = read_iom_parse_item_errors(_VarSet, Term, ItemSpecs),
add_nonfatal_error(rme_could_not_parse_item, ItemSpecs, !Errors),
report_unexpected_term_at_end(FileKind, Term, !Errors)
;
IOMResult = read_iom_ok(_IOMVarSet, IOMTerm, _IOM),
report_unexpected_term_at_end(FileKind, IOMTerm, !Errors)
).
:- pred report_unexpected_term_at_end(file_kind::in, term::in,
read_module_errors::in, read_module_errors::out) is det.
report_unexpected_term_at_end(FileKind, Term, !Errors) :-
Context = get_term_context(Term),
(
FileKind = fk_src,
Error = rme_end_module_not_at_end_of_src,
Pieces = [words("Error: item(s) after the"),
decl("end_module"), words("declaration."), nl]
;
FileKind = fk_int(_IntFileKind),
Error = rme_unexpected_term_in_int_or_opt,
Pieces = [words("Error: unexpected item in interface file"), nl]
;
FileKind = fk_opt(_OptFileKind),
Error = rme_unexpected_term_in_int_or_opt,
Pieces = [words("Error: unexpected item in optimization file"), nl]
),
Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
Context, Pieces),
add_nonfatal_error(Error, [Spec], !Errors).
%---------------------------------------------------------------------------%
:- end_module parse_tree.parse_module.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink