mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 14:57:03 +00:00
ab8c2771f7
compiler/prog_item.m:
Add types for representing .opt and .trans_opt files that specify
exactly what kinds of items may appear in them.
Provide a mechanism for representing just the kinds of pragmas
that we may want to put into .opt files to represent a predicate marker.
To make the above possible, generalize the item_pragma_info type.
Do not store the "maybe attributes" field in all pragmas; store it
in just the one pragma for which it had pragma-specific code (which code
is dubious anyway). Its only use is to suppress error messages about
incorrect pragmas if that pragma was created by the compiler, on the
theory that the user cannot do anything about any such error messages.
However, if such errors are never reported to anyone, then they won't
be fixed. I think it is better to allow such problems to be discovered,
even if they cause a bit of annoyance to the discoverer. The default
content of the field as set by the parser, item_origin_user, can be
misleading anway; it is correct when the pragma is read in from a .m file
or from a .int* file, but it is wrong when read in from a .*opt file,
since the contents of those are decided by the compiler.
Store a varset and tvarset in structure sharing and reuse pragmas,
since without this, one cannot print them out properly.
compiler/intermod.m:
Change the predicates that write out .opt and .trans_opt files
to return as large a fraction of the parse trees of those files
as possible, as a step towards generating those files not directly,
but by building and then writing out those parse trees. For now,
we cannot do this fully for .opt files, because for a few item kinds,
it is far from obvious how to represent as a item what we write out.
Leave the opening and closing of the file streams for writing out
.opt and .trans_opt files to our caller, because for .opt files,
this allows us to avoid having to open the file *twice*.
Put the output of result-of-analysis pragmas into a standard order.
Factor out as common code the process for deciding what should go into
.opt files.
Give a field of the intermod_info structure a more precise name.
compiler/mercury_compile_front_end.m:
Hold the stream of the .opt file open between the two different pieces
of code that write out the two different parts of .opt files.
If --experiment5 is set, write out the parse tree of the .opt file
to the .optx file, to enable comparison with the .opt file.
compiler/mercury_compile_middle_passes.m:
If --experiment5 is set, write out the parse tree of the .trans_opt file
to the .trans_optx file, to enable comparison with the .trans_opt file.
Reset a memo table for structure_{sharing,reuse}.analysis.
compiler/structure_reuse.analysis.m:
compiler/structure_sharing.analysis.m:
Don't take an I/O state pair as arguments, since we needed them *only*
for that reset, and for progress messages.
Give the main predicates more descriptive names.
compiler/trailing_analysis.m:
Give the main predicate a more descriptive names.
compiler/closure_analysis.m:
Don't take an I/O state pair as arguments, since we needed them *only*
for progress messages.
compiler/add_pragma.m:
Don't ignore an error, since one of the other changes in this diff
could have fixed its cause.
compiler/convert_interface.m:
Export utility functions needed by code added by this diff.
ompiler/lp_rational.m:
Tighten the inst of an output argument for use by intermod.m.
Bring programming style up to date.
compiler/parse_pragma.m:
Don't put a maybe attributes field into item_pragma_infos.
Include the varset in structure sharing and reuse pragmas.
Use simplest_spec where possible.
compiler/parse_tree_out.m:
Add predicates for writing out the new parse trees of .opt and
.trans_opt files.
compiler/parse_tree_out_pragma.m:
Add predicates needed by the new code in parse_tree_out.m.
compiler/add_mutable_aux_preds.m:
compiler/canonicalize_interface.m:
compiler/comp_unit_interface.m:
compiler/equiv_type.m:
compiler/get_dependencies.m:
compiler/grab_modules.m:
compiler/item_util.m:
compiler/make_hlds_error.m:
compiler/make_hlds_passes.m:
compiler/make_hlds_separate_items.m:
compiler/module_qual.qualify_items.m:
compiler/prog_item_stats.m:
compiler/recompilation.version.m:
Conform to the changes above.
2857 lines
129 KiB
Mathematica
2857 lines
129 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2015 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.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% 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 generate_short_interface_int3(globals::in, raw_compilation_unit::in,
|
|
parse_tree_int3::out, parse_tree_int::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% Generate the .int2 using the same approach as we use for .int3 files.
|
|
% THIS PREDICATE IS ONLY FOR EXPERIMENTAL PURPOSES.
|
|
%
|
|
:- pred generate_interface_int2_via_int3(globals::in, aug_compilation_unit::in,
|
|
parse_tree_int::out, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% generate_private_interface_int0(AugCompUnit, ParseTreeInt0):
|
|
%
|
|
% 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 generate_private_interface_int0(aug_compilation_unit::in,
|
|
parse_tree_int::out, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% generate_pre_grab_pre_qual_interface_for_int1_int2(RawCompUnit,
|
|
% InterfaceRawCompUnit):
|
|
%
|
|
% Prepare for the generation of .int and .int2 files by generating
|
|
% the part of the raw compilation unit that needs to be module qualified
|
|
% before the invocation of generate_interfaces_int1_int2.
|
|
%
|
|
% 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.
|
|
%
|
|
% XXX ITEM_LIST Document why we do all this *before* module qualification.
|
|
%
|
|
% XXX ITEM_LIST The original comment on this predicate,
|
|
% when it was conjoined with the code of get_interface above, was:
|
|
% "Given the raw compilation unit of a module, extract and return
|
|
% the part of that module that will go into the .int file of the module.
|
|
% This will typically mostly be the interface section of the module,
|
|
% but it may also contain parts of the implementation section as well.
|
|
% Both parts may be somewhat modified; for example, we may remove
|
|
% the bodies of instance definitions in an interface section,
|
|
% but put the original, non-abstract instance definition in the
|
|
% implementation section."
|
|
%
|
|
:- pred generate_pre_grab_pre_qual_interface_for_int1_int2(
|
|
raw_compilation_unit::in, raw_compilation_unit::out) is det.
|
|
|
|
% Generate the contents for the .int and .int2 files.
|
|
%
|
|
:- pred generate_interfaces_int1_int2(globals::in, aug_compilation_unit::in,
|
|
parse_tree_int::out, parse_tree_int::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% XXX ITEM_LIST
|
|
% The predicates in rest of the interface should not be needed at all.
|
|
%
|
|
|
|
% This predicate is exported for use by modules.m.
|
|
%
|
|
% XXX ITEM_LIST When the predicate above is deleted, this function
|
|
% should not be needed in this module anymore either, and so it should be
|
|
% moved elsewhere.
|
|
%
|
|
:- func make_foreign_import(module_name, foreign_language) = item_fim.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.check_parse_tree_type_defns.
|
|
:- import_module parse_tree.convert_interface.
|
|
:- import_module parse_tree.decide_type_repn.
|
|
:- import_module parse_tree.file_kind.
|
|
:- import_module parse_tree.item_util.
|
|
:- import_module parse_tree.module_qual.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_foreign.
|
|
:- import_module parse_tree.prog_mutable.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module multi_map.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_short_interface_int3(Globals, RawCompUnit,
|
|
ParseTreeInt3, ParseTreeInt, !Specs) :-
|
|
RawCompUnit =
|
|
raw_compilation_unit(ModuleName, ModuleNameContext, RawItemBlocks),
|
|
get_short_interface_int3_from_item_blocks(RawItemBlocks,
|
|
set.init, IntInclModuleNames, set.init, IntImportModuleNames0,
|
|
cord.init, OrigIntTypeDefnsCord, cord.init, IntTypeDefnsCord,
|
|
cord.init, IntInstDefnsCord, cord.init, IntModeDefnsCord,
|
|
cord.init, IntTypeClassesCord, cord.init, IntInstancesCord,
|
|
cord.init, OrigIntForeignEnumsCord,
|
|
cord.init, OrigImpTypeDefnsCord, cord.init, OrigImpForeignEnumsCord,
|
|
do_not_need_imports, NeedImports),
|
|
(
|
|
NeedImports = do_not_need_imports,
|
|
IntImportModuleNames = set.init
|
|
;
|
|
NeedImports = do_need_imports,
|
|
IntImportModuleNames = IntImportModuleNames0
|
|
),
|
|
OrigIntTypeDefns = cord.list(OrigIntTypeDefnsCord),
|
|
IntTypeDefns = cord.list(IntTypeDefnsCord),
|
|
IntInstDefns = cord.list(IntInstDefnsCord),
|
|
IntModeDefns = cord.list(IntModeDefnsCord),
|
|
IntTypeClasses = cord.list(IntTypeClassesCord),
|
|
IntInstances = cord.list(IntInstancesCord),
|
|
OrigIntForeignEnums = cord.list(OrigIntForeignEnumsCord),
|
|
OrigImpTypeDefns = cord.list(OrigImpTypeDefnsCord),
|
|
OrigImpForeignEnums = cord.list(OrigImpForeignEnumsCord),
|
|
|
|
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
|
|
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
|
|
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
|
|
|
|
OrigIntTypeDefnMap = type_ctor_defn_items_to_map(OrigIntTypeDefns),
|
|
OrigIntForeignEnumMap =
|
|
type_ctor_foreign_enum_items_to_map(OrigIntForeignEnums),
|
|
OrigImpTypeDefnMap = type_ctor_defn_items_to_map(OrigImpTypeDefns),
|
|
OrigImpForeignEnumMap =
|
|
type_ctor_foreign_enum_items_to_map(OrigImpForeignEnums),
|
|
% For now, we want only the error messages.
|
|
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
|
|
OrigIntTypeDefnMap, OrigImpTypeDefnMap,
|
|
OrigIntForeignEnumMap, OrigImpForeignEnumMap,
|
|
TypeCtorCheckedMap, !Specs),
|
|
globals.lookup_bool_option(Globals, experiment1, Experiment1),
|
|
(
|
|
Experiment1 = no,
|
|
map.init(IntTypeRepnMap)
|
|
;
|
|
Experiment1 = yes,
|
|
decide_repns_for_simple_types_for_int3(ModuleName, TypeCtorCheckedMap,
|
|
IntTypeRepnInfos),
|
|
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepnInfos)
|
|
),
|
|
ParseTreeInt3 = parse_tree_int3(ModuleName, ModuleNameContext,
|
|
IntInclModuleNames, IntImportModuleNames,
|
|
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
|
|
IntTypeClasses, IntInstances, IntTypeRepnMap),
|
|
ParseTreeInt0 = convert_parse_tree_int3_to_parse_tree_int(ParseTreeInt3),
|
|
% Any Specs this can generate would be better reported when the module
|
|
% is being compiled to target language code.
|
|
module_qualify_parse_tree_int3(Globals, ParseTreeInt0, ParseTreeInt,
|
|
[], _Specs).
|
|
|
|
:- type need_imports
|
|
---> do_not_need_imports
|
|
; do_need_imports.
|
|
|
|
:- pred get_short_interface_int3_from_item_blocks(list(raw_item_block)::in,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
need_imports::in, need_imports::out) is det.
|
|
|
|
get_short_interface_int3_from_item_blocks([],
|
|
!IntIncls, !IntImports,
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums,
|
|
!OrigImpTypeDefns, !OrigImpForeignEnums, !NeedImports).
|
|
get_short_interface_int3_from_item_blocks([RawItemBlock | RawItemBlocks],
|
|
!IntIncls, !IntImports,
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums,
|
|
!OrigImpTypeDefns, !OrigImpForeignEnums, !NeedImports) :-
|
|
RawItemBlock = item_block(_, Section, Incls, Avails, _FIMs, Items),
|
|
(
|
|
Section = ms_interface,
|
|
list.foldl(add_included_module_name, Incls, !IntIncls),
|
|
list.filter_map(avail_is_import, Avails, Imports),
|
|
ImportModuleNames = list.map(get_import_module_name, Imports),
|
|
set.insert_list(ImportModuleNames, !IntImports),
|
|
get_short_interface_int3_from_items_int(Items,
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums, !NeedImports)
|
|
;
|
|
Section = ms_implementation,
|
|
get_short_interface_int3_from_items_imp(Items,
|
|
!OrigImpTypeDefns, !OrigImpForeignEnums)
|
|
),
|
|
get_short_interface_int3_from_item_blocks(RawItemBlocks,
|
|
!IntIncls, !IntImports,
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums,
|
|
!OrigImpTypeDefns, !OrigImpForeignEnums, !NeedImports).
|
|
|
|
:- pred get_short_interface_int3_from_items_int(list(item)::in,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
need_imports::in, need_imports::out) is det.
|
|
|
|
get_short_interface_int3_from_items_int([],
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums, !NeedImports).
|
|
get_short_interface_int3_from_items_int([Item | Items],
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums, !NeedImports) :-
|
|
(
|
|
Item = item_type_defn(ItemTypeDefnInfo),
|
|
cord.snoc(ItemTypeDefnInfo, !OrigIntTypeDefns),
|
|
% XXX TYPE_REPN do this in decide_type_repn.m?
|
|
make_type_defn_abstract_type_for_int3(ItemTypeDefnInfo,
|
|
AbstractOrForeignItemTypeDefnInfo),
|
|
cord.snoc(AbstractOrForeignItemTypeDefnInfo, !IntTypeDefns)
|
|
;
|
|
Item = item_inst_defn(ItemInstInfo),
|
|
AbstractItemInstInfo =
|
|
ItemInstInfo ^ id_inst_defn := abstract_inst_defn,
|
|
cord.snoc(AbstractItemInstInfo, !IntInstDefns)
|
|
;
|
|
Item = item_mode_defn(ItemModeInfo),
|
|
AbstractItemModeInfo =
|
|
ItemModeInfo ^ md_mode_defn := abstract_mode_defn,
|
|
cord.snoc(AbstractItemModeInfo, !IntModeDefns)
|
|
;
|
|
Item = item_typeclass(ItemTypeClassInfo),
|
|
ItemTypeClassInfo = item_typeclass_info(ClassName, ParamsTVars,
|
|
_Constraints, _FunDeps, _Methods, TVarSet, Context, SeqNum),
|
|
AbstractItemTypeClassInfo = item_typeclass_info(ClassName, ParamsTVars,
|
|
[], [], class_interface_abstract, TVarSet, Context, SeqNum),
|
|
cord.snoc(AbstractItemTypeClassInfo, !IntTypeClasses)
|
|
;
|
|
Item = item_instance(ItemInstanceInfo),
|
|
AbstractItemInstanceInfo = ItemInstanceInfo ^ ci_method_instances
|
|
:= instance_body_abstract,
|
|
cord.snoc(AbstractItemInstanceInfo, !IntInstances),
|
|
% We may need the imported modules to module qualify the names
|
|
% of the type constructors in the instance's member types.
|
|
!:NeedImports = do_need_imports
|
|
;
|
|
Item = item_foreign_enum(ItemForeignEnumInfo),
|
|
cord.snoc(ItemForeignEnumInfo, !OrigIntForeignEnums)
|
|
;
|
|
( Item = item_clause(_)
|
|
; Item = item_mutable(_)
|
|
; Item = item_pred_decl(_)
|
|
; Item = item_mode_decl(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_pragma(_)
|
|
; Item = item_promise(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
; Item = item_type_repn(_)
|
|
)
|
|
),
|
|
get_short_interface_int3_from_items_int(Items,
|
|
!OrigIntTypeDefns, !IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !OrigIntForeignEnums, !NeedImports).
|
|
|
|
:- pred make_type_defn_abstract_type_for_int3(item_type_defn_info::in,
|
|
item_type_defn_info::out) is det.
|
|
|
|
make_type_defn_abstract_type_for_int3(ItemTypeDefn0, ItemTypeDefn) :-
|
|
TypeDefn0 = ItemTypeDefn0 ^ td_ctor_defn,
|
|
(
|
|
TypeDefn0 = parse_tree_du_type(DetailsDu),
|
|
make_du_type_abstract(DetailsDu, DetailsAbstract),
|
|
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn
|
|
:= parse_tree_abstract_type(DetailsAbstract)
|
|
;
|
|
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.
|
|
DetailsAbstract = abstract_solver_type,
|
|
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn
|
|
:= parse_tree_abstract_type(DetailsAbstract)
|
|
;
|
|
TypeDefn0 = parse_tree_eqv_type(_),
|
|
% 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,
|
|
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn
|
|
:= parse_tree_abstract_type(DetailsAbstract)
|
|
;
|
|
TypeDefn0 = parse_tree_foreign_type(DetailsForeign0),
|
|
% We always need the definitions of foreign types
|
|
% to handle inter-language interfacing correctly.
|
|
% XXX Even in .int3 files?
|
|
% 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
|
|
).
|
|
|
|
:- pred get_short_interface_int3_from_items_imp(list(item)::in,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out)
|
|
is det.
|
|
|
|
get_short_interface_int3_from_items_imp([],
|
|
!ImpTypeDefns, !ImpForeignEnums).
|
|
get_short_interface_int3_from_items_imp([Item | Items],
|
|
!ImpTypeDefns, !ImpForeignEnums) :-
|
|
(
|
|
Item = item_type_defn(ItemTypeDefnInfo),
|
|
cord.snoc(ItemTypeDefnInfo, !ImpTypeDefns)
|
|
;
|
|
Item = item_foreign_enum(ItemForeignEnumInfo),
|
|
cord.snoc(ItemForeignEnumInfo, !ImpForeignEnums)
|
|
;
|
|
( Item = item_typeclass(_)
|
|
; Item = item_instance(_)
|
|
; Item = item_inst_defn(_)
|
|
; Item = item_mode_defn(_)
|
|
; Item = item_clause(_)
|
|
; Item = item_mutable(_)
|
|
; Item = item_pred_decl(_)
|
|
; Item = item_mode_decl(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_pragma(_)
|
|
; Item = item_promise(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
; Item = item_type_repn(_)
|
|
)
|
|
),
|
|
get_short_interface_int3_from_items_imp(Items,
|
|
!ImpTypeDefns, !ImpForeignEnums).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_interface_int2_via_int3(Globals, AugCompUnit, ParseTreeInt23,
|
|
!Specs) :-
|
|
AugCompUnit = aug_compilation_unit(ModuleName, ModuleNameContext,
|
|
_ModuleVersionNumbers, SrcItemBlocks,
|
|
_DirectIntItemBlocks, _IndirectIntItemBlocks,
|
|
_OptItemBlocks, _IntForOptItemBlocks),
|
|
list.map(src_to_raw_item_block, SrcItemBlocks, RawItemBlocks),
|
|
get_short_interface_int3_from_item_blocks(RawItemBlocks,
|
|
set.init, IntInclModuleNames, set.init, IntImportModuleNames0,
|
|
cord.init, OrigIntTypeDefnsCord, cord.init, IntTypeDefnsCord,
|
|
cord.init, IntInstDefnsCord, cord.init, IntModeDefnsCord,
|
|
cord.init, IntTypeClassesCord, cord.init, IntInstancesCord,
|
|
cord.init, OrigIntForeignEnumsCord,
|
|
cord.init, OrigImpTypeDefnsCord, cord.init, OrigImpForeignEnumsCord,
|
|
do_not_need_imports, NeedImports),
|
|
(
|
|
NeedImports = do_not_need_imports,
|
|
IntImportModuleNames = set.init
|
|
;
|
|
NeedImports = do_need_imports,
|
|
IntImportModuleNames = IntImportModuleNames0
|
|
),
|
|
OrigIntTypeDefns = cord.list(OrigIntTypeDefnsCord),
|
|
IntTypeDefns = cord.list(IntTypeDefnsCord),
|
|
IntInstDefns = cord.list(IntInstDefnsCord),
|
|
IntModeDefns = cord.list(IntModeDefnsCord),
|
|
IntTypeClasses = cord.list(IntTypeClassesCord),
|
|
IntInstances = cord.list(IntInstancesCord),
|
|
OrigIntForeignEnums = cord.list(OrigIntForeignEnumsCord),
|
|
OrigImpTypeDefns = cord.list(OrigImpTypeDefnsCord),
|
|
OrigImpForeignEnums = cord.list(OrigImpForeignEnumsCord),
|
|
|
|
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
|
|
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
|
|
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
|
|
|
|
OrigIntTypeDefnMap = type_ctor_defn_items_to_map(OrigIntTypeDefns),
|
|
OrigIntForeignEnumMap =
|
|
type_ctor_foreign_enum_items_to_map(OrigIntForeignEnums),
|
|
OrigImpTypeDefnMap = type_ctor_defn_items_to_map(OrigImpTypeDefns),
|
|
OrigImpForeignEnumMap =
|
|
type_ctor_foreign_enum_items_to_map(OrigImpForeignEnums),
|
|
% For now, we want only the error messages.
|
|
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
|
|
OrigIntTypeDefnMap, OrigImpTypeDefnMap,
|
|
OrigIntForeignEnumMap, OrigImpForeignEnumMap,
|
|
TypeCtorCheckedMap, !Specs),
|
|
globals.lookup_bool_option(Globals, experiment1, Experiment1),
|
|
(
|
|
Experiment1 = no,
|
|
map.init(IntTypeRepnMap)
|
|
;
|
|
Experiment1 = yes,
|
|
decide_repns_for_simple_types_for_int3(ModuleName, TypeCtorCheckedMap,
|
|
IntTypeRepnInfos),
|
|
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepnInfos)
|
|
),
|
|
ParseTreeInt3 = parse_tree_int3(ModuleName, ModuleNameContext,
|
|
IntInclModuleNames, IntImportModuleNames,
|
|
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
|
|
IntTypeClasses, IntInstances, IntTypeRepnMap),
|
|
ParseTreeInt23Prime =
|
|
convert_parse_tree_int3_to_parse_tree_int(ParseTreeInt3),
|
|
ParseTreeInt23 = ParseTreeInt23Prime ^ pti_int_file_kind := ifk_int2.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_private_interface_int0(AugCompUnit, ParseTreeInt0, !Specs) :-
|
|
AugCompUnit = aug_compilation_unit(ModuleName,
|
|
ModuleNameContext, ModuleVersionNumbers, SrcItemBlocks,
|
|
_DirectIntItemBlocks, _IndirectIntItemBlocks,
|
|
_OptItemBlocks, _IntForOptItemBlocks),
|
|
set.init(IntIncls0),
|
|
set.init(ImpIncls0),
|
|
set.init(IntImports0),
|
|
set.init(IntUses0),
|
|
set.init(ImpImports0),
|
|
set.init(ImpUses0),
|
|
set.init(IntFIMSpecs0),
|
|
set.init(ImpFIMSpecs0),
|
|
get_private_interface_int0_from_item_blocks(ModuleName, SrcItemBlocks,
|
|
IntIncls0, IntIncls, ImpIncls0, ImpIncls,
|
|
IntImports0, IntImports, IntUses0, IntUses1,
|
|
ImpImports0, ImpImports1, ImpUses0, ImpUses1,
|
|
IntFIMSpecs0, IntFIMSpecs, ImpFIMSpecs0, ImpFIMSpecs,
|
|
cord.init, IntTypeDefnsCord, cord.init, ImpTypeDefnsCord,
|
|
cord.init, IntInstDefnsCord, cord.init, ImpInstDefnsCord,
|
|
cord.init, IntModeDefnsCord, cord.init, ImpModeDefnsCord,
|
|
cord.init, IntTypeClassesCord, cord.init, ImpTypeClassesCord,
|
|
cord.init, IntInstancesCord, cord.init, ImpInstancesCord,
|
|
cord.init, IntPredDeclsCord, cord.init, ImpPredDeclsCord,
|
|
cord.init, IntModeDeclsCord, cord.init, ImpModeDeclsCord,
|
|
cord.init, IntForeignEnumsCord, cord.init, ImpForeignEnumsCord,
|
|
cord.init, IntPragmasCord, cord.init, ImpPragmasCord,
|
|
cord.init, IntPromisesCord, cord.init, ImpPromisesCord),
|
|
( if map.search(ModuleVersionNumbers, ModuleName, VersionNumbers) then
|
|
MaybeVersionNumbers = version_numbers(VersionNumbers)
|
|
else
|
|
MaybeVersionNumbers = no_version_numbers
|
|
),
|
|
set.difference(IntUses1, IntImports, IntUses),
|
|
set.union(IntImports, IntUses, IntImportsUses),
|
|
set.difference(ImpImports1, IntImportsUses, ImpImports),
|
|
set.difference(ImpUses1, IntImportsUses, ImpUses2),
|
|
set.difference(ImpUses2, ImpImports, ImpUses),
|
|
IntTypeDefns = cord.list(IntTypeDefnsCord),
|
|
ImpTypeDefns = cord.list(ImpTypeDefnsCord),
|
|
IntInstDefns = cord.list(IntInstDefnsCord),
|
|
ImpInstDefns = cord.list(ImpInstDefnsCord),
|
|
IntModeDefns = cord.list(IntModeDefnsCord),
|
|
ImpModeDefns = cord.list(ImpModeDefnsCord),
|
|
IntTypeClasses = cord.list(IntTypeClassesCord),
|
|
ImpTypeClasses = cord.list(ImpTypeClassesCord),
|
|
IntInstances = cord.list(IntInstancesCord),
|
|
ImpInstances = cord.list(ImpInstancesCord),
|
|
IntPredDecls = cord.list(IntPredDeclsCord),
|
|
ImpPredDecls = cord.list(ImpPredDeclsCord),
|
|
IntModeDecls = cord.list(IntModeDeclsCord),
|
|
ImpModeDecls = cord.list(ImpModeDeclsCord),
|
|
IntForeignEnums = cord.list(IntForeignEnumsCord),
|
|
ImpForeignEnums = cord.list(ImpForeignEnumsCord),
|
|
IntPragmas = cord.list(IntPragmasCord),
|
|
ImpPragmas = cord.list(ImpPragmasCord),
|
|
IntPromises = cord.list(IntPromisesCord),
|
|
ImpPromises = cord.list(ImpPromisesCord),
|
|
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
|
|
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
|
|
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
|
|
ImpTypeDefnMap = type_ctor_defn_items_to_map(ImpTypeDefns),
|
|
ImpInstDefnMap = inst_ctor_defn_items_to_map(ImpInstDefns),
|
|
ImpModeDefnMap = mode_ctor_defn_items_to_map(ImpModeDefns),
|
|
IntForeignEnumMap = type_ctor_foreign_enum_items_to_map(IntForeignEnums),
|
|
ImpForeignEnumMap = type_ctor_foreign_enum_items_to_map(ImpForeignEnums),
|
|
% For now, we want only the error messages.
|
|
create_type_ctor_checked_map(do_insist_on_defn, ModuleName,
|
|
IntTypeDefnMap, ImpTypeDefnMap, IntForeignEnumMap, ImpForeignEnumMap,
|
|
_TypeCtorCheckedMap, !Specs),
|
|
ParseTreeInt0Prime = parse_tree_int0(ModuleName, ModuleNameContext,
|
|
MaybeVersionNumbers, IntIncls, ImpIncls,
|
|
IntImports, IntUses, ImpImports, ImpUses, IntFIMSpecs, ImpFIMSpecs,
|
|
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
|
|
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
|
|
IntForeignEnumMap, IntPragmas, IntPromises,
|
|
ImpTypeDefnMap, ImpInstDefnMap, ImpModeDefnMap,
|
|
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
|
|
ImpForeignEnumMap, ImpPragmas, ImpPromises),
|
|
ParseTreeInt0 =
|
|
convert_parse_tree_int0_to_parse_tree_int(ParseTreeInt0Prime).
|
|
|
|
% get_private_interface_int0_from_item_blocks processes each item
|
|
% in the item blocks of a module, as part of the process of creating
|
|
% .int0 files.
|
|
%
|
|
% The `.int0' file contains items which are available to any module in the
|
|
% interface section, and items which are only available to submodules in
|
|
% the implementation section. The term "private interface" is ambiguous:
|
|
% sometimes it refers to the `.int0' file which, as just explained,
|
|
% contains the public interface as well. The term "private interface
|
|
% proper" may be used to refer to the information in the implementation
|
|
% section of the `.int0' file.
|
|
%
|
|
% (Historically, the `.int0' file did not distinguish between the public
|
|
% and private interfaces.)
|
|
%
|
|
% This predicate has several jobs.
|
|
%
|
|
% - It removes items that do not belong in the private interface,
|
|
% in either sense. This includes clauses, pragmas that function as
|
|
% clauses, and initialise and finalise declarations, since effectively
|
|
% they also represent code.
|
|
%
|
|
% - It expands any mutable declarations into the pred and mode declarations
|
|
% for their access predicates, since only these components of a
|
|
% mutable declaration should be written to a private interface file.
|
|
%
|
|
% - It makes any instance declarations abstract.
|
|
%
|
|
% - It separates the includes, avails and items into those that appear
|
|
% in the interface section and in the implementation section
|
|
% respectively. (There is an exception to this, marked with
|
|
% an XXX below).
|
|
%
|
|
:- pred get_private_interface_int0_from_item_blocks(module_name::in,
|
|
list(src_item_block)::in,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(fim_spec)::in, set(fim_spec)::out,
|
|
set(fim_spec)::in, set(fim_spec)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_pred_decl_info)::in, cord(item_pred_decl_info)::out,
|
|
cord(item_pred_decl_info)::in, cord(item_pred_decl_info)::out,
|
|
cord(item_mode_decl_info)::in, cord(item_mode_decl_info)::out,
|
|
cord(item_mode_decl_info)::in, cord(item_mode_decl_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_pragma_info)::in, cord(item_pragma_info)::out,
|
|
cord(item_pragma_info)::in, cord(item_pragma_info)::out,
|
|
cord(item_promise_info)::in, cord(item_promise_info)::out,
|
|
cord(item_promise_info)::in, cord(item_promise_info)::out) is det.
|
|
|
|
get_private_interface_int0_from_item_blocks(_ModuleName, [],
|
|
!IntIncls, !ImpIncls, !IntImports, !IntUses, !ImpImports, !ImpUses,
|
|
!IntFIMSpecs, !ImpFIMSpecs, !IntTypeDefns, !ImpTypeDefns,
|
|
!IntInstDefns, !ImpInstDefns, !IntModeDefns, !ImpModeDefns,
|
|
!IntTypeClasses, !ImpTypeClasses, !IntInstances,!ImpInstances,
|
|
!IntPredDecls, !ImpPredDecls, !IntModeDecls, !ImpModeDecls,
|
|
!IntForeignEnums, !ImpForeignEnums, !IntPragmas, !ImpPragmas,
|
|
!IntPromises, !ImpPromises).
|
|
get_private_interface_int0_from_item_blocks(ModuleName,
|
|
[ItemBlock | ItemBlocks],
|
|
!IntIncls, !ImpIncls, !IntImports, !IntUses, !ImpImports, !ImpUses,
|
|
!IntFIMSpecs, !ImpFIMSpecs, !IntTypeDefns, !ImpTypeDefns,
|
|
!IntInstDefns, !ImpInstDefns, !IntModeDefns, !ImpModeDefns,
|
|
!IntTypeClasses, !ImpTypeClasses, !IntInstances,!ImpInstances,
|
|
!IntPredDecls, !ImpPredDecls, !IntModeDecls, !ImpModeDecls,
|
|
!IntForeignEnums, !ImpForeignEnums, !IntPragmas, !ImpPragmas,
|
|
!IntPromises, !ImpPromises) :-
|
|
ItemBlock = item_block(_, SrcSection, Incls, Avails, FIMs, Items),
|
|
(
|
|
SrcSection = sms_interface,
|
|
list.foldl(add_included_module_name, Incls, !IntIncls),
|
|
avail_imports_uses(Avails, Imports, Uses),
|
|
set.insert_list(list.map(get_import_module_name, Imports),
|
|
!IntImports),
|
|
set.insert_list(list.map(get_use_module_name, Uses),
|
|
!IntUses),
|
|
list.foldl(add_fim_to_specs, FIMs, !IntFIMSpecs),
|
|
get_private_interface_int0_from_items(ModuleName, Items,
|
|
!IntTypeDefns, !IntInstDefns, !IntModeDefns,
|
|
!IntTypeClasses, !IntInstances, !IntPredDecls, !IntModeDecls,
|
|
!IntForeignEnums, !IntPragmas, !IntPromises)
|
|
;
|
|
( SrcSection = sms_implementation
|
|
; SrcSection = sms_impl_but_exported_to_submodules
|
|
),
|
|
% XXX ITEM_LIST Our parent calls grab_unqual_imported_modules,
|
|
% which has traditionally NOT changed sms_implementation
|
|
% to sms_impl_but_exported_to_submodules even in the presence
|
|
% of submodules, but future factorizations of common code
|
|
% may change that.
|
|
list.foldl(add_included_module_name, Incls, !ImpIncls),
|
|
avail_imports_uses(Avails, Imports, Uses),
|
|
set.insert_list(list.map(get_import_module_name, Imports),
|
|
!ImpImports),
|
|
set.insert_list(list.map(get_use_module_name, Uses),
|
|
!ImpUses),
|
|
list.foldl(add_fim_to_specs, FIMs, !ImpFIMSpecs),
|
|
get_private_interface_int0_from_items(ModuleName, Items,
|
|
!ImpTypeDefns, !ImpInstDefns, !ImpModeDefns,
|
|
!ImpTypeClasses, !ImpInstances, !ImpPredDecls, !ImpModeDecls,
|
|
!ImpForeignEnums, !ImpPragmas, !ImpPromises)
|
|
),
|
|
get_private_interface_int0_from_item_blocks(ModuleName, ItemBlocks,
|
|
!IntIncls, !ImpIncls, !IntImports, !IntUses, !ImpImports, !ImpUses,
|
|
!IntFIMSpecs, !ImpFIMSpecs, !IntTypeDefns, !ImpTypeDefns,
|
|
!IntInstDefns, !ImpInstDefns, !IntModeDefns, !ImpModeDefns,
|
|
!IntTypeClasses, !ImpTypeClasses, !IntInstances,!ImpInstances,
|
|
!IntPredDecls, !ImpPredDecls, !IntModeDecls, !ImpModeDecls,
|
|
!IntForeignEnums, !ImpForeignEnums, !IntPragmas, !ImpPragmas,
|
|
!IntPromises, !ImpPromises).
|
|
|
|
:- pred get_private_interface_int0_from_items(module_name::in, list(item)::in,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_pred_decl_info)::in, cord(item_pred_decl_info)::out,
|
|
cord(item_mode_decl_info)::in, cord(item_mode_decl_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_pragma_info)::in, cord(item_pragma_info)::out,
|
|
cord(item_promise_info)::in, cord(item_promise_info)::out) is det.
|
|
|
|
get_private_interface_int0_from_items(_ModuleName, [],
|
|
!TypeDefns, !InstDefns, !ModeDefns, !TypeClasses, !Instances,
|
|
!PredDecls, !ModeDecls, !ForeignEnums, !Pragmas, !Promises).
|
|
get_private_interface_int0_from_items(ModuleName, [Item | Items],
|
|
!TypeDefns, !InstDefns, !ModeDefns, !TypeClasses, !Instances,
|
|
!PredDecls, !ModeDecls, !ForeignEnums, !Pragmas, !Promises) :-
|
|
% XXX ITEM_LIST The action here for types, insts, modes, pred decls,
|
|
% mode decls, typeclasses and promises follows what this predicate
|
|
% used to do before the item list change.
|
|
(
|
|
Item = item_type_defn(TypeDefn),
|
|
cord.snoc(TypeDefn, !TypeDefns)
|
|
;
|
|
Item = item_inst_defn(InstDefn),
|
|
cord.snoc(InstDefn, !InstDefns)
|
|
;
|
|
Item = item_mode_defn(ModeDefn),
|
|
cord.snoc(ModeDefn, !ModeDefns)
|
|
;
|
|
Item = item_pred_decl(PredDecl),
|
|
cord.snoc(PredDecl, !PredDecls)
|
|
;
|
|
Item = item_mode_decl(ModeDecl),
|
|
cord.snoc(ModeDecl, !ModeDecls)
|
|
;
|
|
Item = item_typeclass(TypeClass),
|
|
cord.snoc(TypeClass, !TypeClasses)
|
|
;
|
|
Item = item_instance(Instance),
|
|
AbstractInstance =
|
|
Instance ^ ci_method_instances := instance_body_abstract,
|
|
cord.snoc(AbstractInstance, !Instances)
|
|
;
|
|
Item = item_foreign_enum(ItemForeignEnumInfo),
|
|
cord.snoc(ItemForeignEnumInfo, !ForeignEnums)
|
|
;
|
|
Item = item_pragma(ItemPragma),
|
|
ItemPragma = item_pragma_info(Pragma, _, _),
|
|
AllowedInInterface = pragma_allowed_in_interface(Pragma),
|
|
(
|
|
AllowedInInterface = no
|
|
;
|
|
AllowedInInterface = yes,
|
|
cord.snoc(ItemPragma, !Pragmas)
|
|
)
|
|
;
|
|
Item = item_promise(Promise),
|
|
cord.snoc(Promise, !Promises)
|
|
;
|
|
Item = item_mutable(ItemMutable),
|
|
ItemMutable = item_mutable_info(MutableName,
|
|
_OrigType, Type, _OrigInst, Inst, _Value, _Varset, MutAttrs,
|
|
Context, _SeqNum),
|
|
compute_needed_public_mutable_aux_preds(MutAttrs, PublicAuxPreds),
|
|
list.map(
|
|
make_mutable_aux_pred_decl(ModuleName, MutableName, Type, Inst,
|
|
Context),
|
|
PublicAuxPreds, PublicAuxPredDecls),
|
|
!:PredDecls = !.PredDecls ++ cord.from_list(PublicAuxPredDecls)
|
|
;
|
|
Item = item_type_repn(_)
|
|
% process_item_for_private_interface should be invoked only on items
|
|
% from the *source file*, not on items read from any interface file.
|
|
% Any occurrence of item_type_repns in the source file should have been
|
|
% caught and reported by the parsing code. If through some bug
|
|
% they make it here, neither reporting them again nor aborting the
|
|
% compiler is likely to be helpful.
|
|
;
|
|
( Item = item_clause(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
)
|
|
% Don't include in either section of the private interface.
|
|
),
|
|
get_private_interface_int0_from_items(ModuleName, Items,
|
|
!TypeDefns, !InstDefns, !ModeDefns, !TypeClasses, !Instances,
|
|
!PredDecls, !ModeDecls, !ForeignEnums, !Pragmas, !Promises).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_pre_grab_pre_qual_interface_for_int1_int2(RawCompUnit,
|
|
InterfaceRawCompUnit) :-
|
|
RawCompUnit = raw_compilation_unit(ModuleName, ModuleNameContext,
|
|
RawItemBlocks),
|
|
generate_pre_grab_pre_qual_item_blocks(RawItemBlocks,
|
|
cord.init, IntInclsCord, cord.init, ImpInclsCord,
|
|
cord.init, IntAvailsCord, cord.init, ImpAvailsCord,
|
|
cord.init, IntFIMsCord, cord.init, ImpFIMsCord,
|
|
cord.init, IntItemsCord, cord.init, ImpItemsCord),
|
|
IntIncls = cord.list(IntInclsCord),
|
|
ImpIncls = cord.list(ImpInclsCord),
|
|
IntAvails = cord.list(IntAvailsCord),
|
|
ImpAvails = cord.list(ImpAvailsCord),
|
|
IntFIMs = cord.list(IntFIMsCord),
|
|
ImpFIMs = cord.list(ImpFIMsCord),
|
|
IntItems = cord.list(IntItemsCord),
|
|
ImpItems = cord.list(ImpItemsCord),
|
|
int_imp_items_to_item_blocks(ModuleName, ms_interface, ms_implementation,
|
|
IntIncls, ImpIncls, IntAvails, ImpAvails,
|
|
IntFIMs, ImpFIMs, IntItems, ImpItems, InterfaceItemBlocks),
|
|
InterfaceRawCompUnit = raw_compilation_unit(ModuleName, ModuleNameContext,
|
|
InterfaceItemBlocks).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred generate_pre_grab_pre_qual_item_blocks(list(raw_item_block)::in,
|
|
cord(item_include)::in, cord(item_include)::out,
|
|
cord(item_include)::in, cord(item_include)::out,
|
|
cord(item_avail)::in, cord(item_avail)::out,
|
|
cord(item_avail)::in, cord(item_avail)::out,
|
|
cord(item_fim)::in, cord(item_fim)::out,
|
|
cord(item_fim)::in, cord(item_fim)::out,
|
|
cord(item)::in, cord(item)::out, cord(item)::in, cord(item)::out) is det.
|
|
|
|
generate_pre_grab_pre_qual_item_blocks([],
|
|
!IntInclsCord, !ImpInclsCord, !IntAvailsCord, !ImpAvailsCord,
|
|
!IntFIMsCord, !ImpFIMsCord, !IntItemsCord, !ImpItemsCord).
|
|
generate_pre_grab_pre_qual_item_blocks([RawItemBlock | RawItemBlocks],
|
|
!IntInclsCord, !ImpInclsCord, !IntAvailsCord, !ImpAvailsCord,
|
|
!IntFIMsCord, !ImpFIMsCord, !IntItemsCord, !ImpItemsCord) :-
|
|
RawItemBlock = item_block(_, Section, Incls, Avails, FIMs, Items),
|
|
(
|
|
Section = ms_interface,
|
|
!:IntInclsCord = !.IntInclsCord ++ cord.from_list(Incls),
|
|
!:IntAvailsCord = !.IntAvailsCord ++ cord.from_list(Avails),
|
|
!:IntFIMsCord = !.IntFIMsCord ++ cord.from_list(FIMs),
|
|
generate_pre_grab_pre_qual_items_int(Items, !IntItemsCord)
|
|
;
|
|
Section = ms_implementation,
|
|
!:ImpInclsCord = !.ImpInclsCord ++ cord.from_list(Incls),
|
|
!:ImpAvailsCord = !.ImpAvailsCord ++ cord.from_list(Avails),
|
|
!:ImpFIMsCord = !.ImpFIMsCord ++ cord.from_list(FIMs),
|
|
generate_pre_grab_pre_qual_items_imp(Items, !ImpItemsCord)
|
|
),
|
|
generate_pre_grab_pre_qual_item_blocks(RawItemBlocks,
|
|
!IntInclsCord, !ImpInclsCord, !IntAvailsCord, !ImpAvailsCord,
|
|
!IntFIMsCord, !ImpFIMsCord, !IntItemsCord, !ImpItemsCord).
|
|
|
|
:- pred generate_pre_grab_pre_qual_items_int(list(item)::in,
|
|
cord(item)::in, cord(item)::out) is det.
|
|
|
|
generate_pre_grab_pre_qual_items_int([], !IntItemsCord).
|
|
generate_pre_grab_pre_qual_items_int([Item | Items], !IntItemsCord) :-
|
|
( if Item = item_instance(ItemInstance) then
|
|
AbstractItemInstance = ItemInstance ^ ci_method_instances
|
|
:= instance_body_abstract,
|
|
AbstractItem = item_instance(AbstractItemInstance),
|
|
cord.snoc(AbstractItem, !IntItemsCord)
|
|
else
|
|
cord.snoc(Item, !IntItemsCord)
|
|
),
|
|
generate_pre_grab_pre_qual_items_int(Items, !IntItemsCord).
|
|
|
|
:- pred generate_pre_grab_pre_qual_items_imp(list(item)::in,
|
|
cord(item)::in, cord(item)::out) is det.
|
|
|
|
generate_pre_grab_pre_qual_items_imp([], !ImpItemsCord).
|
|
generate_pre_grab_pre_qual_items_imp([Item | Items], !ImpItemsCord) :-
|
|
(
|
|
Item = item_type_defn(TypeDefnInfo),
|
|
delete_uc_preds_make_solver_type_dummy(TypeDefnInfo, TypeDefnInfo1),
|
|
Item1 = item_type_defn(TypeDefnInfo1),
|
|
cord.snoc(Item1, !ImpItemsCord)
|
|
;
|
|
Item = item_typeclass(ItemTypeClassInfo),
|
|
% `:- typeclass' declarations may be referred to by the constructors
|
|
% in type declarations. Since these constructors are abstractly
|
|
% exported, we won't need the local instance declarations.
|
|
% XXX I (zs) guess that should actually be "we won't need the
|
|
% *method* declarations".
|
|
AbstractItemTypeClassInfo = ItemTypeClassInfo ^ tc_class_methods
|
|
:= class_interface_abstract,
|
|
AbstractItem = item_typeclass(AbstractItemTypeClassInfo),
|
|
cord.snoc(AbstractItem, !ImpItemsCord)
|
|
;
|
|
Item = item_foreign_enum(_),
|
|
cord.snoc(Item, !ImpItemsCord)
|
|
;
|
|
( Item = item_clause(_)
|
|
; Item = item_inst_defn(_)
|
|
; Item = item_mode_defn(_)
|
|
; Item = item_pred_decl(_)
|
|
; Item = item_mode_decl(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_pragma(_)
|
|
; Item = item_promise(_)
|
|
; Item = item_instance(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
; Item = item_mutable(_)
|
|
)
|
|
;
|
|
Item = item_type_repn(_),
|
|
% XXX TYPE_REPN Implement this.
|
|
unexpected($pred, "item_type_repn")
|
|
),
|
|
generate_pre_grab_pre_qual_items_imp(Items, !ImpItemsCord).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
generate_interfaces_int1_int2(Globals, AugCompUnit,
|
|
ParseTreeInt1, ParseTreeInt2, !Specs) :-
|
|
generate_interface_int1(AugCompUnit, IntInclModuleNames, IntImportsUses,
|
|
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
|
|
IntTypeDefns, IntInstDefns, IntModeDefns, IntTypeClasses, IntInstances,
|
|
ImpTypeDefns, TypeCtorCheckedMap, ParseTreeInt1A, !Specs),
|
|
generate_interface_int2(Globals, AugCompUnit,
|
|
IntInclModuleNames, IntImportsUses,
|
|
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
|
|
IntTypeDefns, IntInstDefns, IntModeDefns, IntTypeClasses, IntInstances,
|
|
ImpTypeDefns, TypeCtorCheckedMap, ParseTreeInt2A),
|
|
ParseTreeInt1 = convert_parse_tree_int1_to_parse_tree_int(ParseTreeInt1A),
|
|
ParseTreeInt2 = convert_parse_tree_int2_to_parse_tree_int(ParseTreeInt2A).
|
|
|
|
:- pred generate_interface_int1(aug_compilation_unit::in,
|
|
set(module_name)::out, set(module_name)::out,
|
|
set(fim_spec)::out, set(fim_spec)::out,
|
|
list(item_type_defn_info)::out,
|
|
list(item_inst_defn_info)::out, list(item_mode_defn_info)::out,
|
|
list(item_typeclass_info)::out, list(item_instance_info)::out,
|
|
list(item_type_defn_info)::out,
|
|
type_ctor_checked_map::out, parse_tree_int1::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
generate_interface_int1(AugCompUnit, IntIncls, IntImportsUses,
|
|
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
|
|
IntTypeDefns, IntInstDefns, IntModeDefns,
|
|
IntTypeClasses, IntInstances,
|
|
ImpTypeDefns, TypeCtorCheckedMap, ParseTreeInt1, !Specs) :-
|
|
% We return some of our intermediate results to our caller, for use
|
|
% in constructing the .int2 file.
|
|
AugCompUnit = aug_compilation_unit(ModuleName, ModuleNameContext,
|
|
_ModuleVersionNumbers, SrcItemBlocks,
|
|
_DirectIntItemBlocks, _IndirectIntItemBlocks,
|
|
_OptItemBlocks, _IntForOptItemBlocks),
|
|
|
|
% 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.
|
|
set.init(IntImportsUses0),
|
|
set.init(ImpImportsUses0),
|
|
set.init(IntExplicitFIMSpecs0),
|
|
set.init(ImpExplicitFIMSpecs0),
|
|
set.init(IntImplicitFIMLangs0),
|
|
set.init(ImpImplicitFIMLangs0),
|
|
multi_map.init(IntTypesMap0),
|
|
multi_map.init(ImpTypesMap0),
|
|
|
|
% XXX Why are we ignoring _IntModulesNeededByTypeClassDefns?
|
|
get_interface_int1_item_blocks_loop(SrcItemBlocks,
|
|
set.init, IntIncls, set.init, ImpIncls,
|
|
IntImportsUses0, IntImportsUses, ImpImportsUses0, ImpImportsUses1,
|
|
IntExplicitFIMSpecs0, IntExplicitFIMSpecs,
|
|
ImpExplicitFIMSpecs0, ImpExplicitFIMSpecs,
|
|
IntImplicitFIMLangs0, IntImplicitFIMLangs,
|
|
ImpImplicitFIMLangs0, ImpImplicitFIMLangs1,
|
|
IntTypesMap0, IntTypesMap, cord.init, IntTypeDefnsCord,
|
|
cord.init, IntInstDefnsCord, cord.init, IntModeDefnsCord,
|
|
cord.init, IntTypeClassesCord, cord.init, IntInstancesCord,
|
|
cord.init, IntPredDeclsCord, cord.init, IntModeDeclsCord,
|
|
cord.init, IntForeignEnumsCord, cord.init, IntPragmasCord,
|
|
cord.init, IntPromisesCord,
|
|
set.init, _IntModulesNeededByTypeClassDefns,
|
|
ImpTypesMap0, ImpTypesMap, cord.init, OrigImpTypeDefnsCord,
|
|
cord.init, ImpTypeClassesCord, cord.init, ImpForeignEnumsCord,
|
|
set.init, ImpModulesNeededByTypeClassDefns),
|
|
|
|
IntTypeDefns = cord.list(IntTypeDefnsCord),
|
|
IntInstDefns = cord.list(IntInstDefnsCord),
|
|
IntModeDefns = cord.list(IntModeDefnsCord),
|
|
IntTypeClasses = cord.list(IntTypeClassesCord),
|
|
IntInstances = cord.list(IntInstancesCord),
|
|
IntPredDecls = cord.list(IntPredDeclsCord),
|
|
IntModeDecls = cord.list(IntModeDeclsCord),
|
|
IntForeignEnums = cord.list(IntForeignEnumsCord),
|
|
IntPragmas = cord.list(IntPragmasCord),
|
|
IntPromises = cord.list(IntPromisesCord),
|
|
|
|
OrigImpTypeDefns = cord.list(OrigImpTypeDefnsCord),
|
|
ImpTypeClasses = cord.list(ImpTypeClassesCord),
|
|
ImpForeignEnums0 = cord.list(ImpForeignEnumsCord),
|
|
|
|
BothTypesMap = multi_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 types whose definitions we are keeping in the implementation
|
|
% section.
|
|
get_requirements_of_imp_exported_types(IntTypesMap, ImpTypesMap,
|
|
BothTypesMap, NeededImpTypeCtors, ImpModulesNeededByTypeDefns),
|
|
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.
|
|
( if set.is_empty(ImpNeededModules) then
|
|
% This gets the same result as the else case, only more quickly.
|
|
set.init(ImpImportsUses)
|
|
else
|
|
ImpImportsUses2 = set.intersect(ImpImportsUses1, ImpNeededModules),
|
|
ImpImportsUses = set.difference(ImpImportsUses2, IntImportsUses)
|
|
),
|
|
|
|
% Compute the list of type definitions we deleted from ImpItems0
|
|
% that we want to add back to the implementation section,
|
|
% possibly in their abstract form.
|
|
map.foldl2(
|
|
maybe_add_maybe_abstract_type_defns(BothTypesMap, IntTypesMap,
|
|
NeededImpTypeCtors),
|
|
ImpTypesMap, [], ImpTypeDefns,
|
|
ImpImplicitFIMLangs1, ImpImplicitFIMLangs2),
|
|
|
|
% Figure out which of the foreign enum items we deleted from ImpItems0
|
|
% we want to add back to the implementation section.
|
|
% Record the needs of these foreign enum items for
|
|
% foreign_import_module items.
|
|
list.foldl2(add_foreign_enum_item_if_needed(IntTypesMap),
|
|
ImpForeignEnums0, [], ImpForeignEnums,
|
|
ImpImplicitFIMLangs2, ImpImplicitFIMLangs),
|
|
|
|
set.foldl(add_self_fim(ModuleName), IntImplicitFIMLangs,
|
|
IntExplicitFIMSpecs, IntFIMSpecs),
|
|
set.foldl(add_self_fim(ModuleName), ImpImplicitFIMLangs,
|
|
ImpExplicitFIMSpecs, ImpFIMSpecs0),
|
|
set.difference(ImpFIMSpecs0, IntFIMSpecs, ImpFIMSpecs),
|
|
|
|
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
|
|
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
|
|
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
|
|
IntForeignEnumMap = type_ctor_foreign_enum_items_to_map(IntForeignEnums),
|
|
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepns),
|
|
OrigImpTypeDefnMap = type_ctor_defn_items_to_map(OrigImpTypeDefns),
|
|
ImpTypeDefnMap = type_ctor_defn_items_to_map(ImpTypeDefns),
|
|
ImpForeignEnumMap = type_ctor_foreign_enum_items_to_map(ImpForeignEnums),
|
|
% For now, we want only the error messages.
|
|
create_type_ctor_checked_map(do_insist_on_defn, ModuleName,
|
|
IntTypeDefnMap, OrigImpTypeDefnMap,
|
|
IntForeignEnumMap, ImpForeignEnumMap, TypeCtorCheckedMap, !Specs),
|
|
|
|
DummyMaybeVersionNumbers = no_version_numbers,
|
|
% XXX TODO
|
|
IntTypeRepns = [],
|
|
ParseTreeInt1 = parse_tree_int1(ModuleName, ModuleNameContext,
|
|
DummyMaybeVersionNumbers, IntIncls, ImpIncls,
|
|
IntImportsUses, ImpImportsUses, IntFIMSpecs, ImpFIMSpecs,
|
|
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
|
|
IntTypeClasses, IntInstances,
|
|
IntPredDecls, IntModeDecls,
|
|
IntForeignEnumMap, IntPragmas, IntPromises,
|
|
IntTypeRepnMap,
|
|
ImpTypeDefnMap, ImpForeignEnumMap, 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).
|
|
|
|
%---------------------%
|
|
|
|
:- type type_defn_map == multi_map(type_ctor, item_type_defn_info).
|
|
:- type type_defn_pair == pair(type_ctor, item_type_defn_info).
|
|
|
|
% get_interface_int1_item_blocks_loop(SrcItemBlocks,
|
|
% !IntIncls, !ImpIncls, !IntImportsUses, !ImpImportsUses,
|
|
% !IntExplicitFIMSpecs, !ImpExplicitFIMSpecs,
|
|
% !IntImplicitFIMLangs, !ImpImplicitFIMLangs,
|
|
% !IntTypesMap, !IntTypeDefnsCord,
|
|
% !IntInstDefnsCord, !IntModeDefnsCord,
|
|
% !IntTypeClassesCord, !IntInstancesCord,
|
|
% !IntPredDeclsCord, !IntModeDeclsCord,
|
|
% !IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
% !IntModulesNeededByTypeClassDefns,
|
|
% !ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
% !ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns):
|
|
%
|
|
% Do the bulk of the work needed to generate a module's .int file
|
|
% from the module's augmented compilation unit.
|
|
%
|
|
% The input is the list of source item blocks in the module's
|
|
% augmented compilation unit, *after* they have been processed
|
|
%
|
|
% - by generate_pre_grab_pre_qual_item_blocks_int1_int2, which deletes
|
|
% most kinds of items from implementation sections, and
|
|
%
|
|
% - by having everything fully module qualified (in the absence of any
|
|
% qualification errors).
|
|
%
|
|
% Our outputs are as follows.
|
|
%
|
|
% !:IntIncls and !:ImpIncls are the module names included in the
|
|
% interface and implementation sections respectively.
|
|
%
|
|
% !:IntImportsUses and !:ImpImportsUses are the modules imported and/or
|
|
% used in the interface and implementation sections respectively.
|
|
%
|
|
% !:IntExplicitFIMSpecs and !:ImpExplicitFIMSpecs are the
|
|
% foreign_import_modules explicitly includes in the
|
|
% the interface and implementation sections respectively.
|
|
% !:IntImplicitFIMLangs and !:ImpImplicitFIMLangs are the languages
|
|
% for which we need to generate an implicit foreign_import_module
|
|
% for the current module, as needed by the interface and implementation
|
|
% items we return in the following arguments.
|
|
%
|
|
% The arguments from !:IntTypeDefnsCord to !:IntPromisesCord
|
|
% contain the parts of the interface section of the source module
|
|
% that we want to include in the .int file. Likewise,
|
|
% the arguments !:ImpTypeClassesCord and !:ImpForeignEnumsCord
|
|
% contain parts of the implementation section of the source module
|
|
% that we want to include in the .int file. However, until we switch over
|
|
% to using type_repn items, we also need to include in the .int file
|
|
% a subset of the type definitions from the implementation section.
|
|
%
|
|
% We return !:IntTypesMap and !:ImpTypesMap, which contain
|
|
% the type definitions in the interface and implementation sections
|
|
% respectively, to our caller as the raw material for it to use in
|
|
% computing that subset. They both map the type constructors
|
|
% of the types defined in the interface and implementation sections
|
|
% respectively to the list of definitions of that type. (We need a list
|
|
% for two reasons: because a type may be defined both in Mercury and
|
|
% in several target languages, and because of the potential presence
|
|
% of erroneous double definitions.)
|
|
%
|
|
% We also return type definitions in !OrigImpTypeDefnsCord for use
|
|
% in computing the checked type definition map.
|
|
%
|
|
% !:{Int,Imp}ModulesNeededByTypeClassDefns are the sets of the modules
|
|
% needed by any superclass constraints on any typeclass declaration
|
|
% in the interface and the implementation sections. A module may be needed
|
|
% because it defines the typeclass in the superclass constraint,
|
|
% or because it defines a type constructor mentioned anywhere
|
|
% in the superclass constraint.
|
|
%
|
|
:- pred get_interface_int1_item_blocks_loop(list(src_item_block)::in,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
set(fim_spec)::in, set(fim_spec)::out,
|
|
set(fim_spec)::in, set(fim_spec)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out,
|
|
type_defn_map::in, type_defn_map::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_pred_decl_info)::in, cord(item_pred_decl_info)::out,
|
|
cord(item_mode_decl_info)::in, cord(item_mode_decl_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_pragma_info)::in, cord(item_pragma_info)::out,
|
|
cord(item_promise_info)::in, cord(item_promise_info)::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
type_defn_map::in, type_defn_map::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_interface_int1_item_blocks_loop([],
|
|
!IntIncls, !ImpIncls, !IntImportsUses, !ImpImportsUses,
|
|
!IntExplicitFIMSpecs, !ImpExplicitFIMSpecs,
|
|
!IntImplicitFIMLangs, !ImpImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord,
|
|
!IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns).
|
|
get_interface_int1_item_blocks_loop([SrcItemBlock | SrcItemBlocks],
|
|
!IntIncls, !ImpIncls, !IntImportsUses, !ImpImportsUses,
|
|
!IntExplicitFIMSpecs, !ImpExplicitFIMSpecs,
|
|
!IntImplicitFIMLangs, !ImpImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord,
|
|
!IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns) :-
|
|
SrcItemBlock = item_block(_, SrcSection, Incls, Avails, FIMs, Items),
|
|
(
|
|
SrcSection = sms_interface,
|
|
list.foldl(add_included_module_name, Incls, !IntIncls),
|
|
get_interface_int1_avails_loop(Avails, !IntImportsUses),
|
|
list.foldl(add_fim_to_specs, FIMs, !IntExplicitFIMSpecs),
|
|
get_interface_int1_items_loop_int(Items, !IntImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord,
|
|
!IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns)
|
|
;
|
|
SrcSection = sms_implementation,
|
|
list.foldl(add_included_module_name, Incls, !ImpIncls),
|
|
get_interface_int1_avails_loop(Avails, !ImpImportsUses),
|
|
list.foldl(add_fim_to_specs, FIMs, !ImpExplicitFIMSpecs),
|
|
get_interface_int1_items_loop_imp(Items, !ImpImplicitFIMLangs,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns)
|
|
;
|
|
SrcSection = sms_impl_but_exported_to_submodules,
|
|
% The code that transforms sms_implementation to this
|
|
% should not have been run.
|
|
unexpected($pred, "sms_impl_but_exported_to_submodules")
|
|
),
|
|
get_interface_int1_item_blocks_loop(SrcItemBlocks,
|
|
!IntIncls, !ImpIncls, !IntImportsUses, !ImpImportsUses,
|
|
!IntExplicitFIMSpecs, !ImpExplicitFIMSpecs,
|
|
!IntImplicitFIMLangs, !ImpImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord,
|
|
!IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns).
|
|
|
|
:- pred get_interface_int1_avails_loop(list(item_avail)::in,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_interface_int1_avails_loop([], !ImportsUses).
|
|
get_interface_int1_avails_loop([Avail | Avails], !ImportsUses) :-
|
|
( Avail = avail_import(avail_import_info(ModuleName, _Ctxt, _SeqNum))
|
|
; Avail = avail_use(avail_use_info(ModuleName, _Ctxt, _SeqNum))
|
|
),
|
|
set.insert(ModuleName, !ImportsUses),
|
|
get_interface_int1_avails_loop(Avails, !ImportsUses).
|
|
|
|
:- pred get_interface_int1_items_loop_int(list(item)::in,
|
|
set(foreign_language)::in, set(foreign_language)::out,
|
|
type_defn_map::in, type_defn_map::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out,
|
|
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_instance_info)::in, cord(item_instance_info)::out,
|
|
cord(item_pred_decl_info)::in, cord(item_pred_decl_info)::out,
|
|
cord(item_mode_decl_info)::in, cord(item_mode_decl_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
cord(item_pragma_info)::in, cord(item_pragma_info)::out,
|
|
cord(item_promise_info)::in, cord(item_promise_info)::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_interface_int1_items_loop_int([], !IntImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord, !IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns).
|
|
get_interface_int1_items_loop_int([Item | Items], !IntImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord, !IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns) :-
|
|
(
|
|
Item = item_type_defn(ItemTypeDefn),
|
|
ItemTypeDefn =
|
|
item_type_defn_info(Name, TypeParams, TypeDefn, _, _, _),
|
|
TypeCtor = type_ctor(Name, list.length(TypeParams)),
|
|
multi_map.set(TypeCtor, ItemTypeDefn, !IntTypesMap),
|
|
cord.snoc(ItemTypeDefn, !IntTypeDefnsCord),
|
|
( if
|
|
TypeDefn = parse_tree_foreign_type(DetailsForeign),
|
|
DetailsForeign = type_details_foreign(ForeignType, _, _)
|
|
then
|
|
Lang = foreign_type_language(ForeignType),
|
|
set.insert(Lang, !IntImplicitFIMLangs)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
Item = item_inst_defn(ItemInstDefn),
|
|
cord.snoc(ItemInstDefn, !IntInstDefnsCord)
|
|
;
|
|
Item = item_mode_defn(ItemModeDefn),
|
|
cord.snoc(ItemModeDefn, !IntModeDefnsCord)
|
|
;
|
|
Item = item_typeclass(ItemTypeClass),
|
|
cord.snoc(ItemTypeClass, !IntTypeClassesCord),
|
|
% 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_from_constraint, Constraints,
|
|
!IntModulesNeededByTypeClassDefns)
|
|
;
|
|
Item = item_instance(ItemInstance),
|
|
cord.snoc(ItemInstance, !IntInstancesCord)
|
|
;
|
|
Item = item_pred_decl(ItemPredDecl),
|
|
cord.snoc(ItemPredDecl, !IntPredDeclsCord)
|
|
;
|
|
Item = item_mode_decl(ItemModeDecl),
|
|
cord.snoc(ItemModeDecl, !IntModeDeclsCord)
|
|
;
|
|
Item = item_foreign_enum(ItemForeignEnum),
|
|
cord.snoc(ItemForeignEnum, !IntForeignEnumsCord),
|
|
ItemForeignEnum = item_foreign_enum_info(Lang, _, _, _, _),
|
|
set.insert(Lang, !IntImplicitFIMLangs)
|
|
;
|
|
Item = item_pragma(ItemPragma),
|
|
ItemPragma = item_pragma_info(Pragma, _Context, _SeqNum),
|
|
AllowedInInterface = pragma_allowed_in_interface(Pragma),
|
|
(
|
|
AllowedInInterface = no
|
|
% A clause-like pragma in the interface is a bug, but it should be
|
|
% reported when we try to generate code for the module.
|
|
;
|
|
AllowedInInterface = yes,
|
|
cord.snoc(ItemPragma, !IntPragmasCord),
|
|
Langs = pragma_needs_foreign_imports(Pragma),
|
|
expect(unify(Langs, []), $pred, "interface pragma needs Langs")
|
|
)
|
|
;
|
|
Item = item_promise(ItemPromise),
|
|
PromiseType = ItemPromise ^ prom_type,
|
|
(
|
|
PromiseType = promise_type_true
|
|
% Ignore the item, which deletes it.
|
|
% XXX ITEM_LIST We should reconsider this decision,
|
|
% since it limits optimization opportunities in other modules.
|
|
;
|
|
( PromiseType = promise_type_exclusive
|
|
; PromiseType = promise_type_exhaustive
|
|
; PromiseType = promise_type_exclusive_exhaustive
|
|
),
|
|
cord.snoc(ItemPromise, !IntPromisesCord)
|
|
)
|
|
;
|
|
( Item = item_clause(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
; Item = item_mutable(_)
|
|
)
|
|
% The presence of these items in the interface section is an error.
|
|
% We delay reporting this bug until we generate target code
|
|
% for this module. (Aborting would not be a good idea; it would
|
|
% lead to the failure of tests/valid/mutable_interface_in_main.)
|
|
% I (zs) think they should be silently deleted here;
|
|
% the error should be reported when we try to generate code
|
|
% for this module.
|
|
;
|
|
Item = item_type_repn(_),
|
|
% We shouldn't yet have invoked any code that creates
|
|
% type_repn items.
|
|
unexpected($pred, "item_type_repn")
|
|
),
|
|
get_interface_int1_items_loop_int(Items, !IntImplicitFIMLangs,
|
|
!IntTypesMap, !IntTypeDefnsCord, !IntInstDefnsCord, !IntModeDefnsCord,
|
|
!IntTypeClassesCord, !IntInstancesCord,
|
|
!IntPredDeclsCord, !IntModeDeclsCord,
|
|
!IntForeignEnumsCord, !IntPragmasCord, !IntPromisesCord,
|
|
!IntModulesNeededByTypeClassDefns).
|
|
|
|
:- pred get_interface_int1_items_loop_imp(list(item)::in,
|
|
set(foreign_language)::in, set(foreign_language)::out,
|
|
type_defn_map::in, type_defn_map::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
cord(item_typeclass_info)::in, cord(item_typeclass_info)::out,
|
|
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_interface_int1_items_loop_imp([], !ImpImplicitFIMLangs,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns).
|
|
get_interface_int1_items_loop_imp([Item | Items], !ImpImplicitFIMLangs,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns) :-
|
|
(
|
|
Item = item_type_defn(ItemTypeDefn),
|
|
% 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_items_imp has replace 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_eqv_type(_)
|
|
; TypeDefn = parse_tree_foreign_type(_)
|
|
),
|
|
ItemTypeDefn1 = ItemTypeDefn
|
|
),
|
|
multi_map.set(TypeCtor, ItemTypeDefn1, !ImpTypesMap),
|
|
cord.snoc(ItemTypeDefn, !OrigImpTypeDefnsCord)
|
|
;
|
|
Item = item_typeclass(ItemTypeClass),
|
|
cord.snoc(ItemTypeClass, !ImpTypeClassesCord),
|
|
% 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_from_constraint, Constraints,
|
|
!ImpModulesNeededByTypeClassDefns)
|
|
;
|
|
Item = item_foreign_enum(ItemForeignEnum),
|
|
cord.snoc(ItemForeignEnum, !ImpForeignEnumsCord),
|
|
ItemForeignEnum = item_foreign_enum_info(Lang, _, _, _, _),
|
|
set.insert(Lang, !ImpImplicitFIMLangs)
|
|
;
|
|
( Item = item_inst_defn(_)
|
|
; Item = item_mode_defn(_)
|
|
; Item = item_pred_decl(_)
|
|
; Item = item_mode_decl(_)
|
|
; Item = item_instance(_)
|
|
; Item = item_foreign_export_enum(_)
|
|
; Item = item_pragma(_)
|
|
; Item = item_clause(_)
|
|
; Item = item_promise(_)
|
|
; Item = item_initialise(_)
|
|
; Item = item_finalise(_)
|
|
; Item = item_mutable(_)
|
|
; Item = item_type_repn(_)
|
|
),
|
|
unexpected($pred,
|
|
"generate_pre_grab_pre_qual_items_imp should've deleted imp item")
|
|
),
|
|
get_interface_int1_items_loop_imp(Items, !ImpImplicitFIMLangs,
|
|
!ImpTypesMap, !OrigImpTypeDefnsCord, !ImpTypeClassesCord,
|
|
!ImpForeignEnumsCord, !ImpModulesNeededByTypeClassDefns).
|
|
|
|
:- pred add_fim_to_specs(item_fim::in,
|
|
set(fim_spec)::in, set(fim_spec)::out) is det.
|
|
|
|
add_fim_to_specs(FIM, !FIMSpecs) :-
|
|
FIM = item_fim(Lang, ModuleName, _Context, _SeqNum),
|
|
FIMSpec = fim_spec(Lang, ModuleName),
|
|
set.insert(FIMSpec, !FIMSpecs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred accumulate_modules_from_constraint(prog_constraint::in,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_from_constraint(Constraint, !Modules) :-
|
|
Constraint = constraint(ClassName, ArgTypes),
|
|
(
|
|
ClassName = qualified(ModuleName, _),
|
|
set.insert(ModuleName, !Modules)
|
|
;
|
|
ClassName = unqualified(_),
|
|
unexpected($pred, "unknown typeclass in constraint")
|
|
),
|
|
accumulate_modules_from_types(ArgTypes, !Modules).
|
|
|
|
:- pred accumulate_modules_from_types(list(mer_type)::in,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_from_types([], !Modules).
|
|
accumulate_modules_from_types([Type | Types], !Modules) :-
|
|
accumulate_modules_from_type(Type, !Modules),
|
|
accumulate_modules_from_types(Types, !Modules).
|
|
|
|
:- pred accumulate_modules_from_type(mer_type::in,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_from_type(Type, !Modules) :-
|
|
(
|
|
% 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(TypeName, ArgTypes, _),
|
|
det_sym_name_get_module_name(TypeName, ModuleName),
|
|
set.insert(ModuleName, !Modules),
|
|
accumulate_modules_from_types(ArgTypes, !Modules)
|
|
;
|
|
Type = kinded_type(KindedType, _),
|
|
accumulate_modules_from_type(KindedType, !Modules)
|
|
;
|
|
( Type = tuple_type(ArgTypes, _)
|
|
; Type = apply_n_type(_, ArgTypes, _)
|
|
; Type = higher_order_type(_, ArgTypes, _HOInstInfo, _, _)
|
|
),
|
|
% XXX ITEM_LIST accumulate modules from _HOInstInfo
|
|
accumulate_modules_from_types(ArgTypes, !Modules)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% 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 an enum type, 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, 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
|
|
% or foreign type 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 that type_ctor
|
|
% also has foreign language definitions (since we put a type_ctor
|
|
% into AbsExpEqvLhsTypeCtors only if it has either an equivalence
|
|
% or a foreign language 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) :-
|
|
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, list(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 = [],
|
|
% The list of values for a key in a multi_map should never be empty.
|
|
unexpected($pred, "ImpItemTypeDefnInfos = []")
|
|
;
|
|
ImpItemTypeDefnInfos = [ImpItemTypeDefnInfo],
|
|
% 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, ImpItemTypeDefnInfo,
|
|
!AbsExpEqvLhsTypeCtors, !AbsExpEnumTypeCtors,
|
|
!DirectDummyTypeCtors)
|
|
;
|
|
ImpItemTypeDefnInfos = [_, _ | _],
|
|
% 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.
|
|
list.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, _, _, _),
|
|
(
|
|
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, _),
|
|
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.
|
|
constructor_list_represents_dummy_type(BothTypesMap, OoMCtors,
|
|
MaybeEqCmp, MaybeDirectArgCtors)
|
|
then
|
|
set.insert(TypeCtor, !DirectDummyTypeCtors)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
( ImpTypeDefn = parse_tree_abstract_type(_)
|
|
; ImpTypeDefn = 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
|
|
list.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_used_by_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, _, _),
|
|
% 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_used_by_type_ctor, RhsTypeCtors,
|
|
!ModulesNeededByTypeDefns)
|
|
;
|
|
( ImpTypeDefn = parse_tree_abstract_type(_)
|
|
; ImpTypeDefn = parse_tree_solver_type(_)
|
|
; ImpTypeDefn = parse_tree_foreign_type(_)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred accumulate_modules_used_by_type_ctor(type_ctor::in,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_used_by_type_ctor(TypeCtor, !Modules) :-
|
|
TypeCtor = type_ctor(SymName, _Arity),
|
|
(
|
|
SymName = qualified(ModuleName, _),
|
|
set.insert(ModuleName, !Modules)
|
|
;
|
|
SymName = unqualified(_),
|
|
% Our ancestor generate_interfaces_int1_int2 should be invoked
|
|
% only *after* the module qualification of the augmented compilation
|
|
% unit whose contents we are now processing.
|
|
unexpected($pred, "unqualified type encountered")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% 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.check_dummy_type' for the definition
|
|
% of a dummy type.
|
|
%
|
|
% NOTE: changes here may require changes to `type_util.check_dummy_type'.
|
|
%
|
|
:- pred constructor_list_represents_dummy_type(type_defn_map::in,
|
|
one_or_more(constructor)::in, maybe_canonical::in,
|
|
maybe(list(sym_name_and_arity))::in) is semidet.
|
|
|
|
constructor_list_represents_dummy_type(TypeDefnMap,
|
|
OoMCtors, MaybeCanonical, MaybeDirectArgCtors) :-
|
|
constructor_list_represents_dummy_type_2(TypeDefnMap,
|
|
OoMCtors, MaybeCanonical, MaybeDirectArgCtors, []).
|
|
|
|
:- pred constructor_list_represents_dummy_type_2(type_defn_map::in,
|
|
one_or_more(constructor)::in, maybe_canonical::in,
|
|
maybe(list(sym_name_and_arity))::in, list(mer_type)::in) is semidet.
|
|
|
|
constructor_list_represents_dummy_type_2(TypeDefnMap, 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, ArgType, CoveredTypes) = yes
|
|
).
|
|
|
|
:- func ctor_arg_is_dummy_type(type_defn_map, mer_type, list(mer_type)) = bool.
|
|
|
|
ctor_arg_is_dummy_type(TypeDefnMap, 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?
|
|
multi_map.search(TypeDefnMap, TypeCtor, ItemTypeDefnInfos),
|
|
list.member(ItemTypeDefnInfo, ItemTypeDefnInfos),
|
|
TypeDefn = ItemTypeDefnInfo ^ td_ctor_defn,
|
|
TypeDefn = parse_tree_du_type(DetailsDu),
|
|
DetailsDu = type_details_du(OoMCtors, MaybeEqCmp,
|
|
MaybeDirectArgCtors),
|
|
constructor_list_represents_dummy_type_2(TypeDefnMap,
|
|
OoMCtors, MaybeEqCmp, MaybeDirectArgCtors,
|
|
[Type | 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")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% Given a type constructor's type definitions from the implementation
|
|
% section, as recorded in ImpTypesMap, include their abstract versions
|
|
% in !ImpTypeDefnItems, the list of type definition items scheduled to be
|
|
% added back to the implementation section, *provided* that
|
|
%
|
|
% - the type constructor is in NeededTypeCtors, and
|
|
%
|
|
% - *either* the type has no declaration or definition in the interface,
|
|
% *or* at least one of the type definitions in the implementation section
|
|
% contains more information than a pure abstract type declaration
|
|
% (such as may be found in the interface section) would.
|
|
%
|
|
% By "pure abstract" type declarations, we mean abstract type
|
|
% declarations that give no further implementation. This means that
|
|
% `type_is_abstract_enum' declarations are not *pure* abstract.
|
|
% XXX ITEM_LIST I (zs) believe that the intention behind this proviso
|
|
% was to allow items representing the following scenario to be left
|
|
% alone:
|
|
%
|
|
% :- interface.
|
|
% :- type t1.
|
|
% ...
|
|
% :- implementation.
|
|
% :- type t1 where type_is_abstract_enum(...).
|
|
%
|
|
% XXX ITEM_LIST Just because *one* definition in the implementation has
|
|
% more info than a pure abstract type declaration *should not* result in
|
|
% us adding back to the implementation section any other type definitions
|
|
% that *do* represent nothing more than a pure abstract type declaration.
|
|
% Note that this distinction should matter only for types whose set of
|
|
% definitions are erroneous, such a type that is defined both as
|
|
% an equivalence type and as a du type.
|
|
%
|
|
:- pred maybe_add_maybe_abstract_type_defns(
|
|
type_defn_map::in, type_defn_map::in, set(type_ctor)::in,
|
|
type_ctor::in, list(item_type_defn_info)::in,
|
|
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out) is det.
|
|
|
|
maybe_add_maybe_abstract_type_defns(BothTypesMap, IntTypesMap,
|
|
NeededTypeCtors, TypeCtor, ImpItemTypeDefnInfos,
|
|
!ImpTypeDefns, !ImpImplicitFIMLangs) :-
|
|
( if
|
|
set.member(TypeCtor, NeededTypeCtors),
|
|
make_imp_types_abstract(BothTypesMap,
|
|
ImpItemTypeDefnInfos, AbstractImpItemTypeDefnInfos),
|
|
% This negated piece of code succeeds iff
|
|
% EITHER the type is private,
|
|
% OR it is abstract exported, and
|
|
% EITHER it has two or more definitions in the implementation
|
|
% OR it has at least one definition that is not general du.
|
|
not (
|
|
multi_map.contains(IntTypesMap, TypeCtor),
|
|
list.all_true(is_pure_abstract_type_defn,
|
|
AbstractImpItemTypeDefnInfos)
|
|
)
|
|
then
|
|
add_type_defn_items(AbstractImpItemTypeDefnInfos,
|
|
!ImpTypeDefns, !ImpImplicitFIMLangs)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred is_pure_abstract_type_defn(item_type_defn_info::in) is semidet.
|
|
|
|
is_pure_abstract_type_defn(ImpItemTypeDefnInfo) :-
|
|
ImpItemTypeDefnInfo ^ td_ctor_defn = parse_tree_abstract_type(Details),
|
|
% XXX ITEM_LIST This test may do the wrong thing for
|
|
% abstract_{dummy,notag,solver}_types, once we start generating them.
|
|
Details \= abstract_type_fits_in_n_bits(_).
|
|
|
|
:- pred make_imp_types_abstract(type_defn_map::in,
|
|
list(item_type_defn_info)::in, list(item_type_defn_info)::out) is det.
|
|
|
|
make_imp_types_abstract(BothTypesMap, !ImpItemTypeDefnInfos) :-
|
|
(
|
|
!.ImpItemTypeDefnInfos = [],
|
|
% The list of values for a key in a multi_map should never be empty.
|
|
unexpected($pred, "!.ImpItemTypeDefnInfos = []")
|
|
;
|
|
!.ImpItemTypeDefnInfos = [ImpItemTypeDefnInfo0],
|
|
make_imp_type_abstract(BothTypesMap,
|
|
ImpItemTypeDefnInfo0, ImpItemTypeDefnInfo),
|
|
!:ImpItemTypeDefnInfos = [ImpItemTypeDefnInfo]
|
|
;
|
|
!.ImpItemTypeDefnInfos = [_, _ | _]
|
|
% This type constructor has two or more definitions, which is
|
|
% an error, but it should be reported somewhere else.
|
|
% XXX This is not true. It is perfectly ok for a type constructor
|
|
% to have one Mercury definition as a du type and several foreign
|
|
% language definitions. For these, we probably *should* process
|
|
% the du definition as above.
|
|
% XXX TYPE_REPN In such cases, we should consider replacing
|
|
% the foreign definitions with a new kind of internal-use-only item
|
|
% that records the presence of foreign type definitions for the type,
|
|
% and lists, for each foreign language with a definition, the
|
|
% assertions from that definition, but no more.
|
|
).
|
|
|
|
:- pred make_imp_type_abstract(type_defn_map::in,
|
|
item_type_defn_info::in, item_type_defn_info::out) is det.
|
|
|
|
make_imp_type_abstract(BothTypesMap, !ImpItemTypeDefnInfo) :-
|
|
% 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.
|
|
!.ImpItemTypeDefnInfo = item_type_defn_info(_, _, TypeDefn0, _, _, _),
|
|
(
|
|
TypeDefn0 = parse_tree_du_type(DetailsDu0),
|
|
DetailsDu0 = type_details_du(OoMCtors, MaybeEqCmp,
|
|
MaybeDirectArgCtors),
|
|
( if
|
|
constructor_list_represents_dummy_type(BothTypesMap,
|
|
OoMCtors, MaybeEqCmp, MaybeDirectArgCtors)
|
|
then
|
|
% Leave dummy types alone.
|
|
true
|
|
else
|
|
( if du_type_is_enum(DetailsDu0, NumFunctors) then
|
|
num_bits_needed_for_n_values(NumFunctors, NumBits),
|
|
DetailsAbs = abstract_type_fits_in_n_bits(NumBits)
|
|
else
|
|
DetailsAbs = abstract_type_general
|
|
),
|
|
TypeDefn = parse_tree_abstract_type(DetailsAbs),
|
|
!ImpItemTypeDefnInfo ^ td_ctor_defn := TypeDefn
|
|
)
|
|
;
|
|
TypeDefn0 = parse_tree_eqv_type(_)
|
|
% XXX TYPE_REPN We currently leave the type definition alone.
|
|
% However, in the future we should test whether the type
|
|
% equivalence is to a type that requires special treatment,
|
|
% either with respect to type representation (because it is smaller
|
|
% than a word, because it is bigger than a word, or because it is
|
|
% guaranteed to be an aligned pointer) or because it needs to be
|
|
% passed in an FP register.
|
|
%
|
|
% If the type does require special treatment, we should generate
|
|
% an item that specifies that treatment, and no more.
|
|
% If the type does not require special treatment, we should
|
|
% generate an item that specifies the absence of a need for
|
|
% special treatment: a simple abstract type definition
|
|
% should suffice.
|
|
;
|
|
TypeDefn0 = parse_tree_foreign_type(_)
|
|
;
|
|
TypeDefn0 = parse_tree_abstract_type(_)
|
|
% This type is already abstract.
|
|
;
|
|
TypeDefn0 = parse_tree_solver_type(_),
|
|
% generate_pre_grab_pre_qual_items_imp should have already made
|
|
% this type abstract.
|
|
unexpected($pred, "solver type should have been made abstract")
|
|
).
|
|
|
|
:- pred add_type_defn_items(list(item_type_defn_info)::in,
|
|
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out) is det.
|
|
|
|
add_type_defn_items([], !RevImpTypeDefns, !ImpImplicitFIMLangs).
|
|
add_type_defn_items([ImpTypeDefn | ImpTypeDefns],
|
|
!RevImpTypeDefns, !ImpImplicitFIMLangs) :-
|
|
!:RevImpTypeDefns = [ImpTypeDefn | !.RevImpTypeDefns],
|
|
ImpTypeDefn = item_type_defn_info(_, _, TypeDefn, _, _, _),
|
|
( if
|
|
TypeDefn = parse_tree_foreign_type(DetailsForeign),
|
|
DetailsForeign = type_details_foreign(ForeignType, _, _)
|
|
then
|
|
set.insert(foreign_type_language(ForeignType), !ImpImplicitFIMLangs)
|
|
else
|
|
true
|
|
),
|
|
add_type_defn_items(ImpTypeDefns, !RevImpTypeDefns, !ImpImplicitFIMLangs).
|
|
|
|
%---------------------%
|
|
|
|
:- pred add_foreign_enum_item_if_needed(type_defn_map::in,
|
|
item_foreign_enum_info::in,
|
|
list(item_foreign_enum_info)::in, list(item_foreign_enum_info)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out) is det.
|
|
|
|
add_foreign_enum_item_if_needed(IntTypesMap, ForeignEnumItem,
|
|
!ImpForeignEnumItems, !ImpImplicitFIMLangs) :-
|
|
ForeignEnumItem = item_foreign_enum_info(Lang, TypeCtor, _, _, _),
|
|
( if
|
|
map.search(IntTypesMap, TypeCtor, Defns),
|
|
some_type_defn_is_non_abstract(Defns)
|
|
then
|
|
!:ImpForeignEnumItems = [ForeignEnumItem | !.ImpForeignEnumItems],
|
|
set.insert(Lang, !ImpImplicitFIMLangs)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred some_type_defn_is_non_abstract(list(item_type_defn_info)::in)
|
|
is semidet.
|
|
|
|
some_type_defn_is_non_abstract([Defn | Defns]) :-
|
|
Defn = item_type_defn_info(_, _, Body, _, _, _),
|
|
( if Body = parse_tree_abstract_type(_) then
|
|
some_type_defn_is_non_abstract(Defns)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% generate_interface_int2(Globals, AugCompUnit,
|
|
% IntInclModuleNames, IntImportsUses,
|
|
% IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
|
|
% IntTypeDefnItems, IntInstDefns, IntModeDefns,
|
|
% IntTypeClasses, IntInstances, ImpTypeDefnItems, TypeCtorCheckedMap,
|
|
% ParseTreeInt2):
|
|
%
|
|
% The input arguments should be the relevant parts of the .int1 file
|
|
% computed by our parent.
|
|
%
|
|
:- pred generate_interface_int2(globals::in, aug_compilation_unit::in,
|
|
set(module_name)::in, set(module_name)::in,
|
|
set(fim_spec)::in, set(fim_spec)::in,
|
|
list(item_type_defn_info)::in,
|
|
list(item_inst_defn_info)::in, list(item_mode_defn_info)::in,
|
|
list(item_typeclass_info)::in, list(item_instance_info)::in,
|
|
list(item_type_defn_info)::in,
|
|
type_ctor_checked_map::in, parse_tree_int2::out) is det.
|
|
|
|
generate_interface_int2(Globals, AugCompUnit,
|
|
IntInclModuleNames, IntImportsUses,
|
|
IntExplicitFIMSpecs, ImpExplicitFIMSpecs,
|
|
IntTypeDefns, IntInstDefns, IntModeDefns, IntTypeClasses, IntInstances,
|
|
ImpTypeDefns, TypeCtorCheckedMap, ParseTreeInt2) :-
|
|
AugCompUnit = aug_compilation_unit(ModuleName, ModuleNameContext,
|
|
_ModuleVersionNumbers, _SrcItemBlocks,
|
|
_DirectIntItemBlocks, _IndirectIntItemBlocks,
|
|
_OptItemBlocks, _IntForOptItemBlocks),
|
|
|
|
some [!UnqualSymNames, !UsedModuleNames] (
|
|
!:UnqualSymNames = no_unqual_symnames,
|
|
set.init(!:UsedModuleNames),
|
|
|
|
get_int2_items_from_int1_int_type_defn(IntTypeDefns,
|
|
!UnqualSymNames, !UsedModuleNames,
|
|
cord.init, ShortIntTypeDefnsCord,
|
|
set.init, ShortIntImplicitFIMLangs),
|
|
get_int2_items_from_int1_int_inst_defn(IntInstDefns,
|
|
!UnqualSymNames, !UsedModuleNames),
|
|
get_int2_items_from_int1_int_mode_defn(IntModeDefns,
|
|
!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),
|
|
|
|
ShortIntTypeDefns = cord.list(ShortIntTypeDefnsCord),
|
|
ShortIntInstDefns = IntInstDefns,
|
|
ShortIntModeDefns = IntModeDefns,
|
|
ShortIntTypeClasses = cord.list(ShortIntTypeClassesCord),
|
|
ShortIntInstances = cord.list(ShortIntInstancesCord),
|
|
|
|
UnqualSymNames = !.UnqualSymNames,
|
|
UsedModuleNames = !.UsedModuleNames
|
|
),
|
|
|
|
get_int2_items_from_int1_imp_types(ImpTypeDefns,
|
|
set.init, ShortImpImplicitFIMLangs),
|
|
|
|
globals.lookup_bool_option(Globals, experiment1, Experiment1),
|
|
(
|
|
Experiment1 = no,
|
|
map.init(ShortIntTypeRepnMap)
|
|
;
|
|
Experiment1 = yes,
|
|
% XXX We should pass to decide_repns_for_simple_types not just
|
|
% the type definitions in this module, but also all the type_REPNs
|
|
% we have read in from the .int3 files of the imported modules.
|
|
% That would allow decide_repns_for_simple_types to take into
|
|
% account that an imported type (such as bool) is subword sized,
|
|
% and that therefore some types that have fields of that type
|
|
% may themselves be subword sized, if all their arguments are subword
|
|
% sized and there are few enough of them. (Note that will in general
|
|
% require fully expanding the relevant type equivalence chains.)
|
|
decide_repns_for_simple_types_for_int3(ModuleName, TypeCtorCheckedMap,
|
|
ShortIntTypeRepns),
|
|
ShortIntTypeRepnMap = type_ctor_repn_items_to_map(ShortIntTypeRepns)
|
|
),
|
|
|
|
(
|
|
UnqualSymNames = no_unqual_symnames,
|
|
% UsedModuleNames may contain references to implicitly imported
|
|
% builtin modules, which we do not want to *explicitly* import.
|
|
% Intersecting it with IntImportsUses deletes these.
|
|
set.intersect(UsedModuleNames, IntImportsUses, ShortIntUsedModuleNames)
|
|
;
|
|
UnqualSymNames = some_unqual_symnames,
|
|
% Since some item did not get fully qualified, the module has an error.
|
|
% If we deleted any element of IntImportsUses, a compiler invocation
|
|
% that read the .int2 file we are generating could print
|
|
% an error message that points the blame at that modification,
|
|
% rather than at the contents of the .m file we were given.
|
|
ShortIntUsedModuleNames = IntImportsUses
|
|
),
|
|
|
|
% 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,
|
|
|
|
% 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).
|
|
%
|
|
ShortImpTypeDefns = ImpTypeDefns,
|
|
|
|
ShortIntTypeDefnMap = type_ctor_defn_items_to_map(ShortIntTypeDefns),
|
|
ShortIntInstDefnMap = inst_ctor_defn_items_to_map(ShortIntInstDefns),
|
|
ShortIntModeDefnMap = mode_ctor_defn_items_to_map(ShortIntModeDefns),
|
|
ShortImpTypeDefnMap = type_ctor_defn_items_to_map(ShortImpTypeDefns),
|
|
|
|
ParseTreeInt2 = parse_tree_int2(ModuleName, ModuleNameContext,
|
|
DummyMaybeVersionNumbers,
|
|
IntInclModuleNames, ShortIntUsedModuleNames,
|
|
ShortIntFIMSpecs, ShortImpFIMSpecs,
|
|
ShortIntTypeDefnMap, ShortIntInstDefnMap, ShortIntModeDefnMap,
|
|
ShortIntTypeClasses, ShortIntInstances, ShortIntTypeRepnMap,
|
|
ShortImpTypeDefnMap).
|
|
|
|
%---------------------%
|
|
|
|
:- 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 get_int2_items_from_int1_int_type_defn(list(item_type_defn_info)::in,
|
|
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
|
|
set(module_name)::in, set(module_name)::out,
|
|
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out,
|
|
set(foreign_language)::in, set(foreign_language)::out) is det.
|
|
|
|
get_int2_items_from_int1_int_type_defn([],
|
|
!MaybeUnqual, !ModuleNames, !IntTypeDefnsCord, !IntImplicitFIMLangs).
|
|
get_int2_items_from_int1_int_type_defn([TypeDefnInfo0 | TypeDefnInfos0],
|
|
!MaybeUnqual, !ModuleNames, !IntTypeDefnsCord, !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.
|
|
cord.snoc(TypeDefnInfo, !IntTypeDefnsCord)
|
|
;
|
|
TypeDefn0 = parse_tree_solver_type(_),
|
|
% TypeDefnInfo cannot refer to other modules.
|
|
TypeDefn = parse_tree_abstract_type(abstract_solver_type),
|
|
TypeDefnInfo = TypeDefnInfo0 ^ td_ctor_defn := TypeDefn,
|
|
cord.snoc(TypeDefnInfo, !IntTypeDefnsCord)
|
|
;
|
|
TypeDefn0 = parse_tree_abstract_type(_),
|
|
% TypeDefnInfo0 cannot refer to other modules.
|
|
cord.snoc(TypeDefnInfo0, !IntTypeDefnsCord)
|
|
;
|
|
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,
|
|
cord.snoc(TypeDefnInfo, !IntTypeDefnsCord),
|
|
% 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),
|
|
cord.snoc(TypeDefnInfo0, !IntTypeDefnsCord),
|
|
DetailsEqv0 = type_details_eqv(EqvType0),
|
|
accumulate_modules_in_type(EqvType0, !MaybeUnqual, !ModuleNames)
|
|
),
|
|
get_int2_items_from_int1_int_type_defn(TypeDefnInfos0,
|
|
!MaybeUnqual, !ModuleNames, !IntTypeDefnsCord, !IntImplicitFIMLangs).
|
|
|
|
:- pred get_int2_items_from_int1_int_inst_defn(list(item_inst_defn_info)::in,
|
|
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_int2_items_from_int1_int_inst_defn([],
|
|
!MaybeUnqual, !ModuleNames).
|
|
get_int2_items_from_int1_int_inst_defn([InstDefnInfo | InstDefnInfos],
|
|
!MaybeUnqual, !ModuleNames) :-
|
|
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)
|
|
),
|
|
get_int2_items_from_int1_int_inst_defn(InstDefnInfos,
|
|
!MaybeUnqual, !ModuleNames).
|
|
|
|
:- pred get_int2_items_from_int1_int_mode_defn(list(item_mode_defn_info)::in,
|
|
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
get_int2_items_from_int1_int_mode_defn([],
|
|
!MaybeUnqual, !ModuleNames).
|
|
get_int2_items_from_int1_int_mode_defn([ModeDefnInfo | ModeDefnInfos],
|
|
!MaybeUnqual, !ModuleNames) :-
|
|
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)
|
|
),
|
|
get_int2_items_from_int1_int_mode_defn(ModeDefnInfos,
|
|
!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_instance_info)::in, cord(item_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),
|
|
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_items_from_int1_imp_types(list(item_type_defn_info)::in,
|
|
set(foreign_language)::in, set(foreign_language)::out) is det.
|
|
|
|
get_int2_items_from_int1_imp_types([], !ImpImplicitFIMLangs).
|
|
get_int2_items_from_int1_imp_types([ImpTypeDefn | ImpTypeDefns],
|
|
!ImpImplicitFIMLangs) :-
|
|
TypeDefn = ImpTypeDefn ^ td_ctor_defn,
|
|
( if TypeDefn = parse_tree_foreign_type(DetailsForeign) then
|
|
DetailsForeign = type_details_foreign(ForeignType, _, _),
|
|
Lang = foreign_type_language(ForeignType),
|
|
set.insert(Lang, !ImpImplicitFIMLangs)
|
|
else
|
|
true
|
|
),
|
|
get_int2_items_from_int1_imp_types(ImpTypeDefns, !ImpImplicitFIMLangs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% 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),
|
|
% 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).
|
|
delete_uc_preds_from_du_type(DetailsDu0, DetailsDu),
|
|
TypeDefn = parse_tree_du_type(DetailsDu),
|
|
ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := TypeDefn
|
|
;
|
|
TypeDefn0 = parse_tree_abstract_type(_AbstractDetails),
|
|
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 du_type_is_enum(DetailsDu, NumFunctors) then
|
|
num_bits_needed_for_n_values(NumFunctors, NumBits),
|
|
DetailsAbstract = abstract_type_fits_in_n_bits(NumBits)
|
|
else if du_type_is_notag(Ctors, MaybeCanonical) then
|
|
DetailsAbstract = abstract_notag_type
|
|
else if du_type_is_dummy(DetailsDu) then
|
|
DetailsAbstract = abstract_dummy_type
|
|
else
|
|
DetailsAbstract = abstract_type_general
|
|
).
|
|
|
|
:- 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))
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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 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_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(_PredOrFunc, ArgTypes,
|
|
_HOInstInfo, _Purity, _EvalMethod)
|
|
),
|
|
accumulate_modules_in_types(ArgTypes, !MaybeUnqual, !ModuleNames)
|
|
;
|
|
Type = kinded_type(ArgType, _Kind),
|
|
accumulate_modules_in_type(ArgType, !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 = free(Type),
|
|
accumulate_modules_in_type(Type, !MaybeUnqual, !ModuleNames)
|
|
;
|
|
Inst = bound(_Uniq, _InstTestsResults, BoundInsts),
|
|
accumulate_modules_in_bound_insts(BoundInsts,
|
|
!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)
|
|
;
|
|
Inst = abstract_inst(SymName, ArgInsts),
|
|
accumulate_module(SymName, !MaybeUnqual, !ModuleNames),
|
|
accumulate_modules_in_insts(ArgInsts, !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_inst(bound_inst::in,
|
|
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_in_bound_inst(BoundInst, !MaybeUnqual, !ModuleNames) :-
|
|
BoundInst = bound_functor(ConsId, ArgInsts),
|
|
( if ConsId = cons(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)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- 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_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_bound_insts(list(bound_inst)::in,
|
|
maybe_unqual_symnames::in, maybe_unqual_symnames::out,
|
|
set(module_name)::in, set(module_name)::out) is det.
|
|
|
|
accumulate_modules_in_bound_insts([], !MaybeUnqual, !ModuleNames).
|
|
accumulate_modules_in_bound_insts([BoundInst | BoundInsts],
|
|
!MaybeUnqual, !ModuleNames) :-
|
|
accumulate_modules_in_bound_inst(BoundInst, !MaybeUnqual, !ModuleNames),
|
|
accumulate_modules_in_bound_insts(BoundInsts, !MaybeUnqual, !ModuleNames).
|
|
|
|
:- 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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
% The rest of this module should not be needed.
|
|
%---------------------------------------------------------------------------%
|
|
|
|
make_foreign_import(ModuleName, Lang) = FIM :-
|
|
FIM = item_fim(Lang, ModuleName, term.context_init, -1).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.comp_unit_interface.
|
|
%---------------------------------------------------------------------------%
|