mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 02:13:54 +00:00
a13a6d0f97
compiler/hlds_pred.m:
compiler/hlds_proc_util.m:
As above. hlds_proc_util.m now contains utility predicates
that most modules that import hlds_pred.m don't need.
(More than four times as many modules import hlds_pred.m
as now import hlds_proc_util.m.)
compiler/*.m:
Conform to the changes above.
765 lines
31 KiB
Mathematica
765 lines
31 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1998-2001, 2003-2012 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: pd_info.m.
|
|
% Main author: stayl.
|
|
%
|
|
% Types for deforestation.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.pd_info.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.instmap.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module transform_hlds.pd_term.
|
|
|
|
:- import_module bool.
|
|
:- import_module counter.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type pd_info
|
|
---> pd_info(
|
|
pdi_module_info :: module_info,
|
|
pdi_maybe_unfold_info :: maybe(unfold_info),
|
|
pdi_goal_version_index :: goal_version_index,
|
|
pdi_versions :: version_index,
|
|
pdi_proc_arg_info :: pd_arg_info,
|
|
pdi_counter :: counter,
|
|
pdi_global_term_info :: global_term_info,
|
|
pdi_parent_versions :: set(pred_proc_id),
|
|
pdi_depth :: int,
|
|
pdi_created_versions :: set(pred_proc_id),
|
|
pdi_useless_versions :: useless_versions,
|
|
pdi_progress_stream :: io.text_output_stream
|
|
).
|
|
|
|
% Map from list of called preds in the conjunctions
|
|
% to the specialised versions.
|
|
%
|
|
:- type goal_version_index == map(list(pred_proc_id), list(pred_proc_id)).
|
|
|
|
:- type useless_versions == set(pair(pred_proc_id)).
|
|
|
|
% Map from version id to the info about the version.
|
|
%
|
|
:- type version_index == map(pred_proc_id, version_info).
|
|
|
|
:- pred pd_info_init(io.text_output_stream::in, module_info::in,
|
|
pd_arg_info::in, pd_info::out) is det.
|
|
|
|
:- pred pd_info_init_unfold_info(pred_proc_id::in, pred_info::in,
|
|
proc_info::in, pd_info::in, pd_info::out) is det.
|
|
|
|
:- pred pd_info_get_module_info(pd_info::in, module_info::out) is det.
|
|
:- pred pd_info_get_unfold_info(pd_info::in, unfold_info::out) is det.
|
|
:- pred pd_info_get_goal_version_index(pd_info::in, goal_version_index::out)
|
|
is det.
|
|
:- pred pd_info_get_versions(pd_info::in, version_index::out) is det.
|
|
:- pred pd_info_get_proc_arg_info(pd_info::in, pd_arg_info::out) is det.
|
|
:- pred pd_info_get_counter(pd_info::in, counter::out) is det.
|
|
:- pred pd_info_get_global_term_info(pd_info::in, global_term_info::out)
|
|
is det.
|
|
:- pred pd_info_get_parent_versions(pd_info::in, set(pred_proc_id)::out)
|
|
is det.
|
|
:- pred pd_info_get_depth(pd_info::in, int::out) is det.
|
|
:- pred pd_info_get_created_versions(pd_info::in, set(pred_proc_id)::out)
|
|
is det.
|
|
:- pred pd_info_get_useless_versions(pd_info::in, useless_versions::out)
|
|
is det.
|
|
:- pred pd_info_get_progress_stream(pd_info::in, io.text_output_stream::out)
|
|
is det.
|
|
|
|
:- pred pd_info_set_module_info(module_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_unfold_info(unfold_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_unset_unfold_info(
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_goal_version_index(goal_version_index::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_versions(version_index::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_proc_arg_info(pd_arg_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_counter(counter::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_global_term_info(global_term_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_parent_versions(set(pred_proc_id)::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_depth(int::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_created_versions(set(pred_proc_id)::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_useless_versions(useless_versions::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
:- pred pd_info_update_goal(hlds_goal::in, pd_info::in, pd_info::out) is det.
|
|
|
|
:- pred pd_info_bind_var_to_functors(prog_var::in,
|
|
cons_id::in, list(cons_id)::in, pd_info::in, pd_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.modecheck_util.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.pred_name.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
:- import_module transform_hlds.pd_debug.
|
|
:- import_module transform_hlds.pd_util.
|
|
|
|
:- import_module int.
|
|
:- import_module require.
|
|
:- import_module term_context.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
pd_info_init(ProgressStream, ModuleInfo, ProcArgInfos, PDInfo) :-
|
|
map.init(GoalVersionIndex),
|
|
map.init(Versions),
|
|
set.init(ParentVersions),
|
|
pd_term.global_term_info_init(GlobalInfo),
|
|
set.init(CreatedVersions),
|
|
set.init(UselessVersions),
|
|
PDInfo = pd_info(ModuleInfo, no, GoalVersionIndex,
|
|
Versions, ProcArgInfos, counter.init(0), GlobalInfo, ParentVersions,
|
|
0, CreatedVersions, UselessVersions, ProgressStream).
|
|
|
|
pd_info_init_unfold_info(PredProcId, PredInfo, ProcInfo, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
get_constrained_inst_vars(ModuleInfo, ArgModes, HeadInstVars),
|
|
proc_info_get_initial_instmap(ModuleInfo, ProcInfo, InstMap),
|
|
CostDelta = 0,
|
|
pd_term.local_term_info_init(LocalTermInfo),
|
|
Parents = set.make_singleton_set(PredProcId),
|
|
UnfoldInfo = unfold_info(ProcInfo, HeadInstVars, InstMap, CostDelta,
|
|
LocalTermInfo, PredInfo, Parents, PredProcId, 0, no, no),
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
|
|
pd_info_get_module_info(PDInfo, PDInfo ^ pdi_module_info).
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo) :-
|
|
MaybeUnfoldInfo = PDInfo ^ pdi_maybe_unfold_info,
|
|
(
|
|
MaybeUnfoldInfo = yes(UnfoldInfo)
|
|
;
|
|
MaybeUnfoldInfo = no,
|
|
unexpected($pred, "unfold_info not set")
|
|
).
|
|
pd_info_get_goal_version_index(PDInfo, PDInfo ^ pdi_goal_version_index).
|
|
pd_info_get_versions(PDInfo, PDInfo ^ pdi_versions).
|
|
pd_info_get_proc_arg_info(PDInfo, PDInfo ^ pdi_proc_arg_info).
|
|
pd_info_get_counter(PDInfo, PDInfo ^ pdi_counter).
|
|
pd_info_get_global_term_info(PDInfo, PDInfo ^ pdi_global_term_info).
|
|
pd_info_get_parent_versions(PDInfo, PDInfo ^ pdi_parent_versions).
|
|
pd_info_get_depth(PDInfo, PDInfo ^ pdi_depth).
|
|
pd_info_get_created_versions(PDInfo, PDInfo ^ pdi_created_versions).
|
|
pd_info_get_useless_versions(PDInfo, PDInfo ^ pdi_useless_versions).
|
|
pd_info_get_progress_stream(PDInfo, PDInfo ^ pdi_progress_stream).
|
|
|
|
pd_info_set_module_info(ModuleInfo, !PDInfo) :-
|
|
!PDInfo ^ pdi_module_info := ModuleInfo.
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo) :-
|
|
!PDInfo ^ pdi_maybe_unfold_info := yes(UnfoldInfo).
|
|
pd_info_unset_unfold_info(!PDInfo) :-
|
|
!PDInfo ^ pdi_maybe_unfold_info := no.
|
|
pd_info_set_goal_version_index(Index, !PDInfo) :-
|
|
!PDInfo ^ pdi_goal_version_index := Index.
|
|
pd_info_set_versions(Versions, !PDInfo) :-
|
|
!PDInfo ^ pdi_versions := Versions.
|
|
pd_info_set_proc_arg_info(ProcArgInfo, !PDInfo) :-
|
|
!PDInfo ^ pdi_proc_arg_info := ProcArgInfo.
|
|
pd_info_set_counter(Counter, !PDInfo) :-
|
|
!PDInfo ^ pdi_counter := Counter.
|
|
pd_info_set_global_term_info(TermInfo, !PDInfo) :-
|
|
!PDInfo ^ pdi_global_term_info := TermInfo.
|
|
pd_info_set_parent_versions(Parents, !PDInfo) :-
|
|
!PDInfo ^ pdi_parent_versions := Parents.
|
|
pd_info_set_depth(Depth, !PDInfo) :-
|
|
!PDInfo ^ pdi_depth := Depth.
|
|
pd_info_set_created_versions(Versions, !PDInfo) :-
|
|
!PDInfo ^ pdi_created_versions := Versions.
|
|
pd_info_set_useless_versions(Versions, !PDInfo) :-
|
|
!PDInfo ^ pdi_useless_versions := Versions.
|
|
|
|
pd_info_update_goal(hlds_goal(_, GoalInfo), !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
Delta = goal_info_get_instmap_delta(GoalInfo),
|
|
apply_instmap_delta(Delta, InstMap0, InstMap),
|
|
pd_info_set_instmap(InstMap, !PDInfo).
|
|
|
|
pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
lookup_var_type(VarTable, Var, Type),
|
|
bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
|
|
InstMap0, InstMap, ModuleInfo0, ModuleInfo),
|
|
pd_info_set_instmap(InstMap, !PDInfo),
|
|
pd_info_set_module_info(ModuleInfo, !PDInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- interface.
|
|
|
|
% unfold_info contains information used while searching a procedure
|
|
% body for unfolding and deforestation opportunities.
|
|
:- type unfold_info
|
|
---> unfold_info(
|
|
ufi_proc_info :: proc_info,
|
|
ufi_head_inst_vars :: map(inst_var, mer_inst),
|
|
ufi_instmap :: instmap,
|
|
|
|
% Improvement in cost measured while processing this procedure.
|
|
ufi_cost_delta :: int,
|
|
|
|
% Information used to prevent infinite unfolding within the
|
|
% current procedure..
|
|
ufi_local_term_info :: local_term_info,
|
|
|
|
ufi_pred_info :: pred_info,
|
|
ufi_parents :: set(pred_proc_id),
|
|
|
|
% Current pred_proc_id.
|
|
ufi_pred_proc_id :: pred_proc_id,
|
|
|
|
% Increase in size measured while processing this procedure.
|
|
ufi_size_delta :: int,
|
|
|
|
% Has anything changed?
|
|
ufi_changed :: bool,
|
|
|
|
% Does determinism analysis need to be rerun.
|
|
ufi_rerun_det :: bool
|
|
).
|
|
|
|
% pd_arg_info records which procedures have arguments for which
|
|
% it might be worthwhile to attempt deforestation if there
|
|
% is extra information about them, and the branches of the single
|
|
% branched goal in the top level conjunction which produce that extra
|
|
% information.
|
|
:- type pd_arg_info == map(pred_proc_id, pd_proc_arg_info).
|
|
|
|
:- type pd_proc_arg_info == pd_branch_info(int).
|
|
|
|
:- type pd_branch_info(T)
|
|
---> pd_branch_info(
|
|
branch_info_map(T),
|
|
|
|
% variables for which we want extra left context
|
|
set(T),
|
|
|
|
% outputs for which we have no extra information
|
|
set(T)
|
|
).
|
|
|
|
% Vars for which there is extra information at the end
|
|
% of some branches, and the branches which add the extra
|
|
% information (numbered from 1).
|
|
:- type branch_info_map(T) == map(T, set(int)).
|
|
|
|
:- pred pd_info_get_proc_info(pd_info::in, proc_info::out) is det.
|
|
:- pred pd_info_get_head_inst_vars(pd_info::in, map(inst_var, mer_inst)::out)
|
|
is det.
|
|
:- pred pd_info_get_instmap(pd_info::in, instmap::out) is det.
|
|
:- pred pd_info_get_cost_delta(pd_info::in, int::out) is det.
|
|
:- pred pd_info_get_local_term_info(pd_info::in, local_term_info::out) is det.
|
|
:- pred pd_info_get_pred_info(pd_info::in, pred_info::out) is det.
|
|
:- pred pd_info_get_parents(pd_info::in, set(pred_proc_id)::out) is det.
|
|
:- pred pd_info_get_pred_proc_id(pd_info::in, pred_proc_id::out) is det.
|
|
:- pred pd_info_get_size_delta(pd_info::in, int::out) is det.
|
|
:- pred pd_info_get_changed(pd_info::in, bool::out) is det.
|
|
:- pred pd_info_get_rerun_det(pd_info::in, bool::out) is det.
|
|
|
|
:- pred pd_info_set_proc_info(proc_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_instmap(instmap::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_cost_delta(int::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_local_term_info(local_term_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_pred_info(pred_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_parents(set(pred_proc_id)::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_pred_proc_id(pred_proc_id::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_size_delta(int::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_changed(bool::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_set_rerun_det(bool::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
:- pred pd_info_incr_cost_delta(int::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pred pd_info_incr_size_delta(int::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
pd_info_get_proc_info(PDInfo, UnfoldInfo ^ ufi_proc_info) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_head_inst_vars(PDInfo, UnfoldInfo ^ ufi_head_inst_vars) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_instmap(PDInfo, UnfoldInfo ^ ufi_instmap) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_cost_delta(PDInfo, UnfoldInfo ^ ufi_cost_delta) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_local_term_info(PDInfo, UnfoldInfo ^ ufi_local_term_info) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_pred_info(PDInfo, UnfoldInfo ^ ufi_pred_info) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_parents(PDInfo, UnfoldInfo ^ ufi_parents) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_pred_proc_id(PDInfo, UnfoldInfo ^ ufi_pred_proc_id) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_size_delta(PDInfo, UnfoldInfo ^ ufi_size_delta) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_changed(PDInfo, UnfoldInfo ^ ufi_changed) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
pd_info_get_rerun_det(PDInfo, UnfoldInfo ^ ufi_rerun_det) :-
|
|
pd_info_get_unfold_info(PDInfo, UnfoldInfo).
|
|
|
|
pd_info_set_proc_info(ProcInfo, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_proc_info := ProcInfo,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_instmap(InstMap, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_instmap := InstMap,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_cost_delta(CostDelta, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_cost_delta := CostDelta,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_local_term_info(TermInfo, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_local_term_info := TermInfo,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_pred_info(PredInfo, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_pred_info := PredInfo,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_parents(Parents, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_parents := Parents,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_pred_proc_id(PredProcId, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_pred_proc_id := PredProcId,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_size_delta(SizeDelta, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_size_delta := SizeDelta,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_changed(Changed, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_changed := Changed,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
pd_info_set_rerun_det(Rerun, !PDInfo) :-
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo0),
|
|
UnfoldInfo = UnfoldInfo0 ^ ufi_rerun_det := Rerun,
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
|
|
|
|
pd_info_incr_cost_delta(Delta1, !PDInfo) :-
|
|
pd_info_get_cost_delta(!.PDInfo, Delta0),
|
|
Delta = Delta0 + Delta1,
|
|
pd_info_set_cost_delta(Delta, !PDInfo).
|
|
|
|
pd_info_incr_size_delta(Delta1, !PDInfo) :-
|
|
pd_info_get_size_delta(!.PDInfo, Delta0),
|
|
Delta = Delta0 + Delta1,
|
|
pd_info_set_size_delta(Delta, !PDInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- interface.
|
|
|
|
% Find the deforestation procedure which most closely matches
|
|
% the given goal.
|
|
%
|
|
:- pred pd_info_search_version(pd_info::in, hlds_goal::in, maybe_version::out)
|
|
is det.
|
|
|
|
% Create a new predicate for the input goal, returning a goal
|
|
% which calls the new predicate.
|
|
%
|
|
:- pred pd_info_define_new_pred(hlds_goal::in,
|
|
pred_proc_id::out, hlds_goal::out, pd_info::in, pd_info::out) is det.
|
|
|
|
% Add a version to the table.
|
|
%
|
|
:- pred pd_info_register_version(pred_proc_id::in, version_info::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
% Remove a version and make sure it is never recreated.
|
|
%
|
|
:- pred pd_info_invalidate_version(pred_proc_id::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
% Remove a version, but allow it to be recreated if it
|
|
% is used elsewhere.
|
|
%
|
|
:- pred pd_info_remove_version(pred_proc_id::in,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
% The result of looking up a specialised version of a pred.
|
|
:- type maybe_version
|
|
---> no_version
|
|
; version(
|
|
mv_is_exact :: version_is_exact,
|
|
mv_ppid :: pred_proc_id,
|
|
mv_version :: version_info,
|
|
|
|
% renaming of the version info
|
|
mv_renaming :: map(prog_var, prog_var),
|
|
|
|
% var types substitution
|
|
mv_tsubst :: tsubst
|
|
).
|
|
|
|
:- type version_is_exact
|
|
---> exact
|
|
; more_general.
|
|
|
|
:- type version_info
|
|
---> version_info(
|
|
% goal before unfolding.
|
|
version_orig_goal :: hlds_goal,
|
|
|
|
% calls being deforested.
|
|
version_deforest_calls :: list(pred_proc_id),
|
|
|
|
% arguments.
|
|
version_arg_vars :: list(prog_var),
|
|
|
|
% argument types.
|
|
version_arg_types :: list(mer_type),
|
|
|
|
% initial insts of the nonlocals.
|
|
version_init_insts :: instmap,
|
|
|
|
% cost of the original goal.
|
|
version_orig_cost :: int,
|
|
|
|
% improvement in cost.
|
|
version_cost_improv :: int,
|
|
|
|
% parent versions.
|
|
version_parents :: set(pred_proc_id),
|
|
|
|
% the version which was generalised to produce this version.
|
|
version_source :: maybe(pred_proc_id)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
pd_info_search_version(PDInfo, Goal, MaybeVersion) :-
|
|
trace [io(!IO)] (
|
|
pd_debug_output_goal(PDInfo, "Searching for version:\n", Goal, !IO)
|
|
),
|
|
pd_util.goal_get_calls(Goal, CalledPreds),
|
|
pd_info_get_versions(PDInfo, Versions),
|
|
pd_info_get_goal_version_index(PDInfo, GoalVersionIndex),
|
|
pd_info_get_module_info(PDInfo, ModuleInfo),
|
|
pd_info_get_proc_info(PDInfo, ProcInfo),
|
|
pd_info_get_instmap(PDInfo, InstMap),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
( if
|
|
map.search(GoalVersionIndex, CalledPreds, VersionIds),
|
|
pd_info_get_matching_version(ModuleInfo, Goal, InstMap,
|
|
VarTable, VersionIds, Versions, MaybeVersion0)
|
|
then
|
|
MaybeVersion = MaybeVersion0
|
|
else
|
|
MaybeVersion = no_version
|
|
),
|
|
trace [io(!IO)] (
|
|
pd_debug_search_version_result(PDInfo, MaybeVersion, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred pd_info_get_matching_version(module_info::in, hlds_goal::in,
|
|
instmap::in, var_table::in, list(pred_proc_id)::in,
|
|
version_index::in, maybe_version::out) is semidet.
|
|
|
|
pd_info_get_matching_version(_, _, _, _, [], _, no_version).
|
|
pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap, VarTable,
|
|
[VersionId | VersionIds], Versions, MaybeVersion) :-
|
|
map.lookup(Versions, VersionId, Version),
|
|
Version = version_info(OldGoal, _, OldArgs, OldArgTypes,
|
|
OldInstMap, _, _, _, _),
|
|
( if
|
|
pd_info_goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs,
|
|
OldArgTypes, ThisGoal, ThisInstMap, VarTable, VersionId, Version,
|
|
MaybeVersion1)
|
|
then
|
|
(
|
|
MaybeVersion1 = no_version,
|
|
pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap,
|
|
VarTable, VersionIds, Versions, MaybeVersion)
|
|
;
|
|
MaybeVersion1 = version(exact, _, _, _, _),
|
|
MaybeVersion = MaybeVersion1
|
|
;
|
|
MaybeVersion1 = version(more_general, PredProcId,
|
|
MoreGeneralVersion, Renaming, TypeSubn),
|
|
pd_info_get_matching_version(ModuleInfo, ThisGoal,
|
|
ThisInstMap, VarTable, VersionIds,
|
|
Versions, MaybeVersion2),
|
|
pd_info_pick_version(ModuleInfo, PredProcId, Renaming,
|
|
TypeSubn, MoreGeneralVersion, MaybeVersion2, MaybeVersion)
|
|
)
|
|
else
|
|
pd_info_get_matching_version(ModuleInfo, ThisGoal, ThisInstMap,
|
|
VarTable, VersionIds, Versions, MaybeVersion)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Choose between two versions.
|
|
%
|
|
:- pred pd_info_pick_version(module_info::in, pred_proc_id::in,
|
|
map(prog_var, prog_var)::in, tsubst::in, version_info::in,
|
|
maybe_version::in, maybe_version::out) is det.
|
|
|
|
pd_info_pick_version(_, PredProcId, Renaming, TSubn, VersionInfo, no_version,
|
|
version(more_general, PredProcId, VersionInfo, Renaming, TSubn)).
|
|
pd_info_pick_version(_, _, _, _, _,
|
|
version(exact, PredProcId, Version2, Renaming2, TSubn2),
|
|
version(exact, PredProcId, Version2, Renaming2, TSubn2)).
|
|
pd_info_pick_version(_ModuleInfo, PredProcId1, Renaming1, TSubn1, Version1,
|
|
version(more_general, PredProcId2, Version2, Renaming2, TSubn2),
|
|
MaybeVersion) :-
|
|
Version1 = version_info(_, _, _, _, _, _, CostDelta1, _, _),
|
|
Version2 = version_info(_, _, _, _, _, _, CostDelta2, _, _),
|
|
% Select the version with the biggest decrease in cost.
|
|
( if CostDelta1 > CostDelta2 then
|
|
MaybeVersion = version(more_general, PredProcId1,
|
|
Version1, Renaming1, TSubn1)
|
|
else
|
|
MaybeVersion = version(more_general, PredProcId2,
|
|
Version2, Renaming2, TSubn2)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The aim of this is to check whether the first goal can be used
|
|
% instead of the second if specialisation on the second goal does
|
|
% not produce any more improvement.
|
|
%
|
|
% An old version is more general than a new one if:
|
|
% - the goals have the same "shape" (see pd_util.goals_match).
|
|
% - each variable in the old goal maps to exactly one
|
|
% variable in the new (multiple vars in the new goal can
|
|
% map to one var in the old).
|
|
% - each nonlocal in the new goal maps to a non-local in the
|
|
% old (i.e. the old version produces all the variables
|
|
% that the new one does).
|
|
% - for each pair of corresponding insts in the above mapping,
|
|
% the old inst must be at least as general as the
|
|
% new one, i.e inst_matches_initial(FirstInst, SecondInst) (?)
|
|
%
|
|
:- pred pd_info_goal_is_more_general(module_info::in, hlds_goal::in,
|
|
instmap::in, list(prog_var)::in, list(mer_type)::in, hlds_goal::in,
|
|
instmap::in, var_table::in, pred_proc_id::in,
|
|
version_info::in, maybe_version::out) is semidet.
|
|
|
|
pd_info_goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs,
|
|
OldArgTypes, NewGoal, NewInstMap, NewVarTable, PredProcId,
|
|
Version, MaybeVersion) :-
|
|
pd_util.goals_match(ModuleInfo, OldGoal, OldArgs, OldArgTypes,
|
|
NewGoal, NewVarTable, OldNewRenaming, TypeRenaming),
|
|
OldGoal = hlds_goal(_, OldGoalInfo),
|
|
OldNonLocals0 = goal_info_get_nonlocals(OldGoalInfo),
|
|
set_of_var.to_sorted_list(OldNonLocals0, OldNonLocalsList),
|
|
pd_info_check_insts(ModuleInfo, OldNonLocalsList, OldNewRenaming,
|
|
OldInstMap, NewInstMap, NewVarTable, exact, Exact),
|
|
|
|
MaybeVersion = version(Exact, PredProcId, Version,
|
|
OldNewRenaming, TypeRenaming).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Check that all the insts in the old version are at least as
|
|
% general as the insts in the new version.
|
|
%
|
|
:- pred pd_info_check_insts(module_info::in, list(prog_var)::in,
|
|
map(prog_var, prog_var)::in, instmap::in, instmap::in, var_table::in,
|
|
version_is_exact::in, version_is_exact::out) is semidet.
|
|
|
|
pd_info_check_insts(_, [], _, _, _, _, !ExactSoFar).
|
|
pd_info_check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap,
|
|
NewInstMap, VarTable, !ExactSoFar) :-
|
|
instmap_lookup_var(OldInstMap, OldVar, OldVarInst),
|
|
map.lookup(VarRenaming, OldVar, NewVar),
|
|
instmap_lookup_var(NewInstMap, NewVar, NewVarInst),
|
|
lookup_var_type(VarTable, NewVar, Type),
|
|
inst_matches_initial(ModuleInfo, Type, NewVarInst, OldVarInst),
|
|
(
|
|
!.ExactSoFar = exact,
|
|
% Does inst_matches_initial(Inst1, Inst2, M) and
|
|
% inst_matches_initial(Inst2, Inst1, M) imply that Inst1
|
|
% and Inst2 are interchangable?
|
|
( if
|
|
inst_matches_initial(ModuleInfo, Type, OldVarInst, NewVarInst)
|
|
then
|
|
!:ExactSoFar = exact
|
|
else
|
|
!:ExactSoFar = more_general
|
|
)
|
|
;
|
|
!.ExactSoFar = more_general
|
|
),
|
|
pd_info_check_insts(ModuleInfo, Vars, VarRenaming, OldInstMap,
|
|
NewInstMap, VarTable, !ExactSoFar).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
pd_info_define_new_pred(Goal, PredProcId, CallGoal, !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap),
|
|
Goal = hlds_goal(_, GoalInfo),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
set_of_var.to_sorted_list(NonLocals, Args),
|
|
pd_info_get_counter(!.PDInfo, Counter0),
|
|
counter.allocate(SeqNum, Counter0, Counter),
|
|
pd_info_set_counter(Counter, !PDInfo),
|
|
pd_info_get_pred_info(!.PDInfo, PredInfo),
|
|
PredModule = pred_info_module(PredInfo),
|
|
PredName = pred_info_name(PredInfo),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
LineNum = term_context.context_line(Context),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
|
|
Origin = origin_compiler(made_for_deforestation(LineNum, SeqNum)),
|
|
Transform = tn_deforestation(pf_predicate, lnc(LineNum, SeqNum)),
|
|
make_transformed_pred_sym_name(PredModule, PredName, Transform,
|
|
NewPredSymName),
|
|
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo),
|
|
pred_info_get_typevarset(PredInfo, TVarSet),
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
pred_info_get_class_context(PredInfo, ClassContext),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
|
|
proc_info_get_inst_varset(ProcInfo, InstVarSet),
|
|
proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj),
|
|
proc_info_get_var_name_remap(ProcInfo, VarNameRemap),
|
|
% XXX handle the extra typeinfo arguments for
|
|
% --typeinfo-liveness properly.
|
|
hlds_pred.define_new_pred(NewPredSymName, Origin, TVarSet, InstVarSet,
|
|
VarTable, RttiVarMaps, ClassContext, InstMap, VarNameRemap, Markers,
|
|
address_is_not_taken, HasParallelConj, PredProcId, Args, _ExtraArgs,
|
|
Goal, CallGoal, ModuleInfo0, ModuleInfo),
|
|
pd_info_set_module_info(ModuleInfo, !PDInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
pd_info_register_version(PredProcId, Version, !PDInfo) :-
|
|
trace [io(!IO)] (
|
|
pd_debug_register_version(!.PDInfo, PredProcId, Version, !IO)
|
|
),
|
|
pd_info_get_goal_version_index(!.PDInfo, GoalVersionIndex0),
|
|
Goal = Version ^ version_orig_goal,
|
|
pd_util.goal_get_calls(Goal, Calls),
|
|
( if map.search(GoalVersionIndex0, Calls, VersionList0) then
|
|
VersionList = [PredProcId | VersionList0],
|
|
map.det_update(Calls, VersionList, GoalVersionIndex0, GoalVersionIndex)
|
|
else
|
|
VersionList = [PredProcId],
|
|
map.det_insert(Calls, VersionList, GoalVersionIndex0, GoalVersionIndex)
|
|
),
|
|
pd_info_set_goal_version_index(GoalVersionIndex, !PDInfo),
|
|
pd_info_get_versions(!.PDInfo, Versions0),
|
|
map.det_insert(PredProcId, Version, Versions0, Versions),
|
|
pd_info_set_versions(Versions, !PDInfo),
|
|
pd_info_get_created_versions(!.PDInfo, CreatedVersions0),
|
|
set.insert(PredProcId, CreatedVersions0, CreatedVersions),
|
|
pd_info_set_created_versions(CreatedVersions, !PDInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
pd_info_invalidate_version(PredProcId, !PDInfo) :-
|
|
pd_info_get_versions(!.PDInfo, Versions0),
|
|
map.lookup(Versions0, PredProcId, Version),
|
|
Goal = Version ^ version_orig_goal,
|
|
pd_util.goal_get_calls(Goal, Calls),
|
|
( if
|
|
Calls = [FirstCall | _],
|
|
list.last(Calls, LastCall)
|
|
then
|
|
% Make sure we never create another version to deforest
|
|
% this pair of calls.
|
|
pd_info_get_useless_versions(!.PDInfo, Useless0),
|
|
set.insert(FirstCall - LastCall, Useless0, Useless),
|
|
pd_info_set_useless_versions(Useless, !PDInfo)
|
|
else
|
|
true
|
|
),
|
|
pd_info_remove_version(PredProcId, !PDInfo).
|
|
|
|
pd_info_remove_version(PredProcId, !PDInfo) :-
|
|
pd_info_get_versions(!.PDInfo, Versions0),
|
|
map.lookup(Versions0, PredProcId, Version),
|
|
Goal = Version ^ version_orig_goal,
|
|
pd_util.goal_get_calls(Goal, Calls),
|
|
map.delete(PredProcId, Versions0, Versions),
|
|
pd_info_set_versions(Versions, !PDInfo),
|
|
|
|
pd_info_get_goal_version_index(!.PDInfo, GoalIndex0),
|
|
( if map.search(GoalIndex0, Calls, GoalVersions0) then
|
|
list.delete_all(GoalVersions0, PredProcId, GoalVersions),
|
|
map.det_update(Calls, GoalVersions, GoalIndex0, GoalIndex),
|
|
pd_info_set_goal_version_index(GoalIndex, !PDInfo)
|
|
else
|
|
true
|
|
),
|
|
|
|
pd_info_get_created_versions(!.PDInfo, CreatedVersions0),
|
|
set.delete(PredProcId, CreatedVersions0, CreatedVersions),
|
|
pd_info_set_created_versions(CreatedVersions, !PDInfo),
|
|
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
|
|
PredProcId = proc(PredId, _),
|
|
module_info_remove_predicate(PredId, ModuleInfo0, ModuleInfo),
|
|
pd_info_set_module_info(ModuleInfo, !PDInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.pd_info.
|
|
%---------------------------------------------------------------------------%
|