mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 18:33:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
b357a3dadcdf29c8d8ca184d65f7634a1a94de36
mercury/compiler/prog_foreign_enum.m
Zoltan Somogyi 25f8a6cc99 Add new option --generate-dependencies-ints. 
This new option extends --generate-dependencies to take advantage of the
opportunity afforded by the fact that "mmc --generate-dependencies prog.m"
reads in every Mercury source file in the current directory that is
part of "prog". It does this by

- generating the .int3 file of all local-directory modules of the program;
- generating the .int0 file for each these modules that has submodules;
- generating the .int and .int2 files of all local-directory modules
  of the program.

Normally, the process of creating .int0, .int and .int3 files would
need to read in .int0 and .int3 files, but in every one of these cases,
we have just written out those files, so simply holding onto their
parse trees, we can skip this step. On my laptop, on a directory
containing library/*.m, mdbcomp/*.m and compiler/*.m, generating
the dependencies and generating all the .int3/.int0/.int/.int2 files
takes just over 25 seconds. Using the new option, the same process
takes less than 10 seconds.

compiler/options.m:
    Add the new option.

compiler/op_mode.m:
    Add a new variant of the existing op_mode for --generate-dependencies,
    which we select in the presence of the new option.

compiler/mercury_compile_main.m:
    Implement the new op_mode.

    Fix an old issue, which is that "mmc --make-private-interface x.m"
    generated a .int0 file for *every* module in x.m, even the modules
    that don't have any submodules.

compiler/deps_map.m:
    The code implementing the new option needs to know which modules
    of the program are in the current directory. The deps_map structure
    built by the code shared with the implementation of --generate-dependencies
    has not needed that info until now, so add a new field to the deps
    structure of each module to provide this info.

compiler/generate_dep_d_files.m:
    Return the deps_map created by the code that implements both
    --generate-dependencies and the new option to mercury_compile_main.m.

compiler/write_module_interface_files.m:
    Add a flag to the predicates that first construct the parse trees of,
    and then write out, .int3/.int0/.int/.int2 files, that
    mercury_compile_main.m can use to tell them to record the parse trees
    in the have read module maps.

    Add new variants of two of those predicates that take some of their
    arguments from burdened_module structures, since that is the form
    in which mercury_compile_main.m has that info.

compiler/module_baggage.m:
    The predicates in write_module_interface_files.m that generate
    .int0/.int/.int2 files take an argument that should be the timestamp
    of the source file they are being derived from, if that timestamp
    is needed for smart recompilation. Until now, we only ever invoked
    those predicates when we have just read in the source file,
    and this timestamp was readily available. The code implementing
    the new option needs to store this info for a short time, and
    the module baggage is the obvious place to store it, so add this field
    to the baggage.

compiler/error_spec.m:
    An invocation of the compiler with new option may report errors that
    prevent the construction of interface files for several modules.
    The new code in mercury_compile.m prints the error_specs that have
    contexts in the order of those contexts, but we want to print
    the messages without contexts (which in this case report that
    certain files could not be written or copied) to have a useful
    order too. Make this possible by allowing the invisible pieces
    we use for ordering to specify that order via a string (in this case,
    the name of the file that e.g. could not be written), rather than
    the only previous option, an integer.

compiler/grab_modules.m:
compiler/make.get_module_dep_info.m:
compiler/make.module_dep_file.m:
    Fill in the new field in the module baggage.

compiler/check_module_interface.m:
compiler/handle_options.m:
compiler/make_hlds_error.m:
compiler/parse_module.m:
compiler/prog_foreign_enum.m:
compiler/typecheck_error_util.m:
compiler/typecheck_msgs.m:
compiler/write_deps_file.m:
compiler/write_error_spec.m:
    Conform to the changes above.
2023-10-12 06:50:07 +11:00

375 lines
15 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015-2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% This module checks the correctness of Mercury name to foreign name mappings
% in foreign enum and foreign export enum declarations.
%
%---------------------------------------------------------------------------%
:- module parse_tree.prog_foreign_enum.
:- interface.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
:- import_module bimap.
:- import_module list.
:- import_module set_tree234.
%---------------------------------------------------------------------------%
:- type for_fe_or_fee
---> for_foreign_enum
; for_foreign_export_enum.
% build_ctor_name_to_foreign_name_map_loop(ForWhat, Context, ContextPieces,
% TypeModuleName, ValidCtorNames, MercuryForeignAL, MercuryForeignBiMap,
% !Specs):
%
% Given MercuryForeignAL, a list of pairs of Mercury and foreign names,
% check that all the Mercury names are correctly module qualified
% (i.e. they are in module TypeModuleName), that they name a valid data
% constructor (i.e. one in ValidCtorNames) and try to construct a bimap
% (MercuryForeignBiMap) between those two sets of names, using the rules
% appropriate for either foreign_enum or foreign_export_enum pragmas,
% as selected by ForWhat.
%
% Generate an error message for each Mercury name that is not correctly
% module qualified, for each name that is not a valid ctor, and for each
% deviation of MercuryForeignAL from the relevant rules. Use ContextPieces
% as the first half of each error message, and Context as their context.
%
:- pred build_ctor_name_to_foreign_name_map(for_fe_or_fee::in,
prog_context::in, list(format_piece)::in, module_name::in,
set_tree234(string)::in, assoc_list(sym_name, string)::in,
bimap(string, string)::out,
list(error_spec)::in, list(error_spec)::out) is det.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module cord.
:- import_module pair.
:- import_module string.
%---------------------------------------------------------------------------%
build_ctor_name_to_foreign_name_map(ForWhat, Context, ContextPieces,
TypeModuleName, ValidCtorNames, MercuryForeignAL,
MercuryForeignBiMap, !Specs) :-
MercuryForeignBiMap0 = bimap.init,
SeenCtorNames0 = set_tree234.init,
SeenForeignNames0 = set_tree234.init,
BadQualCtorSymNamesCord0 = cord.init,
InvalidCtorSymNamesCord0 = cord.init,
RepeatedCtorNamesCord0 = cord.init,
RepeatedForeignNamesCord0 = cord.init,
build_ctor_name_to_foreign_name_map_loop(TypeModuleName, ValidCtorNames,
MercuryForeignAL, MercuryForeignBiMap0, MercuryForeignBiMap,
SeenCtorNames0, SeenCtorNames, SeenForeignNames0,
BadQualCtorSymNamesCord0, BadQualCtorSymNamesCord,
InvalidCtorSymNamesCord0, InvalidCtorSymNamesCord,
RepeatedCtorNamesCord0, RepeatedCtorNamesCord,
RepeatedForeignNamesCord0, RepeatedForeignNamesCord),
% Badly qualified data constructor names should have been caught by
% parse_pragma.m, and should have prevented the construction
% of the foreign_enum pragma, for at least one of our callers
% (check_type_inst_mode_defns.m), but maybe not the other
% (add_foreign_enum.m).
( if cord.is_empty(BadQualCtorSymNamesCord) then
true
else
add_bad_qual_ctors_error(Context, ContextPieces,
cord.to_list(BadQualCtorSymNamesCord), !Specs)
),
( if cord.is_empty(InvalidCtorSymNamesCord) then
true
else
add_unknown_ctors_error(Context, ContextPieces,
cord.to_list(InvalidCtorSymNamesCord), !Specs)
),
RepeatedCtorNames = cord.to_list(RepeatedCtorNamesCord),
RepeatedForeignNames = cord.to_list(RepeatedForeignNamesCord),
( if
RepeatedCtorNames = [],
RepeatedForeignNames = []
then
true
else
% How should we describe the contents of RepeatedForeignNames
% in error messages: as "names" or "values"?
%
% (The variable is RepeatedForeignNames because
% RepeatedForeignNamesOrValues would be too long.)
(
ForWhat = for_foreign_export_enum,
% Foreign_export_enums specify name of the foreign lval
% (variable name or macro name) to set to the representation
% of the Mercury constant chosen by the Mercury compiler.
NameOrValue = "name",
NamesOrValues = "names"
;
ForWhat = for_foreign_enum,
% Foreign_enums tell the Mercury compiler what rval it should
% use to represent the Mercury constant. The rval may be
% the value of a variable, but it may also be a constant
% (or possibly even a constant expression).
NameOrValue = "value",
NamesOrValues = "values"
),
MainPieces = ContextPieces ++
[invis_order_default_start(3, ""), words("error: "),
words("the specified mapping between"),
words("the names of Mercury constructors"),
words("and the corresponding foreign"), words(NamesOrValues),
words("is inconsistent."), nl],
(
RepeatedCtorNames = [],
CtorNamePieces = []
;
RepeatedCtorNames = [_ | _],
CtorNamePieces =
[words("The following Mercury constructor"),
words(choose_number(RepeatedCtorNames,
"name is", "names are")),
words("repeated:"), nl_indent_delta(2)] ++
list_to_quoted_pieces(RepeatedCtorNames) ++
[suffix("."), nl_indent_delta(-2)]
),
(
RepeatedForeignNames = [],
ForeignNamePieces = []
;
RepeatedForeignNames = [_ | _],
ForeignNamePieces =
[words("The following foreign"),
words(choose_number(RepeatedForeignNames,
NameOrValue ++ " is", NamesOrValues ++ " are")),
words("repeated:"), nl_indent_delta(2)] ++
list_to_quoted_pieces(RepeatedForeignNames) ++
[suffix("."), nl_indent_delta(-2)]
),
Pieces = MainPieces ++ CtorNamePieces ++ ForeignNamePieces,
Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
Context, Pieces),
!:Specs = [Spec | !.Specs]
),
(
ForWhat = for_foreign_export_enum
;
ForWhat = for_foreign_enum,
set_tree234.difference(ValidCtorNames, SeenCtorNames, UnseenCtorNames),
set_tree234.to_sorted_list(UnseenCtorNames, UnseenCtorNamesList),
(
UnseenCtorNamesList = []
;
UnseenCtorNamesList = [_ | _],
add_foreign_enum_unmapped_ctors_error(Context, ContextPieces,
UnseenCtorNamesList, !Specs)
)
).
:- pred build_ctor_name_to_foreign_name_map_loop(module_name::in,
set_tree234(string)::in, assoc_list(sym_name, string)::in,
bimap(string, string)::in, bimap(string, string)::out,
set_tree234(string)::in, set_tree234(string)::out, set_tree234(string)::in,
cord(sym_name)::in, cord(sym_name)::out,
cord(sym_name)::in, cord(sym_name)::out,
cord(string)::in, cord(string)::out,
cord(string)::in, cord(string)::out) is det.
build_ctor_name_to_foreign_name_map_loop(_, _, [], !MercuryForeignBiMap,
!SeenCtorNames, _SeenForeignNames, !BadQualCtorSymNames,
!InvalidCtorSymNames, !RepeatedCtorNames, !RepeatedForeignNames).
build_ctor_name_to_foreign_name_map_loop(TypeModuleName, ValidCtorNames,
[MercuryForeign | MercuryForeignAL], !MercuryForeignBiMap,
!SeenCtorNames, !.SeenForeignNames, !BadQualCtorSymNames,
!InvalidCtorSymNames, !RepeatedCtorNames, !RepeatedForeignNames) :-
MercuryForeign = CtorSymName - ForeignName,
some [!OK] (
!:OK = yes,
(
CtorSymName = qualified(CtorModuleName, CtorName),
( if CtorModuleName = TypeModuleName then
true
else
cord.snoc(CtorSymName, !BadQualCtorSymNames),
!:OK = no
)
;
CtorSymName = unqualified(CtorName)
),
( if set_tree234.contains(ValidCtorNames, CtorName) then
true
else
cord.snoc(CtorSymName, !InvalidCtorSymNames),
!:OK = no
),
( if set_tree234.insert_new(CtorName, !SeenCtorNames) then
true
else
!:RepeatedCtorNames = cord.snoc(!.RepeatedCtorNames, CtorName),
!:OK = no
),
( if set_tree234.insert_new(ForeignName, !SeenForeignNames) then
true
else
cord.snoc(ForeignName, !RepeatedForeignNames),
!:OK = no
),
(
!.OK = yes,
bimap.det_insert(CtorName, ForeignName, !MercuryForeignBiMap)
;
!.OK = no
)
),
build_ctor_name_to_foreign_name_map_loop(TypeModuleName, ValidCtorNames,
MercuryForeignAL, !MercuryForeignBiMap,
!SeenCtorNames, !.SeenForeignNames, !BadQualCtorSymNames,
!InvalidCtorSymNames, !RepeatedCtorNames, !RepeatedForeignNames).
%---------------------------------------------------------------------------%
:- pred add_bad_qual_ctors_error(prog_context::in, list(format_piece)::in,
list(sym_name)::in, list(error_spec)::in, list(error_spec)::out) is det.
add_bad_qual_ctors_error(Context, ContextPieces, Ctors, !Specs) :-
HasOrHave = choose_number(Ctors, "symbol has", "symbols have"),
ErrorPieces = [invis_order_default_start(2, ""),
words("error: the following"),
words(HasOrHave), words("a module qualification"),
words("that is not compatible with the type definition:"),
nl_indent_delta(2)] ++
qual_ctors_to_line_pieces(Ctors, [suffix("."), nl]),
Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
Context, ContextPieces ++ ErrorPieces),
!:Specs = [Spec | !.Specs].
%---------------------%
:- func qual_ctors_to_line_pieces(list(sym_name), list(format_piece))
= list(format_piece).
qual_ctors_to_line_pieces(Ctors, Final) = Pieces :-
Components = list.map(qual_ctor_to_format_piece, Ctors),
Pieces = component_list_to_line_pieces(Components, Final).
:- func qual_ctor_to_format_piece(sym_name) = list(format_piece).
qual_ctor_to_format_piece(SymName) = [qual_sym_name(SymName)].
%---------------------------------------------------------------------------%
% add_unknown_ctors_error(Context, ContextPieces, Ctors, !Specs):
%
% Given ContextPieces as the first half of an error message that
% identifies a type, generate a complete error message about Ctors
% not being constructor(s) of that type.
%
:- pred add_unknown_ctors_error(prog_context::in, list(format_piece)::in,
list(sym_name)::in, list(error_spec)::in, list(error_spec)::out) is det.
add_unknown_ctors_error(Context, ContextPieces, Ctors, !Specs) :-
IsOrAre = choose_number(Ctors, "symbol is not a constructor",
"symbols are not constructors"),
ErrorPieces = [invis_order_default_start(1, ""),
words("error: the following"), words(IsOrAre),
words("of the type:"), nl_indent_delta(2)] ++
unqual_ctors_to_line_pieces(Ctors, [suffix("."), nl]),
Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
Context, ContextPieces ++ ErrorPieces),
!:Specs = [Spec | !.Specs].
%---------------------%
:- func unqual_ctors_to_line_pieces(list(sym_name), list(format_piece))
= list(format_piece).
unqual_ctors_to_line_pieces(Ctors, Final) = Pieces :-
Components = list.map(unqual_ctor_to_format_piece, Ctors),
Pieces = component_list_to_line_pieces(Components, Final).
:- func unqual_ctor_to_format_piece(sym_name) = list(format_piece).
unqual_ctor_to_format_piece(SymName) = [unqual_sym_name(SymName)].
%---------------------------------------------------------------------------%
% add_foreign_enum_unmapped_ctors_error(Context, ContextPieces, CtorNames,
% !Specs):
%
% Given ContextPieces as the first half of an error message that
% identifies a type, generate a complete error message about CtorNames
% not being mapped to a foreign language value.
%
:- pred add_foreign_enum_unmapped_ctors_error(prog_context::in,
list(format_piece)::in,
list(string)::in(non_empty_list),
list(error_spec)::in, list(error_spec)::out) is det.
add_foreign_enum_unmapped_ctors_error(Context, ContextPieces, CtorNames0,
!Specs) :-
list.sort(CtorNames0, CtorNames),
list.split_upto(10, CtorNames, CtorsStart, CtorsEnd),
DoOrDoes = choose_number(CtorNames, "constructor does", "constructors do"),
PrefixPieces = ContextPieces ++ [
words("error: the following"), words(DoOrDoes),
words("not have a foreign value:")
],
(
CtorsEnd = [],
CtorsPieces =
[nl_indent_delta(2)] ++
ctor_names_to_line_pieces(CtorNames, [suffix(".")]) ++
[nl_indent_delta(-2)],
CtorsComponent = always(CtorsPieces)
;
CtorsEnd = [_ | _],
list.length(CtorsEnd, NumEndCtors),
NonVerboseCtorsPieces =
[nl_indent_delta(2)] ++
ctor_names_to_line_pieces(CtorsStart,
[suffix(","), fixed("...")]) ++
[nl_indent_delta(-2), words("and"),
int_fixed(NumEndCtors), words("more."), nl],
VerboseCtorsPieces =
[nl_indent_delta(2)] ++
ctor_names_to_line_pieces(CtorNames, [suffix(".")]) ++
[nl_indent_delta(-2)],
CtorsComponent =
verbose_and_nonverbose(VerboseCtorsPieces, NonVerboseCtorsPieces)
),
Msg = simple_msg(Context, [always(PrefixPieces), CtorsComponent]),
Spec = error_spec($pred, severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
%---------------------%
:- func ctor_names_to_line_pieces(list(string), list(format_piece))
= list(format_piece).
ctor_names_to_line_pieces(CtorNames, Final) = Pieces :-
Components = list.map(ctor_name_to_format_piece, CtorNames),
Pieces = component_list_to_line_pieces(Components, Final).
:- func ctor_name_to_format_piece(string) = list(format_piece).
ctor_name_to_format_piece(CtorName) = [quote(CtorName)].
%---------------------------------------------------------------------------%
:- end_module parse_tree.prog_foreign_enum.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink