mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
3aca14b385
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.
3682 lines
160 KiB
Mathematica
3682 lines
160 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% 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.
|
|
%---------------------------------------------------------------------------%
|