mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 14:25:56 +00:00
459847a064
Estimated hours taken: 18 Branches: main Move the univ, maybe, pair and unit types from std_util into their own modules. std_util still contains the general purpose higher-order programming constructs. library/std_util.m: Move univ, maybe, pair and unit (plus any other related types and procedures) into their own modules. library/maybe.m: New module. This contains the maybe and maybe_error types and the associated procedures. library/pair.m: New module. This contains the pair type and associated procedures. library/unit.m: New module. This contains the types unit/0 and unit/1. library/univ.m: New module. This contains the univ type and associated procedures. library/library.m: Add the new modules. library/private_builtin.m: Update the declaration of the type_ctor_info struct for univ. runtime/mercury.h: Update the declaration for the type_ctor_info struct for univ. runtime/mercury_mcpp.h: runtime/mercury_hlc_types.h: Update the definition of MR_Univ. runtime/mercury_init.h: Fix a comment: ML_type_name is now exported from type_desc.m. compiler/mlds_to_il.m: Update the the name of the module that defines univs (which are handled specially by the il code generator.) library/*.m: compiler/*.m: browser/*.m: mdbcomp/*.m: profiler/*.m: deep_profiler/*.m: Conform to the above changes. Import the new modules where they are needed; don't import std_util where it isn't needed. Fix formatting in lots of modules. Delete duplicate module imports. tests/*: Update the test suite to confrom to the above changes.
752 lines
28 KiB
Mathematica
752 lines
28 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2006 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% File: structure_sharing.analysis.m.
|
|
% Main authors: nancy.
|
|
|
|
% Implementation of the structure sharing analysis needed for compile-time
|
|
% garbage collection (CTGC).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.ctgc.structure_sharing.analysis.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module transform_hlds.ctgc.structure_sharing.domain.
|
|
|
|
:- import_module io.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred structure_sharing_analysis(module_info::in, module_info::out,
|
|
sharing_as_table::out, io::di, io::uo) is det.
|
|
|
|
:- pred write_pred_sharing_info(module_info::in, pred_id::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module ll_backend.liveness.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.modules.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module transform_hlds.ctgc.fixpoint_table.
|
|
:- import_module transform_hlds.ctgc.util.
|
|
:- import_module transform_hlds.dependency_graph.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
structure_sharing_analysis(!ModuleInfo, !:SharingTable, !IO) :-
|
|
%
|
|
% Annotate the HLDS with liveness information.
|
|
%
|
|
annotate_liveness(!ModuleInfo, !IO),
|
|
%
|
|
% Load all structure sharing information present in the HLDS.
|
|
%
|
|
load_structure_sharing_table(!.ModuleInfo, !:SharingTable),
|
|
%
|
|
% Analyse structure sharing for the module.
|
|
%
|
|
sharing_analysis(!ModuleInfo, !SharingTable, !IO),
|
|
%
|
|
% Maybe write structure sharing pragmas to .opt files.
|
|
%
|
|
globals.io_lookup_bool_option(make_optimization_interface,
|
|
MakeOptInt, !IO),
|
|
(
|
|
MakeOptInt = yes,
|
|
make_opt_int(!.ModuleInfo, !IO)
|
|
;
|
|
MakeOptInt = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Preliminary steps
|
|
%
|
|
|
|
:- pred load_structure_sharing_table(module_info::in, sharing_as_table::out)
|
|
is det.
|
|
|
|
load_structure_sharing_table(ModuleInfo, SharingTable) :-
|
|
module_info_predids(ModuleInfo, PredIds),
|
|
list.foldl(load_structure_sharing_table_2(ModuleInfo), PredIds,
|
|
sharing_as_table_init, SharingTable).
|
|
|
|
:- pred load_structure_sharing_table_2(module_info::in, pred_id::in,
|
|
sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
load_structure_sharing_table_2(ModuleInfo, PredId, !SharingTable) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
list.foldl(load_structure_sharing_table_3(ModuleInfo, PredId),
|
|
ProcIds, !SharingTable).
|
|
|
|
:- pred load_structure_sharing_table_3(module_info::in, pred_id::in,
|
|
proc_id::in, sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
load_structure_sharing_table_3(ModuleInfo, PredId, ProcId, !SharingTable) :-
|
|
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
|
|
proc_info_get_structure_sharing(ProcInfo, MaybePublicSharing),
|
|
(
|
|
MaybePublicSharing = yes(PublicSharing),
|
|
PPId = proc(PredId, ProcId),
|
|
PrivateSharing = from_structure_sharing_domain(PublicSharing),
|
|
sharing_as_table_set(PPId, PrivateSharing, !SharingTable)
|
|
;
|
|
MaybePublicSharing = no
|
|
).
|
|
|
|
% Annotate the HLDS with pre-birth and post-death information, as
|
|
% used by the liveness pass (liveness.m). This information is used to
|
|
% eliminate useless sharing pairs during sharing analysis.
|
|
%
|
|
:- pred annotate_liveness(module_info::in, module_info::out, io::di,
|
|
io::uo) is det.
|
|
|
|
annotate_liveness(!ModuleInfo, !IO) :-
|
|
process_all_nonimported_procs(update_proc_io(detect_liveness_proc),
|
|
!ModuleInfo, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred sharing_analysis(module_info::in, module_info::out,
|
|
sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
|
|
|
|
sharing_analysis(!ModuleInfo, !SharingTable, !IO) :-
|
|
%
|
|
% Perform a bottom-up traversal of the SCCs in the program,
|
|
% analysing structure sharing in each one as we go.
|
|
%
|
|
module_info_ensure_dependency_info(!ModuleInfo),
|
|
module_info_get_maybe_dependency_info(!.ModuleInfo, MaybeDepInfo),
|
|
(
|
|
MaybeDepInfo = yes(DepInfo),
|
|
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
|
|
list.foldl2(analyse_scc(!.ModuleInfo), SCCs, !SharingTable, !IO)
|
|
;
|
|
MaybeDepInfo = no,
|
|
unexpected(this_file, "No dependency information.")
|
|
),
|
|
%
|
|
% Record the sharing results in the HLDS.
|
|
%
|
|
map.foldl(save_sharing_in_module_info, !.SharingTable, !ModuleInfo).
|
|
|
|
:- pred save_sharing_in_module_info(pred_proc_id::in, sharing_as::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
save_sharing_in_module_info(PPId, SharingAs, !ModuleInfo) :-
|
|
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
|
|
proc_info_set_structure_sharing(to_structure_sharing_domain(SharingAs),
|
|
ProcInfo0, ProcInfo),
|
|
module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
|
|
|
|
:- pred analyse_scc(module_info::in, list(pred_proc_id)::in,
|
|
sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
|
|
|
|
analyse_scc(ModuleInfo, SCC, !SharingTable, !IO) :-
|
|
( preds_requiring_no_analysis(ModuleInfo, SCC) ->
|
|
true
|
|
;
|
|
analyse_scc_until_fixpoint(ModuleInfo, SCC, !.SharingTable,
|
|
ss_fixpoint_table_init(SCC), FixpointTable, !IO),
|
|
list.foldl(update_sharing_in_table(FixpointTable), SCC, !SharingTable)
|
|
).
|
|
|
|
:- pred analyse_scc_until_fixpoint(module_info::in, list(pred_proc_id)::in,
|
|
sharing_as_table::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
|
|
io::di, io::uo) is det.
|
|
|
|
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
|
|
!FixpointTable, !IO) :-
|
|
list.foldl2(analyse_pred_proc(ModuleInfo, SharingTable), SCC,
|
|
!FixpointTable, !IO),
|
|
( ss_fixpoint_table_stable(!.FixpointTable) ->
|
|
true
|
|
;
|
|
ss_fixpoint_table_new_run(!FixpointTable),
|
|
analyse_scc_until_fixpoint(ModuleInfo, SCC, SharingTable,
|
|
!FixpointTable, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Perform structure sharing analysis on a procedure
|
|
%
|
|
|
|
:- pred analyse_pred_proc(module_info::in, sharing_as_table::in,
|
|
pred_proc_id::in, ss_fixpoint_table::in, ss_fixpoint_table::out,
|
|
io::di, io::uo) is det.
|
|
|
|
analyse_pred_proc(ModuleInfo, SharingTable, PPId, !FixpointTable, !IO) :-
|
|
% Collect relevant compiler options.
|
|
globals.io_lookup_bool_option(very_verbose, Verbose, !IO),
|
|
globals.io_lookup_int_option(structure_sharing_widening, WideningLimit,
|
|
!IO),
|
|
|
|
% Collect relevant procedure information.
|
|
%
|
|
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
|
|
% Write progress message for the start of analysing current procedure.
|
|
%
|
|
Run = ss_fixpoint_table_which_run(!.FixpointTable),
|
|
TabledAsDescr = ss_fixpoint_table_get_short_description(PPId,
|
|
!.FixpointTable),
|
|
write_proc_progress_message(
|
|
"% Sharing analysis (run " ++ string.int_to_string(Run) ++ ") ",
|
|
PPId, ModuleInfo, !IO),
|
|
|
|
% In some cases the sharing can be predicted to be bottom, in which
|
|
% case a full sharing analysis is not needed.
|
|
%
|
|
some [!Sharing] (
|
|
!:Sharing = sharing_as_init,
|
|
( bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) ->
|
|
maybe_write_string(Verbose, "\t\t: bottom predicted", !IO)
|
|
;
|
|
% Start analysis.
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
|
|
!FixpointTable, !Sharing, !IO),
|
|
FullAsDescr = short_description(!.Sharing),
|
|
|
|
sharing_as_project(HeadVars, !Sharing),
|
|
ProjAsDescr = short_description(!.Sharing),
|
|
|
|
domain.apply_widening(ModuleInfo, ProcInfo, WideningLimit,
|
|
WideningDone, !Sharing),
|
|
(
|
|
WideningDone = yes,
|
|
WidenAsDescr = short_description(!.Sharing)
|
|
;
|
|
WideningDone = no,
|
|
WidenAsDescr = "-"
|
|
),
|
|
|
|
maybe_write_string(Verbose, "\t\t: " ++
|
|
TabledAsDescr ++ "->" ++
|
|
FullAsDescr ++ "/" ++
|
|
ProjAsDescr ++ "/" ++
|
|
WidenAsDescr, !IO)
|
|
),
|
|
ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, PPId, !.Sharing,
|
|
!FixpointTable)
|
|
),
|
|
maybe_write_string(Verbose, "\t\t (ft = " ++
|
|
ss_fixpoint_table_description(!.FixpointTable) ++ ")\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Succeeds if the sharing of a procedure can safely be approximated by
|
|
% "bottom", simply by looking at the modes and types of the arguments.
|
|
%
|
|
:- pred bottom_sharing_is_safe_approximation(module_info::in,
|
|
proc_info::in) is semidet.
|
|
|
|
bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, Modes),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
list.map(map.lookup(VarTypes), HeadVars, Types),
|
|
|
|
ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
|
|
|
|
Test = (pred(Pair::in) is semidet :-
|
|
Pair = Mode - Type,
|
|
|
|
% mode is not unique nor clobbered.
|
|
mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
|
|
\+ inst_is_unique(ModuleInfo, RightInst),
|
|
\+ inst_is_clobbered(ModuleInfo, RightInst),
|
|
|
|
% mode is output.
|
|
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
|
|
ArgMode = top_out,
|
|
|
|
% type is not primitive
|
|
\+ type_is_atomic(Type, ModuleInfo)
|
|
),
|
|
list.filter(Test, ModeTypePairs, TrueModeTypePairs),
|
|
TrueModeTypePairs = [].
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Structure sharing analysis of goals
|
|
%
|
|
|
|
:- pred analyse_goal(module_info::in, pred_info::in, proc_info::in,
|
|
sharing_as_table::in, hlds_goal::in,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out,
|
|
sharing_as::in, sharing_as::out, io::di, io::uo) is det.
|
|
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
|
|
!FixpointTable, !SharingAs, !IO) :-
|
|
Goal = GoalExpr - GoalInfo,
|
|
(
|
|
GoalExpr = conj(ConjType, Goals),
|
|
(
|
|
ConjType = plain_conj,
|
|
list.foldl3(analyse_goal(ModuleInfo, PredInfo, ProcInfo,
|
|
SharingTable), Goals, !FixpointTable, !SharingAs, !IO)
|
|
;
|
|
ConjType = parallel_conj,
|
|
goal_info_get_context(GoalInfo, Context),
|
|
context_to_string(Context, ContextString),
|
|
!:SharingAs = sharing_as_top_sharing_accumulate(
|
|
"par_conj (" ++ ContextString ++ ")", !.SharingAs)
|
|
)
|
|
;
|
|
GoalExpr = call(CalleePredId, CalleeProcId, CalleeArgs, _, _, _),
|
|
CalleePPId = proc(CalleePredId, CalleeProcId),
|
|
lookup_sharing(ModuleInfo, SharingTable, CalleePPId,
|
|
!FixpointTable, CalleeSharing),
|
|
|
|
% Rename
|
|
proc_info_get_vartypes(ProcInfo, AllTypes),
|
|
list.map(map.lookup(AllTypes), CalleeArgs, ActualTypes),
|
|
pred_info_get_typevarset(PredInfo, ActualTVarset),
|
|
sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CalleeArgs,
|
|
ActualTypes, ActualTVarset, CalleeSharing, RenamedSharing),
|
|
|
|
% Combine
|
|
!:SharingAs = sharing_as_comb(ModuleInfo, ProcInfo,
|
|
RenamedSharing, !.SharingAs)
|
|
;
|
|
GoalExpr = generic_call(_GenDetails, _, _, _),
|
|
goal_info_get_context(GoalInfo, Context),
|
|
context_to_string(Context, ContextString),
|
|
!:SharingAs = sharing_as_top_sharing_accumulate(
|
|
"generic call (" ++ ContextString ++ ")", !.SharingAs)
|
|
;
|
|
GoalExpr = unify(_, _, _, Unification, _),
|
|
!:SharingAs = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
|
|
GoalInfo, !.SharingAs)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
list.foldl3(
|
|
analyse_disj(ModuleInfo, PredInfo, ProcInfo,
|
|
SharingTable, !.SharingAs),
|
|
Goals, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
|
|
;
|
|
GoalExpr = switch(_, _, Cases),
|
|
list.foldl3(
|
|
analyse_case(ModuleInfo, PredInfo, ProcInfo,
|
|
SharingTable, !.SharingAs),
|
|
Cases, !FixpointTable, sharing_as_init, !:SharingAs, !IO)
|
|
;
|
|
GoalExpr = not(_Goal)
|
|
% XXX Check theory, but a negated goal can not create bindings,
|
|
% hence it also can not create additional sharing.
|
|
;
|
|
GoalExpr = scope(_, SubGoal),
|
|
% XXX Check theory.
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, SubGoal,
|
|
!FixpointTable, !SharingAs, !IO)
|
|
;
|
|
GoalExpr = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
|
|
IfGoal, !FixpointTable, !.SharingAs, IfSharingAs, !IO),
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
|
|
ThenGoal, !FixpointTable, IfSharingAs, ThenSharingAs, !IO),
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable,
|
|
ElseGoal, !FixpointTable, !.SharingAs, ElseSharingAs, !IO),
|
|
!:SharingAs = sharing_as_least_upper_bound(ModuleInfo, ProcInfo,
|
|
ThenSharingAs, ElseSharingAs)
|
|
;
|
|
GoalExpr = foreign_proc(_Attrs, _ForeignPredId, _ForeignProcId,
|
|
_ForeignArgs, _, _),
|
|
% XXX User annotated structure sharing information is not yet
|
|
% supported.
|
|
goal_info_get_context(GoalInfo, Context),
|
|
context_to_string(Context, ContextString),
|
|
!:SharingAs = sharing_as_top_sharing_accumulate(
|
|
"foreign_proc not handles yet (" ++ ContextString ++ ")",
|
|
!.SharingAs)
|
|
;
|
|
GoalExpr = shorthand(_),
|
|
unexpected(this_file, "analyse_goal: shorthand goal.")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Additional code for analysing disjuctions
|
|
%
|
|
|
|
:- pred analyse_disj(module_info::in, pred_info::in, proc_info::in,
|
|
sharing_as_table::in, sharing_as::in, hlds_goal::in,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out,
|
|
sharing_as::in, sharing_as::out, io::di, io::uo) is det.
|
|
|
|
analyse_disj(ModuleInfo, PredInfo, ProcInfo, SharingTable, SharingBeforeDisj,
|
|
Goal, !FixpointTable, !Sharing, !IO) :-
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
|
|
!FixpointTable, SharingBeforeDisj, GoalSharing, !IO),
|
|
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
|
|
GoalSharing).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Additional code for analysing switches
|
|
%
|
|
|
|
:- pred analyse_case(module_info::in, pred_info::in, proc_info::in,
|
|
sharing_as_table::in, sharing_as::in, case::in,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out,
|
|
sharing_as::in, sharing_as::out, io::di, io::uo) is det.
|
|
|
|
analyse_case(ModuleInfo, PredInfo, ProcInfo, SharingTable, Sharing0,
|
|
Case, !FixpointTable, !Sharing, !IO) :-
|
|
Case = case(_, Goal),
|
|
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
|
|
!FixpointTable, Sharing0, CaseSharing, !IO),
|
|
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
|
|
CaseSharing).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling calls
|
|
%
|
|
|
|
% Lookup the sharing information of a procedure identified by its
|
|
% pred_proc_id.
|
|
% 1 - first look in the fixpoint table (which may change the state
|
|
% of this table wrt recursiveness);
|
|
% 2 - then look in sharing_as_table (as we might already have analysed
|
|
% the predicate, if defined in same module, or analysed in other
|
|
% imported module)
|
|
% 3 - try to predict bottom;
|
|
% 4 - react appropriately if the calls happen to be to
|
|
% * either compiler generated predicates
|
|
% * or predicates from builtin.m and private_builtin.m
|
|
%
|
|
:- pred lookup_sharing(module_info::in, sharing_as_table::in, pred_proc_id::in,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out, sharing_as::out) is det.
|
|
|
|
lookup_sharing(ModuleInfo, SharingTable, PPId, !FixpointTable, SharingAs) :-
|
|
(
|
|
% 1 -- check fixpoint table
|
|
ss_fixpoint_table_get_as(PPId, SharingAs0, !FixpointTable)
|
|
->
|
|
SharingAs = SharingAs0
|
|
;
|
|
% 2 -- look up in SharingTable
|
|
SharingAs0 = sharing_as_table_search(PPId, SharingTable)
|
|
->
|
|
SharingAs = SharingAs0
|
|
;
|
|
% 3 -- predict bottom sharing
|
|
%
|
|
% If it is neither in the fixpoint table, nor in the sharing
|
|
% table, then this means that we have never analysed the called
|
|
% procedure, yet in some cases we can still simply predict that
|
|
% the sharing the called procedure creates is bottom.
|
|
predict_called_pred_is_bottom(ModuleInfo, PPId)
|
|
->
|
|
SharingAs = sharing_as_init
|
|
;
|
|
% 4 -- use top-sharing with appropriate message.
|
|
SharingAs = top_sharing_not_found(ModuleInfo, PPId)
|
|
).
|
|
|
|
:- pred predict_called_pred_is_bottom(module_info::in, pred_proc_id::in)
|
|
is semidet.
|
|
|
|
predict_called_pred_is_bottom(ModuleInfo, PPId) :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
|
|
(
|
|
% 1. inferred determinism is erroneous/failure.
|
|
proc_info_get_inferred_determinism(ProcInfo, Determinism),
|
|
(
|
|
Determinism = erroneous
|
|
;
|
|
Determinism = failure
|
|
)
|
|
;
|
|
% 2. bottom_sharing_is_safe_approximation
|
|
bottom_sharing_is_safe_approximation(ModuleInfo, ProcInfo)
|
|
;
|
|
% 3. call to a compiler generate special predicate:
|
|
% "unify", "index", "compare" or "initialise".
|
|
pred_info_get_origin(PredInfo, Origin),
|
|
Origin = special_pred(_)
|
|
;
|
|
% 4. (XXX UNSAFE!! To verify) any call to private_builtin and builtin
|
|
% procedures.
|
|
PredModule = pred_info_module(PredInfo),
|
|
any_mercury_builtin_module(PredModule)
|
|
).
|
|
|
|
:- func top_sharing_not_found(module_info, pred_proc_id) = sharing_as.
|
|
|
|
top_sharing_not_found(ModuleInfo, PPId) = TopSharing :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _),
|
|
PPId = proc(PredId, ProcId),
|
|
PredModuleName = pred_info_module(PredInfo),
|
|
|
|
TopSharing = sharing_as_top_sharing("Lookup sharing failed for " ++
|
|
sym_name_to_escaped_string(PredModuleName) ++ "." ++
|
|
pred_info_name(PredInfo) ++ "/" ++
|
|
int_to_string(pred_info_orig_arity(PredInfo)) ++ " (id = " ++
|
|
int_to_string(pred_id_to_int(PredId)) ++ "," ++
|
|
int_to_string(proc_id_to_int(ProcId))).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred update_sharing_in_table(ss_fixpoint_table::in, pred_proc_id::in,
|
|
sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
update_sharing_in_table(FixpointTable, PPId, !SharingTable) :-
|
|
sharing_as_table_set(PPId,
|
|
ss_fixpoint_table_get_final_as(PPId, FixpointTable),
|
|
!SharingTable).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Structure sharing fixpoint table.
|
|
%
|
|
|
|
:- type ss_fixpoint_table == fixpoint_table(pred_proc_id, sharing_as).
|
|
|
|
% Initialise the fixpoint table for the given set of pred_proc_id's.
|
|
%
|
|
:- func ss_fixpoint_table_init(list(pred_proc_id)) = ss_fixpoint_table.
|
|
|
|
% Add the results of a new analysis pass to the already existing
|
|
% fixpoint table.
|
|
%
|
|
:- pred ss_fixpoint_table_new_run(ss_fixpoint_table::in,
|
|
ss_fixpoint_table::out) is det.
|
|
|
|
% The fixpoint table keeps track of the number of analysis passes. This
|
|
% predicate returns this number.
|
|
%
|
|
:- func ss_fixpoint_table_which_run(ss_fixpoint_table) = int.
|
|
|
|
% A fixpoint is reached if all entries in the table are stable,
|
|
% i.e. haven't been modified by the last analysis pass.
|
|
%
|
|
:- pred ss_fixpoint_table_stable(ss_fixpoint_table::in) is semidet.
|
|
|
|
% Give a string description of the state of the fixpoint table.
|
|
%
|
|
:- func ss_fixpoint_table_description(ss_fixpoint_table) = string.
|
|
|
|
% Enter the newly computed structure sharing description for a given
|
|
% procedure. If the description is different from the one that was
|
|
% already stored for that procedure, the stability of the fixpoint
|
|
% table is set to "unstable".
|
|
% Software error if the procedure is not in the fixpoint table.
|
|
%
|
|
:- pred ss_fixpoint_table_new_as(module_info::in, proc_info::in,
|
|
pred_proc_id::in, sharing_as::in,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out) is det.
|
|
|
|
% Retrieve the structure sharing description for a given pred_proc_id.
|
|
%
|
|
% If the id is part of the fixpoint table, but does not yet record any
|
|
% sharing information about that pred_proc_id, then this means that the
|
|
% set of pred_proc_id's to which the fixpoint table relates is mutually
|
|
% recursive, hence the table is characterised as recursive.
|
|
%
|
|
% If the id is not part of the fixpoint table: fail.
|
|
%
|
|
:- pred ss_fixpoint_table_get_as(pred_proc_id::in, sharing_as::out,
|
|
ss_fixpoint_table::in, ss_fixpoint_table::out) is semidet.
|
|
|
|
:- func ss_fixpoint_table_get_short_description(pred_proc_id,
|
|
ss_fixpoint_table) = string.
|
|
|
|
% Retrieve the structure sharing information without changing the table.
|
|
% To be used after fixpoint has been reached.
|
|
% Software error if the procedure is not in the table.
|
|
%
|
|
:- func ss_fixpoint_table_get_final_as(pred_proc_id,
|
|
ss_fixpoint_table) = sharing_as.
|
|
|
|
% Same as ss_fixpoint_table_get_final_as, yet fails instead of aborting
|
|
% if the procedure is not in the table.
|
|
%
|
|
:- func ss_fixpoint_table_get_final_as_semidet(pred_proc_id,
|
|
ss_fixpoint_table) = sharing_as is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func wrapped_init(pred_proc_id) = sharing_as.
|
|
|
|
wrapped_init(_Id) = sharing_as_init.
|
|
|
|
ss_fixpoint_table_init(Keys) = init_fixpoint_table(wrapped_init, Keys).
|
|
|
|
ss_fixpoint_table_new_run(!Table) :-
|
|
fixpoint_table.new_run(!Table).
|
|
|
|
ss_fixpoint_table_which_run(Tin) = fixpoint_table.which_run(Tin).
|
|
|
|
ss_fixpoint_table_stable(Table) :-
|
|
fixpoint_table.fixpoint_reached(Table).
|
|
|
|
ss_fixpoint_table_description(Table) = fixpoint_table.description(Table).
|
|
|
|
ss_fixpoint_table_new_as(ModuleInfo, ProcInfo, Id, SharingAs, !Table) :-
|
|
add_to_fixpoint_table(sharing_as_is_subsumed_by(ModuleInfo, ProcInfo),
|
|
Id, SharingAs, !Table).
|
|
|
|
ss_fixpoint_table_get_as(PPId, SharingAs, !Table) :-
|
|
get_from_fixpoint_table(PPId, SharingAs, !Table).
|
|
|
|
ss_fixpoint_table_get_short_description(PPId, Table) = Descr :-
|
|
( As = ss_fixpoint_table_get_final_as_semidet(PPId, Table) ->
|
|
Descr = short_description(As)
|
|
;
|
|
Descr = "-"
|
|
).
|
|
|
|
ss_fixpoint_table_get_final_as(PPId, T) =
|
|
get_from_fixpoint_table_final(PPId, T).
|
|
|
|
ss_fixpoint_table_get_final_as_semidet(PPId, T) =
|
|
get_from_fixpoint_table_final_semidet(PPId, T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for writing out optimization interfaces
|
|
%
|
|
|
|
:- pred make_opt_int(module_info::in, io::di, io::uo) is det.
|
|
|
|
make_opt_int(ModuleInfo, !IO) :-
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
|
|
globals.io_lookup_bool_option(verbose, Verbose, !IO),
|
|
maybe_write_string(Verbose, "% Appending structure_sharing pragmas to ",
|
|
!IO),
|
|
maybe_write_string(Verbose, add_quotes(OptFileName), !IO),
|
|
maybe_write_string(Verbose, "...", !IO),
|
|
maybe_flush_output(Verbose, !IO),
|
|
io.open_append(OptFileName, OptFileRes, !IO),
|
|
(
|
|
OptFileRes = ok(OptFile),
|
|
io.set_output_stream(OptFile, OldStream, !IO),
|
|
module_info_predids(ModuleInfo, PredIds),
|
|
list.foldl(write_pred_sharing_info(ModuleInfo), PredIds, !IO),
|
|
io.set_output_stream(OldStream, _, !IO),
|
|
io.close_output(OptFile, !IO),
|
|
maybe_write_string(Verbose, " done.\n", !IO)
|
|
;
|
|
OptFileRes = error(IOError),
|
|
maybe_write_string(Verbose, " failed!\n", !IO),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.write_strings(["Error opening file `",
|
|
OptFileName, "' for output: ", IOErrorMessage], !IO),
|
|
io.set_exit_status(1, !IO)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Code for writing out structure_sharing pragmas
|
|
%
|
|
|
|
write_pred_sharing_info(ModuleInfo, PredId, !IO) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_import_status(PredInfo, ImportStatus),
|
|
module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
|
|
TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
|
|
(
|
|
(
|
|
ImportStatus = exported
|
|
;
|
|
ImportStatus = opt_exported
|
|
),
|
|
\+ is_unify_or_compare_pred(PredInfo),
|
|
|
|
% XXX These should be allowed, but the predicate declaration for the
|
|
% specialized predicate is not produced before the structure_sharing
|
|
% pramgas are read in, resulting in an undefined predicate error.
|
|
\+ set.member(PredId, TypeSpecForcePreds)
|
|
->
|
|
PredName = pred_info_name(PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
ModuleName = pred_info_module(PredInfo),
|
|
pred_info_get_procedures(PredInfo, ProcTable),
|
|
pred_info_context(PredInfo, Context),
|
|
SymName = qualified(ModuleName, PredName),
|
|
pred_info_get_typevarset(PredInfo, TypeVarSet),
|
|
list.foldl(
|
|
write_proc_sharing_info(PredId, ProcTable, PredOrFunc,
|
|
SymName, Context, TypeVarSet),
|
|
ProcIds, !IO)
|
|
;
|
|
true
|
|
).
|
|
|
|
:- pred write_proc_sharing_info(pred_id::in, proc_table::in,
|
|
pred_or_func::in, sym_name::in, prog_context::in, tvarset::in,
|
|
proc_id::in, io::di, io::uo) is det.
|
|
|
|
write_proc_sharing_info(_PredId, ProcTable, PredOrFunc, SymName, Context,
|
|
TypeVarSet, ProcId, !IO) :-
|
|
globals.io_lookup_bool_option(structure_sharing_analysis,
|
|
SharingAnalysis, !IO),
|
|
(
|
|
SharingAnalysis = yes,
|
|
map.lookup(ProcTable, ProcId, ProcInfo),
|
|
proc_info_get_structure_sharing(ProcInfo, MaybeSharingAs),
|
|
proc_info_declared_argmodes(ProcInfo, Modes),
|
|
proc_info_get_varset(ProcInfo, VarSet),
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
list.map(map.lookup(VarTypes), HeadVars, HeadVarTypes),
|
|
write_pragma_structure_sharing_info(PredOrFunc, SymName, Modes,
|
|
Context, HeadVars, yes(VarSet), HeadVarTypes, yes(TypeVarSet),
|
|
MaybeSharingAs, !IO)
|
|
;
|
|
SharingAnalysis = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "structure_sharing.analysis.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.ctgc.structure_sharing.analysis.
|
|
%-----------------------------------------------------------------------------%
|