mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
7d2146d3a9
compiler/recompilation.record_uses.m:
Rename the eqv_expand_info type to item_recomp_deps to better document
its purpose (it is to record which equivalence expansions *an item
depends on*). Finish documenting the type itself.
Rename the predicates operating on values of that type accordingly,
together with the variables in their clauses.
Since the point of the type is to record info about an item,
make the main predicate that constructs values of this type
take *the id the actual item* as input. Previously, it was just
a sym_name that was part of the item id. We still need that version
in two places (where we don't know the final item id yet), but use it
only when we have to. In each case, document *why* we have to.
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/qual_info.m:
compiler/add_pragma_type_spec.m:
Conform to the changes above.
Use a consistent naming scheme for the variables of the renamed type.
In one case, stop using a "some [!StateVar]" scope that hurts
readability more than it helps.
350 lines
13 KiB
Mathematica
350 lines
13 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2009, 2011-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2015, 2017-2026 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: qual_info.m.
|
|
% Main author: fjh.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.qual_info.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.status.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.build_eqv_maps.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.module_qual.
|
|
:- import_module parse_tree.module_qual.mq_info.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.vartypes.
|
|
:- import_module recompilation.
|
|
:- import_module recompilation.record_uses.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type qual_info.
|
|
|
|
:- pred init_qual_info(mq_info::in, type_eqv_map::in, qual_info::out) is det.
|
|
|
|
% Update the qual_info when processing a new clause.
|
|
%
|
|
:- pred update_qual_info(tvar_name_map::in, tvarset::in, vartypes::in,
|
|
maybe_opt_imported::in, qual_info::in, qual_info::out) is det.
|
|
|
|
:- pred qual_info_get_tvarset(qual_info::in, tvarset::out) is det.
|
|
:- pred qual_info_get_explicit_var_types(qual_info::in, vartypes::out) is det.
|
|
:- pred qual_info_get_mq_info(qual_info::in, mq_info::out) is det.
|
|
:- pred qual_info_get_maybe_opt_imported(qual_info::in,
|
|
maybe_opt_imported::out) is det.
|
|
:- pred qual_info_get_found_syntax_error(qual_info::in, bool::out) is det.
|
|
:- pred qual_info_get_found_trace_goal(qual_info::in, bool::out) is det.
|
|
|
|
:- pred qual_info_set_explicit_var_types(vartypes::in,
|
|
qual_info::in, qual_info::out) is det.
|
|
:- pred qual_info_set_mq_info(mq_info::in,
|
|
qual_info::in, qual_info::out) is det.
|
|
:- pred qual_info_set_found_syntax_error(bool::in,
|
|
qual_info::in, qual_info::out) is det.
|
|
:- pred qual_info_set_found_trace_goal(bool::in,
|
|
qual_info::in, qual_info::out) is det.
|
|
|
|
:- pred apply_to_recompilation_info(
|
|
pred(recompilation_info, recompilation_info)::in(pred(in, out) is det),
|
|
qual_info::in, qual_info::out) is det.
|
|
|
|
% Move the recompilation_info from the qual_info to the module_info
|
|
% after make_hlds is finished with it and the qual_info is dead.
|
|
%
|
|
:- pred set_module_recompilation_info(qual_info::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
% Process an explicit type qualification.
|
|
%
|
|
:- pred process_type_qualification(prog_var::in, mer_type::in, tvarset::in,
|
|
prog_context::in, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
:- pred make_atomic_unification(prog_var::in, unify_rhs::in, prog_context::in,
|
|
unify_main_context::in, list(unify_sub_context)::in, purity::in,
|
|
hlds_goal::out, qual_info::in, qual_info::out) is det.
|
|
|
|
% As above, except with default purity pure.
|
|
%
|
|
:- pred make_atomic_unification(prog_var::in, unify_rhs::in, prog_context::in,
|
|
unify_main_context::in, list(unify_sub_context)::in,
|
|
hlds_goal::out, qual_info::in, qual_info::out) is det.
|
|
|
|
:- pred record_called_pred_or_func(pred_or_func::in, sym_name::in,
|
|
user_arity::in, qual_info::in, qual_info::out) is det.
|
|
|
|
:- pred construct_and_record_pred_or_func_call(pred_id::in, pred_or_func::in,
|
|
sym_name::in, list(prog_var)::in, hlds_goal_info::in, hlds_goal::out,
|
|
qual_info::in, qual_info::out) is det.
|
|
|
|
:- pred construct_pred_or_func_call(pred_id::in, pred_or_func::in,
|
|
sym_name::in, list(prog_var)::in, hlds_goal_info::in, hlds_goal::out)
|
|
is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.make_goal.
|
|
:- import_module parse_tree.equiv_type.
|
|
:- import_module parse_tree.module_qual.id_set.
|
|
:- import_module parse_tree.module_qual.qualify_items.
|
|
:- import_module parse_tree.prog_type_scan.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module recompilation.item_types.
|
|
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Information used to process explicit type qualifications.
|
|
%
|
|
:- type qual_info
|
|
---> qual_info(
|
|
% Used to expand equivalence types.
|
|
qual_type_eqv_map :: type_eqv_map,
|
|
|
|
% All type variables for predicate.
|
|
qual_tvarset :: tvarset,
|
|
|
|
% Map from clause type variable to actual type variable
|
|
% in tvarset.
|
|
qual_tvar_renaming :: tvar_renaming,
|
|
|
|
% Type variables in tvarset occurring in the predicate's
|
|
% argument types indexed by name.
|
|
qual_tvar_name_map :: tvar_name_map,
|
|
|
|
qual_explicit_vartypes :: vartypes,
|
|
|
|
% Module qualification info.
|
|
qual_mq_info :: mq_info,
|
|
|
|
qual_maybe_opt_imported :: maybe_opt_imported,
|
|
|
|
% Was there a syntax error in the clause?
|
|
qual_found_syntax_error :: bool,
|
|
|
|
% Was there a trace goal in the clause?
|
|
qual_found_trace_goal :: bool
|
|
).
|
|
|
|
init_qual_info(MQInfo, TypeEqvMap, QualInfo) :-
|
|
varset.init(TVarSet),
|
|
map.init(Renaming),
|
|
map.init(Index),
|
|
init_vartypes(VarTypes),
|
|
FoundSyntaxError = no,
|
|
FoundTraceGoal = no,
|
|
QualInfo = qual_info(TypeEqvMap, TVarSet, Renaming, Index, VarTypes,
|
|
MQInfo, is_not_opt_imported, FoundSyntaxError, FoundTraceGoal).
|
|
|
|
update_qual_info(TVarNameMap, TVarSet, VarTypes, MaybeOptImported,
|
|
!QualInfo) :-
|
|
!.QualInfo = qual_info(TypeEqvMap, _TVarSet0, _Renaming0, _TVarNameMap0,
|
|
_VarTypes0, MQInfo, _MaybeOptImported, _FoundError, _FoundTraceGoal),
|
|
% The renaming for one clause is useless in the others.
|
|
map.init(Renaming),
|
|
!:QualInfo = qual_info(TypeEqvMap, TVarSet, Renaming, TVarNameMap,
|
|
VarTypes, MQInfo, MaybeOptImported, no, no).
|
|
|
|
qual_info_get_tvarset(Info, X) :-
|
|
X = Info ^ qual_tvarset.
|
|
qual_info_get_explicit_var_types(Info, X) :-
|
|
X = Info ^ qual_explicit_vartypes.
|
|
qual_info_get_mq_info(Info, X) :-
|
|
X = Info ^ qual_mq_info.
|
|
qual_info_get_maybe_opt_imported(Info, X) :-
|
|
X = Info ^ qual_maybe_opt_imported.
|
|
qual_info_get_found_syntax_error(Info, X) :-
|
|
X = Info ^ qual_found_syntax_error.
|
|
qual_info_get_found_trace_goal(Info, X) :-
|
|
X = Info ^ qual_found_trace_goal.
|
|
|
|
qual_info_set_explicit_var_types(X, !Info) :-
|
|
!Info ^ qual_explicit_vartypes := X.
|
|
qual_info_set_mq_info(X, !Info) :-
|
|
!Info ^ qual_mq_info := X.
|
|
qual_info_set_found_syntax_error(X, !Info) :-
|
|
!Info ^ qual_found_syntax_error := X.
|
|
qual_info_set_found_trace_goal(X, !Info) :-
|
|
!Info ^ qual_found_trace_goal := X.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
apply_to_recompilation_info(Pred, !QualInfo) :-
|
|
qual_info_get_mq_info(!.QualInfo, MQInfo0),
|
|
mq_info_get_recompilation_info(MQInfo0, MaybeRecompInfo0),
|
|
(
|
|
MaybeRecompInfo0 = yes(RecompInfo0),
|
|
Pred(RecompInfo0, RecompInfo),
|
|
mq_info_set_recompilation_info(yes(RecompInfo), MQInfo0, MQInfo),
|
|
qual_info_set_mq_info(MQInfo, !QualInfo)
|
|
;
|
|
MaybeRecompInfo0 = no
|
|
).
|
|
|
|
set_module_recompilation_info(QualInfo, !ModuleInfo) :-
|
|
qual_info_get_mq_info(QualInfo, MQInfo),
|
|
mq_info_get_recompilation_info(MQInfo, RecompInfo),
|
|
module_info_set_maybe_recompilation_info(RecompInfo, !ModuleInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
process_type_qualification(Var, Type0, VarSet, Context, !QualInfo, !Specs) :-
|
|
!.QualInfo = qual_info(TypeEqvMap, TVarSet0, TVarRenaming0,
|
|
TVarNameMap0, VarTypes0, MQInfo0, MaybeOptImported,
|
|
FoundSyntaxError, FoundTraceGoal),
|
|
(
|
|
MaybeOptImported = is_opt_imported,
|
|
% Types in `.opt' files should already be fully module qualified.
|
|
Type1 = Type0,
|
|
MQInfo = MQInfo0
|
|
;
|
|
MaybeOptImported = is_not_opt_imported,
|
|
% Type qualifications cannot appear in the interface of a module.
|
|
qualify_type_qualification(mq_not_used_in_interface, Context,
|
|
Type0, Type1, MQInfo0, MQInfo, !Specs)
|
|
),
|
|
|
|
% Find any new type variables introduced by this type, and
|
|
% add them to the var-name index and the variable renaming.
|
|
type_vars_in_type(Type1, TVars),
|
|
get_new_tvars(TVars, VarSet, TVarSet0, TVarSet1,
|
|
TVarNameMap0, TVarNameMap, TVarRenaming0, TVarRenaming),
|
|
|
|
% Apply the updated renaming to convert type variables in
|
|
% the clause to type variables in the tvarset.
|
|
apply_renaming_to_type(TVarRenaming, Type1, Type2),
|
|
|
|
% Expand equivalence types.
|
|
% We don't need to record the expanded types for smart recompilation
|
|
% because at the moment, no recompilation.item_id can depend on a
|
|
% clause item.
|
|
ItemRecompDeps0 = no_item_recomp_deps,
|
|
equiv_type.replace_in_type(TypeEqvMap, Type2, Type, _, TVarSet1, TVarSet,
|
|
ItemRecompDeps0, _),
|
|
update_var_types(Var, Type, Context, VarTypes0, VarTypes, !Specs),
|
|
!:QualInfo = qual_info(TypeEqvMap, TVarSet, TVarRenaming,
|
|
TVarNameMap, VarTypes, MQInfo, MaybeOptImported,
|
|
FoundSyntaxError, FoundTraceGoal).
|
|
|
|
:- pred update_var_types(prog_var::in, mer_type::in, prog_context::in,
|
|
vartypes::in, vartypes::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
update_var_types(Var, Type, Context, !VarTypes, !Specs) :-
|
|
( if search_var_type(!.VarTypes, Var, Type0) then
|
|
( if Type = Type0 then
|
|
true
|
|
else
|
|
Pieces = [words("Error: explicit type qualification")] ++
|
|
color_as_incorrect(
|
|
[words("does not match prior qualification.")]) ++
|
|
[nl],
|
|
Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
)
|
|
else
|
|
add_var_type(Var, Type, !VarTypes)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_atomic_unification(Var, RHS, Context, MainContext, SubContext, Purity,
|
|
Goal, !QualInfo) :-
|
|
(
|
|
RHS = rhs_var(_)
|
|
;
|
|
RHS = rhs_lambda_goal(_, _, _, _, _, _, _)
|
|
;
|
|
RHS = rhs_functor(ConsId, _, _),
|
|
record_used_functor(ConsId, !QualInfo)
|
|
),
|
|
create_atomic_complicated_unification(Var, RHS, Context,
|
|
MainContext, SubContext, Purity, Goal).
|
|
|
|
make_atomic_unification(Var, RHS, Context, MainContext, SubContext,
|
|
Goal, !QualInfo) :-
|
|
make_atomic_unification(Var, RHS, Context, MainContext, SubContext,
|
|
purity_pure, Goal, !QualInfo).
|
|
|
|
record_called_pred_or_func(PredOrFunc, SymName, UserArity, !QualInfo) :-
|
|
UserArity = user_arity(UserArityInt),
|
|
Id = recomp_item_name(SymName, UserArityInt),
|
|
( PredOrFunc = pf_predicate, UsedItemType = used_predicate
|
|
; PredOrFunc = pf_function, UsedItemType = used_function
|
|
),
|
|
apply_to_recompilation_info(record_used_item(UsedItemType, Id, Id),
|
|
!QualInfo).
|
|
|
|
:- pred record_used_functor(cons_id::in, qual_info::in, qual_info::out) is det.
|
|
|
|
record_used_functor(ConsId, !QualInfo) :-
|
|
( if ConsId = du_data_ctor(DuCtor) then
|
|
DuCtor = du_ctor(SymName, Arity, _),
|
|
Id = recomp_item_name(SymName, Arity),
|
|
apply_to_recompilation_info(record_used_item(used_functor, Id, Id),
|
|
!QualInfo)
|
|
else
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
construct_and_record_pred_or_func_call(PredId, PredOrFunc, SymName, ArgVars,
|
|
GoalInfo, Goal, !QualInfo) :-
|
|
construct_pred_or_func_call(PredId, PredOrFunc, SymName, ArgVars,
|
|
GoalInfo, Goal),
|
|
PredFormArity = arg_list_arity(ArgVars),
|
|
user_arity_pred_form_arity(PredOrFunc, UserArity, PredFormArity),
|
|
record_called_pred_or_func(PredOrFunc, SymName, UserArity, !QualInfo).
|
|
|
|
construct_pred_or_func_call(PredId, PredOrFunc, SymName, ArgVars,
|
|
GoalInfo, Goal) :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
GoalExpr = plain_call(PredId, invalid_proc_id, ArgVars, not_builtin,
|
|
no, SymName),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(ArgVars, FuncArgVars, RetArgVar),
|
|
list.length(FuncArgVars, Arity),
|
|
TypeCtor = cons_id_dummy_type_ctor,
|
|
ConsId = du_data_ctor(du_ctor(SymName, Arity, TypeCtor)),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
RHS = rhs_functor(ConsId, is_not_exist_constr, FuncArgVars),
|
|
create_pure_atomic_complicated_unification(RetArgVar, RHS,
|
|
Context, umc_explicit, [], hlds_goal(GoalExpr, _)),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.make_hlds.qual_info.
|
|
%-----------------------------------------------------------------------------%
|