mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
mercury/compiler/comp_unit_interface.m
Zoltan Somogyi 3aca14b385 Compile the Mercury system with --warn-unused-types. 
configure.ac:
    Require the installed compiler to support that option.

STANDARD_MCFLAGS:
    Specify that option.

compiler/canonicalize_interface.m:
compiler/comp_unit_interface.m:
compiler/inst_user.m:
compiler/parse_module.m:
compiler/switch_util.m:
compiler/type_ctor_info.m:
deep_profiler/mdprof_dump.m:
library/digraph.m:
slice/mcov.m:
    Delete unused equivalence types that were picked up by the option.
2026-03-09 03:07:51 +11:00

3682 lines
160 KiB
Mathematica
Raw Permalink Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015-2016, 2018-2026 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.
%---------------------------------------------------------------------------%
%
% File: comp_unit_interface.m.
% Authors: fjh (original version), zs (current version).
%
% Given the raw compilation unit of a module, extract the part of that module
% that will go into the .int file of the module.
%
%---------------------------------------------------------------------------%
:- module parse_tree.comp_unit_interface.
:- 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.module_baggage.
:- import_module parse_tree.prog_parse_tree.
:- import_module parse_tree.read_modules.
:- import_module io.
:- import_module list.
:- import_module maybe.
% Each of the predicates
%
% generate_parse_tree_int3
% generate_parse_tree_int0
% generate_parse_tree_int12
%
% has an argument of this type. Their callers can set this argument to
% do_add_new_to_hptm to tell the predicate to add the interface file(s)
% it has constructed to !HaveParseTreeMaps.
%
:- type maybe_add_to_hptm
---> do_not_add_new_to_hptm
; do_add_new_to_hptm.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type generate_int3_result
---> gpti3_ok(
% We successfully generated this parse tree.
parse_tree_int3,
% The file name of the .int3 file.
file_name,
% The messages we created for (non-fatal) errors
% while generating the parse tree.
list(error_spec)
)
; gpti3_error(
% We couldn't generate the .int3 file of this module.
module_name,
% The format pieces, if any, to include in any error message
% that reports the .int3 file not being written.
list(format_piece),
% The messages describing the reason(s) for the failure.
list(error_spec)
).
% Given the parse tree of a module's source code and its baggage,
% generate the parse tree of the module's .int3 file.
%
:- pred generate_parse_tree_int3(globals::in, maybe_add_to_hptm::in,
burdened_module::in, generate_int3_result::out,
have_parse_tree_maps::in, have_parse_tree_maps::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% This type is similar to generate_int3_result, with its one difference
% being the inclusion of the maybe(timestamp) field from the source file's
% module_baggage structure, which we need when writing out the .int0 file.
:- type generate_int0_result
---> gpti0_ok(
parse_tree_int0,
maybe(timestamp),
file_name,
list(error_spec)
)
; gpti0_error(
module_name,
list(format_piece),
list(error_spec)
).
% Given the parse tree of a module's source code and its baggage,
% generate the parse tree of the module's .int0 file.
%
:- pred generate_parse_tree_int0(io.text_output_stream::in, globals::in,
maybe_add_to_hptm::in, burdened_module::in, generate_int0_result::out,
have_parse_tree_maps::in, have_parse_tree_maps::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% This type is similar to generate_int0_result, with its differences
% being the inclusion of two parse trees, and two pairs of file names,
% instead of one.
:- type generate_int12_result
---> gpti12_ok(
parse_tree_int1,
parse_tree_int2,
maybe(timestamp), % The timestamp of the source file.
file_name, % .int file name
file_name, % .int2 file name
list(error_spec)
)
; gpti12_error(
module_name,
list(format_piece),
list(error_spec)
).
% Given the parse tree of a module's source code and its baggage,
% generate the parse trees of the module's .int and .int3 files.
%
:- pred generate_parse_tree_int12(io.text_output_stream::in, globals::in,
maybe_add_to_hptm::in, burdened_module::in, generate_int12_result::out,
have_parse_tree_maps::in, have_parse_tree_maps::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module parse_tree.check_type_inst_mode_defns.
:- import_module parse_tree.convert_import_use.
:- import_module parse_tree.convert_include.
:- import_module parse_tree.decide_type_repn.
:- import_module parse_tree.error_util.
:- import_module parse_tree.file_kind.
:- import_module parse_tree.file_names.
:- import_module parse_tree.grab_modules.
:- import_module parse_tree.item_util.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.module_qual.qualify_items.
:- import_module parse_tree.parse_error.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.parse_tree_out_item.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_mutable.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_repn.
:- import_module parse_tree.prog_type_subst.
:- import_module parse_tree.prog_type_test.
:- import_module parse_tree.type_inst_mode_map.
:- import_module bool.
:- import_module cord.
:- import_module map.
:- import_module one_or_more.
:- import_module one_or_more_map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module set_tree234.
:- import_module string.
:- import_module term.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
generate_parse_tree_int3(Globals, AddToHptm, BurdenedModule,
GenerateResult, !HaveParseTreeMaps, !IO) :-
BurdenedModule = burdened_module(_Baggage, ParseTreeModuleSrc),
create_parse_tree_int3(ParseTreeModuleSrc, UnQualParseTreeInt3),
module_qualify_parse_tree_int3(Globals, UnQualParseTreeInt3, ParseTreeInt3,
[], _QualSpecs),
% We ignore _QualSpecs. The original comment about this was:
% Any Specs this can generate would be better reported
% when the module is being compiled to target language code.
% And create_parse_tree_int3 cannot return any error_specs either.
% This means that EffectivelyErrors is guaranteed to be "no".
% The error handling code here is therefore has no job to do.
% It is here it *may* get a job later, if we ever decide
% we want to look for and report error when creating .int3 files.
Specs0 = [],
filter_interface_generation_specs(Globals, Specs0, Specs1),
EffectivelyErrors =
contains_errors_or_warnings_treated_as_errors(Globals, Specs1),
ModuleName = ParseTreeModuleSrc ^ ptms_module_name,
(
EffectivelyErrors = no,
ExtraSuffix = "",
construct_int_file_name(Globals, ModuleName, ifk_int3, ExtraSuffix,
FileName, !IO),
(
AddToHptm = do_not_add_new_to_hptm
;
AddToHptm = do_add_new_to_hptm,
Int3Map0 = !.HaveParseTreeMaps ^ hptm_int3,
HM = have_module(FileName, ParseTreeInt3, was_constructed),
map.set(ModuleName, HM, Int3Map0, Int3Map),
!HaveParseTreeMaps ^ hptm_int3 := Int3Map
),
GenerateResult = gpti3_ok(ParseTreeInt3, FileName, Specs1)
;
EffectivelyErrors = yes,
GenerateResult = gpti3_error(ModuleName, [], Specs1)
).
% This qualifies everything as much as it can given the information
% in the current module and writes out the .int3 file.
% XXX document me better
%
:- pred create_parse_tree_int3(parse_tree_module_src::in,
parse_tree_int3::out) is det.
create_parse_tree_int3(ParseTreeModuleSrc, ParseTreeInt3) :-
ParseTreeModuleSrc = parse_tree_module_src(ModuleName, ModuleNameContext,
OrigInclMap, OrigImportUseMap,
_IntFIMSpecMap, _ImpFIMSpecMap, _IntSelfFIMLangs, _ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
_TypeSpecs, _InstModeSpecs,
OrigIntTypeClasses, OrigIntInstances, _IntPredDecls, _IntModeDecls,
_IntDeclPragmas, _IntDeclMarkers, _IntPromises, _IntBadClauses,
_ImpTypeClasses, _ImpInstances, _ImpPredDecls, _ImpModeDecls,
_ImpClauses, _ImpForeignProcs, _ImpForeignExportEnums,
_ImpDeclPragmas, _ImpDeclMarkers, _ImpImplPragmas, _ImpImplMarkers,
_ImpPromises, _ImpInitialises, _ImpFinalises, _ImpMutables),
map.foldl(add_only_int_include, OrigInclMap, map.init, IntInclMap),
IntTypeClasses = list.map(make_typeclass_abstract_for_int3,
OrigIntTypeClasses),
IntInstances = list.map(make_instance_abstract, OrigIntInstances),
(
IntInstances = [],
map.init(IntImportMap)
;
IntInstances = [_ | _],
map.foldl(acc_int_imports, OrigImportUseMap, map.init, IntImportMap)
),
map.foldl(make_type_ctor_checked_defn_abstract_for_int3,
TypeCtorCheckedMap, map.init, IntTypeCtorCheckedMap),
map.foldl(make_inst_ctor_checked_defn_abstract_for_int3,
InstCtorCheckedMap, map.init, IntInstCtorCheckedMap),
map.foldl(make_mode_ctor_checked_defn_abstract_for_int3,
ModeCtorCheckedMap, map.init, IntModeCtorCheckedMap),
decide_repns_for_simple_types_for_int3(ModuleName, TypeCtorCheckedMap,
IntTypeRepnMap),
ParseTreeInt3 = parse_tree_int3(ModuleName, ModuleNameContext,
IntInclMap, IntImportMap,
IntTypeCtorCheckedMap, IntInstCtorCheckedMap, IntModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntTypeRepnMap).
:- pred acc_int_imports(module_name::in, maybe_implicit_import_and_or_use::in,
int_import_map::in, int_import_map::out) is det.
acc_int_imports(ModuleName, ImportUseInfo, !ContextMap) :-
(
ImportUseInfo = implicit_avail(_, MaybeSectionImportAndOrUse),
(
MaybeSectionImportAndOrUse = no
;
MaybeSectionImportAndOrUse = yes(SectionImportAndOrUse),
(
SectionImportAndOrUse = int_import(Context),
map.det_insert(ModuleName, int_import(Context), !ContextMap)
;
( SectionImportAndOrUse = int_use(_)
; SectionImportAndOrUse = imp_import(_)
; SectionImportAndOrUse = imp_use(_)
; SectionImportAndOrUse = int_use_imp_import(_, _)
)
)
)
;
ImportUseInfo = explicit_avail(SectionImportAndOrUse),
(
SectionImportAndOrUse = int_import(Context),
map.det_insert(ModuleName, int_import(Context), !ContextMap)
;
( SectionImportAndOrUse = int_use(_)
; SectionImportAndOrUse = imp_import(_)
; SectionImportAndOrUse = imp_use(_)
; SectionImportAndOrUse = int_use_imp_import(_, _)
)
)
).
%---------------------------------------------------------------------------%
:- pred make_type_ctor_checked_defn_abstract_for_int3(
type_ctor::in, type_ctor_checked_defn::in,
type_ctor_checked_map::in, type_ctor_checked_map::out) is det.
make_type_ctor_checked_defn_abstract_for_int3(TypeCtor, CheckedTypeDefn0,
!CheckedTypeMap) :-
(
CheckedTypeDefn0 = checked_defn_solver(SolverDefn0, _SrcDefns0),
( if
(
SolverDefn0 = solver_type_abstract(AbstractStatus,
AbstractSolverDefn),
AbstractStatus = abstract_solver_type_exported
;
SolverDefn0 = solver_type_full(MaybeAbstractSolverDefn,
_ActualSolverDefn),
MaybeAbstractSolverDefn = yes(AbstractSolverDefn)
)
then
SolverDefn = solver_type_abstract(abstract_solver_type_exported,
AbstractSolverDefn),
IntDefn = wrap_abstract_type_defn(AbstractSolverDefn),
SrcDefns = src_defns_solver(yes(IntDefn), no),
CheckedTypeDefn = checked_defn_solver(SolverDefn, SrcDefns),
map.det_insert(TypeCtor, CheckedTypeDefn, !CheckedTypeMap)
else
true
)
;
CheckedTypeDefn0 = checked_defn_std(StdDefn0, _SrcDefns0),
(
StdDefn0 = std_mer_type_eqv(EqvStatus, EqvDefn0),
(
( EqvStatus = std_eqv_type_mer_exported
; EqvStatus = std_eqv_type_abstract_exported
),
AbsStatus = std_abs_type_abstract_exported,
% XXX Is this right for solver types?
% XXX TYPE_REPN Is this right for types that are eqv to enums,
% or to known size ints/uints?
DetailsAbstract = abstract_type_general,
AbsDefn = EqvDefn0 ^ td_ctor_defn := DetailsAbstract,
CSCsMaybeDefn = c_java_csharp(no, no, no),
StdDefn = std_mer_type_abstract(AbsStatus, AbsDefn,
CSCsMaybeDefn),
IntDefn = wrap_abstract_type_defn(AbsDefn),
SrcDefns = src_defns_std([IntDefn], [], []),
CheckedTypeDefn = checked_defn_std(StdDefn, SrcDefns),
map.det_insert(TypeCtor, CheckedTypeDefn, !CheckedTypeMap)
;
EqvStatus = std_eqv_type_all_private
)
;
StdDefn0 = std_mer_type_subtype(SubStatus, SubDefn0),
(
( SubStatus = std_sub_type_mer_exported
; SubStatus = std_sub_type_abstract_exported
),
AbsStatus = std_abs_type_abstract_exported,
DetailsSub = SubDefn0 ^ td_ctor_defn,
make_sub_type_abstract(DetailsSub, DetailsAbstract),
AbsDefn = SubDefn0 ^ td_ctor_defn := DetailsAbstract,
CJCsMaybeDefn = c_java_csharp(no, no, no),
StdDefn = std_mer_type_abstract(AbsStatus, AbsDefn,
CJCsMaybeDefn),
IntDefn = wrap_abstract_type_defn(AbsDefn),
SrcDefns = src_defns_std([IntDefn], [], []),
CheckedTypeDefn = checked_defn_std(StdDefn, SrcDefns),
map.det_insert(TypeCtor, CheckedTypeDefn, !CheckedTypeMap)
;
SubStatus = std_sub_type_all_private
)
;
(
StdDefn0 = std_mer_type_du_all_plain_constants(DuStatus,
DuDefn0, _HeadCtor, _TailCtors, CJCsMaybeDefnOrEnum),
CJCsMaybeDefnOrEnum = c_java_csharp(MaybeDefnOrEnumC,
MaybeDefnOrEnumJava, MaybeDefnOrEnumCsharp),
GetForeignTypeOnly =
( pred(MaybeDorE::in, MaybeFT::out) is det :-
(
MaybeDorE = no,
MaybeFT = no
;
MaybeDorE = yes(DorE),
(
DorE = foreign_type_or_enum_enum(_),
MaybeFT = no
;
DorE = foreign_type_or_enum_type(FT),
MaybeFT = yes(FT)
)
)
),
GetForeignTypeOnly(MaybeDefnOrEnumC, MaybeDefnC0),
GetForeignTypeOnly(MaybeDefnOrEnumJava, MaybeDefnJava0),
GetForeignTypeOnly(MaybeDefnOrEnumCsharp, MaybeDefnCsharp0),
CJCsMaybeDefn0 = c_java_csharp(MaybeDefnC0, MaybeDefnJava0,
MaybeDefnCsharp0)
;
StdDefn0 = std_mer_type_du_not_all_plain_constants(DuStatus,
DuDefn0, CJCsMaybeDefn0)
),
(
( DuStatus = std_du_type_mer_ft_exported
; DuStatus = std_du_type_mer_exported
; DuStatus = std_du_type_abstract_exported
),
DetailsDu = DuDefn0 ^ td_ctor_defn,
(
DuStatus = std_du_type_mer_ft_exported,
AbsStatus = std_abs_type_ft_exported,
make_du_type_abstract(DetailsDu, DetailsAbstract),
CJCsMaybeDefn = CJCsMaybeDefn0,
get_c_j_cs_defns(CJCsMaybeDefn, CJCsDefns),
IntCJCsDefns = list.map(wrap_foreign_type_defn, CJCsDefns)
;
DuStatus = std_du_type_mer_exported,
AbsStatus = std_abs_type_abstract_exported,
make_du_type_abstract(DetailsDu, DetailsAbstract),
CJCsMaybeDefn = c_java_csharp(no, no, no),
IntCJCsDefns = []
;
DuStatus = std_du_type_abstract_exported,
AbsStatus = std_abs_type_abstract_exported,
% XXX We *could* use the DetailsAbstract value computed by
% make_du_type_abstract in this case as well as in
% all the other cases. The difference would be that
% this *could* add to the .int3 file we are generating
% information about TypeCtor being a direct dummy type,
% a notag type, or an enum type, in the form of e.g.
% a "where type_is_abstract_enum(N)" clause in the type
% declaration.
DetailsAbstract = abstract_type_general,
CJCsMaybeDefn = c_java_csharp(no, no, no),
IntCJCsDefns = []
),
AbsDefn = DuDefn0 ^ td_ctor_defn := DetailsAbstract,
StdDefn = std_mer_type_abstract(AbsStatus, AbsDefn,
CJCsMaybeDefn),
IntDefn = wrap_abstract_type_defn(AbsDefn),
SrcDefns = src_defns_std([IntDefn | IntCJCsDefns], [], []),
CheckedTypeDefn = checked_defn_std(StdDefn, SrcDefns),
map.det_insert(TypeCtor, CheckedTypeDefn, !CheckedTypeMap)
;
DuStatus = std_du_type_all_private
)
;
StdDefn0 = std_mer_type_abstract(AbsStatus, AbsDefn,
CJCsMaybeDefn0),
(
(
AbsStatus = std_abs_type_ft_exported,
CJCsMaybeDefn = CJCsMaybeDefn0
;
AbsStatus = std_abs_type_abstract_exported,
CJCsMaybeDefn = c_java_csharp(no, no, no)
),
get_c_j_cs_defns(CJCsMaybeDefn, CJCsDefns),
IntCJCsDefns = list.map(wrap_foreign_type_defn, CJCsDefns),
StdDefn = std_mer_type_abstract(AbsStatus, AbsDefn,
CJCsMaybeDefn),
IntDefn = wrap_abstract_type_defn(AbsDefn),
SrcDefns = src_defns_std([IntDefn | IntCJCsDefns], [], []),
CheckedTypeDefn = checked_defn_std(StdDefn, SrcDefns),
map.det_insert(TypeCtor, CheckedTypeDefn, !CheckedTypeMap)
;
AbsStatus = std_abs_type_all_private
)
)
).
:- pred get_c_j_cs_defns(c_j_cs_maybe_defn::in,
list(item_type_defn_info_foreign)::out) is det.
get_c_j_cs_defns(CJCsMaybeDefn, CJCsDefns) :-
CJCsMaybeDefn = c_java_csharp(MaybeDefnC, MaybeDefnJava, MaybeDefnCsharp),
MaybeToList =
( pred(MaybeDefn::in, Defns::out) is det :-
(
MaybeDefn = no,
Defns = []
;
MaybeDefn = yes(Defn),
Defns = [Defn]
)
),
MaybeToList(MaybeDefnC, DefnsC),
MaybeToList(MaybeDefnJava, DefnsJava),
MaybeToList(MaybeDefnCsharp, DefnsCsharp),
CJCsDefns = DefnsC ++ DefnsJava ++ DefnsCsharp.
%---------------------%
:- pred make_inst_ctor_checked_defn_abstract_for_int3(
inst_ctor::in, inst_ctor_checked_defn::in,
inst_ctor_checked_map::in, inst_ctor_checked_map::out) is det.
make_inst_ctor_checked_defn_abstract_for_int3(InstCtor, CheckedInstDefn0,
!CheckedInstMap) :-
CheckedInstDefn0 = checked_defn_inst(StdDefn0, SrcDefns0),
StdDefn0 = std_inst_defn(Status0, MaybeAbstractDefn),
(
( Status0 = std_inst_exported
; Status0 = std_inst_abstract_exported
),
Status = std_inst_abstract_exported,
AbstractDefn = MaybeAbstractDefn ^ id_inst_defn := abstract_inst_defn,
StdDefn = std_inst_defn(Status, AbstractDefn),
SrcDefns0 = src_defns_inst(MaybeIntDefn0, _MaybeImpDefn0),
MaybeIntDefn = map_maybe(make_inst_defn_abstract, MaybeIntDefn0),
SrcDefns = src_defns_inst(MaybeIntDefn, no),
CheckedInstDefn = checked_defn_inst(StdDefn, SrcDefns),
map.det_insert(InstCtor, CheckedInstDefn, !CheckedInstMap)
;
Status0 = std_inst_all_private
).
%---------------------%
:- pred make_mode_ctor_checked_defn_abstract_for_int3(
mode_ctor::in, mode_ctor_checked_defn::in,
mode_ctor_checked_map::in, mode_ctor_checked_map::out) is det.
make_mode_ctor_checked_defn_abstract_for_int3(ModeCtor, CheckedModeDefn0,
!CheckedModeMap) :-
CheckedModeDefn0 = checked_defn_mode(StdDefn0, SrcDefns0),
StdDefn0 = std_mode_defn(Status0, MaybeAbstractDefn),
(
( Status0 = std_mode_exported
; Status0 = std_mode_abstract_exported
),
Status = std_mode_abstract_exported,
AbstractDefn = MaybeAbstractDefn ^ md_mode_defn := abstract_mode_defn,
StdDefn = std_mode_defn(Status, AbstractDefn),
SrcDefns0 = src_defns_mode(MaybeIntDefn0, _MaybeImpDefn0),
MaybeIntDefn = map_maybe(make_mode_defn_abstract, MaybeIntDefn0),
SrcDefns = src_defns_mode(MaybeIntDefn, no),
CheckedModeDefn = checked_defn_mode(StdDefn, SrcDefns),
map.det_insert(ModeCtor, CheckedModeDefn, !CheckedModeMap)
;
Status0 = std_mode_all_private
).
%---------------------%
:- func make_typeclass_abstract_for_int3(item_typeclass_info)
= item_abstract_typeclass_info.
make_typeclass_abstract_for_int3(TypeClass) = AbstractTypeClass :-
TypeClass = item_typeclass_info(ClassName, ParamsTVars,
_Constraints, _FunDeps, _Methods, TVarSet, Context, SeqNum),
AbstractTypeClass = item_typeclass_info(ClassName, ParamsTVars,
[], [], class_interface_abstract, TVarSet, Context, SeqNum).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
generate_parse_tree_int0(ProgressStream, Globals, AddToHptm, BurdenedModule,
GenerateResult, !HaveParseTreeMaps, !IO) :-
BurdenedModule = burdened_module(Baggage0, ParseTreeModuleSrc0),
ModuleName = ParseTreeModuleSrc0 ^ ptms_module_name,
generate_pre_grab_pre_qual_interface_for_int0(ParseTreeModuleSrc0,
IntParseTreeModuleSrc),
grab_unqual_imported_modules_make_int(ProgressStream, Globals,
IntParseTreeModuleSrc, AugMakeIntUnit1, Baggage0, Baggage,
!HaveParseTreeMaps, !IO),
% Check whether we succeeded.
GetErrors = Baggage ^ mb_errors,
GetSpecs = get_read_module_specs(GetErrors),
GetSpecsEffectivelyErrors =
contains_errors_or_warnings_treated_as_errors(Globals, GetSpecs),
( if
GetSpecsEffectivelyErrors = no,
there_are_no_errors(GetErrors)
then
% Module-qualify the aug_make_int_unit.
module_qualify_aug_make_int_unit(Globals,
AugMakeIntUnit1, AugMakeIntUnit, [], QualSpecs),
filter_interface_generation_specs(Globals,
GetSpecs ++ QualSpecs, EffectiveGetQualSpecs),
(
EffectiveGetQualSpecs = [],
% Construct the `.int0' file.
create_parse_tree_int0(AugMakeIntUnit, ParseTreeInt0),
ExtraSuffix = "",
construct_int_file_name(Globals, ModuleName, ifk_int0, ExtraSuffix,
FileName, !IO),
(
AddToHptm = do_not_add_new_to_hptm
;
AddToHptm = do_add_new_to_hptm,
Int0Map0 = !.HaveParseTreeMaps ^ hptm_int0,
HM = have_module(FileName, ParseTreeInt0, was_constructed),
map.set(ModuleName, HM, Int0Map0, Int0Map),
!HaveParseTreeMaps ^ hptm_int0 := Int0Map
),
MaybeTimestamp = Baggage0 ^ mb_maybe_timestamp,
maybe_add_delayed_messages(AugMakeIntUnit, [], Specs),
GenerateResult = gpti0_ok(ParseTreeInt0, MaybeTimestamp,
FileName, Specs)
;
EffectiveGetQualSpecs = [_ | _],
maybe_add_delayed_messages(AugMakeIntUnit,
EffectiveGetQualSpecs, Specs),
GenerateResult = gpti0_error(ModuleName, [], Specs)
)
else
% The negative indent is to let the rest of the error_spec
% start at the left margin.
PrefixPieces = [words("Error reading .int3 and/or .int0 files."),
nl_indent_delta(-1)],
maybe_add_delayed_messages(AugMakeIntUnit1, GetSpecs, Specs),
GenerateResult = gpti0_error(ModuleName, PrefixPieces, Specs)
).
%---------------------------------------------------------------------------%
% Delete from the parse tree of the module any items that
% we don't need either
% - to include in the final .int0 file,
% - to module qualify something that we do include there.
% We do this to stop module qualification from having to do redundant
% work, by processing items whose processing cannot affect the final
% parse tree we generate.
%
:- pred generate_pre_grab_pre_qual_interface_for_int0(
parse_tree_module_src::in, parse_tree_module_src::out) is det.
generate_pre_grab_pre_qual_interface_for_int0(ParseTreeModuleSrc,
IntParseTreeModuleSrc) :-
ParseTreeModuleSrc = parse_tree_module_src(ModuleName,
ModuleNameContext, InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
_TypeSpecs, _InstModeSpecs,
IntTypeClasses, IntInstances0, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises, _IntBadClausePreds,
ImpTypeClasses, ImpInstances0, ImpPredDecls, ImpModeDecls,
_ImpClauses, _ImpForeignProcs, _ImpForeignExportEnums,
ImpDeclPragmas, ImpDeclMarkers, _ImpImplPragmas, _ImpImplMarkers,
ImpPromises, _ImpInitialises, _ImpFinalises, ImpMutables),
% Make instances abstract in both interface and implementation sections.
% Delete from the implementation section any abstract instances
% that would duplicate one in the interface section.
OutInfo = init_write_int_merc_out_info,
IntAbsInstances0 = list.map(make_instance_abstract, IntInstances0),
IntAbsInstanceStrs =
list.map(item_abstract_instance_to_string(OutInfo), IntAbsInstances0),
set_tree234.list_to_set(IntAbsInstanceStrs, IntAbsInstanceStrSet),
ImpAbsInstances1 = list.map(make_instance_abstract, ImpInstances0),
KeepImpAbsInstanceTest =
( pred(AbsInstance::in) is semidet :-
Str = item_abstract_instance_to_string(OutInfo, AbsInstance),
not set_tree234.contains(IntAbsInstanceStrSet, Str)
),
list.filter(KeepImpAbsInstanceTest, ImpAbsInstances1, ImpAbsInstances0),
IntParseTreeModuleSrc = parse_tree_module_src(ModuleName,
ModuleNameContext, InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
[], [],
IntTypeClasses, coerce(IntAbsInstances0), IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises, set.init,
ImpTypeClasses, coerce(ImpAbsInstances0), ImpPredDecls, ImpModeDecls,
[], [], [],
ImpDeclPragmas, ImpDeclMarkers, [], [],
ImpPromises, [], [], ImpMutables).
%---------------------------------------------------------------------------%
% create_parse_tree_int0(AugMakeIntUnit, ParseTreeInt0, !Specs):
%
% Generate the private interface of a module (its .int0 file), which
% makes available some not-generally-available items to the other modules
% nested inside it.
%
:- pred create_parse_tree_int0(aug_make_int_unit::in,
parse_tree_int0::out) is det.
create_parse_tree_int0(AugMakeIntUnit, ParseTreeInt0) :-
AugMakeIntUnit = aug_make_int_unit(ParseTreeModuleSrc, _, _, _, _,
ModuleItemVersionNumbersMap),
( if map.search(ModuleItemVersionNumbersMap, ModuleName, MIVNs) then
MaybeVersionNumbers = version_numbers(MIVNs)
else
MaybeVersionNumbers = no_version_numbers
),
ParseTreeModuleSrc = parse_tree_module_src(ModuleName, ModuleNameContext,
InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
_TypeSpecs, _InstModeSpecs,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises, _IntBadClausePreds,
ImpTypeClasses, ImpInstances, ImpPredDecls0, ImpModeDecls,
_ImpClauses, _ImpForeignProcs, _ImpForeignExportEnums,
ImpDeclPragmas, ImpDeclMarkers, _ImpImplPragmas, _ImpImplMarkers,
ImpPromises, _ImpInitialises, _ImpFinalises, ImpMutables),
import_and_or_use_map_to_explicit_int_imp_import_use_maps(ImportUseMap,
SectionImportUseMap, _, _, _, _),
map.keys_as_set(IntFIMSpecMap, IntFIMSpecs0),
map.keys_as_set(ImpFIMSpecMap, ImpFIMSpecs0),
% Add implicit self FIMs for the {Int,Imp}SelfFIMLangs
% to their respective sections.
set.union(
set.map(fim_module_lang_to_spec(ModuleName), IntSelfFIMLangs),
IntFIMSpecs0, IntFIMSpecs),
set.union(
set.map(fim_module_lang_to_spec(ModuleName), ImpSelfFIMLangs),
ImpFIMSpecs0, ImpFIMSpecs1),
% Make the implementation FIMs disjoint from the interface FIMs.
set.difference(ImpFIMSpecs1, IntFIMSpecs, ImpFIMSpecs),
IntAbsInstances = list.map(check_instance_is_abstract, IntInstances),
ImpAbsInstances = list.map(check_instance_is_abstract, ImpInstances),
ImpPredDecls = ImpPredDecls0 ++ list.condense(
list.map(declare_mutable_aux_preds_for_int0(ModuleName), ImpMutables)),
ParseTreeInt0 = parse_tree_int0(ModuleName, ModuleNameContext,
MaybeVersionNumbers, InclMap, SectionImportUseMap,
IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntAbsInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises,
ImpTypeClasses, ImpAbsInstances, ImpPredDecls, ImpModeDecls,
ImpDeclPragmas, ImpDeclMarkers, ImpPromises).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
generate_parse_tree_int12(ProgressStream, Globals, AddToHptm,
BurdenedModule, GenerateResult, !HaveParseTreeMaps, !IO) :-
BurdenedModule = burdened_module(Baggage0, ParseTreeModuleSrc0),
ModuleName = ParseTreeModuleSrc0 ^ ptms_module_name,
generate_pre_grab_pre_qual_interface_for_int1_int2(ParseTreeModuleSrc0,
IntParseTreeModuleSrc),
% Get the .int3 files for imported modules.
grab_unqual_imported_modules_make_int(ProgressStream, Globals,
IntParseTreeModuleSrc, AugMakeIntUnit1, Baggage0, Baggage,
!HaveParseTreeMaps, !IO),
% Check whether we succeeded.
GetErrors = Baggage ^ mb_errors,
GetSpecs = get_read_module_specs(GetErrors),
GetSpecsEffectivelyErrors =
contains_errors_or_warnings_treated_as_errors(Globals, GetSpecs),
( if
GetSpecsEffectivelyErrors = no,
there_are_no_errors(GetErrors)
then
% Module-qualify the aug_make_int_unit.
%
% Note that doing this only if the condition above succeeds avoids
% the generation of avalanche error messages, which is good,
% but it also prevents us from generating useful, non-avalanche
% error messages, e.g. in tests/invalid_make_int/test_nested.m,
% we would be able to report that the fourth argument of predicate
% "foo" refers to a nonexistent type.
%
% In the absence of a sure way to filter out all avalanche errors
% from QualSpecs, we have to decide between generating some avalanche
% error messages or foregoing the generation of some non-avalanche
% error messages. This position of this call makes the latter choice.
module_qualify_aug_make_int_unit(Globals,
AugMakeIntUnit1, AugMakeIntUnit, [], QualSpecs),
filter_interface_generation_specs(Globals,
GetSpecs ++ QualSpecs, EffectiveGetQualSpecs),
(
EffectiveGetQualSpecs = [],
create_parse_trees_int1_int2(Globals, AugMakeIntUnit,
ParseTreeInt1, ParseTreeInt2, [], GenerateSpecs),
filter_interface_generation_specs(Globals,
GenerateSpecs, FilteredGenerateSpecs),
ExtraSuffix = "",
construct_int_file_name(Globals, ModuleName, ifk_int1, ExtraSuffix,
FileName1, !IO),
construct_int_file_name(Globals, ModuleName, ifk_int2, ExtraSuffix,
FileName2, !IO),
(
AddToHptm = do_not_add_new_to_hptm
;
AddToHptm = do_add_new_to_hptm,
Int1Map0 = !.HaveParseTreeMaps ^ hptm_int1,
Int2Map0 = !.HaveParseTreeMaps ^ hptm_int2,
HM1 = have_module(FileName1, ParseTreeInt1, was_constructed),
HM2 = have_module(FileName2, ParseTreeInt2, was_constructed),
map.set(ModuleName, HM1, Int1Map0, Int1Map),
map.set(ModuleName, HM2, Int2Map0, Int2Map),
!HaveParseTreeMaps ^ hptm_int1 := Int1Map,
!HaveParseTreeMaps ^ hptm_int2 := Int2Map
),
MaybeTimestamp = Baggage0 ^ mb_maybe_timestamp,
maybe_add_delayed_messages(AugMakeIntUnit,
FilteredGenerateSpecs, Specs),
GenerateResult = gpti12_ok(ParseTreeInt1, ParseTreeInt2,
MaybeTimestamp, FileName1, FileName2, Specs)
;
EffectiveGetQualSpecs = [_ | _],
maybe_add_delayed_messages(AugMakeIntUnit,
EffectiveGetQualSpecs, Specs),
GenerateResult = gpti12_error(ModuleName, [], Specs)
)
else
% The negative indent is to let the rest of the error_spec
% start at the left margin.
PrefixPieces = [words("Error reading .int3 and/or .int0 files."),
nl_indent_delta(-1)],
maybe_add_delayed_messages(AugMakeIntUnit1, GetSpecs, Specs),
GenerateResult = gpti12_error(ModuleName, PrefixPieces, Specs)
).
%---------------------------------------------------------------------------%
% generate_pre_grab_pre_qual_interface_for_int1_int2(ParseTreeModuleSrc,
% IntParseTreeModuleSrc):
%
% Delete from the parse tree of the module any items that
% we don't need either
% - to include in the final .int/.int2 files,
% - to module qualify something that we do include there.
% We do this to stop module qualification from having to do redundant
% work, by processing items whose processing cannot affect the final
% parse tree we generate.
%
% XXX Do we need the rest of this comment? It is about half the length
% of the code itself.
%
% We return interface sections almost intact, changing them only by
% making instance declarations abstract. We delete most kinds of items
% from implementation sections, keeping only
%
% - Module includes.
%
% - Module imports and uses.
%
% - Type definitions, in a possibly changed form. Specifically,
% we replace the definitions (a) solver types and (b) noncanonical
% du and foreign types with their abstract forms. We leave the
% definitions of all other types (canonical du and foreign types,
% equivalence types, and already abtract types) unchanged.
%
% - Typeclass declarations in their abstract from.
%
% - Foreign_enum pragmas.
%
% - Foreign_import_module declarations.
%
:- pred generate_pre_grab_pre_qual_interface_for_int1_int2(
parse_tree_module_src::in, parse_tree_module_src::out) is det.
generate_pre_grab_pre_qual_interface_for_int1_int2(ParseTreeModuleSrc,
IntParseTreeModuleSrc) :-
ParseTreeModuleSrc = parse_tree_module_src(ModuleName,
ModuleNameContext, InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
TypeSpecs, InstModeSpecs,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises, IntBadClausePreds,
ImpTypeClasses, _ImpInstances, _ImpPredDecls, _ImpModeDecls,
_ImpClauses, _ImpForeignProcs, _ImpForeignExportEnums,
_ImpDeclPragmas, _ImpDeclMarkers, _ImpImplPragmas, _ImpImplMarkers,
_ImpPromises, _ImpInitialises, _ImpFinalises, _ImpMutables),
IntInstancesAbstract = list.map(make_instance_abstract, IntInstances),
map.map_values_only(pre_grab_pre_qual_type_ctor_checked_defn,
TypeCtorCheckedMap, IntTypeCtorCheckedMap),
map.foldl(pre_grab_pre_qual_inst_ctor_checked_defn,
InstCtorCheckedMap, map.init, IntInstCtorCheckedMap),
map.foldl(pre_grab_pre_qual_mode_ctor_checked_defn,
ModeCtorCheckedMap, map.init, IntModeCtorCheckedMap),
AbstractImpTypeClasses = list.map(make_typeclass_abstract, ImpTypeClasses),
IntParseTreeModuleSrc = parse_tree_module_src(ModuleName,
ModuleNameContext, InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
IntTypeCtorCheckedMap, IntInstCtorCheckedMap, IntModeCtorCheckedMap,
TypeSpecs, InstModeSpecs,
IntTypeClasses, coerce(IntInstancesAbstract),
IntPredDecls, IntModeDecls, IntDeclPragmas, IntDeclMarkers,
IntPromises, IntBadClausePreds,
coerce(AbstractImpTypeClasses), [],
[], [], [], [], [], [], [], [], [], [], [], [], []).
% Keep the interface part of the given type_ctor_checked_defn unchanged,
% but modify its implementation-section part by
%
% - making solver types abstract, and
%
% - deleting any user-specified equality and comparison predicates.
%
:- pred pre_grab_pre_qual_type_ctor_checked_defn(
type_ctor_checked_defn::in, type_ctor_checked_defn::out) is det.
pre_grab_pre_qual_type_ctor_checked_defn(CheckedDefn0, CheckedDefn) :-
(
CheckedDefn0 = checked_defn_solver(SolverDefn0, _SrcDefns0),
(
SolverDefn0 = solver_type_abstract(_Status, _Defn0),
% This solver type has only a declaration. If it is in the
% interface section, we keep it unchanged because it is there.
% If it is in the implementation section, we want to keep
% an abstract version of it, but it already abstract,
% so we keep in unchanged for that reason.
CheckedDefn = CheckedDefn0
;
SolverDefn0 = solver_type_full(MaybeAbstractDefn0, FullDefn0),
% Solver type *definitions* can occur only in implementation
% sections. This means that
%
% - if there is a declaration of the solver type in the interface,
% we keep only that declaration;
%
% - otherwise, we turn the definition in the implementation section
% into a declaration.
(
MaybeAbstractDefn0 = yes(AbstractDefn0),
Status = abstract_solver_type_exported,
SolverDefn = solver_type_abstract(Status, AbstractDefn0),
WrapAbstractDefn0 = wrap_abstract_type_defn(AbstractDefn0),
SrcDefns = src_defns_solver(yes(WrapAbstractDefn0), no)
;
MaybeAbstractDefn0 = no,
Status = abstract_solver_type_private,
AbstractDefn = FullDefn0 ^ td_ctor_defn
:= abstract_solver_type,
SolverDefn = solver_type_abstract(Status, AbstractDefn),
WrapAbstractDefn = wrap_abstract_type_defn(AbstractDefn),
SrcDefns = src_defns_solver(no, yes(WrapAbstractDefn))
),
CheckedDefn = checked_defn_solver(SolverDefn, SrcDefns)
)
;
CheckedDefn0 = checked_defn_std(StdDefn0, SrcDefns0),
(
( StdDefn0 = std_mer_type_eqv(_Status, _EqvDefn)
; StdDefn0 = std_mer_type_subtype(_Status, _SubDefn)
),
% These kinds of types
% - are not solver types, and
% - they cannot refer to equality or comparison predicates.
CheckedDefn = CheckedDefn0
;
StdDefn0 = std_mer_type_du_all_plain_constants(Status,
DuDefn0, HeadCtor, TailCtors, MaybeCJCsDefnOrEnum0),
SrcDefns0 = src_defns_std(IntDefns0, ImpDefns0, ImpForeignEnums0),
(
Status = std_du_type_mer_ft_exported,
StdDefn = StdDefn0,
SrcDefns = SrcDefns0
;
Status = std_du_type_mer_exported,
delete_uc_preds_from_c_j_cs_maybe_defn_or_enum(
MaybeCJCsDefnOrEnum0, MaybeCJCsDefnOrEnum),
StdDefn = std_mer_type_du_all_plain_constants(Status,
DuDefn0, HeadCtor, TailCtors, MaybeCJCsDefnOrEnum),
list.map(delete_uc_preds_make_solver_type_dummy,
ImpDefns0, ImpDefns),
SrcDefns = src_defns_std(IntDefns0, ImpDefns,
ImpForeignEnums0)
;
( Status = std_du_type_abstract_exported
; Status = std_du_type_all_private
),
delete_uc_preds_from_du_type_defn(DuDefn0, DuDefn),
delete_uc_preds_from_c_j_cs_maybe_defn_or_enum(
MaybeCJCsDefnOrEnum0, MaybeCJCsDefnOrEnum),
StdDefn = std_mer_type_du_all_plain_constants(Status,
DuDefn, HeadCtor, TailCtors, MaybeCJCsDefnOrEnum),
list.map(delete_uc_preds_make_solver_type_dummy,
ImpDefns0, ImpDefns),
SrcDefns = src_defns_std(IntDefns0, ImpDefns,
ImpForeignEnums0)
),
CheckedDefn = checked_defn_std(StdDefn, SrcDefns)
;
StdDefn0 = std_mer_type_du_not_all_plain_constants(Status,
DuDefn0, MaybeCJCsDefn0),
SrcDefns0 = src_defns_std(IntDefns0, ImpDefns0, ImpForeignEnums0),
(
Status = std_du_type_mer_ft_exported,
StdDefn = StdDefn0,
SrcDefns = SrcDefns0
;
Status = std_du_type_mer_exported,
delete_uc_preds_from_c_j_cs_maybe_defn(MaybeCJCsDefn0,
MaybeCJCsDefn),
StdDefn = std_mer_type_du_not_all_plain_constants(Status,
DuDefn0, MaybeCJCsDefn),
list.map(delete_uc_preds_make_solver_type_dummy,
ImpDefns0, ImpDefns),
SrcDefns = src_defns_std(IntDefns0, ImpDefns,
ImpForeignEnums0)
;
( Status = std_du_type_abstract_exported
; Status = std_du_type_all_private
),
delete_uc_preds_from_du_type_defn(DuDefn0, DuDefn),
delete_uc_preds_from_c_j_cs_maybe_defn(MaybeCJCsDefn0,
MaybeCJCsDefn),
StdDefn = std_mer_type_du_not_all_plain_constants(Status,
DuDefn, MaybeCJCsDefn),
list.map(delete_uc_preds_make_solver_type_dummy,
ImpDefns0, ImpDefns),
SrcDefns = src_defns_std(IntDefns0, ImpDefns,
ImpForeignEnums0)
),
CheckedDefn = checked_defn_std(StdDefn, SrcDefns)
;
StdDefn0 = std_mer_type_abstract(Status, AbsDefn,
MaybeCJCsDefn0),
(
Status = std_abs_type_ft_exported,
StdDefn = StdDefn0,
SrcDefns = SrcDefns0
;
( Status = std_abs_type_abstract_exported
; Status = std_abs_type_all_private
),
delete_uc_preds_from_c_j_cs_maybe_defn(MaybeCJCsDefn0,
MaybeCJCsDefn),
StdDefn = std_mer_type_abstract(Status, AbsDefn,
MaybeCJCsDefn),
list.map(delete_uc_preds_make_solver_type_dummy,
ImpDefns0, ImpDefns),
SrcDefns0 = src_defns_std(IntDefns0, ImpDefns0,
ImpForeignEnums0),
SrcDefns = src_defns_std(IntDefns0, ImpDefns,
ImpForeignEnums0)
),
CheckedDefn = checked_defn_std(StdDefn, SrcDefns)
)
).
% Keep only the part of the inst_ctor_checked_defn
% that is in the interface section.
%
:- pred pre_grab_pre_qual_inst_ctor_checked_defn(inst_ctor::in,
inst_ctor_checked_defn::in,
inst_ctor_checked_map::in, inst_ctor_checked_map::out) is det.
pre_grab_pre_qual_inst_ctor_checked_defn(InstCtor, CheckedDefn0,
!InstCtorCheckedMap) :-
CheckedDefn0 = checked_defn_inst(StdDefn0, SrcDefns0),
StdDefn0 = std_inst_defn(Status, _Defn0),
SrcDefns0 = src_defns_inst(MaybeIntDefn, MaybeImpDefn),
(
Status = std_inst_exported,
expect(unify(MaybeImpDefn, no), $pred, "exported but has imp defn"),
map.det_insert(InstCtor, CheckedDefn0, !InstCtorCheckedMap)
;
Status = std_inst_abstract_exported,
(
MaybeIntDefn = yes(IntDefn),
StdDefn = std_inst_defn(Status, IntDefn),
SrcDefns = src_defns_inst(MaybeIntDefn, no),
CheckedDefn = checked_defn_inst(StdDefn, SrcDefns),
map.det_insert(InstCtor, CheckedDefn, !InstCtorCheckedMap)
;
MaybeIntDefn = no,
unexpected($pred, "std_inst_abstract_exported but no int defn")
)
;
Status = std_inst_all_private
% We do not put any checked definition into !InstCtorCheckedMap.
).
% Keep only the part of the mode_ctor_checked_defn
% that is in the interface section.
%
:- pred pre_grab_pre_qual_mode_ctor_checked_defn(mode_ctor::in,
mode_ctor_checked_defn::in,
mode_ctor_checked_map::in, mode_ctor_checked_map::out) is det.
pre_grab_pre_qual_mode_ctor_checked_defn(ModeCtor, CheckedDefn0,
!ModeCtorCheckedMap) :-
CheckedDefn0 = checked_defn_mode(StdDefn0, SrcDefns0),
StdDefn0 = std_mode_defn(Status, _Defn0),
SrcDefns0 = src_defns_mode(MaybeIntDefn, MaybeImpDefn),
(
Status = std_mode_exported,
expect(unify(MaybeImpDefn, no), $pred, "exported but has imp defn"),
map.det_insert(ModeCtor, CheckedDefn0, !ModeCtorCheckedMap)
;
Status = std_mode_abstract_exported,
(
MaybeIntDefn = yes(IntDefn),
StdDefn = std_mode_defn(Status, IntDefn),
SrcDefns = src_defns_mode(MaybeIntDefn, no),
CheckedDefn = checked_defn_mode(StdDefn, SrcDefns),
map.det_insert(ModeCtor, CheckedDefn, !ModeCtorCheckedMap)
;
MaybeIntDefn = no,
unexpected($pred, "std_mode_abstract_exported but no int defn")
)
;
Status = std_mode_all_private
% We do not put any checked definition into !ModeCtorCheckedMap.
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Generate the contents for the .int and .int2 files.
%
:- pred create_parse_trees_int1_int2(globals::in, aug_make_int_unit::in,
parse_tree_int1::out, parse_tree_int2::out,
list(error_spec)::in, list(error_spec)::out) is det.
create_parse_trees_int1_int2(Globals, AugMakeIntUnit,
ParseTreeInt1, ParseTreeInt2, !Specs) :-
create_parse_tree_int1(Globals, AugMakeIntUnit,
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
TypeCtorRepnMap, ParseTreeInt1, !Specs),
create_parse_tree_int2(AugMakeIntUnit,
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
TypeCtorRepnMap, ParseTreeInt2).
:- pred create_parse_tree_int1(globals::in, aug_make_int_unit::in,
set(fim_spec)::out, set(fim_spec)::out,
type_ctor_checked_map::out,
inst_ctor_checked_map::out, mode_ctor_checked_map::out,
type_ctor_repn_map::out, parse_tree_int1::out,
list(error_spec)::in, list(error_spec)::out) is det.
create_parse_tree_int1(Globals, AugMakeIntUnit,
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
IntTypeCtorCheckedMap, IntInstCtorCheckedMap, IntModeCtorCheckedMap,
TypeCtorRepnMap, ParseTreeInt1, !Specs) :-
% We return some of our intermediate results to our caller, for use
% in constructing the .int2 file.
AugMakeIntUnit = aug_make_int_unit(ParseTreeModuleSrc, _,
_, DirectIntSpecs, IndirectIntSpecs, _),
ParseTreeModuleSrc = parse_tree_module_src(ModuleName, ModuleNameContext,
InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, _ImpSelfFIMLangs,
TypeCtorCheckedMap0, InstCtorCheckedMap0, ModeCtorCheckedMap0,
_TypeSpecs, _InstModeSpecs,
IntTypeClasses, IntInstances0, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises0, _IntBadClausePreds,
ImpTypeClasses0, _ImpInstances, _ImpPredDecls, _ImpModeDecls,
_ImpClauses, _ImpForeignProcs, _ImpForeignExportEnums,
_ImpDeclPragmas, _ImpDeclMarkers, _ImpImplPragmas, _ImpImplMarkers,
_ImpPromises, _ImpInitialises, _ImpFinalises, _ImpMutables),
% Separate out the contents of the interface section(s) from the
% contents of the implementation section(s). Separate out the
% foreign enum pragmas and foreign_import_module items in the
% implementation section, for possible selective reinclusion later.
% Likewise, remove type definitions from the implementation section
% after recording them in ImpTypesMap. Record the type definitions
% in the interface section as well, in IntTypesMap. Record the set of
% modules that we need access to due to references in typeclass
% definition items.
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap0,
IntTypeDefns0, ImpTypeDefns0, _ImpForeignEnums0),
list.foldl(record_type_defn_int, IntTypeDefns0,
one_or_more_map.init, IntTypesMap),
list.foldl(record_type_defn_imp, ImpTypeDefns0,
one_or_more_map.init, ImpTypesMap),
BothTypesMap = one_or_more_map.merge(IntTypesMap, ImpTypesMap),
% Compute the set of type_ctors whose definitions in the implementation
% section we need to preserve, possibly in abstract form (that is
% figured out below).
%
% Also, work out which modules we will need access to due to the
% definitions of equivalence types, foreign types, dummy, enum and other
% du types whose definitions we are keeping in the implementation
% section.
get_requirements_of_imp_exported_types(IntTypesMap, ImpTypesMap,
BothTypesMap, NeededImpTypeCtors, ImpModulesNeededByTypeDefns),
ImpTypeClasses = list.map(check_typeclass_is_abstract, ImpTypeClasses0),
list.foldl(record_modules_needed_by_typeclass_imp, ImpTypeClasses,
set.init, ImpModulesNeededByTypeClassDefns),
set.union(ImpModulesNeededByTypeClassDefns, ImpModulesNeededByTypeDefns,
ImpNeededModules),
% XXX ITEM_LIST We should put a use_module decl into the interface
% of the .int file ONLY IF the module is actually used in the interface.
%
% We already *do* generate warnings for any modules we import or use
% in the interface that are not required in the interface, and programmers
% do tend to delete such unnecessary imports from the interface,
% so fixing this overestimation is not all that urgent.
%
% Since everything we put into a .int file should be fully module
% qualified, we convert all import_modules into use_modules.
map.filter_map_values(
make_imports_into_uses_maybe_implicit(ImpNeededModules),
ImportUseMap, SectionUseOnlyMap),
map.keys_as_set(IntFIMSpecMap, IntExplicitFIMSpecs),
map.keys_as_set(ImpFIMSpecMap, ImpExplicitFIMSpecs),
% Note that _ImpSelfFIMLangs above contains the set of foreign languages
% for which an implicit self FIM is needed by anything in the
% implementation section of the *source file*. We are now starting to
% compute the set of foreign languages for which an implicit self FIM
% is needed by anything in the implementation section *of the interface
% file we are constructing*, which will be a *subset* of _ImpSelfFIMLangs.
% XXX Using _ImpSelfFIMLangs from ParseTreeModuleSrc instead of the value
% of ImpSelfFIMLangs we compute here and below would therefore be
% an overapproximation, but I (zs) don't think the cost in code complexity
% of avoiding this overapproximation is worth the negligible benefits
% it gets us.
map.foldl2(
hide_type_ctor_checked_defn_imp_details_for_int1(BothTypesMap,
NeededImpTypeCtors),
TypeCtorCheckedMap0, map.init, IntTypeCtorCheckedMap,
set.init, ImpSelfFIMLangs),
set.foldl(add_self_fim(ModuleName), IntSelfFIMLangs,
IntExplicitFIMSpecs, IntFIMSpecs),
set.foldl(add_self_fim(ModuleName), ImpSelfFIMLangs,
ImpExplicitFIMSpecs, ImpFIMSpecs0),
set.difference(ImpFIMSpecs0, IntFIMSpecs, ImpFIMSpecs),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap0,
IntInstDefns, _ImpInstDefns),
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
create_inst_ctor_checked_map(do_not_insist_on_defn,
IntInstDefnMap, map.init, IntInstCtorCheckedMap, !Specs),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap0,
IntModeDefns, _ImpModeDefns),
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
create_mode_ctor_checked_map(do_not_insist_on_defn,
IntModeDefnMap, map.init, IntModeCtorCheckedMap, !Specs),
globals.lookup_bool_option(Globals, experiment1, Experiment1),
(
Experiment1 = no,
map.init(TypeCtorRepnMap)
;
Experiment1 = yes,
decide_repns_for_all_types_for_int1(Globals, ModuleName,
TypeCtorCheckedMap0, DirectIntSpecs, IndirectIntSpecs,
TypeCtorRepnMap, RepnSpecs),
!:Specs = !.Specs ++ RepnSpecs
),
IntInstances = list.map(check_instance_is_abstract, IntInstances0),
list.filter(keep_promise_item_int, IntPromises0, IntPromises),
DummyMaybeVersionNumbers = no_version_numbers,
% XXX TODO
ParseTreeInt1 = parse_tree_int1(ModuleName, ModuleNameContext,
DummyMaybeVersionNumbers, InclMap, SectionUseOnlyMap,
IntFIMSpecs, ImpFIMSpecs,
IntTypeCtorCheckedMap, IntInstCtorCheckedMap, IntModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises,
TypeCtorRepnMap, ImpTypeClasses).
%---------------------%
:- pred add_self_fim(module_name::in, foreign_language::in,
set(fim_spec)::in, set(fim_spec)::out) is det.
add_self_fim(ModuleName, Lang, !FIMSpecs) :-
FIMSpec = fim_spec(Lang, ModuleName),
set.insert(FIMSpec, !FIMSpecs).
:- pred make_imports_into_uses_maybe_implicit(set(module_name)::in,
module_name::in, maybe_implicit_import_and_or_use::in,
section_use::out) is semidet.
make_imports_into_uses_maybe_implicit(ImpNeededModules, ModuleName,
ImportUse, SectionUseOnly) :-
(
ImportUse = explicit_avail(Explicit),
make_imports_into_uses(ImpNeededModules, ModuleName,
Explicit, SectionUseOnly)
;
ImportUse = implicit_avail(_Implicit, MaybeExplicit),
MaybeExplicit = yes(Explicit),
make_imports_into_uses(ImpNeededModules, ModuleName,
Explicit, SectionUseOnly)
).
:- pred make_imports_into_uses(set(module_name)::in, module_name::in,
section_import_and_or_use::in, section_use::out) is semidet.
make_imports_into_uses(ImpNeededModules, ModuleName, Explicit0, Explicit) :-
(
( Explicit0 = int_import(IntContext)
; Explicit0 = int_use(IntContext)
; Explicit0 = int_use_imp_import(IntContext, _ImpContext)
),
Explicit = int_use(IntContext)
;
( Explicit0 = imp_import(ImpContext)
; Explicit0 = imp_use(ImpContext)
),
( if set.contains(ImpNeededModules, ModuleName) then
Explicit = imp_use(ImpContext)
else
fail
)
).
%---------------------%
:- type type_defn_map == one_or_more_map(type_ctor, item_type_defn_info).
:- pred record_type_defn_int(item_type_defn_info::in,
type_defn_map::in, type_defn_map::out) is det.
record_type_defn_int(ItemTypeDefn, !IntTypesMap) :-
ItemTypeDefn = item_type_defn_info(Name, TypeParams, _, _, _, _),
TypeCtor = type_ctor(Name, list.length(TypeParams)),
one_or_more_map.add(TypeCtor, ItemTypeDefn, !IntTypesMap).
:- pred record_type_defn_imp(item_type_defn_info::in,
type_defn_map::in, type_defn_map::out) is det.
record_type_defn_imp(ItemTypeDefn, !ImpTypesMap) :-
% We don't add this to the final item cord we intend to put
% into the interface file yet -- we may be removing it.
% If we *do* want the items for a given type_ctor, we will create
% new copies of the items from the type_ctor's entry in ImpTypesMap.
% We do however gather it for use in checking the type definitions
% in the module.
ItemTypeDefn = item_type_defn_info(Name, TypeParams, TypeDefn, _, _, _),
TypeCtor = type_ctor(Name, list.length(TypeParams)),
(
TypeDefn = parse_tree_solver_type(_),
% generate_pre_grab_pre_qual_interface_for_int1_int2 has replaced
% solver type definitions with a dummy definition, and we want
% to put that dummy definition into !OrigImpTypeDefnsCord
% so that we don't generate inappropriate error messages
% about the solver type being declared but not defined.
% On the other hand, we want to put just a declaration,
% not a definition, of the solver type into .int and .int2 files.
TypeDefn1 = parse_tree_abstract_type(abstract_solver_type),
ItemTypeDefn1 = ItemTypeDefn ^ td_ctor_defn := TypeDefn1
;
( TypeDefn = parse_tree_abstract_type(_)
; TypeDefn = parse_tree_du_type(_)
; TypeDefn = parse_tree_sub_type(_)
; TypeDefn = parse_tree_eqv_type(_)
; TypeDefn = parse_tree_foreign_type(_)
),
ItemTypeDefn1 = ItemTypeDefn
),
one_or_more_map.add(TypeCtor, ItemTypeDefn1, !ImpTypesMap).
:- pred record_modules_needed_by_typeclass_imp(
item_abstract_typeclass_info::in,
set(module_name)::in, set(module_name)::out) is det.
record_modules_needed_by_typeclass_imp(ItemTypeClass,
!ImpModulesNeededByTypeClassDefns) :-
% The superclass constraints on the typeclass being declared
% may refer to typeclasses that this module has imported.
Constraints = ItemTypeClass ^ tc_superclasses,
list.foldl(accumulate_modules_in_qual_constraint, Constraints,
!ImpModulesNeededByTypeClassDefns).
:- pred keep_promise_item_int(item_promise_info::in) is semidet.
keep_promise_item_int(ItemPromise) :-
PromiseType = ItemPromise ^ prom_type,
require_complete_switch [PromiseType]
(
PromiseType = promise_type_true,
fail
;
( PromiseType = promise_type_exclusive
; PromiseType = promise_type_exhaustive
; PromiseType = promise_type_exclusive_exhaustive
)
).
%---------------------------------------------------------------------------%
% get_requirements_of_imp_exported_types(IntTypesMap, ImpTypesMap,
% BothTypesMap, NeededTypeCtors, ModulesNeededByTypeDefns):
%
% Compute NeededTypeCtors, the set of type constructors whose definitions
% we need to keep in the implementation section of the .int file
% (in their original or abstract form), and ModulesNeededByTypeDefns,
% the set of modules whose :- import_module and :- use_module declarations
% we need to keep because they define type_ctors used in these kept
% type definitions.
%
% We do this using two passes.
%
% In the first pass, we process every type with a definition in the
% implementation.
%
% - If that definition is equivalence type definition, and there is
% any definition of that same type_ctor in the interface (presumably
% but necessarily as an abstract type), then include the type_ctor
% in AbsExpEqvLhsTypeCtors. We include these type_ctors in
% NeededImpTypeCtors because on 32-bit platforms, if type t1 is
% defined to be equivalent to a 64 bit float, then we need to take
% this into account when deciding the representation of types
% with t1 fields even if type t1 is abstract exported.
% XXX TYPE_REPN We should convey this info in type_repn items,
% not type_defn items, since the latter can be used for purposes
% other than type representation.
%
% - We handle foreign type definitions the same way as equivalence type
% definitions, just in case the foreign type is also bigger than a word.
% XXX TYPE_REPN Again, this info should be in a type_repn item.
% XXX TYPE_REPN Shouldn't boxing make the size of the foreign type
% immaterial?
%
% - If the definition defines a subtype, and there are any definitions of
% that same type_ctor in the interface, then include the type_ctor in
% AbsExpEqvLhsTypeCtors, and the type_ctors of any supertype or
% equivalence types up to the base type. We include these type_ctors in
% NeededImpTypeCtors because the representation of subtypes must be the
% same as that of their base types.
%
% - If the definition defines an enum type (not a subtype), and there is a
% definition of the same type_ctor in the interface, we include the
% type_ctor in AbsExpEnumTypeCtors. This is so that when we abstract
% export the type_ctor, we can record that its size is less than one
% word.
% XXX TYPE_REPN Again, this info should be in a type_repn item.
%
% - If the definition defines a dummy type (not a subtype), we include the
% type_ctor in DirectDummyTypeCtors.
% XXX ITEM_LIST Presumably (by me -zs) this is so that when we abstract
% export them, we can record that it needs no storage.
% XXX However, we currently include dummy types in the
% implementation section of the .int file unchanged, and we do so
% even if the type is not mentioned in the interface section at all.
% XXX TYPE_REPN Again, this info should be in a type_repn item.
%
% The first pass ignores all other type definitions.
%
% The second pass processes the type_ctors in AbsExpEqvLhsTypeCtors,
% i.e. the abstract exported type_ctors which have an equivalence type,
% foreign type, or subtype definition in the implementation section.
% Its job is to compute three sets.
%
% - The first set is AbsExpEqvRhsTypeCtors, the set of type_ctors
% that occur in any (partial or full) expansion of an equivalence type
% in AbsExpEqvLhsTypeCtors. This means that if e.g. type t2 is abstract
% exported and its definition in the implementation section is
%
% :- type t2 == t3(t4, t5).
% :- type t3(A, B) ---> ... a discriminated union definition ...
% :- type t4 ---> ... a discriminated union definition ...
% :- type t5 == t6.
% :- type t6 ---> ... a discriminated union definition ...
%
% then we return {t2, t3, t4, t5, t6} as AbsExpEqvRhsTypeCtors.
%
% - The second set is DuArgTypeCtors, the set of type_ctors that occur
% on the right hand side (i.e. among the field argument types) of
% a discriminated union definition of a type_ctor that is in
% AbsExpEqvLhsTypeCtors, which should happen only when that type_ctor
% also has foreign language definitions or a subtype definition
% (since we put a type_ctor into AbsExpEqvLhsTypeCtors only if it has
% either an equivalence definition, foreign language definition,
% or subtype definition). If these type_ctors are not
% otherwise included in the .int file, this will cause our caller
% to include an abstract declaration of these type_ctors in the
% .int file, to disambiguate the references to these types
% in the full (in the sense of non-abstractified) du Mercury definitions
% we include in the .int file next to the foreign language definitions.
%
% - The third set we return is ModulesNeededByTypeDefns, which consists
% of the names of the modules that define the type_ctors in the first
% two sets.
%
% XXX ITEM_LIST The comment lines starting with a double percent
% are the comment on the original version of this predicate.
%
%% Figure out the set of abstract equivalence type constructors (i.e.
%% the types that are exported as abstract types and which are defined
%% in the implementation section as equivalence types or as foreign types).
%% Return in NeededTypeCtors the smallest set containing those
%% constructors, and the set of private type constructors referred to
%% by the right hand side of any type in NeededTypeCtors.
%%
%% XXX Return in DirectDummyTypeCtors the set of dummy type constructors.
%%
%% Given a du type definition in the implementation section, we should
%% include it in AbsImpExpLhsTypeCtors if the type constructor is abstract
%% exported and the implementation section also contains a foreign_type
%% definition of the type constructor.
%%
%% Given a enumeration type definition in the implementation section, we
%% should include it in AbsImpExpEnumTypeCtors if the type constructor is
%% abstract exported.
%%
%% Return in NeededModules the set of modules that define the type
%% constructors in NeededTypeCtors.
%
:- pred get_requirements_of_imp_exported_types(type_defn_map::in,
type_defn_map::in, type_defn_map::in,
set(type_ctor)::out, set(module_name)::out) is det.
get_requirements_of_imp_exported_types(IntTypesMap, ImpTypesMap,
BothTypesMap, NeededImpTypeCtors, ModulesNeededByTypeDefns) :-
% XXX may want to rename AbsExpEqvLhsTypeCtors as it also includes
% foreign types and subtypes
map.foldl3(
accumulate_abs_imp_exported_type_lhs(IntTypesMap, BothTypesMap),
ImpTypesMap,
set.init, AbsExpEqvLhsTypeCtors,
set.init, AbsExpEnumTypeCtors,
set.init, DirectDummyTypeCtors),
set.fold3(accumulate_abs_imp_exported_type_rhs(ImpTypesMap),
AbsExpEqvLhsTypeCtors,
set.init, AbsExpEqvRhsTypeCtors,
set.init, DuArgTypeCtors,
set.init, ModulesNeededByTypeDefns),
NeededImpTypeCtors = set.union_list([AbsExpEqvLhsTypeCtors,
AbsExpEqvRhsTypeCtors, AbsExpEnumTypeCtors, DirectDummyTypeCtors,
DuArgTypeCtors]).
:- pred accumulate_abs_imp_exported_type_lhs(type_defn_map::in,
type_defn_map::in, type_ctor::in, one_or_more(item_type_defn_info)::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out) is det.
accumulate_abs_imp_exported_type_lhs(IntTypesMap, BothTypesMap,
TypeCtor, ImpItemTypeDefnInfos, !AbsExpEqvLhsTypeCtors,
!AbsExpEnumTypeCtors, !DirectDummyTypeCtors) :-
ImpItemTypeDefnInfos =
one_or_more(HeadImpItemTypeDefnInfo, TailImpItemTypeDefnInfos),
(
TailImpItemTypeDefnInfos = [],
% Don't construct a closure when a type_ctor has only one definition
% in the implementation section, since this the common case.
accumulate_abs_imp_exported_type_lhs_in_defn(IntTypesMap, BothTypesMap,
TypeCtor, HeadImpItemTypeDefnInfo,
!AbsExpEqvLhsTypeCtors, !AbsExpEnumTypeCtors,
!DirectDummyTypeCtors)
;
TailImpItemTypeDefnInfos = [_ | _],
% A type may have multiple definitions in the implementation section
% because it may be defined both in Mercury and in a foreign language.
% A type with multiple definitions doesn't typically include
% an equivalence type among those definitions, but we have to be
% prepared for such an eventuality anyway.
one_or_more.foldl3(
accumulate_abs_imp_exported_type_lhs_in_defn(IntTypesMap,
BothTypesMap, TypeCtor),
ImpItemTypeDefnInfos,
!AbsExpEqvLhsTypeCtors, !AbsExpEnumTypeCtors,
!DirectDummyTypeCtors)
).
:- pred accumulate_abs_imp_exported_type_lhs_in_defn(type_defn_map::in,
type_defn_map::in, type_ctor::in, item_type_defn_info::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out) is det.
accumulate_abs_imp_exported_type_lhs_in_defn(IntTypesMap, BothTypesMap,
TypeCtor, ImpItemTypeDefnInfo, !AbsExpEqvLhsTypeCtors,
!AbsExpEnumTypeCtors, !DirectDummyTypeCtors) :-
ImpItemTypeDefnInfo = item_type_defn_info(_, _, ImpTypeDefn, TVarSet,
_, _),
(
ImpTypeDefn = parse_tree_eqv_type(_),
( if map.search(IntTypesMap, TypeCtor, _) then
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors)
else
true
)
;
ImpTypeDefn = parse_tree_foreign_type(_),
( if map.search(IntTypesMap, TypeCtor, _) then
% XXX ITEM_LIST This looks like a lost opportunity to me (zs),
% because the only foreign types that *need* the same treatment
% as equivalence types are foreign types that are bigger than
% one word in size. The ones that have can_pass_as_mercury_type
% as an attribute are supposed to fit into one word (though
% that assertion may be valid for some platforms only) and thus
% *could* be left out of !AbsExpEqvLhsTypeCtors.
%
% However, before making such a change, consider everything
% in the discussion on this topic on m-rev on 2019 feb 18-19.
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors)
else
true
)
;
ImpTypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(OoMCtors, MaybeEqCmp, MaybeDirectArgCtors),
( if
map.search(IntTypesMap, TypeCtor, _),
non_sub_du_type_is_enum(DetailsDu, _NumFunctors)
then
set.insert(TypeCtor, !AbsExpEnumTypeCtors)
else if
% XXX ITEM_LIST Why don't we insist that TypeCtor occurs
% in IntTypesMap?
% XXX ITEM_LIST If a type has one function symbol
% with arity one and the argument type is equivalent
% to a dummy type that is defined in another module,
% we will NOT include TypeCtor in !DirectDummyTypeCtors,
% since we won't know enough about the contents of the
% other module.
non_sub_du_constructor_list_represents_dummy_type(BothTypesMap,
TVarSet, OoMCtors, MaybeEqCmp, MaybeDirectArgCtors)
then
set.insert(TypeCtor, !DirectDummyTypeCtors)
else
true
)
;
ImpTypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(SuperType, _OoMCtors),
( if map.search(IntTypesMap, TypeCtor, _) then
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors),
( if type_to_ctor(SuperType, SuperTypeCtor) then
set.singleton_set(TypeCtor, Seen0),
accumulate_eqv_and_supertypes(BothTypesMap,
SuperTypeCtor, !AbsExpEqvLhsTypeCtors, Seen0, _Seen)
else
true
)
else
true
)
;
( ImpTypeDefn = parse_tree_abstract_type(_)
; ImpTypeDefn = parse_tree_solver_type(_)
)
).
% Accumulate all supertype and equivalence type ctors leading to the
% base type ctor. The base type ctor does not need to be included.
%
:- pred accumulate_eqv_and_supertypes(type_defn_map::in, type_ctor::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out) is det.
accumulate_eqv_and_supertypes(BothTypesMap, TypeCtor, !AbsExpEqvLhsTypeCtors,
!Seen) :-
% Check for circular types.
( if set.insert_new(TypeCtor, !Seen) then
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors),
( if map.search(BothTypesMap, TypeCtor, ItemTypeDefnInfos) then
one_or_more.foldl2(
accumulate_eqv_and_supertypes_in_defn(BothTypesMap, TypeCtor),
ItemTypeDefnInfos, !AbsExpEqvLhsTypeCtors, !Seen)
else
true
)
else
true
).
:- pred accumulate_eqv_and_supertypes_in_defn(type_defn_map::in,
type_ctor::in, item_type_defn_info::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out) is det.
accumulate_eqv_and_supertypes_in_defn(BothTypesMap, TypeCtor, ItemTypeDefnInfo,
!AbsExpEqvLhsTypeCtors, !Seen) :-
ItemTypeDefnInfo = item_type_defn_info(_, _, TypeDefn, _, _, _),
(
TypeDefn = parse_tree_eqv_type(DetailsEqv),
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors),
DetailsEqv = type_details_eqv(RhsType),
( if type_to_ctor(RhsType, RhsTypeCtor) then
accumulate_eqv_and_supertypes(BothTypesMap, RhsTypeCtor,
!AbsExpEqvLhsTypeCtors, !Seen)
else
true
)
;
TypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(SuperType, _),
% Not yet at the base type.
set.insert(TypeCtor, !AbsExpEqvLhsTypeCtors),
( if type_to_ctor(SuperType, SuperTypeCtor) then
accumulate_eqv_and_supertypes(BothTypesMap, SuperTypeCtor,
!AbsExpEqvLhsTypeCtors, !Seen)
else
true
)
;
TypeDefn = parse_tree_du_type(_DetailsDu)
% This is the base type.
;
( TypeDefn = parse_tree_foreign_type(_)
; TypeDefn = parse_tree_abstract_type(_)
; TypeDefn = parse_tree_solver_type(_)
)
).
:- pred accumulate_abs_imp_exported_type_rhs(type_defn_map::in, type_ctor::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_abs_imp_exported_type_rhs(ImpTypesMap, TypeCtor,
!AbsExpEqvRhsTypeCtors, !DuArgTypeCtors, !ModulesNeededByTypeDefns) :-
( if map.search(ImpTypesMap, TypeCtor, ImpTypeDefns) then
one_or_more.foldl3(
accumulate_abs_eqv_type_rhs_in_defn(ImpTypesMap),
ImpTypeDefns,
!AbsExpEqvRhsTypeCtors, !DuArgTypeCtors, !ModulesNeededByTypeDefns)
else
% TypeCtor is not defined in the implementation section
% of this module.
true
).
:- pred accumulate_abs_eqv_type_rhs_in_defn(type_defn_map::in,
item_type_defn_info::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_abs_eqv_type_rhs_in_defn(ImpTypesMap, ImpItemTypeDefnInfo,
!AbsExpEqvRhsTypeCtors, !DuArgTypeCtors, !ModulesNeededByTypeDefns) :-
ImpItemTypeDefnInfo = item_type_defn_info(_, _, ImpTypeDefn, _, _, _),
(
ImpTypeDefn = parse_tree_eqv_type(DetailsEqv),
DetailsEqv = type_details_eqv(RhsType),
type_to_user_type_ctor_set(RhsType, set.init, RhsTypeCtors),
% Logically, we want to invoke the call to set.union and the
% calls to set.foldl/foldl3 below on all RhsTypeCtors. However, for
% any type_ctor in RhsTypeCtors that is in !.AbsExpEqvRhsTypeCtors,
% we have alteady done so, and since all three operations are
% idempotent, there is no point in invoking them again.
set.difference(RhsTypeCtors, !.AbsExpEqvRhsTypeCtors, NewRhsTypeCtors),
set.union(NewRhsTypeCtors, !AbsExpEqvRhsTypeCtors),
set.fold(accumulate_modules_in_qual_type_ctor, NewRhsTypeCtors,
!ModulesNeededByTypeDefns),
% XXX ITEM_LIST I (zs) *think* that the reason why we ignore the
% result of the second accumulator (!DuArgTypeCtors) in this call
% is because the appearance of a type_ctor in RhsTypeCtors
% on the right hand side of an equivalence type definition
% will (by itself) only generate an abstract definition for that
% type_ctor in the .int file, so other modules need not know about
% any type_ctors just because they appear on the right hand side
% of *its* definition. However, I am far from sure.
set.fold3(accumulate_abs_imp_exported_type_rhs(ImpTypesMap),
NewRhsTypeCtors,
!AbsExpEqvRhsTypeCtors, set.init, _, !ModulesNeededByTypeDefns)
;
(
ImpTypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(OoMCtors, _, _)
;
ImpTypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(_, OoMCtors)
),
% There must exist a foreign type alternative to this type.
% XXX ITEM_LIST I (zs) would like to see a proof argument for that,
% since I don't think it is true. Unfortunately, we cannot check it
% locally.
% As the du type will be exported, we require all the type_ctors
% inside all the argument types of all the data constructors, and the
% modules that define them.
ctors_to_user_type_ctor_set(one_or_more_to_list(OoMCtors),
set.init, RhsTypeCtors),
set.union(RhsTypeCtors, !DuArgTypeCtors),
set.fold(accumulate_modules_in_qual_type_ctor, RhsTypeCtors,
!ModulesNeededByTypeDefns)
;
( ImpTypeDefn = parse_tree_abstract_type(_)
; ImpTypeDefn = parse_tree_solver_type(_)
; ImpTypeDefn = parse_tree_foreign_type(_)
)
).
%---------------------%
% Given a type, return the set of user-defined type constructors
% occurring in it. We do not gather the type constructors of
% builtin types, higher-order types and typle types, because
% are always available without any module needing to be imported,
% which is what our caller uses our results for.
%
:- pred type_to_user_type_ctor_set(mer_type::in,
set(type_ctor)::in, set(type_ctor)::out) is det.
type_to_user_type_ctor_set(Type, !TypeCtors) :-
( if type_to_ctor_and_args(Type, TypeCtor, ArgTypes) then
TypeCtor = type_ctor(SymName, _Arity),
( if
( is_builtin_type_sym_name(SymName)
; type_ctor_is_higher_order(TypeCtor, _, _)
; type_ctor_is_tuple(TypeCtor)
)
then
true
else
set.insert(TypeCtor, !TypeCtors)
),
list.foldl(type_to_user_type_ctor_set, ArgTypes, !TypeCtors)
else
true
).
:- pred ctors_to_user_type_ctor_set(list(constructor)::in,
set(type_ctor)::in, set(type_ctor)::out) is det.
ctors_to_user_type_ctor_set([], !TypeCtors).
ctors_to_user_type_ctor_set([Ctor | Ctors], !TypeCtors) :-
Ctor = ctor(_, _, _, CtorArgs, _, _),
ctor_args_to_user_type_ctor_set(CtorArgs, !TypeCtors),
ctors_to_user_type_ctor_set(Ctors, !TypeCtors).
:- pred ctor_args_to_user_type_ctor_set(list(constructor_arg)::in,
set(type_ctor)::in, set(type_ctor)::out) is det.
ctor_args_to_user_type_ctor_set([], !TypeCtors).
ctor_args_to_user_type_ctor_set([Arg | Args], !TypeCtors) :-
Arg = ctor_arg(_, Type, _),
type_to_user_type_ctor_set(Type, !TypeCtors),
ctor_args_to_user_type_ctor_set(Args, !TypeCtors).
%---------------------%
% Certain types, e.g. io.state and store.store(S), are just dummy types
% used to ensure logical semantics; there is no need to actually pass them,
% and so when importing or exporting procedures to/from C, we don't include
% arguments with these types.
%
% See the documentation for `type_util.is_type_a_dummy' for the definition
% of a dummy type.
%
% NOTE: changes here may require changes to `type_util.is_type_a_dummy'.
%
% This predicate can only be used to test non-subtype du types.
%
:- pred non_sub_du_constructor_list_represents_dummy_type(type_defn_map::in,
tvarset::in, one_or_more(constructor)::in, maybe_canonical::in,
maybe(list(sym_name_arity))::in) is semidet.
non_sub_du_constructor_list_represents_dummy_type(TypeDefnMap, TVarSet,
OoMCtors, MaybeCanonical, MaybeDirectArgCtors) :-
non_sub_du_constructor_list_represents_dummy_type_2(TypeDefnMap, TVarSet,
OoMCtors, MaybeCanonical, MaybeDirectArgCtors, []).
:- pred non_sub_du_constructor_list_represents_dummy_type_2(type_defn_map::in,
tvarset::in, one_or_more(constructor)::in, maybe_canonical::in,
maybe(list(sym_name_arity))::in, list(mer_type)::in) is semidet.
non_sub_du_constructor_list_represents_dummy_type_2(TypeDefnMap, TVarSet,
OoMCtors, canon, no, CoveredTypes) :-
OoMCtors = one_or_more(Ctor, []),
Ctor = ctor(_Ordinal, MaybeExistConstraints, _Name, CtorArgs, _Arity,
_Context),
MaybeExistConstraints = no_exist_constraints,
(
% A single zero-arity constructor.
CtorArgs = []
;
% A constructor with a single dummy argument.
CtorArgs = [ctor_arg(_, ArgType, _)],
ctor_arg_is_dummy_type(TypeDefnMap, TVarSet, ArgType, CoveredTypes)
= yes
).
:- func ctor_arg_is_dummy_type(type_defn_map, tvarset, mer_type,
list(mer_type)) = bool.
ctor_arg_is_dummy_type(TypeDefnMap, TVarSet, Type, CoveredTypes0)
= IsDummyType :-
(
Type = defined_type(SymName, TypeArgs, _Kind),
( if list.member(Type, CoveredTypes0) then
% The type is circular.
IsDummyType = no
else
Arity = list.length(TypeArgs),
TypeCtor = type_ctor(SymName, Arity),
( if
(
is_type_ctor_a_builtin_dummy(TypeCtor)
= is_builtin_dummy_type_ctor
;
% Can we find a definition of the type that tells us
% it is a dummy type?
ctor_arg_is_dummy_type_by_some_type_defn(TypeDefnMap,
TVarSet, Type, TypeCtor, TypeArgs, CoveredTypes0)
)
then
IsDummyType = yes
else
IsDummyType = no
)
)
;
( Type = type_variable(_, _)
; Type = builtin_type(_)
; Type = tuple_type(_, _)
; Type = higher_order_type(_, _, _, _)
; Type = apply_n_type(_, _, _)
),
IsDummyType = no
;
Type = kinded_type(_, _),
unexpected($pred, "kinded_type")
).
:- pred ctor_arg_is_dummy_type_by_some_type_defn(type_defn_map::in,
tvarset::in, mer_type::in, type_ctor::in, list(mer_type)::in,
list(mer_type)::in) is semidet.
ctor_arg_is_dummy_type_by_some_type_defn(TypeDefnMap, TVarSet, Type, TypeCtor,
TypeArgs, CoveredTypes0) :-
one_or_more_map.search(TypeDefnMap, TypeCtor, ItemTypeDefnInfos),
one_or_more.member(ItemTypeDefnInfo, ItemTypeDefnInfos),
ItemTypeDefnInfo = item_type_defn_info(_TypeCtor, TypeDefnTypeParams,
TypeDefn, TypeDefnTVarSet, _Context, _SeqNum),
(
TypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(OoMCtors, MaybeEqCmp, MaybeDirectArgCtors),
non_sub_du_constructor_list_represents_dummy_type_2(TypeDefnMap,
TVarSet, OoMCtors, MaybeEqCmp, MaybeDirectArgCtors,
[Type | CoveredTypes0])
;
TypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(SuperType0, _OoMCtors),
% A subtype can only be a dummy type if its base type is a dummy type.
merge_tvarsets_and_subst_type_args(TVarSet, TypeArgs, TypeDefnTVarSet,
TypeDefnTypeParams, SuperType0, SuperType),
get_base_type(TypeDefnMap, TVarSet, SuperType, BaseType, set.init),
ctor_arg_is_dummy_type(TypeDefnMap, TVarSet, BaseType, CoveredTypes0)
= yes
).
:- pred merge_tvarsets_and_subst_type_args(tvarset::in, list(mer_type)::in,
tvarset::in, list(type_param)::in, mer_type::in, mer_type::out) is det.
merge_tvarsets_and_subst_type_args(TVarSet, TypeArgs,
TVarSet0, TypeParams0, Type0, Type) :-
tvarset_merge_renaming(TVarSet, TVarSet0, _MergedTVarSet, Renaming),
apply_renaming_to_tvars(Renaming, TypeParams0, TypeParams),
map.from_corresponding_lists(TypeParams, TypeArgs, TSubst),
apply_renaming_to_type(Renaming, Type0, Type1),
apply_rec_subst_to_type(TSubst, Type1, Type).
% This predicate is nondet because in a non-checked type_defn_map,
% a type_ctor may have two or more subtype definitions.
%
% XXX CLEANUP Make both this predicate and its callers operate on
% type_ctor_checked_maps.
%
:- pred get_base_type(type_defn_map::in, tvarset::in, mer_type::in,
mer_type::out, set(mer_type)::in) is nondet.
get_base_type(TypeDefnMap, TVarSet, Type, BaseType, !.SeenTypes) :-
Type = defined_type(SymName, TypeArgs, _Kind),
% If Type is in !.SeenTypes, fail. Otherwise, add Type to !SeenTypes.
set.insert_new(Type, !SeenTypes),
Arity = list.length(TypeArgs),
TypeCtor = type_ctor(SymName, Arity),
one_or_more_map.search(TypeDefnMap, TypeCtor, ItemTypeDefnInfos),
one_or_more.member(ItemTypeDefnInfo, ItemTypeDefnInfos),
ItemTypeDefnInfo = item_type_defn_info(_TypeCtor, TypeDefnTypeParams,
TypeDefn, TypeDefnTVarSet, _Context, _SeqNum),
(
TypeDefn = parse_tree_du_type(_DetailsDu),
BaseType = Type
;
TypeDefn = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(SuperType0, _OoMCtors),
merge_tvarsets_and_subst_type_args(TVarSet, TypeArgs,
TypeDefnTVarSet, TypeDefnTypeParams, SuperType0, SuperType),
get_base_type(TypeDefnMap, TVarSet, SuperType, BaseType, !.SeenTypes)
).
%---------------------------------------------------------------------------%
:- pred hide_type_ctor_checked_defn_imp_details_for_int1(type_defn_map::in,
set(type_ctor)::in, type_ctor::in, type_ctor_checked_defn::in,
type_ctor_checked_map::in, type_ctor_checked_map::out,
set(foreign_language)::in, set(foreign_language)::out) is det.
hide_type_ctor_checked_defn_imp_details_for_int1(BothTypesMap,
NeededImpTypeCtors, TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap, !ImpImplicitFIMLangs) :-
(
TypeCtorCheckedDefn0 = checked_defn_solver(_, _),
hide_type_ctor_checked_defn_solver_imp_details_for_int1(TypeCtor,
TypeCtorCheckedDefn0, !TypeCtorCheckedMap)
;
TypeCtorCheckedDefn0 = checked_defn_std(_, _),
hide_type_ctor_checked_defn_std_imp_details_for_int1(BothTypesMap,
NeededImpTypeCtors, TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap, !ImpImplicitFIMLangs)
).
:- inst type_ctor_checked_defn_solver for type_ctor_checked_defn/0
---> checked_defn_solver(ground, ground).
:- inst type_ctor_checked_defn_std for type_ctor_checked_defn/0
---> checked_defn_std(ground, ground).
:- pred hide_type_ctor_checked_defn_solver_imp_details_for_int1(type_ctor::in,
type_ctor_checked_defn::in(type_ctor_checked_defn_solver),
type_ctor_checked_map::in, type_ctor_checked_map::out) is det.
hide_type_ctor_checked_defn_solver_imp_details_for_int1(TypeCtor,
TypeCtorCheckedDefn0, !TypeCtorCheckedMap) :-
TypeCtorCheckedDefn0 = checked_defn_solver(SolverTypeDefn0, _SrcDefns0),
% Leave everything in interface section as is.
% For items in implementation section:
%
% - replace solver types with abstract_solver_type
(
SolverTypeDefn0 = solver_type_abstract(AbstractSolverStatus,
_AbstractDefn),
(
AbstractSolverStatus = abstract_solver_type_exported,
map.det_insert(TypeCtor, TypeCtorCheckedDefn0, !TypeCtorCheckedMap)
;
AbstractSolverStatus = abstract_solver_type_private
)
;
SolverTypeDefn0 = solver_type_full(MaybeAbstractDefn, _FullDefn),
(
MaybeAbstractDefn = no
;
MaybeAbstractDefn = yes(AbstractDefn),
SolverTypeDefn = solver_type_abstract(
abstract_solver_type_exported, AbstractDefn),
SrcDefnsSolver = src_defns_solver(
yes(wrap_abstract_type_defn(AbstractDefn)), no),
TypeCtorCheckedDefn =
checked_defn_solver(SolverTypeDefn, SrcDefnsSolver),
map.det_insert(TypeCtor, TypeCtorCheckedDefn, !TypeCtorCheckedMap)
)
).
:- pred hide_type_ctor_checked_defn_std_imp_details_for_int1(
type_defn_map::in, set(type_ctor)::in,
type_ctor::in, type_ctor_checked_defn::in(type_ctor_checked_defn_std),
type_ctor_checked_map::in, type_ctor_checked_map::out,
set(foreign_language)::in, set(foreign_language)::out) is det.
hide_type_ctor_checked_defn_std_imp_details_for_int1(BothTypesMap,
NeededImpTypeCtors, TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap, !ImpImplicitFIMLangs) :-
TypeCtorCheckedDefn0 = checked_defn_std(StdTypeDefn0, SrcDefnsStd0),
SrcDefnsStd0 =
src_defns_std(SrcIntDefns0, SrcImpDefns0, SrcImpForeignEnums),
% Recording the foreign languages used by foreign enum items in
% !ImpImplicitFIMLangs *even if the item does not end up in the .int file*
% preserves old behavior.
list.foldl(record_foreign_lang_in_foreign_enum,
SrcImpForeignEnums, !ImpImplicitFIMLangs),
% Leave everything in interface section as is.
% For items in implementation section:
%
% - If TypeCtor is not in NeededImpTypeCtors, delete all imp items.
%
% - If TypeCtor is in NeededImpTypeCtors:
% - Leave any equivalences alone.
% - Leave any foreign types alone.
% - Make du types abstract (via make_imp_types_abstract), except where
% we need to convey info that parse_tree_out.m cannot convey.
% - Keep foreign enum item if the type's du constructors are exported.
(
StdTypeDefn0 = std_mer_type_eqv(EqvStatus, EqvDefn),
( if set.member(TypeCtor, NeededImpTypeCtors) then
% We keep both the int and imp parts of this type unchanged.
map.det_insert(TypeCtor, TypeCtorCheckedDefn0, !TypeCtorCheckedMap)
else
% We keep only the int part of this type.
(
EqvStatus = std_eqv_type_mer_exported,
% The entirety of this type is in the interface.
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
;
EqvStatus = std_eqv_type_abstract_exported,
AbstractStatus = std_abs_type_abstract_exported,
AbstractDefn = EqvDefn ^ td_ctor_defn
:= abstract_type_general,
MaybeCJCsDefn = c_java_csharp(no, no, no),
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn),
SrcDefnsStd = src_defns_std(
[wrap_abstract_type_defn(AbstractDefn)], [], []),
TypeCtorCheckedDefn = checked_defn_std(StdTypeDefn,
SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
;
EqvStatus = std_eqv_type_all_private
% No part of this type is in the interface.
)
)
;
StdTypeDefn0 = std_mer_type_subtype(SubStatus, SubDefn),
(
SubStatus = std_sub_type_mer_exported,
% The entirety of this type is in the interface.
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
;
SubStatus = std_sub_type_abstract_exported,
AbstractDefn = make_subtype_defn_abstract(SubDefn),
( if set.member(TypeCtor, NeededImpTypeCtors) then
% There should be exactly one SrcImpDefn0,
% which we replace with AbstractDefn.
SrcImpDefns = [wrap_abstract_type_defn(AbstractDefn)]
else
SrcImpDefns = []
),
AbstractStatus = std_abs_type_abstract_exported,
MaybeCJCsDefn = c_java_csharp(no, no, no),
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn),
SrcDefnsStd = src_defns_std(SrcIntDefns0, SrcImpDefns, []),
TypeCtorCheckedDefn = checked_defn_std(StdTypeDefn,
SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
;
SubStatus = std_sub_type_all_private,
% No part of this type is in the interface.
( if set.member(TypeCtor, NeededImpTypeCtors) then
% There should be exactly one SrcImpDefn0,
% which we replace with AbstractDefn.
%
% XXX CLEANUP We generate the same SrcDefnsStd that we used to,
% but the StdTypeDefn we generate is wrong, because there
% is no std_abs_type_status that exactly matches
% the type_ctor_checked_defn we generate. This is not nice,
% but it *should* be ok, since we will use *only* the
% SrcDefnsStd part of the TypeCtorCheckedDefn; we won't use
% the StdTypeDefn part.
AbstractDefn = make_subtype_defn_abstract(SubDefn),
AbstractStatus = std_abs_type_all_private,
MaybeCJCsDefn = c_java_csharp(no, no, no),
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn),
SrcImpDefns = [wrap_abstract_type_defn(AbstractDefn)],
SrcDefnsStd = src_defns_std([], SrcImpDefns, []),
TypeCtorCheckedDefn = checked_defn_std(StdTypeDefn,
SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
else
true
)
)
;
(
StdTypeDefn0 = std_mer_type_du_all_plain_constants(DuStatus,
DuDefn, HeadCtor0, TailCtors0, MaybeCJCsDefnOrEnum0),
Extras0 = extras_enum(HeadCtor0, TailCtors0, MaybeCJCsDefnOrEnum0)
;
StdTypeDefn0 = std_mer_type_du_not_all_plain_constants(DuStatus,
DuDefn, MaybeCJCsDefn0),
Extras0 = extras_non_enum(MaybeCJCsDefn0)
),
(
DuStatus = std_du_type_mer_ft_exported,
% The entirety of this type is in the interface, except any foreign
% enum items, and we want all components where they are.
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
;
DuStatus = std_du_type_mer_exported,
( if set.member(TypeCtor, NeededImpTypeCtors) then
% This type has a du Mercury definition in the interface,
% and possibly one or more foreign type and/or enum
% definitions in the implementation section, and we want
% all of those items where they are.
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
else
% This type has a du Mercury definition in the interface.
% We don't want any of its foreign type definitions in the
% implementation section, but (since the Mercury function
% symbols are exported) we do want any foreign enum items
% in the implementation section to stay where they are.
delete_any_foreign_type_defn_from_extras(Extras0, Extras),
% Did deleting type definitions make a difference?
( if Extras = Extras0 then
% No, it did not.
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
else
% Yes, it did, so build the updated TypeCtorCheckedDefn.
(
Extras = extras_enum(HeadCtor, TailCtors,
MaybeCJCsDefnOrEnum),
StdTypeDefn = std_mer_type_du_all_plain_constants(
DuStatus, DuDefn, HeadCtor, TailCtors,
MaybeCJCsDefnOrEnum)
;
Extras = extras_non_enum(MaybeCJCsDefn),
StdTypeDefn = std_mer_type_du_not_all_plain_constants(
DuStatus, DuDefn, MaybeCJCsDefn)
),
SrcDefnsStd =
src_defns_std(SrcIntDefns0, [], SrcImpForeignEnums),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
)
)
;
DuStatus = std_du_type_abstract_exported,
% Since we do not export the Mercury function symbols,
% we delete any foreign enum definition from the implementation
% section. We also delete any foreign type definition from
% in implementation section if TypeCtor is not in
% NeededImpTypeCtors.
delete_any_foreign_enum_from_extras(Extras0, MaybeCJCsDefn1),
( if set.member(TypeCtor, NeededImpTypeCtors) then
( if MaybeCJCsDefn1 = c_java_csharp(no, no, no) then
% After deleting any foreign enum items in the
% implementation section, this type has only a du Mercury
% definition left there. Making it abstract preserves
% old behavior.
make_du_type_defn_abstract(BothTypesMap,
DuDefn, MaybeAbstractDefn),
(
MaybeAbstractDefn = no,
% We have to keep the original du definition.
(
Extras0 = extras_enum(HeadCtor, TailCtors, _),
wrap_cjcs_foreign_type_no_enums(MaybeCJCsDefn1,
MaybeCJCsDefnOrEnum),
StdTypeDefn = std_mer_type_du_all_plain_constants(
DuStatus, DuDefn, HeadCtor, TailCtors,
MaybeCJCsDefnOrEnum)
;
Extras0 = extras_non_enum(_),
% A non-enum type can be a dummy by being a notag
% type wrapped around a dummy type.
StdTypeDefn =
std_mer_type_du_not_all_plain_constants(
DuStatus, DuDefn, MaybeCJCsDefn1)
),
SrcImpDefns = [wrap_du_type_defn(DuDefn)]
;
MaybeAbstractDefn = yes(AbstractDefn),
AbstractStatus = std_abs_type_abstract_exported,
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn1),
DetailsAbs = AbstractDefn ^ td_ctor_defn,
( if DetailsAbs = abstract_type_general then
% There is nothing that including AbstractDefn
% in the implementation can tell readers of the
% .int file that they don't already get from
% SrcIntDefns0.
SrcImpDefns = []
else
% XXX None of the available values of
% std_abs_type_status fit this use case.
% XXX Should we replace SrcIntDefns0 with
% AbstractDefn, and SrcImpDefns with []?
SrcImpDefns =
[wrap_abstract_type_defn(AbstractDefn)]
)
),
SrcDefnsStd = src_defns_std(SrcIntDefns0, SrcImpDefns, []),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
else
% This type has a du Mercury definition, and one or more
% foreign type definitions left in the implementation
% section, which means we have two or more definitions
% of the type in the implementation section. Keeping
% all of those definitions preserves old behavior.
(
Extras0 = extras_enum(HeadCtor, TailCtors, _),
wrap_cjcs_foreign_type_no_enums(MaybeCJCsDefn1,
MaybeCJCsDefnOrEnum),
StdTypeDefn = std_mer_type_du_all_plain_constants(
DuStatus, DuDefn, HeadCtor, TailCtors,
MaybeCJCsDefnOrEnum)
;
Extras0 = extras_non_enum(_),
StdTypeDefn = std_mer_type_du_not_all_plain_constants(
DuStatus, DuDefn, MaybeCJCsDefn1)
),
SrcDefnsStd =
src_defns_std(SrcIntDefns0, SrcImpDefns0, []),
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
)
else
make_du_type_defn_abstract(BothTypesMap,
DuDefn, MaybeAbstractDefn),
(
MaybeAbstractDefn = no,
% We need to tell the readers of the .int file that
% this type is a dummy type, but there is no way
% an abstract definition can tell them that. We therefore
% have to tell them that by including DuDefn in the
% implementation section.
AbstractDefn = DuDefn ^ td_ctor_defn
:= abstract_type_general,
SrcImpDefns = [wrap_du_type_defn(DuDefn)]
;
MaybeAbstractDefn = yes(AbstractDefn),
% The AbstractDefn in the interface says everything
% we want to say about this type.
SrcImpDefns = []
),
AbstractStatus = std_abs_type_abstract_exported,
MaybeCJCsDefn = c_java_csharp(no, no, no),
% XXX Should we use SrcIntDefns?
% SrcIntDefns = [wrap_abstract_type_defn(AbstractDefn)],
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn),
SrcDefnsStd = src_defns_std(SrcIntDefns0, SrcImpDefns, []),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
)
;
DuStatus = std_du_type_all_private,
% Since we do not export the Mercury function symbols,
% we delete any foreign enum definition from the implementation
% section. We also delete any foreign type definition from
% in implementation section if TypeCtor is not in
% NeededImpTypeCtors.
delete_any_foreign_enum_from_extras(Extras0, MaybeCJCsDefn1),
( if set.member(TypeCtor, NeededImpTypeCtors) then
( if MaybeCJCsDefn1 = c_java_csharp(no, no, no) then
% This type has only a du Mercury definition in the
% implementation section. Making it abstract
% preserves old behavior.
make_du_type_defn_abstract(BothTypesMap,
DuDefn, MaybeAbstractDefn),
(
MaybeAbstractDefn = no,
StdTypeDefn = StdTypeDefn0,
SrcImpDefns = [wrap_du_type_defn(DuDefn)]
;
MaybeAbstractDefn = yes(AbstractDefn),
% XXX None of the available values of
% std_abs_type_status fit this use case.
AbstractStatus = std_abs_type_abstract_exported,
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn1),
SrcImpDefns = [wrap_abstract_type_defn(AbstractDefn)]
),
SrcDefnsStd = src_defns_std([], SrcImpDefns, []),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
else
% This type has a du Mercury definition, and
% one or more foreign type definitions in the
% implementation section, which means we have two
% or more definitions of the type in the implementation
% section. Keeping all of those definitions
% preserves old behavior. However, we do delete
% any foreign enum items.
SrcDefnsStd =
src_defns_std(SrcIntDefns0, SrcImpDefns0, []),
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
TypeCtorCheckedDefn =
checked_defn_std(StdTypeDefn0, SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
)
else
true
)
)
;
StdTypeDefn0 = std_mer_type_abstract(AbstractStatus,
AbstractDefn, _MaybeCJCsDefn0),
(
AbstractStatus = std_abs_type_ft_exported,
% The entirety of this type is in the interface.
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
;
AbstractStatus = std_abs_type_abstract_exported,
( if set.member(TypeCtor, NeededImpTypeCtors) then
% This type has an abstract Mercury declaration in the
% interface and one or more foreign type definitions
% in the implementation section, but we want both
% where they are.
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
else
MaybeCJCsDefn = c_java_csharp(no, no, no),
StdTypeDefn = std_mer_type_abstract(AbstractStatus,
AbstractDefn, MaybeCJCsDefn),
SrcDefnsStd = src_defns_std(SrcIntDefns0, [], []),
TypeCtorCheckedDefn = checked_defn_std(StdTypeDefn,
SrcDefnsStd),
map.det_insert(TypeCtor, TypeCtorCheckedDefn,
!TypeCtorCheckedMap)
)
;
AbstractStatus = std_abs_type_all_private,
( if set.member(TypeCtor, NeededImpTypeCtors) then
% This type has both an abstract Mercury declaration
% and one or more foreign type definitions in the
% implementation section, and we want both where they are.
list.foldl(record_foreign_lang_in_type_defn,
SrcImpDefns0, !ImpImplicitFIMLangs),
map.det_insert(TypeCtor, TypeCtorCheckedDefn0,
!TypeCtorCheckedMap)
else
true
)
)
).
:- pred make_du_type_defn_abstract(type_defn_map::in,
item_type_defn_info_du::in, maybe(item_type_defn_info_abstract)::out)
is det.
make_du_type_defn_abstract(BothTypesMap, DuDefnInfo, MaybeAbstractDefnInfo) :-
% XXX TYPE_REPN We should record the aspects of the type definition
% that are relevant to type representation (such as "is dummy",
% "fits in n bits", "is equivalent to ...") in a type_repn item,
% and then make the type definition abstract.
DuDefnInfo = item_type_defn_info(_, _, DetailsDu, TVarSet, _, _),
DetailsDu = type_details_du(OoMCtors, MaybeEqCmp, MaybeDirectArgCtors),
( if
non_sub_du_constructor_list_represents_dummy_type(BothTypesMap,
TVarSet, OoMCtors, MaybeEqCmp, MaybeDirectArgCtors)
then
% We cannot return DetailsAbs = abstract_dummy_type, because
% parse_tree_out.m writes out abstract_dummy_types as if they were
% abstract_type_general, which means that if we output
% AbstractDefnInfo, readers of the .int file won't know that
% the type is abstract.
%
% The only way we can tell them that is to keep the original
% DuDefnInfo. We tell our caller that by returning nothing.
MaybeAbstractDefnInfo = no
else
( if non_sub_du_type_is_enum(DetailsDu, NumFunctors) then
num_bits_needed_for_n_dense_values(NumFunctors, NumBits),
DetailsAbs = abstract_type_fits_in_n_bits(NumBits)
else
DetailsAbs = abstract_type_general
),
AbstractDefnInfo = DuDefnInfo ^ td_ctor_defn := DetailsAbs,
MaybeAbstractDefnInfo = yes(AbstractDefnInfo)
).
:- func make_subtype_defn_abstract(item_type_defn_info_sub)
= item_type_defn_info_abstract.
make_subtype_defn_abstract(SubDefn) = AbstractDefn :-
TypeDefn = SubDefn ^ td_ctor_defn,
SuperType = TypeDefn ^ sub_supertype,
type_to_ctor_det(SuperType, SuperTypeCtor),
AbstractDefn = SubDefn ^ td_ctor_defn := abstract_subtype(SuperTypeCtor).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% create_parse_tree_int2(AugMakeIntUnit,
% IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
% TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
% TypeCtorRepnMap, ParseTreeInt2):
%
% The input arguments should be the relevant parts of the .int1 file
% computed by our parent.
%
:- pred create_parse_tree_int2(aug_make_int_unit::in,
set(fim_spec)::in, set(fim_spec)::in,
type_ctor_checked_map::in, inst_ctor_checked_map::in,
mode_ctor_checked_map::in, type_ctor_repn_map::in,
parse_tree_int2::out) is det.
create_parse_tree_int2(AugMakeIntUnit,
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
TypeCtorRepnMap, ParseTreeInt2) :-
AugMakeIntUnit = aug_make_int_unit(ParseTreeModuleSrc, _, _, _, _, _),
ModuleName = ParseTreeModuleSrc ^ ptms_module_name,
ModuleNameContext = ParseTreeModuleSrc ^ ptms_module_name_context,
InclMap = ParseTreeModuleSrc ^ ptms_include_map,
map.foldl(add_only_int_include, InclMap, map.init, ShortIntInclMap),
IntTypeClasses = ParseTreeModuleSrc ^ ptms_int_typeclasses,
IntInstances = ParseTreeModuleSrc ^ ptms_int_instances,
some [!UnqualSymNames, !UsedModuleNames, !ImpEqvUsedModuleNames] (
!:UnqualSymNames = no_unqual_symnames,
set.init(!:UsedModuleNames),
set.init(!:ImpEqvUsedModuleNames),
map.foldl6(restrict_type_ctor_checked_defn_for_int2,
TypeCtorCheckedMap,
map.init, ShortTypeCtorCheckedMap,
!UnqualSymNames, !UsedModuleNames, !ImpEqvUsedModuleNames,
set.init, ShortIntImplicitFIMLangs,
set.init, ShortImpImplicitFIMLangs),
map.foldl2_values(restrict_inst_ctor_checked_defn_for_int2,
InstCtorCheckedMap, !UnqualSymNames, !UsedModuleNames),
map.foldl2_values(restrict_mode_ctor_checked_defn_for_int2,
ModeCtorCheckedMap, !UnqualSymNames, !UsedModuleNames),
get_int2_items_from_int1_int_typeclass(IntTypeClasses,
!UnqualSymNames, !UsedModuleNames,
cord.init, ShortIntTypeClassesCord),
get_int2_items_from_int1_int_instance(IntInstances,
!UnqualSymNames, !UsedModuleNames,
cord.init, ShortIntInstancesCord),
ShortIntTypeClasses = cord.list(ShortIntTypeClassesCord),
ShortIntInstances = cord.list(ShortIntInstancesCord),
UnqualSymNames = !.UnqualSymNames,
UsedModuleNames = !.UsedModuleNames,
ImpEqvUsedModuleNames = !.ImpEqvUsedModuleNames
),
ImportUseMap = ParseTreeModuleSrc ^ ptms_import_use_map,
map.foldl(
make_imports_into_uses_maybe_implicit_int2(UnqualSymNames,
UsedModuleNames, ImpEqvUsedModuleNames),
ImportUseMap, map.init, ShortUseOnlyMap),
% If there is nothing involving a foreign language in the interface,
% then we do not need either explicit or implicit FIMs for that
% language in the interface.
set.filter(fim_spec_is_for_needed_language(ShortIntImplicitFIMLangs),
IntExplicitFIMSpecs, ShortIntExplicitFIMSpecs),
set.foldl(add_self_fim(ModuleName), ShortIntImplicitFIMLangs,
ShortIntExplicitFIMSpecs, ShortIntFIMSpecs),
% The same is true for the implementation section, with two
% differences. One is that the implementation section may need
% a language that the interface does not, and there is an
% explicit FIM for this language that we did not include
% in the interface, we must include it in the implementation.
% Second, we don't want to include a FIM in *both* the interface
% and the implementation.
set.union(IntExplicitFIMSpecs, ImpExplicitFIMSpecs, ExplicitFIMSpecs),
set.filter(fim_spec_is_for_needed_language(ShortImpImplicitFIMLangs),
ExplicitFIMSpecs, ShortImpExplicitFIMSpecs),
set.foldl(add_self_fim(ModuleName), ShortImpImplicitFIMLangs,
ShortImpExplicitFIMSpecs, ShortImpFIMSpecs0),
set.difference(ShortImpFIMSpecs0, ShortIntFIMSpecs, ShortImpFIMSpecs),
DummyMaybeVersionNumbers = no_version_numbers,
ParseTreeInt2 = parse_tree_int2(ModuleName, ModuleNameContext,
DummyMaybeVersionNumbers, ShortIntInclMap,
ShortUseOnlyMap, ShortIntFIMSpecs, ShortImpFIMSpecs,
ShortTypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
ShortIntTypeClasses, ShortIntInstances, TypeCtorRepnMap).
%---------------------%
:- pred fim_spec_is_for_needed_language(set(foreign_language)::in,
fim_spec::in) is semidet.
fim_spec_is_for_needed_language(NeededLangs, FIMSpec) :-
FIMSpec = fim_spec(Lang, _ModuleName),
set.contains(NeededLangs, Lang).
:- pred make_imports_into_uses_maybe_implicit_int2(
maybe_unqual_symnames::in, set(module_name)::in, set(module_name)::in,
module_name::in, maybe_implicit_import_and_or_use::in,
section_use_map::in, section_use_map::out) is det.
make_imports_into_uses_maybe_implicit_int2(UnqualSymNames,
UsedModuleNames, ImpEqvUsedModuleNames,
ModuleName, ImportUse0, !ShortUseOnlyMap) :-
( if
UnqualSymNames = no_unqual_symnames,
not set.contains(UsedModuleNames, ModuleName),
not set.contains(ImpEqvUsedModuleNames, ModuleName)
then
% If every sym_name in the .int2 file is fully module qualified,
% then we keep use_module declarations only for the modules
% that they name.
% This requires UsedModuleNames to cover even implicitly used
% module names.
true
else
(
ImportUse0 = explicit_avail(Explicit0),
( if
make_imports_into_uses_int2(ImpEqvUsedModuleNames, ModuleName,
Explicit0, Explicit)
then
map.det_insert(ModuleName, Explicit, !ShortUseOnlyMap)
else
true
)
;
ImportUse0 = implicit_avail(_Implicit0, MaybeExplicit0),
( if
MaybeExplicit0 = yes(Explicit0),
make_imports_into_uses_int2(ImpEqvUsedModuleNames, ModuleName,
Explicit0, Explicit)
then
map.det_insert(ModuleName, Explicit, !ShortUseOnlyMap)
else
true
)
)
).
:- pred make_imports_into_uses_int2(set(module_name)::in, module_name::in,
section_import_and_or_use::in, section_use::out) is semidet.
make_imports_into_uses_int2(ImpEqvUsedModuleNames, ModuleName,
Explicit0, Explicit) :-
require_complete_switch [Explicit0]
(
( Explicit0 = int_import(IntContext)
; Explicit0 = int_use(IntContext)
; Explicit0 = int_use_imp_import(IntContext, _ImpContext)
),
Explicit = int_use(IntContext)
;
( Explicit0 = imp_import(ImpContext)
; Explicit0 = imp_use(ImpContext)
),
( if set.contains(ImpEqvUsedModuleNames, ModuleName) then
Explicit = imp_use(ImpContext)
else
fail
)
).
%---------------------%
:- pred restrict_type_ctor_checked_defn_for_int2(type_ctor::in,
type_ctor_checked_defn::in,
type_ctor_checked_map::in, type_ctor_checked_map::out,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out,
set(module_name)::in, set(module_name)::out,
set(foreign_language)::in, set(foreign_language)::out,
set(foreign_language)::in, set(foreign_language)::out) is det.
restrict_type_ctor_checked_defn_for_int2(TypeCtor, TypeCtorCheckedDefn0,
!ShortTypeCtorCheckedMap, !MaybeUnqual,
!ModuleNames, !ImpEqvModuleNames,
!IntImplicitFIMLangs, !ImpImplicitFIMLangs) :-
% For now, we need the implementation sections of .int2 files to contain
% all the information that other modules reading that .int file will need
% to correctly decide the representation of the types exported by this
% module.
%
% The computation we use to decide which types' type_defn items
% need to stay in the implementation section of the .int file,
% and in what form, computes exactly this information. Therefore
% we need only the copy the type_defn items that this previous
% computation has given us.
%
% XXX TYPE_REPN In the future, these type_defn items (which include
% some for types that *shouldn't* be exported from the module)
% should be replaced by type_repn items (for only the types which
% *are* exported from the module).
%
% The implementation section of .int2 files needs no other items,
% and when we switch to using type_repn items to decide type
% representations, the implementation sections of .int2 files
% should be empty (as are the implementation sections of .int3 files).
%
% XXX CLEANUP We update only the source definition half of each checked
% definition, and leave the actual definition part alone. This is
% sufficient for our current needs, because the code that generates
% .int2 files looks only at the source definitions. If we ever gave
% the compiler the ability to both construct a .int2 file, and use it,
% in the same compiler invocation, *without* reading in the .int2 file
% again, we would have to fix that.
(
TypeCtorCheckedDefn0 =
checked_defn_solver(SolverTypeDefn0, SrcDefnsSolver0),
SolverTypeDefn = SolverTypeDefn0,
SrcDefnsSolver0 =
src_defns_solver(MaybeIntTypeDefn0, MaybeImpTypeDefn),
maybe.map_fold3_maybe(restrict_type_ctor_int_defn_for_int2,
MaybeIntTypeDefn0, MaybeIntTypeDefn,
!MaybeUnqual, !ImpEqvModuleNames, !ImpImplicitFIMLangs),
maybe.fold3_maybe(get_int2_modules_langs_from_int1_imp_type,
MaybeImpTypeDefn,
!MaybeUnqual, !ImpEqvModuleNames, !ImpImplicitFIMLangs),
SrcDefnsSolver = src_defns_solver(MaybeIntTypeDefn, MaybeImpTypeDefn),
TypeCtorCheckedDefn =
checked_defn_solver(SolverTypeDefn, SrcDefnsSolver)
;
TypeCtorCheckedDefn0 = checked_defn_std(StdTypeDefn0, SrcDefnsStd0),
StdTypeDefn = StdTypeDefn0,
SrcDefnsStd0 = src_defns_std(IntTypeDefns0, ImpTypeDefns,
_ImpForeignEnums),
list.map_foldl3(restrict_type_ctor_int_defn_for_int2,
IntTypeDefns0, IntTypeDefns,
!MaybeUnqual, !ModuleNames, !IntImplicitFIMLangs),
list.foldl3(get_int2_modules_langs_from_int1_imp_type, ImpTypeDefns,
!MaybeUnqual, !ImpEqvModuleNames, !ImpImplicitFIMLangs),
% Foreign enums are never included in .int2 files.
SrcDefnsStd = src_defns_std(IntTypeDefns, ImpTypeDefns, []),
TypeCtorCheckedDefn = checked_defn_std(StdTypeDefn, SrcDefnsStd)
),
map.det_insert(TypeCtor, TypeCtorCheckedDefn, !ShortTypeCtorCheckedMap).
:- pred restrict_type_ctor_int_defn_for_int2(
item_type_defn_info::in, item_type_defn_info::out,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out,
set(foreign_language)::in, set(foreign_language)::out) is det.
restrict_type_ctor_int_defn_for_int2(TypeDefnInfo0, TypeDefnInfo,
!MaybeUnqual, !ModuleNames, !IntImplicitFIMLangs) :-
% generate_pre_grab_pre_qual_interface_for_int1_int2 had invoked
% delete_uc_preds_make_solver_type_dummy on type_defn items
% in the implementation section of the module. We now do the same job
% on type_defn items in the interface section, but we also make any
% solver types abstract.
TypeDefn0 = TypeDefnInfo0 ^ td_ctor_defn,
(
TypeDefn0 = parse_tree_du_type(DetailsDu0),
delete_uc_preds_from_du_type(DetailsDu0, DetailsDu),
TypeDefn = parse_tree_du_type(DetailsDu),
TypeDefnInfo = TypeDefnInfo0 ^ td_ctor_defn := TypeDefn
% XXX DetailsDu cannot refer to other modules in its MaybeCanon
% field, but it *can* refer to other modules in the argument types
% of its constructors.
% zs: This *should* be ok, in that the code consuming the .int2 file
% should not need to do anything with the types of those arguments,
% but I would like to see a correctness argument for that.
;
TypeDefn0 = parse_tree_sub_type(DetailsSub),
DetailsSub = type_details_sub(SuperType, _Ctors),
accumulate_modules_in_type(SuperType, !MaybeUnqual, !ModuleNames),
% The consideration just above about the types of constructors
% in du types applies also to subtypes.
TypeDefnInfo = TypeDefnInfo0
;
TypeDefn0 = parse_tree_solver_type(_),
% A full (i.e. non-abstract) solver type definition in the interface
% section is an error that should have been caught and reported
% when we constructed the type_ctor_checked_map.
unexpected($pred, "parse_tree_abstract_type")
;
TypeDefn0 = parse_tree_abstract_type(_),
% TypeDefnInfo0 cannot refer to other modules.
TypeDefnInfo = TypeDefnInfo0
;
TypeDefn0 = parse_tree_foreign_type(DetailsForeign0),
delete_uc_preds_from_foreign_type(DetailsForeign0, DetailsForeign),
TypeDefn = parse_tree_foreign_type(DetailsForeign),
TypeDefnInfo = TypeDefnInfo0 ^ td_ctor_defn := TypeDefn,
% Foreign types can never refer to Mercury code in other modules,
% but they can refer to *target language* code in other modules.
DetailsForeign = type_details_foreign(ForeignType, _, _),
Lang = foreign_type_language(ForeignType),
set.insert(Lang, !IntImplicitFIMLangs)
;
TypeDefn0 = parse_tree_eqv_type(DetailsEqv0),
TypeDefnInfo = TypeDefnInfo0,
DetailsEqv0 = type_details_eqv(EqvType0),
accumulate_modules_in_type(EqvType0, !MaybeUnqual, !ModuleNames)
).
:- pred restrict_inst_ctor_checked_defn_for_int2(inst_ctor_checked_defn::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
restrict_inst_ctor_checked_defn_for_int2(InstCtorCheckedDefn,
!MaybeUnqual, !ModuleNames) :-
InstCtorCheckedDefn = checked_defn_inst(StdDefn, _SrcDefns),
StdDefn = std_inst_defn(_Status, InstDefnInfo),
InstDefnInfo = item_inst_defn_info(_SymName, _InstArgVars,
MaybeForTypeCtor, MaybeAbstractInstDefn, _InstVarSet,
_Context, _SeqNum),
(
MaybeForTypeCtor = no
;
MaybeForTypeCtor = yes(TypeCtor),
TypeCtor = type_ctor(TypeCtorSymName, _TypectorArity),
accumulate_module(TypeCtorSymName, !MaybeUnqual, !ModuleNames)
),
(
MaybeAbstractInstDefn = abstract_inst_defn
;
MaybeAbstractInstDefn = nonabstract_inst_defn(InstDefn),
InstDefn = eqv_inst(Inst),
accumulate_modules_in_inst(Inst, !MaybeUnqual, !ModuleNames)
).
:- pred restrict_mode_ctor_checked_defn_for_int2(mode_ctor_checked_defn::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
restrict_mode_ctor_checked_defn_for_int2(ModeCtorCheckedDefn,
!MaybeUnqual, !ModuleNames) :-
ModeCtorCheckedDefn = checked_defn_mode(StdDefn, _SrcDefns),
StdDefn = std_mode_defn(_Status, ModeDefnInfo),
ModeDefnInfo = item_mode_defn_info(_SymName, _InstArgVars,
MaybeAbstractModeDefn, _InstVarSet, _Context, _SeqNum),
(
MaybeAbstractModeDefn = abstract_mode_defn
;
MaybeAbstractModeDefn = nonabstract_mode_defn(ModeDefn),
ModeDefn = eqv_mode(Mode),
accumulate_modules_in_mode(Mode, !MaybeUnqual, !ModuleNames)
).
:- pred get_int2_items_from_int1_int_typeclass(list(item_typeclass_info)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out,
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out) is det.
get_int2_items_from_int1_int_typeclass([],
!MaybeUnqual, !ModuleNames, !IntTypeClassesCord).
get_int2_items_from_int1_int_typeclass([TypeClassInfo | TypeClassInfos],
!MaybeUnqual, !ModuleNames, !IntTypeClassesCord) :-
TypeClassInfo = item_typeclass_info(ClassSymName, TypeParams,
SuperclassConstraints, FunDeps, _Methods0, TVarSet, Context, SeqNum),
accumulate_modules_in_constraints(SuperclassConstraints,
!MaybeUnqual, !ModuleNames),
Methods = class_interface_abstract,
AbstractTypeClassInfo = item_typeclass_info(ClassSymName, TypeParams,
SuperclassConstraints, FunDeps, Methods, TVarSet, Context, SeqNum),
cord.snoc(AbstractTypeClassInfo, !IntTypeClassesCord),
get_int2_items_from_int1_int_typeclass(TypeClassInfos,
!MaybeUnqual, !ModuleNames, !IntTypeClassesCord).
:- pred get_int2_items_from_int1_int_instance(list(item_instance_info)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out,
cord(item_abstract_instance_info)::in,
cord(item_abstract_instance_info)::out) is det.
get_int2_items_from_int1_int_instance([],
!MaybeUnqual, !ModuleNames, !IntInstancesCord).
get_int2_items_from_int1_int_instance([InstanceInfo | InstanceInfos],
!MaybeUnqual, !ModuleNames, !IntInstancesCord) :-
InstanceInfo = item_instance_info(ClassSymName,
ArgTypes, OrigArgTypes, ClassConstraints, InstanceBody0,
TVarSet, ContainingModuleName, Context, SeqNum),
expect(unify(InstanceBody0, instance_body_abstract), $pred,
"instance_body_abstract"),
accumulate_module(ClassSymName, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_types(ArgTypes, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_types(OrigArgTypes, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_constraints(ClassConstraints,
!MaybeUnqual, !ModuleNames),
InstanceBody = instance_body_abstract,
AbstractInstanceInfo = item_instance_info(ClassSymName,
ArgTypes, OrigArgTypes, ClassConstraints, InstanceBody,
TVarSet, ContainingModuleName, Context, SeqNum),
cord.snoc(AbstractInstanceInfo, !IntInstancesCord),
get_int2_items_from_int1_int_instance(InstanceInfos,
!MaybeUnqual, !ModuleNames, !IntInstancesCord).
%---------------------%
:- pred get_int2_modules_langs_from_int1_imp_type(item_type_defn_info::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out,
set(foreign_language)::in, set(foreign_language)::out) is det.
get_int2_modules_langs_from_int1_imp_type(ImpTypeDefn,
!MaybeUnqual, !ImpEqvModuleNames, !ImpImplicitFIMLangs) :-
TypeDefn = ImpTypeDefn ^ td_ctor_defn,
(
TypeDefn = parse_tree_du_type(_DetailsDu)
% XXX DetailsDu cannot refer to other modules in its MaybeCanon
% field, but it *can* refer to other modules in the argument types
% of its constructors.
% zs: This *should* be ok, in that the code consuming the .int2 file
% should not need to do anything with the types of those arguments,
% but I would like to see a correctness argument for that.
;
TypeDefn = parse_tree_sub_type(_)
% The consideration just above about the types of constructors
% in du types applies also to subtypes.
;
TypeDefn = parse_tree_solver_type(_),
% TypeDefn cannot refer to other modules.
unexpected($pred, "parse_tree_abstract_type")
;
TypeDefn = parse_tree_abstract_type(_)
% TypeDefn cannot refer to other modules.
;
TypeDefn = parse_tree_foreign_type(_DetailsForeign),
% Foreign types can never refer to Mercury code in other modules,
% though they can refer to *target language* code in other modules.
TypeDefn = parse_tree_foreign_type(DetailsForeign),
DetailsForeign = type_details_foreign(ForeignType, _, _),
Lang = foreign_type_language(ForeignType),
set.insert(Lang, !ImpImplicitFIMLangs)
;
TypeDefn = parse_tree_eqv_type(DetailsEqv),
DetailsEqv = type_details_eqv(EqvType),
accumulate_modules_in_type(EqvType, !MaybeUnqual, !ImpEqvModuleNames)
).
%---------------------------------------------------------------------------%
:- pred delete_uc_preds_from_du_type_defn(
item_type_defn_info_du::in, item_type_defn_info_du::out) is det.
delete_uc_preds_from_du_type_defn(ItemTypeDefn0, ItemTypeDefn) :-
DetailsDu0 = ItemTypeDefn0 ^ td_ctor_defn,
delete_uc_preds_from_du_type(DetailsDu0, DetailsDu),
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := DetailsDu.
:- pred delete_uc_preds_from_c_j_cs_maybe_defn_or_enum(
c_j_cs_maybe_defn_or_enum::in, c_j_cs_maybe_defn_or_enum::out) is det.
delete_uc_preds_from_c_j_cs_maybe_defn_or_enum(CJCsMaybeDefnOrEnum0,
CJCsMaybeDefnOrEnum) :-
CJCsMaybeDefnOrEnum0 = c_java_csharp(MaybeDefnOrEnumC0, MaybeDefnOrEnumJ0,
MaybeDefnOrEnumCs0),
delete_uc_preds_from_maybe_foreign_type_defn_or_enum(MaybeDefnOrEnumC0,
MaybeDefnOrEnumC),
delete_uc_preds_from_maybe_foreign_type_defn_or_enum(MaybeDefnOrEnumJ0,
MaybeDefnOrEnumJ),
delete_uc_preds_from_maybe_foreign_type_defn_or_enum(MaybeDefnOrEnumCs0,
MaybeDefnOrEnumCs),
CJCsMaybeDefnOrEnum = c_java_csharp(MaybeDefnOrEnumC,
MaybeDefnOrEnumJ, MaybeDefnOrEnumCs).
:- pred delete_uc_preds_from_c_j_cs_maybe_defn(
c_j_cs_maybe_defn::in, c_j_cs_maybe_defn::out) is det.
delete_uc_preds_from_c_j_cs_maybe_defn(CJCsMaybeDefn0, CJCsMaybeDefn) :-
CJCsMaybeDefn0 = c_java_csharp(MaybeDefnC0, MaybeDefnJ0, MaybeDefnCs0),
delete_uc_preds_from_maybe_foreign_type_defn(MaybeDefnC0, MaybeDefnC),
delete_uc_preds_from_maybe_foreign_type_defn(MaybeDefnJ0, MaybeDefnJ),
delete_uc_preds_from_maybe_foreign_type_defn(MaybeDefnCs0, MaybeDefnCs),
CJCsMaybeDefn = c_java_csharp(MaybeDefnC, MaybeDefnJ, MaybeDefnCs).
:- pred delete_uc_preds_from_maybe_foreign_type_defn_or_enum(
maybe(foreign_type_or_enum)::in, maybe(foreign_type_or_enum)::out) is det.
delete_uc_preds_from_maybe_foreign_type_defn_or_enum(MaybeDefnOrEnum0,
MaybeDefnOrEnum) :-
(
MaybeDefnOrEnum0 = no,
MaybeDefnOrEnum = no
;
MaybeDefnOrEnum0 = yes(DefnOrEnum0),
(
DefnOrEnum0 = foreign_type_or_enum_enum(_),
MaybeDefnOrEnum = MaybeDefnOrEnum0
;
DefnOrEnum0 = foreign_type_or_enum_type(ItemTypeDefn0),
DetailsForeign0 = ItemTypeDefn0 ^ td_ctor_defn,
delete_uc_preds_from_foreign_type(DetailsForeign0, DetailsForeign),
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := DetailsForeign,
DefnOrEnum = foreign_type_or_enum_type(ItemTypeDefn),
MaybeDefnOrEnum = yes(DefnOrEnum)
)
).
:- pred delete_uc_preds_from_maybe_foreign_type_defn(
maybe(item_type_defn_info_foreign)::in,
maybe(item_type_defn_info_foreign)::out) is det.
delete_uc_preds_from_maybe_foreign_type_defn(MaybeDefn0, MaybeDefn) :-
(
MaybeDefn0 = no,
MaybeDefn = no
;
MaybeDefn0 = yes(ItemTypeDefn0),
DetailsForeign0 = ItemTypeDefn0 ^ td_ctor_defn,
delete_uc_preds_from_foreign_type(DetailsForeign0, DetailsForeign),
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := DetailsForeign,
MaybeDefn = yes(ItemTypeDefn)
).
% XXX TYPE_REPN Consider the relationship between this predicate and
% make_impl_type_abstract in write_module_interface_files.m. Unlike this
% predicate, that one has access to the definitions of the types
% in this module, so it knows whether e.g. an equivalence type definition
% makes the defined type equivalent to a type that needs special treatment
% by the algorithm that decides data representations.
%
:- pred delete_uc_preds_make_solver_type_dummy(
item_type_defn_info::in, item_type_defn_info::out) is det.
delete_uc_preds_make_solver_type_dummy(ItemTypeDefn0, ItemTypeDefn) :-
TypeDefn0 = ItemTypeDefn0 ^ td_ctor_defn,
(
TypeDefn0 = parse_tree_du_type(DetailsDu0),
delete_uc_preds_from_du_type(DetailsDu0, DetailsDu),
TypeDefn = parse_tree_du_type(DetailsDu),
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := TypeDefn
;
TypeDefn0 = parse_tree_sub_type(_),
ItemTypeDefn = ItemTypeDefn0
;
TypeDefn0 = parse_tree_abstract_type(_),
ItemTypeDefn = ItemTypeDefn0
;
TypeDefn0 = parse_tree_solver_type(_),
% rafe: XXX we need to also export the details of the
% forwarding type for the representation and the forwarding
% pred for initialization.
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn :=
parse_tree_solver_type(dummy_solver_type)
;
TypeDefn0 = parse_tree_eqv_type(_),
% For the `.int2' files, we need the full definitions of
% equivalence types. They are needed to ensure that
% non-abstract equivalence types always get fully expanded
% before code generation, even in modules that only indirectly
% import the definition of the equivalence type.
% XXX TYPE_REPN: *After* we have generated a type_repn item
% including this information, we should be able to make
% MaybeAbstractItemTypeDefn actually abstract.
ItemTypeDefn = ItemTypeDefn0
;
TypeDefn0 = parse_tree_foreign_type(DetailsForeign0),
% We always need the definitions of foreign types
% to handle inter-language interfacing correctly.
% However, we want to abstract away any unify and compare predicates.
delete_uc_preds_from_foreign_type(DetailsForeign0, DetailsForeign),
TypeDefn = parse_tree_foreign_type(DetailsForeign),
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := TypeDefn
).
% Return a dummy solver type definition, one that does not refer
% to any other modules. We use this to replace actual solver type
% definitions that will be made abstract later (so we do not lose
% information we do not intend to lose), but for which we do want
% to remember the fact that they *do* have a definition, to avoid
% generating misleading error messages about missing definitions.
%
:- func dummy_solver_type = type_details_solver.
dummy_solver_type = DetailsSolver :-
RepnType = tuple_type([], kind_star),
GroundInst = not_reached,
AnyInst = not_reached,
MutableItems = [],
SolverDetails = solver_type_details(RepnType, GroundInst, AnyInst,
MutableItems),
MaybeCanon = canon,
DetailsSolver = type_details_solver(SolverDetails, MaybeCanon).
:- pred make_du_type_abstract(type_details_du::in, type_details_abstract::out)
is det.
make_du_type_abstract(DetailsDu, DetailsAbstract) :-
DetailsDu = type_details_du(Ctors, MaybeCanonical, _MaybeDirectArgCtors),
( if non_sub_du_type_is_enum(DetailsDu, NumFunctors) then
num_bits_needed_for_n_dense_values(NumFunctors, NumBits),
DetailsAbstract = abstract_type_fits_in_n_bits(NumBits)
else if non_sub_du_type_is_notag(Ctors, MaybeCanonical) then
DetailsAbstract = abstract_notag_type
else if non_sub_du_type_is_dummy(DetailsDu) then
DetailsAbstract = abstract_dummy_type
else
DetailsAbstract = abstract_type_general
).
:- pred make_sub_type_abstract(type_details_sub::in,
type_details_abstract::out) is det.
make_sub_type_abstract(DetailsSub, DetailsAbstract) :-
DetailsSub = type_details_sub(SuperType, _Ctors),
type_to_ctor_det(SuperType, SuperTypeCtor),
DetailsAbstract = abstract_subtype(SuperTypeCtor).
% For the `.int2' files, we need the full definitions of
% discriminated union types. Even if the functors for a type
% are not used within a module, we may need to know them for
% comparing insts, e.g. for comparing `ground' and `bound(...)'.
% XXX ITEM_LIST: zs: That may be so, but writing out the type
% definition unchanged, without something on it that says
% "use these functors *only* for these purposes",
% is a bug in my opinion.
% XXX ITEM_LIST: And most types do NOT have any insts defined for them.
% We could collect (a) the set of type constructors mentioned
% explicitly in insts as being for that type, and (b) the set of
% function symbol/arity pairs that occur in bound insts, and then
% make the type definition totally abstract unless the type constructor
% either is in set (a) or a member of Ctors is in set (b).
%
:- pred delete_uc_preds_from_du_type(type_details_du::in,
type_details_du::out) is det.
delete_uc_preds_from_du_type(DetailsDu0, DetailsDu) :-
MaybeCanonical = DetailsDu0 ^ du_canonical,
(
MaybeCanonical = canon,
DetailsDu = DetailsDu0
;
MaybeCanonical = noncanon(_NonCanonical),
DetailsDu = DetailsDu0 ^ du_canonical
:= noncanon(noncanon_abstract(non_solver_type))
).
:- pred delete_uc_preds_from_foreign_type(type_details_foreign(T)::in,
type_details_foreign(T)::out) is det.
delete_uc_preds_from_foreign_type(DetailsForeign0, DetailsForeign) :-
MaybeCanonical0 = DetailsForeign0 ^ foreign_canonical,
(
MaybeCanonical0 = canon,
DetailsForeign = DetailsForeign0
;
MaybeCanonical0 = noncanon(_NonCanonical),
DetailsForeign = DetailsForeign0 ^ foreign_canonical
:= noncanon(noncanon_abstract(non_solver_type))
).
%---------------------------------------------------------------------------%
:- func make_inst_defn_abstract(item_inst_defn_info) = item_inst_defn_info.
make_inst_defn_abstract(InstDefn) =
InstDefn ^ id_inst_defn := abstract_inst_defn.
:- func make_mode_defn_abstract(item_mode_defn_info) = item_mode_defn_info.
make_mode_defn_abstract(ModeDefn) =
ModeDefn ^ md_mode_defn := abstract_mode_defn.
:- func make_typeclass_abstract(item_typeclass_info) =
item_abstract_typeclass_info.
make_typeclass_abstract(TypeClassInfo) = AbstractTypeClassInfo :-
% XXX AbstractTypeClassInfo = TypeClassInfo ^ tc_class_methods :=
% class_interface_abstract
% does not work; it gets an error about TypeClassInfo not being
% *already* of type item_abstract_typeclass_info.
TypeClassInfo = item_typeclass_info(ClassName, Params,
Supers, FunDeps, _, TVarSet, Context, SeqNum),
AbstractTypeClassInfo = item_typeclass_info(ClassName, Params,
Supers, FunDeps, class_interface_abstract, TVarSet, Context, SeqNum).
:- func check_typeclass_is_abstract(item_typeclass_info)
= item_abstract_typeclass_info.
check_typeclass_is_abstract(TypeClassInfo) = AbstractTypeClassInfo :-
% XXX AbstractTypeClassInfo = TypeClassInfo ^ tc_class_methods :=
% class_interface_abstract
% does not work; it gets an error about TypeClassInfo not being
% *already* of type item_abstract_typeclass_info.
TypeClassInfo = item_typeclass_info(ClassName, Params,
Supers, FunDeps, Methods, TVarSet, Context, SeqNum),
(
Methods = class_interface_abstract,
AbstractTypeClassInfo = item_typeclass_info(ClassName, Params,
Supers, FunDeps, class_interface_abstract, TVarSet,
Context, SeqNum)
;
Methods = class_interface_concrete(_),
unexpected($pred, "class_interface_concrete")
).
:- func make_instance_abstract(item_instance_info)
= item_abstract_instance_info.
make_instance_abstract(InstanceInfo) = AbstractInstanceInfo :-
% XXX AbstractInstanceInfo = InstanceInfo ^ ci_method_instances :=
% instance_body_abstract
% does not work; it gets an error about InstanceInfo not being
% *already* of type item_abstract_instance_info.
InstanceInfo = item_instance_info(ClassName, Types, OrigTypes,
Constraints, _Methods, TVarSet, Module, Context, SeqNum),
AbstractInstanceInfo = item_instance_info(ClassName, Types, OrigTypes,
Constraints, instance_body_abstract, TVarSet, Module, Context, SeqNum).
:- func check_instance_is_abstract(item_instance_info)
= item_abstract_instance_info.
check_instance_is_abstract(InstanceInfo) = AbstractInstanceInfo :-
% XXX AbstractInstanceInfo = InstanceInfo ^ ci_method_instances :=
% instance_body_abstract
% does not work; it gets an error about InstanceInfo not being
% *already* of type item_abstract_instance_info.
InstanceInfo = item_instance_info(ClassName, Types, OrigTypes,
Constraints, Methods, TVarSet, Module, Context, SeqNum),
(
Methods = instance_body_abstract,
AbstractInstanceInfo = item_instance_info(ClassName, Types, OrigTypes,
Constraints, instance_body_abstract, TVarSet, Module,
Context, SeqNum)
;
Methods = instance_body_concrete(_),
unexpected($pred, "instance_body_concrete")
).
%---------------------------------------------------------------------------%
:- pred wrap_cjcs_foreign_type_no_enums(c_j_cs_maybe_defn::in,
c_j_cs_maybe_defn_or_enum::out) is det.
wrap_cjcs_foreign_type_no_enums(CJCsMaybeDefn, CJCsMaybeDefnOrEnum) :-
CJCsMaybeDefn = c_java_csharp(MaybeDefnC, MaybeDefnJava, MaybeDefnCsharp),
wrap_cjcs_foreign_type_no_enum(MaybeDefnC, MaybeDefnOrEnumC),
wrap_cjcs_foreign_type_no_enum(MaybeDefnJava, MaybeDefnOrEnumJava),
wrap_cjcs_foreign_type_no_enum(MaybeDefnCsharp, MaybeDefnOrEnumCsharp),
CJCsMaybeDefnOrEnum = c_java_csharp(MaybeDefnOrEnumC, MaybeDefnOrEnumJava,
MaybeDefnOrEnumCsharp).
:- pred wrap_cjcs_foreign_type_no_enum(maybe(item_type_defn_info_foreign)::in,
maybe(foreign_type_or_enum)::out) is det.
wrap_cjcs_foreign_type_no_enum(MaybeDefn, MaybeDefnOrEnum) :-
(
MaybeDefn = no,
MaybeDefnOrEnum = no
;
MaybeDefn = yes(Defn),
MaybeDefnOrEnum = yes(foreign_type_or_enum_type(Defn))
).
%---------------------------------------------------------------------------%
:- type non_sub_du_extras
---> extras_enum(string, list(string), c_j_cs_maybe_defn_or_enum)
; extras_non_enum(c_j_cs_maybe_defn).
:- pred delete_any_foreign_type_defn_from_extras(non_sub_du_extras::in,
non_sub_du_extras::out) is det.
delete_any_foreign_type_defn_from_extras(Extras0, Extras) :-
(
Extras0 = extras_enum(HeadCtor, TailCtors, MaybeCJCsDefnOrEnum0),
MaybeCJCsDefnOrEnum0 = c_java_csharp(MaybeDefnOrEnumC0,
MaybeDefnOrEnumJava0, MaybeDefnOrEnumCsharp0),
delete_any_foreign_type_defn(MaybeDefnOrEnumC0,
MaybeDefnOrEnumC),
delete_any_foreign_type_defn(MaybeDefnOrEnumJava0,
MaybeDefnOrEnumJava),
delete_any_foreign_type_defn(MaybeDefnOrEnumCsharp0,
MaybeDefnOrEnumCsharp),
MaybeCJCsDefnOrEnum = c_java_csharp(MaybeDefnOrEnumC,
MaybeDefnOrEnumJava, MaybeDefnOrEnumCsharp),
Extras = extras_enum(HeadCtor, TailCtors, MaybeCJCsDefnOrEnum)
;
Extras0 = extras_non_enum(_MaybeCJCsDefn0),
MaybeCJCsDefn = c_java_csharp(no, no, no),
Extras = extras_non_enum(MaybeCJCsDefn)
).
:- pred delete_any_foreign_type_defn(maybe(foreign_type_or_enum)::in,
maybe(foreign_type_or_enum)::out) is det.
delete_any_foreign_type_defn(MaybeDefnOrEnum0, MaybeDefnOrEnum) :-
(
MaybeDefnOrEnum0 = no,
MaybeDefnOrEnum = no
;
MaybeDefnOrEnum0 = yes(DefnOrEnum0),
(
DefnOrEnum0 = foreign_type_or_enum_type(_),
MaybeDefnOrEnum = no
;
DefnOrEnum0 = foreign_type_or_enum_enum(_),
MaybeDefnOrEnum = MaybeDefnOrEnum0
)
).
:- pred delete_any_foreign_enum_from_extras(non_sub_du_extras::in,
c_j_cs_maybe_defn::out) is det.
delete_any_foreign_enum_from_extras(Extras0, MaybeCJCsDefn) :-
(
Extras0 = extras_enum(_HeadCtor, _TailCtors, MaybeCJCsDefnOrEnum0),
MaybeCJCsDefnOrEnum0 = c_java_csharp(MaybeDefnOrEnumC0,
MaybeDefnOrEnumJava0, MaybeDefnOrEnumCsharp0),
delete_any_foreign_enum(MaybeDefnOrEnumC0, MaybeDefnC),
delete_any_foreign_enum(MaybeDefnOrEnumJava0, MaybeDefnJava),
delete_any_foreign_enum(MaybeDefnOrEnumCsharp0, MaybeDefnCsharp),
MaybeCJCsDefn = c_java_csharp(MaybeDefnC,
MaybeDefnJava, MaybeDefnCsharp)
;
Extras0 = extras_non_enum(MaybeCJCsDefn)
).
:- pred delete_any_foreign_enum(maybe(foreign_type_or_enum)::in,
maybe(item_type_defn_info_foreign)::out) is det.
delete_any_foreign_enum(MaybeDefnOrEnum0, MaybeDefn) :-
(
MaybeDefnOrEnum0 = no,
MaybeDefn = no
;
MaybeDefnOrEnum0 = yes(DefnOrEnum0),
(
DefnOrEnum0 = foreign_type_or_enum_type(Defn),
MaybeDefn = yes(Defn)
;
DefnOrEnum0 = foreign_type_or_enum_enum(_),
MaybeDefn = no
)
).
%---------------------------------------------------------------------------%
:- pred record_foreign_lang_in_type_defn(item_type_defn_info::in,
set(foreign_language)::in, set(foreign_language)::out) is det.
record_foreign_lang_in_type_defn(TypeDefnInfo, !Langs) :-
TypeDefn = TypeDefnInfo ^ td_ctor_defn,
(
( TypeDefn = parse_tree_du_type(_)
; TypeDefn = parse_tree_sub_type(_)
; TypeDefn = parse_tree_abstract_type(_)
; TypeDefn = parse_tree_solver_type(_)
; TypeDefn = parse_tree_eqv_type(_)
)
;
TypeDefn = parse_tree_foreign_type(DetailsForeign),
DetailsForeign = type_details_foreign(LangType, _, _),
( LangType = c(_), Lang = lang_c
; LangType = java(_), Lang = lang_java
; LangType = csharp(_), Lang = lang_csharp
),
set.insert(Lang, !Langs)
).
:- pred record_foreign_lang_in_foreign_enum(item_foreign_enum_info::in,
set(foreign_language)::in, set(foreign_language)::out) is det.
record_foreign_lang_in_foreign_enum(ForeignEnumInfo, !Langs) :-
ForeignEnumInfo = item_foreign_enum_info(Lang, _, _, _, _),
set.insert(Lang, !Langs).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred accumulate_modules_in_constraints(list(prog_constraint)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_constraints([], !MaybeUnqual, !ModuleNames).
accumulate_modules_in_constraints([Constraint | Constraints],
!MaybeUnqual, !ModuleNames) :-
accumulate_modules_in_constraint(Constraint, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_constraints(Constraints, !MaybeUnqual, !ModuleNames).
:- pred accumulate_modules_in_constraint(prog_constraint::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_constraint(Constraint, !MaybeUnqual, !ModuleNames) :-
Constraint = constraint(ClassSymName, ArgTypes),
accumulate_module(ClassSymName, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_types(ArgTypes, !MaybeUnqual, !ModuleNames).
%---------------------%
:- pred accumulate_modules_in_qual_constraint(prog_constraint::in,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_qual_constraint(Constraint, !Modules) :-
Constraint = constraint(ClassSymName, ArgTypes),
(
ClassSymName = qualified(ModuleName, _),
set.insert(ModuleName, !Modules)
;
ClassSymName = unqualified(_),
unexpected($pred, "unknown typeclass in constraint")
),
accumulate_modules_in_qual_types(ArgTypes, !Modules).
%---------------------%
:- pred accumulate_modules_in_types(list(mer_type)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_types([], !MaybeUnqual, !ModuleNames).
accumulate_modules_in_types([Type | Types], !MaybeUnqual, !ModuleNames) :-
accumulate_modules_in_type(Type, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_types(Types, !MaybeUnqual, !ModuleNames).
:- pred accumulate_modules_in_type(mer_type::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_type(Type, !MaybeUnqual, !ModuleNames) :-
(
( Type = type_variable(_, _)
; Type = builtin_type(_)
)
;
Type = defined_type(SymName, ArgTypes, _Kind),
accumulate_module(SymName, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_types(ArgTypes, !MaybeUnqual, !ModuleNames)
;
( Type = tuple_type(ArgTypes, _Kind)
; Type = apply_n_type(_TVar, ArgTypes, _Kind)
; Type = higher_order_type(_PorF, ArgTypes, _HO, _Purity)
),
accumulate_modules_in_types(ArgTypes, !MaybeUnqual, !ModuleNames)
;
Type = kinded_type(KindedType, _Kind),
accumulate_modules_in_type(KindedType, !MaybeUnqual, !ModuleNames)
).
%---------------------%
:- pred accumulate_modules_in_qual_types(list(mer_type)::in,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_qual_types([], !ModuleNames).
accumulate_modules_in_qual_types([Type | Types], !ModuleNames) :-
accumulate_modules_in_qual_type(Type, !ModuleNames),
accumulate_modules_in_qual_types(Types, !ModuleNames).
:- pred accumulate_modules_in_qual_type(mer_type::in,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_qual_type(Type, !ModuleNames) :-
(
% Do nothing for these types - they cannot affect the set of
% implementation imports in an interface file.
( Type = type_variable(_, _)
; Type = builtin_type(_)
)
;
Type = defined_type(SymName, ArgTypes, _Kind),
det_sym_name_get_module_name(SymName, ModuleName),
set.insert(ModuleName, !ModuleNames),
accumulate_modules_in_qual_types(ArgTypes, !ModuleNames)
;
( Type = tuple_type(ArgTypes, _Kind)
; Type = apply_n_type(_TVar, ArgTypes, _Kind)
; Type = higher_order_type(_PorF, ArgTypes, _HO, _Purity)
),
% XXX ITEM_LIST accumulate modules from _HOInstInfo
accumulate_modules_in_qual_types(ArgTypes, !ModuleNames)
;
Type = kinded_type(KindedType, _Kind),
accumulate_modules_in_qual_type(KindedType, !ModuleNames)
).
:- pred accumulate_modules_in_qual_type_ctor(type_ctor::in,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_qual_type_ctor(TypeCtor, !ModuleNames) :-
TypeCtor = type_ctor(SymName, _Arity),
(
SymName = qualified(ModuleName, _),
set.insert(ModuleName, !ModuleNames)
;
SymName = unqualified(_)
% Our ancestor create_parse_trees_int1_int2 should be invoked
% only *after* the module qualification of the augmented compilation
% unit whose contents we are now processing, and the module
% qualification pass would have generated an error message
% for this cannot-be-uniquely-qualified name. However, if the
% user has turned off the halt_at_invalid_interface option,
% which is on by default, then the compiler ignores that error,
% and proceeds to call create_parse_trees_int1_int2 above,
% which calls us indirectly.
).
%---------------------%
:- pred accumulate_modules_in_insts(list(mer_inst)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_insts([], !MaybeUnqual, !ModuleNames).
accumulate_modules_in_insts([Inst | Insts], !MaybeUnqual, !ModuleNames) :-
accumulate_modules_in_inst(Inst, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_insts(Insts, !MaybeUnqual, !ModuleNames).
:- pred accumulate_modules_in_inst(mer_inst::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_inst(Inst, !MaybeUnqual, !ModuleNames) :-
(
( Inst = free
; Inst = not_reached
; Inst = ground(_Uniq, _HOInstInfo)
; Inst = inst_var(_InstVar)
; Inst = any(_Uniq, _HOInstInfo)
)
;
Inst = bound(_Uniq, _InstTestsResults, BoundFunctors),
accumulate_modules_in_bound_functors(BoundFunctors,
!MaybeUnqual, !ModuleNames)
;
Inst = constrained_inst_vars(_InstVars, ArgInst),
accumulate_modules_in_inst(ArgInst, !MaybeUnqual, !ModuleNames)
;
Inst = defined_inst(InstName),
accumulate_modules_in_inst_name(InstName, !MaybeUnqual, !ModuleNames)
).
:- pred accumulate_modules_in_inst_name(inst_name::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_inst_name(InstName, !MaybeUnqual, !ModuleNames) :-
(
InstName = user_inst(SymName, ArgInsts),
accumulate_module(SymName, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_insts(ArgInsts, !MaybeUnqual, !ModuleNames)
;
( InstName = unify_inst(_IsLive, _IsReal, ArgInstA, ArgInstB)
; InstName = merge_inst(ArgInstA, ArgInstB)
),
accumulate_modules_in_insts([ArgInstA, ArgInstB],
!MaybeUnqual, !ModuleNames)
;
( InstName = ground_inst(ArgInstName, _Uniq, _IsLive, _IsReal)
; InstName = any_inst(ArgInstName, _Uniq, _IsLive, _IsReal)
; InstName = shared_inst(ArgInstName)
; InstName = mostly_uniq_inst(ArgInstName)
),
accumulate_modules_in_inst_name(ArgInstName,
!MaybeUnqual, !ModuleNames)
;
InstName = typed_ground(_Uniq, Type),
accumulate_modules_in_type(Type, !MaybeUnqual, !ModuleNames)
;
InstName = typed_inst(Type, ArgInstName),
accumulate_modules_in_type(Type, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_inst_name(ArgInstName,
!MaybeUnqual, !ModuleNames)
).
:- pred accumulate_modules_in_bound_functors(list(bound_functor)::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_bound_functors([], !MaybeUnqual, !ModuleNames).
accumulate_modules_in_bound_functors([BoundFunctor | BoundFunctors],
!MaybeUnqual, !ModuleNames) :-
accumulate_modules_in_bound_functor(BoundFunctor,
!MaybeUnqual, !ModuleNames),
accumulate_modules_in_bound_functors(BoundFunctors,
!MaybeUnqual, !ModuleNames).
:- pred accumulate_modules_in_bound_functor(bound_functor::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_bound_functor(BoundFunctor,
!MaybeUnqual, !ModuleNames) :-
BoundFunctor = bound_functor(ConsId, ArgInsts),
( if ConsId = du_data_ctor(du_ctor(SymName, _ConsArity, TypeCtor)) then
accumulate_module(SymName, !MaybeUnqual, !ModuleNames),
TypeCtor = type_ctor(TypeCtorSymName, _Arity),
accumulate_module(TypeCtorSymName, !MaybeUnqual, !ModuleNames)
else
true
),
accumulate_modules_in_insts(ArgInsts, !MaybeUnqual, !ModuleNames).
%---------------------%
:- pred accumulate_modules_in_mode(mer_mode::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_modules_in_mode(Mode, !MaybeUnqual, !ModuleNames) :-
(
Mode = from_to_mode(InstA, InstB),
accumulate_modules_in_inst(InstA, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_inst(InstB, !MaybeUnqual, !ModuleNames)
;
Mode = user_defined_mode(SymName, ArgInsts),
accumulate_module(SymName, !MaybeUnqual, !ModuleNames),
accumulate_modules_in_insts(ArgInsts, !MaybeUnqual, !ModuleNames)
).
%---------------------%
:- type maybe_unqual_symnames
---> no_unqual_symnames
; some_unqual_symnames.
:- pred accumulate_module(sym_name::in,
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
set(module_name)::in, set(module_name)::out) is det.
accumulate_module(SymName, !MaybeUnqual, !ModuleNames) :-
(
SymName = unqualified(_),
!:MaybeUnqual = some_unqual_symnames
;
SymName = qualified(ModuleName, _),
set.insert(ModuleName, !ModuleNames)
).
%---------------------------------------------------------------------------%
:- pred construct_int_file_name(globals::in,
module_name::in, int_file_kind::in, string::in, file_name::out,
io::di, io::uo) is det.
construct_int_file_name(Globals, ModuleName, IntFileKind, ExtraSuffix,
IntFileName, !IO) :-
int_file_kind_to_extension(IntFileKind, _ExtStr, Ext),
% XXX LEGACY
module_name_to_file_name_create_dirs(Globals, $pred, Ext,
ModuleName, IntFileName0, _IntFileNameProposed0, !IO),
IntFileName = IntFileName0 ++ ExtraSuffix.
%---------------------------------------------------------------------------%
:- pred maybe_add_delayed_messages(aug_make_int_unit::in,
list(error_spec)::in, list(error_spec)::out) is det.
maybe_add_delayed_messages(AugMakeIntUnit, OtherSpecs, Specs) :-
(
OtherSpecs = [],
Specs = []
;
OtherSpecs = [_ | _],
DelayedSpecs = AugMakeIntUnit ^ amiu_delayed_specs,
Specs = DelayedSpecs ++ OtherSpecs
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.comp_unit_interface.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink