mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
mercury/compiler/intermod_decide.m
Zoltan Somogyi b560f66ab9 Move four modules from check_hlds.m to hlds.m. 
After this, I think all modules in the check_hlds package belong there.

compiler/inst_match.m:
compiler/mode_test.m:
    Move these modules from the check_hlds package to the hlds package
    because most of their uses are outside the semantic analysis passes
    that the check_hlds package is intended to contain.

compiler/inst_merge.m:
    Move this module from the check_hlds package to the hlds package
    because it is imported by only two modules, instmap.m and inst_match.m,
    and after this diff, both are in the hlds package.

compiler/implementation_defined_literals.m:
    Move this module from the check_hlds package to the hlds package
    because it does a straightforward program transformation that
    does not have anything to do with semantic analysis (though its
    invocation does happen between semantic analysis passes).

compiler/notes/compiler_design.html:
    Update the documentation of the goal_path.m module. (I checked the
    documentation of the moved modules, which did not need updates,
    and found the need for this instead.)

compiler/*.m:
    Conform to the changes above. (For many modules, this deletes
    their import of the check_hlds package itself.)
2026-02-27 15:16:44 +11:00

1253 lines
51 KiB
Mathematica
Raw Permalink Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2023-2026 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: intermod_decide.m.
% Main author: stayl (the original intermod.m).
%
% This module contains code to decide what entities we want to put into
% .opt files.
%
%---------------------------------------------------------------------------%
:- module transform_hlds.intermod_decide.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module transform_hlds.intermod_info.
% Decide what to output to a module's .opt file.
%
:- pred decide_what_to_opt_export(module_info::in, intermod_info::out) is det.
:- pred should_opt_export_type_defn(module_name::in, type_ctor::in,
hlds_type_defn::in) is semidet.
:- pred is_du_type_with_direct_arg_ctors(hlds_type_body::in) is semidet.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.foreign.
:- import_module hlds.goal_form.
:- import_module hlds.goal_refs.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_class.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_cons.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_promise.
:- import_module hlds.mode_test.
:- import_module hlds.pred_table.
:- import_module hlds.special_pred.
:- import_module hlds.status.
:- import_module hlds.type_util.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.optimization_options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_data_pragma.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.var_table.
:- import_module parse_tree.vartypes.
:- import_module transform_hlds.inlining.
:- import_module transform_hlds.intermod_status.
:- import_module bool.
:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
:- type intermod_params
---> intermod_params(
ip_maybe_process_local_preds :: maybe_process_local_preds,
ip_maybe_collect_types :: maybe_collect_types,
ip_maybe_deforest :: maybe_deforest,
ip_inline_simple_threshold :: int,
ip_higher_order_size_limit :: int
).
:- type maybe_collect_types
---> do_not_collect_types
; do_collect_types.
:- type maybe_process_local_preds
---> do_not_process_local_preds
; do_process_local_preds.
decide_what_to_opt_export(ModuleInfo, !:IntermodInfo) :-
module_info_get_globals(ModuleInfo, Globals),
globals.get_opt_tuple(Globals, OptTuple),
InlineSimpleThreshold = OptTuple ^ ot_intermod_inline_simple_threshold,
HigherOrderSizeLimit = OptTuple ^ ot_higher_order_size_limit,
Deforest = OptTuple ^ ot_deforest,
module_info_get_valid_pred_ids(ModuleInfo, RealPredIds),
module_info_get_assertion_table(ModuleInfo, AssertionTable),
assertion_table_pred_ids(AssertionTable, AssertPredIds),
PredIds = AssertPredIds ++ RealPredIds,
Params = intermod_params(do_not_process_local_preds, do_collect_types,
Deforest, InlineSimpleThreshold, HigherOrderSizeLimit),
init_intermod_info(ModuleInfo, !:IntermodInfo),
gather_opt_export_preds(Params, PredIds, !IntermodInfo),
gather_opt_export_instances(!IntermodInfo),
gather_opt_export_types(!IntermodInfo).
%---------------------------------------------------------------------------%
:- pred gather_opt_export_preds(intermod_params::in, list(pred_id)::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_preds(Params0, AllPredIds, !IntermodInfo) :-
% First gather exported preds.
gather_opt_export_preds_in_list(Params0, AllPredIds, !IntermodInfo),
% Then gather preds used by exported preds (recursively).
Params = Params0 ^ ip_maybe_process_local_preds := do_process_local_preds,
set.init(ExtraExportedPreds0),
gather_opt_export_preds_fixpoint(Params, ExtraExportedPreds0,
!IntermodInfo).
:- pred gather_opt_export_preds_fixpoint(intermod_params::in, set(pred_id)::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_preds_fixpoint(Params, ExtraExportedPreds0, !IntermodInfo) :-
intermod_info_get_pred_decls(!.IntermodInfo, ExtraExportedPreds),
NewlyExportedPreds = set.to_sorted_list(
set.difference(ExtraExportedPreds, ExtraExportedPreds0)),
(
NewlyExportedPreds = []
;
NewlyExportedPreds = [_ | _],
gather_opt_export_preds_in_list(Params, NewlyExportedPreds,
!IntermodInfo),
gather_opt_export_preds_fixpoint(Params, ExtraExportedPreds,
!IntermodInfo)
).
:- pred gather_opt_export_preds_in_list(intermod_params::in, list(pred_id)::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_preds_in_list(_, [], !IntermodInfo).
gather_opt_export_preds_in_list(Params, [PredId | PredIds], !IntermodInfo) :-
intermod_info_get_module_info(!.IntermodInfo, ModuleInfo),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
module_info_get_type_spec_tables(ModuleInfo, TypeSpecTables),
TypeSpecTables = type_spec_tables(_, TypeSpecForcePreds, _, _),
pred_info_get_clauses_info(PredInfo, ClausesInfo),
( if
clauses_info_get_explicit_vartypes(ClausesInfo, ExplicitVarTypes),
vartypes_is_empty(ExplicitVarTypes),
should_opt_export_pred(ModuleInfo, PredId, PredInfo,
Params, TypeSpecForcePreds)
then
SavedIntermodInfo = !.IntermodInfo,
% Write a declaration to the `.opt' file for
% `exported_to_submodules' predicates.
intermod_add_pred(PredId, MayOptExportPred0, !IntermodInfo),
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
(
MayOptExportPred0 = may_opt_export_pred,
get_clause_list_for_replacement(ClausesRep, Clauses),
gather_entities_to_opt_export_in_clauses(Clauses,
MayOptExportPred, !IntermodInfo)
;
MayOptExportPred0 = may_not_opt_export_pred,
MayOptExportPred = may_not_opt_export_pred
),
(
MayOptExportPred = may_opt_export_pred,
( if pred_info_defn_has_foreign_proc(PredInfo) then
% The foreign code of this predicate may refer to entities
% in the foreign language that are defined in a foreign module
% that is imported by a foreign_import_module declaration.
intermod_info_set_need_foreign_import_modules(!IntermodInfo)
else
true
),
intermod_info_get_pred_defns(!.IntermodInfo, PredDefns0),
set.insert(PredId, PredDefns0, PredDefns),
intermod_info_set_pred_defns(PredDefns, !IntermodInfo)
;
MayOptExportPred = may_not_opt_export_pred,
% Remove any items added for the clauses for this predicate.
!:IntermodInfo = SavedIntermodInfo
)
else
true
),
gather_opt_export_preds_in_list(Params, PredIds, !IntermodInfo).
:- pred should_opt_export_pred(module_info::in, pred_id::in, pred_info::in,
intermod_params::in, set(pred_id)::in) is semidet.
should_opt_export_pred(ModuleInfo, PredId, PredInfo,
Params, TypeSpecForcePreds) :-
ProcessLocalPreds = Params ^ ip_maybe_process_local_preds,
(
ProcessLocalPreds = do_not_process_local_preds,
( pred_info_is_exported(PredInfo)
; pred_info_is_exported_to_submodules(PredInfo)
)
;
ProcessLocalPreds = do_process_local_preds,
pred_info_get_status(PredInfo, pred_status(status_local))
),
(
% Allow all promises to be opt-exported.
% (may_opt_export_pred should succeed for all promises.)
pred_info_is_promise(PredInfo, _)
;
may_opt_export_pred(PredId, PredInfo, TypeSpecForcePreds),
opt_exporting_pred_is_likely_worthwhile(Params, ModuleInfo,
PredId, PredInfo)
).
:- pred opt_exporting_pred_is_likely_worthwhile(intermod_params::in,
module_info::in, pred_id::in, pred_info::in) is semidet.
opt_exporting_pred_is_likely_worthwhile(Params, ModuleInfo,
PredId, PredInfo) :-
pred_info_get_clauses_info(PredInfo, ClauseInfo),
clauses_info_get_clauses_rep(ClauseInfo, ClausesRep, _ItemNumbers),
get_clause_list_maybe_repeated(ClausesRep, Clauses),
% At this point, the goal size includes some dummy unifications
% HeadVar1 = X, HeadVar2 = Y, etc. which will be optimized away
% later. To account for this, we add the arity to the size thresholds.
pred_info_get_orig_arity(PredInfo, pred_form_arity(Arity)),
(
inlining.is_simple_clause_list(Clauses,
Params ^ ip_inline_simple_threshold + Arity)
;
pred_info_requested_inlining(PredInfo)
;
% Mutable access preds should always be included in .opt files.
pred_info_get_markers(PredInfo, Markers),
marker_is_present(Markers, marker_mutable_access_pred)
;
pred_has_a_higher_order_input_arg(ModuleInfo, PredInfo),
clause_list_size(Clauses, GoalSize),
GoalSize =< Params ^ ip_higher_order_size_limit + Arity
;
Params ^ ip_maybe_deforest = deforest,
% Double the inline-threshold since goals we want to deforest
% will have at least two disjuncts. This allows one simple goal
% in each disjunct. The disjunction adds one to the goal size,
% hence the `+1'.
DeforestThreshold = (Params ^ ip_inline_simple_threshold * 2) + 1,
inlining.is_simple_clause_list(Clauses, DeforestThreshold + Arity),
clause_list_is_deforestable(PredId, Clauses)
).
:- pred may_opt_export_pred(pred_id::in, pred_info::in, set(pred_id)::in)
is semidet.
may_opt_export_pred(PredId, PredInfo, TypeSpecForcePreds) :-
% Predicates with `class_method' markers contain class_method_call
% goals which cannot be written to `.opt' files (they cannot be read
% back in). They will be recreated in the importing module.
pred_info_get_markers(PredInfo, Markers),
not marker_is_present(Markers, marker_class_method),
not marker_is_present(Markers, marker_class_instance_method),
% Don't write stub clauses to `.opt' files.
not marker_is_present(Markers, marker_stub),
% Don't export builtins, since they will be recreated in the
% importing module anyway.
not is_unify_index_or_compare_pred(PredInfo),
not pred_info_is_builtin(PredInfo),
% These will be recreated in the importing module.
not set.member(PredId, TypeSpecForcePreds),
% Don't export non-inlinable predicates.
not marker_is_present(Markers, marker_user_marked_no_inline),
not marker_is_present(Markers, marker_mmc_marked_no_inline),
% Don't export tabled predicates, since they are not inlinable.
pred_info_get_proc_table(PredInfo, ProcTable),
map.values(ProcTable, ProcInfos),
list.all_true(proc_eval_method_is_normal, ProcInfos).
:- pred proc_eval_method_is_normal(proc_info::in) is semidet.
proc_eval_method_is_normal(ProcInfo) :-
proc_info_get_eval_method(ProcInfo, eval_normal).
:- pred gather_entities_to_opt_export_in_clauses(list(clause)::in,
may_opt_export_pred::out, intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_clauses([], may_opt_export_pred,
!IntermodInfo).
gather_entities_to_opt_export_in_clauses([Clause | Clauses], MayOptExportPred,
!IntermodInfo) :-
gather_entities_to_opt_export_in_goal(Clause ^ clause_body,
MayOptExportPred1, !IntermodInfo),
(
MayOptExportPred1 = may_opt_export_pred,
gather_entities_to_opt_export_in_clauses(Clauses,
MayOptExportPred, !IntermodInfo)
;
MayOptExportPred1 = may_not_opt_export_pred,
MayOptExportPred = may_not_opt_export_pred
).
:- pred pred_has_a_higher_order_input_arg(module_info::in, pred_info::in)
is semidet.
pred_has_a_higher_order_input_arg(ModuleInfo, PredInfo) :-
pred_info_get_proc_table(PredInfo, ProcTable),
map.values(ProcTable, ProcInfos),
list.find_first_match(proc_has_a_higher_order_input_arg(ModuleInfo),
ProcInfos, _FirstProcInfoWithHoInput).
:- pred proc_has_a_higher_order_input_arg(module_info::in, proc_info::in)
is semidet.
proc_has_a_higher_order_input_arg(ModuleInfo, ProcInfo) :-
proc_info_get_headvars(ProcInfo, HeadVars),
proc_info_get_argmodes(ProcInfo, ArgModes),
proc_info_get_var_table(ProcInfo, VarTable),
some_input_arg_is_higher_order(ModuleInfo, VarTable, HeadVars, ArgModes).
:- pred some_input_arg_is_higher_order(module_info::in, var_table::in,
list(prog_var)::in, list(mer_mode)::in) is semidet.
some_input_arg_is_higher_order(ModuleInfo, VarTable,
[HeadVar | HeadVars], [ArgMode | ArgModes]) :-
( if
mode_is_input(ModuleInfo, ArgMode),
lookup_var_type(VarTable, HeadVar, Type),
classify_type(ModuleInfo, Type) = ctor_cat_higher_order
then
true
else
some_input_arg_is_higher_order(ModuleInfo, VarTable,
HeadVars, ArgModes)
).
% Rough guess: a goal is deforestable if it contains a single
% top-level branched goal and is recursive.
%
:- pred clause_list_is_deforestable(pred_id::in, list(clause)::in) is semidet.
clause_list_is_deforestable(PredId, Clauses) :-
some [Clause1] (
list.member(Clause1, Clauses),
Goal1 = Clause1 ^ clause_body,
goal_calls_pred_id(Goal1, PredId)
),
(
Clauses = [_, _ | _]
;
Clauses = [Clause2],
Goal2 = Clause2 ^ clause_body,
goal_to_conj_list(Goal2, GoalList),
goal_contains_one_branched_goal(GoalList)
).
:- pred goal_contains_one_branched_goal(list(hlds_goal)::in) is semidet.
goal_contains_one_branched_goal(GoalList) :-
goal_contains_one_branched_goal_acc(GoalList, no).
:- pred goal_contains_one_branched_goal_acc(list(hlds_goal)::in, bool::in)
is semidet.
goal_contains_one_branched_goal_acc([], yes).
goal_contains_one_branched_goal_acc([Goal | Goals], FoundBranch0) :-
Goal = hlds_goal(GoalExpr, _),
(
goal_is_branched(GoalExpr),
FoundBranch0 = no,
FoundBranch = yes
;
goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals,
FoundBranch = FoundBranch0
),
goal_contains_one_branched_goal_acc(Goals, FoundBranch).
% Go over the goal of an exported proc looking for proc decls, types,
% insts and modes that we need to write to the optfile.
%
:- pred gather_entities_to_opt_export_in_goal(hlds_goal::in,
may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_goal(Goal, MayOptExportPred, !IntermodInfo) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
gather_entities_to_opt_export_in_goal_expr(GoalExpr, MayOptExportPred,
!IntermodInfo).
:- pred gather_entities_to_opt_export_in_goal_expr(hlds_goal_expr::in,
may_opt_export_pred::out, intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_goal_expr(GoalExpr, MayOptExportPred,
!IntermodInfo) :-
(
GoalExpr = unify(_LHSVar, RHS, _Mode, _Kind, _UnifyContext),
% Export declarations for preds used in higher order pred constants
% or function calls.
gather_entities_to_opt_export_in_unify_rhs(RHS, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = plain_call(PredId, _, _, _, _, _),
% Ensure that the called predicate will be exported.
intermod_add_pred(PredId, MayOptExportPred, !IntermodInfo)
;
GoalExpr = generic_call(CallType, _, _, _, _),
(
CallType = higher_order(_, _, _, _, _),
MayOptExportPred = may_opt_export_pred
;
CallType = class_method(_, _, _, _),
MayOptExportPred = may_not_opt_export_pred
;
CallType = event_call(_),
MayOptExportPred = may_not_opt_export_pred
;
CallType = cast(CastType),
(
( CastType = unsafe_type_cast
; CastType = unsafe_type_inst_cast
; CastType = equiv_type_cast
; CastType = exists_cast
),
MayOptExportPred = may_not_opt_export_pred
;
CastType = subtype_coerce,
MayOptExportPred = may_opt_export_pred
)
)
;
GoalExpr = call_foreign_proc(Attrs, _, _, _, _, _, _),
% Inlineable exported pragma_foreign_code goals cannot use any
% non-exported types, so we just write out the clauses.
MaybeMayDuplicate = get_may_duplicate(Attrs),
MaybeMayExportBody = get_may_export_body(Attrs),
( if
( MaybeMayDuplicate = yes(proc_may_not_duplicate)
; MaybeMayExportBody = yes(proc_may_not_export_body)
)
then
MayOptExportPred = may_not_opt_export_pred
else
MayOptExportPred = may_opt_export_pred
)
;
GoalExpr = conj(_ConjType, Goals),
gather_entities_to_opt_export_in_goals(Goals, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = disj(Goals),
gather_entities_to_opt_export_in_goals(Goals, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = switch(_Var, _CanFail, Cases),
gather_entities_to_opt_export_in_cases(Cases, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
gather_entities_to_opt_export_in_goal(Cond, MayOptExportPredCond,
!IntermodInfo),
gather_entities_to_opt_export_in_goal(Then, MayOptExportPredThen,
!IntermodInfo),
gather_entities_to_opt_export_in_goal(Else, MayOptExportPredElse,
!IntermodInfo),
( if
MayOptExportPredCond = may_opt_export_pred,
MayOptExportPredThen = may_opt_export_pred,
MayOptExportPredElse = may_opt_export_pred
then
MayOptExportPred = may_opt_export_pred
else
MayOptExportPred = may_not_opt_export_pred
)
;
GoalExpr = negation(SubGoal),
gather_entities_to_opt_export_in_goal(SubGoal, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = scope(_Reason, SubGoal),
% Mode analysis hasn't been run yet, so we don't know yet whether
% from_ground_term_construct scopes actually satisfy their invariants,
% specifically the invariant that say they contain no calls or
% higher-order constants. We therefore cannot special-case them here.
%
% XXX Actually it wouldn't be hard to arrange to get this code to run
% *after* mode analysis.
gather_entities_to_opt_export_in_goal(SubGoal, MayOptExportPred,
!IntermodInfo)
;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_GoalType, _Outer, _Inner,
_MaybeOutputVars, MainGoal, OrElseGoals, _OrElseInners),
gather_entities_to_opt_export_in_goal(MainGoal,
MayOptExportPredMain, !IntermodInfo),
gather_entities_to_opt_export_in_goals(OrElseGoals,
MayOptExportPredOrElse, !IntermodInfo),
( if
MayOptExportPredMain = may_opt_export_pred,
MayOptExportPredOrElse = may_opt_export_pred
then
MayOptExportPred = may_opt_export_pred
else
MayOptExportPred = may_not_opt_export_pred
)
;
ShortHand = try_goal(_MaybeIO, _ResultVar, _SubGoal),
% hlds_out_goal.m does not write out `try' goals properly.
MayOptExportPred = may_not_opt_export_pred
;
ShortHand = bi_implication(_, _),
% These should have been expanded out by now.
unexpected($pred, "bi_implication")
)
).
:- pred gather_entities_to_opt_export_in_goals(list(hlds_goal)::in,
may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_goals([], may_opt_export_pred, !IntermodInfo).
gather_entities_to_opt_export_in_goals([Goal | Goals], !:MayOptExportPred,
!IntermodInfo) :-
gather_entities_to_opt_export_in_goal(Goal, !:MayOptExportPred,
!IntermodInfo),
(
!.MayOptExportPred = may_opt_export_pred,
gather_entities_to_opt_export_in_goals(Goals, !:MayOptExportPred,
!IntermodInfo)
;
!.MayOptExportPred = may_not_opt_export_pred
).
:- pred gather_entities_to_opt_export_in_cases(list(case)::in,
may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_cases([], may_opt_export_pred, !IntermodInfo).
gather_entities_to_opt_export_in_cases([Case | Cases], !:MayOptExportPred,
!IntermodInfo) :-
Case = case(_MainConsId, _OtherConsIds, Goal),
gather_entities_to_opt_export_in_goal(Goal, !:MayOptExportPred,
!IntermodInfo),
(
!.MayOptExportPred = may_opt_export_pred,
gather_entities_to_opt_export_in_cases(Cases, !:MayOptExportPred,
!IntermodInfo)
;
!.MayOptExportPred = may_not_opt_export_pred
).
%---------------------------------------------------------------------------%
:- type may_opt_export_pred
---> may_not_opt_export_pred
; may_opt_export_pred.
% intermod_add_pred/4 tries to do what ever is necessary to ensure that the
% specified predicate will be exported, so that it can be called from
% clauses in the `.opt' file. If it can't, then it returns
% MayOptExportPred = may_not_opt_export_pred,
% which will prevent the caller from being included in the `.opt' file.
%
% If a proc called within an exported proc is local, we need to add
% a declaration for the called proc to the .opt file. If a proc called
% within an exported proc is from a different module, we need to include
% an `:- import_module' declaration to import that module in the `.opt'
% file.
%
:- pred intermod_add_pred(pred_id::in, may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
intermod_add_pred(PredId, MayOptExportPred, !IntermodInfo) :-
( if PredId = invalid_pred_id then
% This will happen for type class instance methods defined using
% the clause syntax. Currently we cannot handle intermodule
% optimization of those.
MayOptExportPred = may_not_opt_export_pred
else
intermod_do_add_pred(PredId, MayOptExportPred, !IntermodInfo)
).
:- pred intermod_do_add_pred(pred_id::in, may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
intermod_do_add_pred(PredId, MayOptExportPred, !IntermodInfo) :-
intermod_info_get_module_info(!.IntermodInfo, ModuleInfo),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_status(PredInfo, PredStatus),
pred_info_get_markers(PredInfo, Markers),
( if
% Calling compiler-generated procedures is fine; we don't need
% to output declarations for them to the `.opt' file, since they
% will be recreated every time anyway. We don't want declarations
% for predicates representing promises either.
( is_unify_index_or_compare_pred(PredInfo)
; pred_info_is_promise(PredInfo, _)
)
then
MayOptExportPred = may_opt_export_pred
else if
% Don't write the caller to the `.opt' file if it calls a pred
% without mode or determinism decls, because then we would need
% to include the mode decls for the callee in the `.opt' file and
% (since writing the `.opt' file happens before mode inference)
% we can't do that because we don't know what the modes are.
%
% XXX This prevents intermodule optimizations in such cases,
% which is a pity.
%
% XXX Actually it wouldn't be hard to arrange to get this code to run
% *after* mode analysis, so this restriction is likely to be
% unnecessary.
(
marker_is_present(Markers, marker_infer_modes)
;
pred_info_get_proc_table(PredInfo, Procs),
ProcIds = pred_info_all_procids(PredInfo),
list.member(ProcId, ProcIds),
map.lookup(Procs, ProcId, ProcInfo),
proc_info_get_declared_determinism(ProcInfo, no)
)
then
MayOptExportPred = may_not_opt_export_pred
else if
% Goals which call impure predicates cannot be written due to
% limitations in mode analysis. The problem is that only head
% unifications are allowed to be reordered with impure goals.
% For example,
%
% p(A::in, B::in, C::out) :- impure foo(A, B, C).
%
% becomes
%
% p(HeadVar1, HeadVar2, HeadVar3) :-
% A = HeadVar1, B = HeadVar2, C = HeadVar3,
% impure foo(A, B, C).
%
% In the clauses written to `.opt' files, the head unifications
% are already expanded, and are expanded again when the `.opt' file
% is read in. The `C = HeadVar3' unification cannot be reordered
% with the impure goal, resulting in a mode error. Fixing this
% in mode analysis would be tricky.
% See tests/valid/impure_intermod.m.
%
% NOTE: the above restriction applies to user predicates.
% For compiler generated mutable access predicates, we can ensure
% that reordering is not necessary by construction, so it is safe
% to include them in .opt files.
pred_info_get_purity(PredInfo, purity_impure),
not marker_is_present(Markers, marker_mutable_access_pred)
then
MayOptExportPred = may_not_opt_export_pred
else if
% If a pred whose code we are going to put in the .opt file calls
% a predicate which is exported, then we do not need to do anything
% special.
(
PredStatus = pred_status(status_exported)
;
PredStatus = pred_status(status_external(OldExternalStatus)),
old_status_is_exported(OldExternalStatus) = yes
)
then
MayOptExportPred = may_opt_export_pred
else if
% Declarations for class methods will be recreated from the class
% declaration in the `.opt' file. Declarations for local classes
% are always written to the `.opt' file.
pred_info_get_markers(PredInfo, Markers),
marker_is_present(Markers, marker_class_method)
then
MayOptExportPred = may_opt_export_pred
else if
% If a pred whose code we are going to put in the `.opt' file calls
% a predicate which is local to that module, then we need to put
% the declaration for the called predicate in the `.opt' file.
pred_status_to_write(PredStatus) = yes
then
MayOptExportPred = may_opt_export_pred,
intermod_info_get_pred_decls(!.IntermodInfo, PredDecls0),
set.insert(PredId, PredDecls0, PredDecls),
intermod_info_set_pred_decls(PredDecls, !IntermodInfo)
else if
( PredStatus = pred_status(status_imported(_))
; PredStatus = pred_status(status_opt_imported)
)
then
% Imported pred - add import for module.
MayOptExportPred = may_opt_export_pred,
PredModule = pred_info_module(PredInfo),
intermod_info_get_use_modules(!.IntermodInfo, Modules0),
set.insert(PredModule, Modules0, Modules),
intermod_info_set_use_modules(Modules, !IntermodInfo)
else
unexpected($pred, "unexpected status")
).
% Resolve overloading and module qualify everything in a unify_rhs.
% Fully module-qualify the right-hand-side of a unification.
% For function calls and higher-order terms, call intermod_add_pred
% so that the predicate or function will be exported if necessary.
%
:- pred gather_entities_to_opt_export_in_unify_rhs(unify_rhs::in,
may_opt_export_pred::out,
intermod_info::in, intermod_info::out) is det.
gather_entities_to_opt_export_in_unify_rhs(RHS, MayOptExportPred,
!IntermodInfo) :-
(
RHS = rhs_var(_),
MayOptExportPred = may_opt_export_pred
;
RHS = rhs_lambda_goal(_Purity, _HOGroundness, _PorF, _NonLocals,
_ArgVarsModes, _Detism, Goal),
gather_entities_to_opt_export_in_goal(Goal, MayOptExportPred,
!IntermodInfo)
;
RHS = rhs_functor(Functor, _Exist, _Vars),
% Is this a higher-order predicate or higher-order function term?
( if Functor = closure_cons(ShroudedPredProcId) then
% Yes, the unification creates a higher-order term.
% Make sure that the predicate/function is exported.
proc(PredId, _) = unshroud_pred_proc_id(ShroudedPredProcId),
intermod_add_pred(PredId, MayOptExportPred, !IntermodInfo)
else
% It is an ordinary constructor, or a constant of a builtin type,
% so just leave it alone.
%
% Function calls and higher-order function applications
% are transformed into ordinary calls and higher-order calls
% by post_typecheck.m, so they cannot occur here.
MayOptExportPred = may_opt_export_pred
)
).
%---------------------------------------------------------------------------%
:- pred gather_opt_export_instances(intermod_info::in, intermod_info::out)
is det.
gather_opt_export_instances(!IntermodInfo) :-
intermod_info_get_module_info(!.IntermodInfo, ModuleInfo),
module_info_get_instance_table(ModuleInfo, Instances),
map.foldl(gather_opt_export_instances_in_class(ModuleInfo), Instances,
!IntermodInfo).
:- pred gather_opt_export_instances_in_class(module_info::in,
class_id::in, list(hlds_instance_defn)::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_instances_in_class(ModuleInfo, ClassId, InstanceDefns,
!IntermodInfo) :-
list.foldl(
gather_opt_export_instance_in_instance_defn(ModuleInfo, ClassId),
InstanceDefns, !IntermodInfo).
:- pred gather_opt_export_instance_in_instance_defn(module_info::in,
class_id::in, hlds_instance_defn::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_instance_in_instance_defn(ModuleInfo, ClassId, InstanceDefn,
!IntermodInfo) :-
InstanceDefn = hlds_instance_defn(ModuleName, InstanceStatus,
TVarSet, OriginalTypes, Types,
InstanceConstraints, MaybeSubsumedContext, Proofs,
InstanceBody0, MaybeMethodInfos, Context),
DefinedThisModule = instance_status_defined_in_this_module(InstanceStatus),
(
DefinedThisModule = yes,
% The bodies are always stripped from instance declarations
% before writing them to *.int* files, so the full instance
% declaration should be written to the .opt file even for
% exported instances, if this is possible.
SavedIntermodInfo = !.IntermodInfo,
(
InstanceBody0 = instance_body_concrete(Methods0),
(
MaybeMethodInfos = yes(MethodInfos)
;
MaybeMethodInfos = no,
unexpected($pred, "method infos not filled in")
),
AddMethodInfoToMap =
( pred(MI::in, Map0::in, Map::out) is det :-
MethodName = MI ^ method_pred_name,
proc(PredId, _) = MI ^ method_orig_proc,
( if map.insert(MethodName, PredId, Map0, Map1) then
Map = Map1
else
Map = Map0
)
),
list.foldl(AddMethodInfoToMap, MethodInfos, map.init,
MethodNameToPredIdMap),
list.map_foldl(
intermod_qualify_instance_method(ModuleInfo,
MethodNameToPredIdMap),
Methods0, Methods, [], PredIds),
list.map_foldl(intermod_add_pred, PredIds, MethodMayOptExportPreds,
!IntermodInfo),
( if
list.all_true(unify(may_opt_export_pred),
MethodMayOptExportPreds)
then
InstanceBody = instance_body_concrete(Methods)
else
% Write an abstract instance declaration if any of the methods
% cannot be written to the `.opt' file for any reason.
InstanceBody = instance_body_abstract,
% Do not write declarations for any of the methods if one
% cannot be written.
!:IntermodInfo = SavedIntermodInfo
)
;
InstanceBody0 = instance_body_abstract,
InstanceBody = InstanceBody0
),
( if
% Don't write an abstract instance declaration
% if the declaration is already in the `.int' file.
(
InstanceBody = instance_body_abstract
=>
instance_status_is_exported(InstanceStatus) = no
)
then
InstanceDefnToWrite = hlds_instance_defn(ModuleName,
InstanceStatus, TVarSet, OriginalTypes, Types,
InstanceConstraints, MaybeSubsumedContext, Proofs,
InstanceBody, MaybeMethodInfos, Context),
intermod_info_get_instances(!.IntermodInfo, Instances0),
Instances = [ClassId - InstanceDefnToWrite | Instances0],
intermod_info_set_instances(Instances, !IntermodInfo)
else
true
)
;
DefinedThisModule = no
).
% Resolve overloading of instance methods before writing them
% to the `.opt' file.
%
:- pred intermod_qualify_instance_method(module_info::in,
map(pred_pf_name_arity, pred_id)::in,
instance_method::in, instance_method::out,
list(pred_id)::in, list(pred_id)::out) is det.
intermod_qualify_instance_method(ModuleInfo, MethodNameToPredIdMap,
InstanceMethod0, InstanceMethod, PredIds0, PredIds) :-
InstanceMethod0 = instance_method(MethodName, InstanceMethodDefn0,
MethodContext),
MethodName =
pred_pf_name_arity(PredOrFunc, _MethodSymName, MethodUserArity),
map.lookup(MethodNameToPredIdMap, MethodName, MethodPredId),
module_info_pred_info(ModuleInfo, MethodPredId, MethodPredInfo),
pred_info_get_arg_types(MethodPredInfo, MethodTVarSet,
MethodExistQTVars, MethodArgTypes),
pred_info_get_external_type_params(MethodPredInfo,
MethodExternalTypeParams),
(
InstanceMethodDefn0 = instance_proc_def_name(InstanceMethodName0),
PredOrFunc = pf_function,
( if
find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
MethodUserArity, MethodTVarSet, MethodExistQTVars,
MethodArgTypes, MethodExternalTypeParams,
MethodContext, MaybePredId, InstanceMethodName)
then
(
MaybePredId = yes(PredId),
PredIds = [PredId | PredIds0]
;
MaybePredId = no,
PredIds = PredIds0
),
InstanceMethodDefn = instance_proc_def_name(InstanceMethodName)
else
% This will force intermod_add_pred to return
% MayOptExportPred = may_not_opt_export_pred.
PredId = invalid_pred_id,
PredIds = [PredId | PredIds0],
% We can just leave the method definition unchanged.
InstanceMethodDefn = InstanceMethodDefn0
)
;
InstanceMethodDefn0 = instance_proc_def_name(InstanceMethodName0),
PredOrFunc = pf_predicate,
init_markers(Markers),
resolve_pred_overloading(ModuleInfo, Markers, MethodTVarSet,
MethodExistQTVars, MethodArgTypes,
MethodExternalTypeParams, MethodContext,
InstanceMethodName0, InstanceMethodName, PredId, _ResolveSpecs),
% Any errors in _ResolveSpecs will be reported when a later compiler
% invocation attempts to generate target language code for this module.
PredIds = [PredId | PredIds0],
InstanceMethodDefn = instance_proc_def_name(InstanceMethodName)
;
InstanceMethodDefn0 = instance_proc_def_clauses(_ItemList),
% XXX For methods defined using this syntax it is a little tricky
% to write out the .opt files, so for now I've just disabled
% intermodule optimization for type class instance declarations
% using the new syntax.
%
% This will force intermod_add_pred to return
% MayOptExportPred = may_not_opt_export_pred.
PredId = invalid_pred_id,
PredIds = [PredId | PredIds0],
% We can just leave the method definition unchanged.
InstanceMethodDefn = InstanceMethodDefn0
),
InstanceMethod = instance_method(MethodName, InstanceMethodDefn,
MethodContext).
% A `func(x/n) is y' method implementation can match an ordinary function,
% a field access function or a constructor. For now, if there are multiple
% possible matches, we don't write the instance method.
%
:- pred find_func_matching_instance_method(module_info::in, sym_name::in,
user_arity::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
external_type_params::in, prog_context::in, maybe(pred_id)::out,
sym_name::out) is semidet.
find_func_matching_instance_method(ModuleInfo, InstanceMethodSymName0,
MethodUserArity, MethodCallTVarSet, MethodCallExistQTVars,
MethodCallArgTypes, MethodCallExternalTypeParams, MethodContext,
MaybePredId, InstanceMethodSymName) :-
MethodUserArity = user_arity(MethodUserArityInt),
( if
% XXX ARITY is_field_access_function_name can take user_arity
% XXX ARITY is_field_access_function_name can return FieldDefns
is_field_access_function_name(ModuleInfo, InstanceMethodSymName0,
MethodUserArityInt, _AccessType, _FieldName, OoMFieldDefns)
then
FieldDefns = one_or_more_to_list(OoMFieldDefns),
TypeCtors0 = list.map(
( func(FieldDefn) = TypeCtor :-
FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, _, _)
), FieldDefns)
else
TypeCtors0 = []
),
module_info_get_cons_table(ModuleInfo, Ctors),
DuCtor = du_ctor(InstanceMethodSymName0, MethodUserArityInt,
cons_id_dummy_type_ctor),
( if search_cons_table(Ctors, DuCtor, MatchingConstructors) then
TypeCtors1 = list.map(
( func(ConsDefn) = TypeCtor :-
ConsDefn ^ cons_type_ctor = TypeCtor
), MatchingConstructors)
else
TypeCtors1 = []
),
TypeCtors = TypeCtors0 ++ TypeCtors1,
module_info_get_predicate_table(ModuleInfo, PredicateTable),
predicate_table_lookup_func_sym_arity(PredicateTable,
may_be_partially_qualified, InstanceMethodSymName0, MethodUserArity,
PredIds),
( if
PredIds = [_ | _],
find_matching_pred_id(ModuleInfo, pf_function, InstanceMethodSymName0,
PredIds, MethodCallTVarSet, MethodCallExistQTVars,
MethodCallArgTypes, MethodCallExternalTypeParams, no,
MethodContext, PredId, InstanceMethodFuncSymName, _ResolveSpecs)
% Any errors in _ResolveSpecs will be reported when a later compiler
% invocation attempts to generate target language code for this module.
then
TypeCtors = [],
MaybePredId = yes(PredId),
InstanceMethodSymName = InstanceMethodFuncSymName
else
TypeCtors = [TheTypeCtor],
MaybePredId = no,
TheTypeCtor = type_ctor(TypeCtorSymName, _),
(
TypeCtorSymName = qualified(TypeModule, _),
MethodName = unqualify_name(InstanceMethodSymName0),
InstanceMethodSymName = qualified(TypeModule, MethodName)
;
TypeCtorSymName = unqualified(_),
unexpected($pred, "unqualified type_ctor in " ++
"hlds_cons_defn or hlds_ctor_field_defn")
)
).
%---------------------------------------------------------------------------%
:- pred gather_opt_export_types(intermod_info::in, intermod_info::out) is det.
gather_opt_export_types(!IntermodInfo) :-
intermod_info_get_module_info(!.IntermodInfo, ModuleInfo),
module_info_get_type_table(ModuleInfo, TypeTable),
foldl_over_type_ctor_defns(gather_opt_export_types_in_type_defn, TypeTable,
!IntermodInfo).
:- pred gather_opt_export_types_in_type_defn(type_ctor::in, hlds_type_defn::in,
intermod_info::in, intermod_info::out) is det.
gather_opt_export_types_in_type_defn(TypeCtor, TypeDefn0, !IntermodInfo) :-
intermod_info_get_module_info(!.IntermodInfo, ModuleInfo),
module_info_get_name(ModuleInfo, ModuleName),
( if should_opt_export_type_defn(ModuleName, TypeCtor, TypeDefn0) then
hlds_data.get_type_defn_body(TypeDefn0, TypeBody0),
(
TypeBody0 = hlds_du_type(TypeBodyDu0),
TypeBodyDu0 = type_body_du(Ctors, AlphaSortedCtors, MaybeSuperType,
MaybeUserEqComp0, MaybeRepn, MaybeForeign0),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
% Note that we don't resolve overloading for the definitions
% which won't be used on this back-end, because their unification
% and comparison predicates have not been typechecked. They are
% only written to the `.opt' it can be handy when building
% against a workspace for the other definitions to be present
% (e.g. when testing compiling a module to IL when the workspace
% was compiled to C).
% XXX The above sentence doesn't make sense, and never did
% (even in the first CVS version in which it appears).
( if
MaybeForeign0 = yes(ForeignTypeBody0),
have_foreign_type_for_backend(Target, ForeignTypeBody0, yes)
then
% The foreign type may be defined in one of the foreign
% modules we import.
intermod_info_set_need_foreign_import_modules(!IntermodInfo),
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
ForeignTypeBody0, ForeignTypeBody, !IntermodInfo),
MaybeForeign = yes(ForeignTypeBody),
MaybeUserEqComp = MaybeUserEqComp0
else
resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
MaybeUserEqComp0, MaybeUserEqComp, !IntermodInfo),
MaybeForeign = MaybeForeign0
),
TypeBodyDu = type_body_du(Ctors, AlphaSortedCtors, MaybeSuperType,
MaybeUserEqComp, MaybeRepn, MaybeForeign),
TypeBody = hlds_du_type(TypeBodyDu),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
TypeBody0 = hlds_foreign_type(ForeignTypeBody0),
% The foreign type may be defined in one of the foreign
% modules we import.
intermod_info_set_need_foreign_import_modules(!IntermodInfo),
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
ForeignTypeBody0, ForeignTypeBody, !IntermodInfo),
TypeBody = hlds_foreign_type(ForeignTypeBody),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
( TypeBody0 = hlds_eqv_type(_)
; TypeBody0 = hlds_solver_type(_)
; TypeBody0 = hlds_abstract_type(_)
),
TypeDefn = TypeDefn0
),
intermod_info_get_types(!.IntermodInfo, Types0),
intermod_info_set_types([TypeCtor - TypeDefn | Types0], !IntermodInfo)
else
true
).
:- pred resolve_foreign_type_body_overloading(module_info::in,
type_ctor::in, foreign_type_body::in, foreign_type_body::out,
intermod_info::in, intermod_info::out) is det.
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
ForeignTypeBody0, ForeignTypeBody, !IntermodInfo) :-
ForeignTypeBody0 = foreign_type_body(MaybeC0, MaybeJava0, MaybeCSharp0),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
% Note that we don't resolve overloading for the foreign definitions
% which won't be used on this back-end, because their unification and
% comparison predicates have not been typechecked. They are only written
% to the `.opt' it can be handy when building against a workspace
% for the other definitions to be present (e.g. when testing compiling
% a module to IL when the workspace was compiled to C).
(
Target = target_c,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeC0, MaybeC, !IntermodInfo)
;
( Target = target_csharp
; Target = target_java
),
MaybeC = MaybeC0
),
(
Target = target_csharp,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeCSharp0, MaybeCSharp, !IntermodInfo)
;
( Target = target_c
; Target = target_java
),
MaybeCSharp = MaybeCSharp0
),
(
Target = target_java,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeJava0, MaybeJava, !IntermodInfo)
;
( Target = target_c
; Target = target_csharp
),
MaybeJava = MaybeJava0
),
ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp).
:- pred resolve_foreign_type_body_overloading_2(module_info::in, type_ctor::in,
foreign_type_lang_body(T)::in, foreign_type_lang_body(T)::out,
intermod_info::in, intermod_info::out) is det.
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeForeignTypeLangData0, MaybeForeignTypeLangData, !IntermodInfo) :-
(
MaybeForeignTypeLangData0 = no,
MaybeForeignTypeLangData = no
;
MaybeForeignTypeLangData0 =
yes(type_details_foreign(Body, MaybeUserEqComp0, Assertions)),
resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
MaybeUserEqComp0, MaybeUserEqComp, !IntermodInfo),
MaybeForeignTypeLangData =
yes(type_details_foreign(Body, MaybeUserEqComp, Assertions))
).
:- pred resolve_unify_compare_overloading(module_info::in,
type_ctor::in, maybe_canonical::in, maybe_canonical::out,
intermod_info::in, intermod_info::out) is det.
resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
MaybeCanonical0, MaybeCanonical, !IntermodInfo) :-
(
MaybeCanonical0 = canon,
MaybeCanonical = MaybeCanonical0
;
MaybeCanonical0 = noncanon(NonCanonical0),
(
( NonCanonical0 = noncanon_abstract(_IsSolverType)
; NonCanonical0 = noncanon_subtype
),
MaybeCanonical = MaybeCanonical0
;
NonCanonical0 = noncanon_uni_cmp(Uni0, Cmp0),
resolve_user_special_pred_overloading(ModuleInfo,
spec_pred_unify, TypeCtor, Uni0, Uni, !IntermodInfo),
resolve_user_special_pred_overloading(ModuleInfo,
spec_pred_compare, TypeCtor, Cmp0, Cmp, !IntermodInfo),
NonCanonical = noncanon_uni_cmp(Uni, Cmp),
MaybeCanonical = noncanon(NonCanonical)
;
NonCanonical0 = noncanon_uni_only(Uni0),
resolve_user_special_pred_overloading(ModuleInfo,
spec_pred_unify, TypeCtor, Uni0, Uni, !IntermodInfo),
NonCanonical = noncanon_uni_only(Uni),
MaybeCanonical = noncanon(NonCanonical)
;
NonCanonical0 = noncanon_cmp_only(Cmp0),
resolve_user_special_pred_overloading(ModuleInfo,
spec_pred_compare, TypeCtor, Cmp0, Cmp, !IntermodInfo),
NonCanonical = noncanon_cmp_only(Cmp),
MaybeCanonical = noncanon(NonCanonical)
)
).
:- pred resolve_user_special_pred_overloading(module_info::in,
special_pred_id::in, type_ctor::in, sym_name::in, sym_name::out,
intermod_info::in, intermod_info::out) is det.
resolve_user_special_pred_overloading(ModuleInfo, SpecialId,
TypeCtor, PredSymName0, PredSymName, !IntermodInfo) :-
module_info_get_special_pred_maps(ModuleInfo, SpecialPredMaps),
lookup_special_pred_maps(SpecialPredMaps, SpecialId, TypeCtor,
SpecialPredId),
module_info_pred_info(ModuleInfo, SpecialPredId, SpecialPredInfo),
pred_info_get_arg_types(SpecialPredInfo, TVarSet, ExistQVars, ArgTypes),
pred_info_get_external_type_params(SpecialPredInfo, ExternalTypeParams),
init_markers(Markers0),
add_marker(marker_calls_are_fully_qualified, Markers0, Markers),
pred_info_get_context(SpecialPredInfo, Context),
resolve_pred_overloading(ModuleInfo, Markers, TVarSet, ExistQVars,
ArgTypes, ExternalTypeParams, Context, PredSymName0, PredSymName,
UserEqPredId, _ResolveSpecs),
% Any errors in _ResolveSpecs will be reported when a later compiler
% invocation attempts to generate target language code for this module.
intermod_add_pred(UserEqPredId, _, !IntermodInfo).
%---------------------------------------------------------------------------%
should_opt_export_type_defn(ModuleName, TypeCtor, TypeDefn) :-
hlds_data.get_type_defn_status(TypeDefn, TypeStatus),
TypeCtor = type_ctor(Name, _Arity),
Name = qualified(ModuleName, _),
(
type_status_to_write(TypeStatus) = yes
;
TypeStatus = type_status(status_exported),
% A du type defined in the interface section (exported) will need
% to be written to the .opt file if it has any direct-arg
% constructors. The type definition in the .opt file will include
% `where direct_arg is` clauses to tell anyone opt-importing the
% type which constructors use the direct-arg representation.
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
is_du_type_with_direct_arg_ctors(TypeBody)
).
is_du_type_with_direct_arg_ctors(TypeBody) :-
TypeBody = hlds_du_type(TypeBodyDu),
TypeBodyDu ^ du_type_repn = yes(DuTypeRepn),
DuTypeRepn ^ dur_direct_arg_ctors = yes(DirectArgCtors),
DirectArgCtors = [_ | _].
%---------------------------------------------------------------------------%
:- end_module transform_hlds.intermod_decide.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink