mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 09:53:36 +00:00
Code Issues Projects Releases Wiki Activity
Files
e5b4e5813d7240331fa8cea669a35cb288ed52ce
mercury/compiler/intermod_decide.m
Zoltan Somogyi d8a31e574e Move six utility modules from check_hlds to hlds. 
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
    Move these modules from the check_hlds package to the hlds package.
    The reason is that all the content of five of these modules, and
    most of the content of one module (inst_util.m) is not used
    exclusively during semantic checking passes. (A later diff
    should deal with the exception.) Some are used by the pass that
    builds the initial HLDS, and all are used by middle-end and backend
    passes. The move therefore reduces the number of inappropriate imports
    of the check_hlds package.

compiler/check_hlds.m:
compiler/hlds.m:
    Effect the transfer.

compiler/*.m:
    Conform to the changes above.
2025-10-08 23:07:13 +11:00

1236 lines
50 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2023-2025 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.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.foreign.
:- import_module check_hlds.
:- import_module check_hlds.mode_test.
:- 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.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) :-
module_info_get_ctor_field_table(ModuleInfo, CtorFieldTable),
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, _, FieldName),
map.search(CtorFieldTable, FieldName, FieldDefns)
then
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, 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, 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, Pred0, Pred, !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, Pred0, Pred, 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.
%---------------------------------------------------------------------------%
:- end_module transform_hlds.intermod_decide.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink