mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-19 15:54:18 +00:00
77a6a6c10c
Estimated hours taken: 16 Branches: main Implement several more changes that together speed up compilation time on training_cars_full by 12%, and also improve tools/speedtest -h by 7.2% and tools/speedtest by 1.6%. The first change is designed to eliminate the time that the compiler spends constructing error messages that are then ignored. The working predicates of prog_io_sym_name used to always return a single result, which either gave a description of the thing being looked, or an error message. However, in many places, the caller did not consider not finding the thing being looked for to be an error, and thus threw away the error message, keeping only the "not found" indication. For each predicate with such callers, this diff provides a parallel predicate that indicates "not found" simply by failing. This allows us to eliminate the construction of the error message, the preparation for the construction of the error message (usually by describing the context), and the construction of the "ok" wrapper. The second change is to specialize the handling of from_ground_term_construct scopes in the termination analyzer. To make this easier, I also cleaned up of the infrastructure of the termination analyzer. The third change is to avoid traversing from_ground_term_construct scopes in quantification.m when finding the variables in a goal, since termination analysis no longer needs the information it gathers. The fourth change is to avoid traversing second and later conjuncts in conjunctions twice. The first step in handling conjunctions is to call implicitly_quantify_conj, which builds up a data structure that pairs each conjunct with the variables that occur free in all the conjuncts following it. However, after this was done and each conjunct was annotated with its nonlocals, we used to compute the variables that occur free in the conjunction as a whole from scratch. This diff changes the code so that we now compute that set based on the information we gathered earlier, avoiding a redundant traversal. The fifth change is to create specialized, lower-arity versions of many of the predicates in quantification.m. These versions are intended for traversals that take place after the compiler has replaced lambda expressions with references to separate procedures. These traversals do not need to pass around arguments representing the variables occurring free in the (now non-existent) lambda expressions. compiler/prog_io_sym_name.m: Make the first change described above. Change some predicate names to adopt a consistent naming scheme in which predicates that do the same job and differ only in how they handle errors have names that differ only in a "try_" prefix. Add some predicate versions that do common tests on the output of the base versions. For example, try_parse_sym_name_and_no_args is a version of try_parse_sym_name_and_args that insists on finding an empty argument list. Remove the unused "error term" argument that we used to need a while ago. Move some predicate definitions to make their order match the order of their declarations. Turn a predicate into a function for its caller's convenience. compiler/term_constr_build.m: Make the second change described above by modeling each from_ground_term_construct scope as a single unification, assigning the total size of the ground term to the variable being built. compiler/term_constr_util.m: Put the arguments of some predicates into a more standard order. compiler/lp_rational.m: Change the names of some function symbols to avoid both the use of graphic characters that require quoting and clashes with other types. Change the names of some predicates to make their purpose clear, and to avoid ambiguity. compiler/quantification.m: Make the third, fourth and fifth changes described above. compiler/*.m: Conform to the changes above.
350 lines
15 KiB
Mathematica
350 lines
15 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2006, 2008-2009 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: field_access.
|
|
%
|
|
% This submodule of make_hlds handles the declarations of fields
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.field_access.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.make_hlds.qual_info.
|
|
:- import_module hlds.make_hlds.state_var.
|
|
:- import_module hlds.make_hlds.superhomogeneous.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_io_util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module pair.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type field_list == assoc_list(ctor_field_name, list(prog_term)).
|
|
|
|
% Expand a field update goal into a list of goals which each get or set
|
|
% one level of the structure.
|
|
%
|
|
% A field update goal:
|
|
% Term = Term0 ^ module_info ^ ctors := Ctors
|
|
% is expanded into
|
|
% V_1 = Term0 ^ module_info,
|
|
% V_3 = V_2 ^ ctors := Ctors,
|
|
% Term = Term0 ^ module_info := V_3.
|
|
%
|
|
:- pred expand_set_field_function_call(prog_context::in,
|
|
unify_main_context::in, unify_sub_contexts::in, field_list::in,
|
|
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
|
|
pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
|
|
num_added_goals::out, prog_varset::in, prog_varset::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
svar_info::in, svar_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% Expand a field extraction goal into a list of goals which each get one
|
|
% level of the structure.
|
|
%
|
|
% A field extraction goal:
|
|
% := (ModuleName, ^ module_info ^ sub_info ^ module_name,
|
|
% DCG_in, DCG_out).
|
|
% is expanded into
|
|
% DCG_out = DCG_in,
|
|
% V_1 = DCG_out ^ module_info
|
|
% V_2 = V_1 ^ sub_info,
|
|
% ModuleName = V_2 ^ module_name.
|
|
%
|
|
:- pred expand_dcg_field_extraction_goal(prog_context::in,
|
|
unify_main_context::in, unify_sub_contexts::in, field_list::in,
|
|
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
|
|
pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
|
|
num_added_goals::out, prog_varset::in, prog_varset::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
svar_info::in, svar_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
% Expand a field extraction function call into a list of goals which
|
|
% each get one level of the structure.
|
|
%
|
|
% A field extraction goal:
|
|
% ModuleName = Info ^ module_info ^ sub_info ^ module_name
|
|
% is expanded into
|
|
% V_1 = Info ^ module_info,
|
|
% V_2 = V_1 ^ sub_info,
|
|
% ModuleName = V_2 ^ module_name.
|
|
%
|
|
:- pred expand_get_field_function_call(prog_context::in,
|
|
unify_main_context::in, unify_sub_contexts::in, field_list::in,
|
|
prog_var::in, prog_var::in, purity::in, cons_id::out,
|
|
pair(cons_id, unify_sub_contexts)::out,
|
|
hlds_goal::out, num_added_goals::out, prog_varset::in, prog_varset::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
svar_info::in, svar_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
:- pred maybe_parse_field_list(prog_term::in, prog_varset::in,
|
|
field_list::out) is semidet.
|
|
|
|
:- pred parse_field_list(prog_term::in, prog_varset::in,
|
|
list(format_component)::in, maybe1(field_list)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.make_hlds.superhomogeneous.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.prog_io_sym_name.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
expand_set_field_function_call(Context, MainContext, SubContext0, FieldNames,
|
|
FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
|
|
Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
expand_set_field_function_call_2(Context, MainContext, SubContext0,
|
|
FieldNames, FieldValueVar, TermInputVar, TermOutputVar, Functor,
|
|
FieldSubContext, Goals, NumAdded,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
|
|
goal_info_init(Context, GoalInfo),
|
|
conj_list_to_goal(Goals, GoalInfo, Goal).
|
|
|
|
:- pred expand_set_field_function_call_2(prog_context::in,
|
|
unify_main_context::in, unify_sub_contexts::in, field_list::in,
|
|
prog_var::in, prog_var::in, prog_var::in, cons_id::out,
|
|
pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
|
|
num_added_goals::out, prog_varset::in, prog_varset::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
svar_info::in, svar_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
expand_set_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
unexpected(this_file,
|
|
"expand_set_field_function_call_2: empty list of field names").
|
|
expand_set_field_function_call_2(Context, MainContext, SubContext0,
|
|
[FieldName - FieldArgs | FieldNames], FieldValueVar,
|
|
TermInputVar, TermOutputVar, Functor, FieldSubContext, Goals, NumAdded,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !Specs),
|
|
(
|
|
FieldNames = [_ | _],
|
|
varset.new_var(!.VarSet, SubTermInputVar, !:VarSet),
|
|
varset.new_var(!.VarSet, SubTermOutputVar, !:VarSet),
|
|
SetArgs = FieldArgVars ++ [TermInputVar, SubTermOutputVar],
|
|
construct_field_access_function_call(set, Context,
|
|
MainContext, SubContext0, FieldName, TermOutputVar,
|
|
SetArgs, purity_pure, Functor, UpdateGoal, !QualInfo),
|
|
UpdateAdded = 1,
|
|
|
|
% Extract the field containing the field to update.
|
|
construct_field_access_function_call(get, Context,
|
|
MainContext, SubContext0, FieldName, SubTermInputVar,
|
|
list.append(FieldArgVars, [TermInputVar]), purity_pure, _,
|
|
GetSubFieldGoal, !QualInfo),
|
|
GetSubFieldAdded = 1,
|
|
|
|
% Recursively update the field.
|
|
SubTermInputArgNumber = 2 + list.length(FieldArgs),
|
|
TermInputContext = unify_sub_context(Functor, SubTermInputArgNumber),
|
|
SubContext = [TermInputContext | SubContext0],
|
|
expand_set_field_function_call_2(Context, MainContext,
|
|
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
|
|
SubTermOutputVar, _, FieldSubContext, Goals0, SetAdded,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
|
|
|
|
FieldAdded = GetSubFieldAdded + SetAdded + UpdateAdded,
|
|
Goals1 = [GetSubFieldGoal | Goals0] ++ [UpdateGoal]
|
|
;
|
|
FieldNames = [],
|
|
SetArgs = FieldArgVars ++ [TermInputVar, FieldValueVar],
|
|
construct_field_access_function_call(set, Context,
|
|
MainContext, SubContext0, FieldName, TermOutputVar,
|
|
SetArgs, purity_pure, Functor, Goal, !QualInfo),
|
|
FieldAdded = 1,
|
|
FieldSubContext = Functor - SubContext0,
|
|
Goals1 = [Goal]
|
|
),
|
|
ArgContext = ac_functor(Functor, MainContext, SubContext0),
|
|
goal_info_init(Context, GoalInfo),
|
|
conj_list_to_goal(Goals1, GoalInfo, Conj0),
|
|
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
|
|
Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
|
|
!SInfo, !Specs),
|
|
NumAdded = FieldAdded + ArgAdded,
|
|
goal_to_conj_list(Conj, Goals).
|
|
|
|
expand_dcg_field_extraction_goal(Context, MainContext, SubContext, FieldNames,
|
|
FieldValueVar, TermInputVar, TermOutputVar, Functor, FieldSubContext,
|
|
Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
% Unify the DCG input and output variables.
|
|
make_atomic_unification(TermOutputVar, rhs_var(TermInputVar), Context,
|
|
MainContext, SubContext, UnifyDCG, !QualInfo),
|
|
UnifyAdded = 1,
|
|
|
|
% Process the access function as a get function on the output DCG variable.
|
|
expand_get_field_function_call_2(Context, MainContext, SubContext,
|
|
FieldNames, FieldValueVar, TermOutputVar, purity_pure,
|
|
Functor, FieldSubContext, Goals1, GetAdded,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
|
|
NumAdded = UnifyAdded + GetAdded,
|
|
Goals = [UnifyDCG | Goals1],
|
|
goal_info_init(Context, GoalInfo),
|
|
conj_list_to_goal(Goals, GoalInfo, Goal).
|
|
|
|
expand_get_field_function_call(Context, MainContext, SubContext0, FieldNames,
|
|
FieldValueVar, TermInputVar, Purity, Functor, FieldSubContext,
|
|
Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
expand_get_field_function_call_2(Context, MainContext, SubContext0,
|
|
FieldNames, FieldValueVar, TermInputVar, Purity, Functor,
|
|
FieldSubContext, Goals, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
|
|
!SInfo, !Specs),
|
|
goal_info_init(Context, GoalInfo),
|
|
conj_list_to_goal(Goals, GoalInfo, Goal).
|
|
|
|
:- pred expand_get_field_function_call_2(prog_context::in,
|
|
unify_main_context::in, unify_sub_contexts::in, field_list::in,
|
|
prog_var::in, prog_var::in, purity::in, cons_id::out,
|
|
pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
|
|
num_added_goals::out, prog_varset::in, prog_varset::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
svar_info::in, svar_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
|
|
!VarSet, !ModuleInfo, !QualInfo, !Sinfo, !Specs) :-
|
|
unexpected(this_file,
|
|
"expand_get_field_function_call_2: empty list of field names").
|
|
expand_get_field_function_call_2(Context, MainContext, SubContext0,
|
|
[FieldName - FieldArgs | FieldNames], FieldValueVar, TermInputVar,
|
|
Purity, Functor, FieldSubContext, Goals, NumAdded,
|
|
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
|
|
make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !Specs),
|
|
GetArgVars = FieldArgVars ++ [TermInputVar],
|
|
(
|
|
FieldNames = [_ | _],
|
|
varset.new_var(!.VarSet, SubTermInputVar, !:VarSet),
|
|
construct_field_access_function_call(get, Context, MainContext,
|
|
SubContext0, FieldName, SubTermInputVar, GetArgVars, Purity,
|
|
Functor, Goal, !QualInfo),
|
|
CallAdded = 1,
|
|
|
|
% Recursively extract until we run out of field names.
|
|
TermInputArgNumber = 1 + list.length(FieldArgVars),
|
|
TermInputContext = unify_sub_context(Functor, TermInputArgNumber),
|
|
SubContext = [TermInputContext | SubContext0],
|
|
expand_get_field_function_call_2(Context, MainContext,
|
|
SubContext, FieldNames, FieldValueVar, SubTermInputVar, Purity,
|
|
_, FieldSubContext, Goals1, ExtractAdded, !VarSet, !ModuleInfo,
|
|
!QualInfo, !SInfo, !Specs),
|
|
Goals2 = [Goal | Goals1],
|
|
FieldAdded = CallAdded + ExtractAdded
|
|
;
|
|
FieldNames = [],
|
|
FieldSubContext = Functor - SubContext0,
|
|
construct_field_access_function_call(get, Context,
|
|
MainContext, SubContext0, FieldName, FieldValueVar,
|
|
GetArgVars, Purity, Functor, Goal, !QualInfo),
|
|
Goals2 = [Goal],
|
|
FieldAdded = 1
|
|
),
|
|
ArgContext = ac_functor(Functor, MainContext, SubContext0),
|
|
goal_info_init(Context, GoalInfo),
|
|
conj_list_to_goal(Goals2, GoalInfo, Conj0),
|
|
insert_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
|
|
Conj0, Conj, ArgAdded, !VarSet, !ModuleInfo, !QualInfo,
|
|
!SInfo, !Specs),
|
|
NumAdded = FieldAdded + ArgAdded,
|
|
goal_to_conj_list(Conj, Goals).
|
|
|
|
:- pred construct_field_access_function_call(field_access_type::in,
|
|
prog_context::in, unify_main_context::in, unify_sub_contexts::in,
|
|
ctor_field_name::in, prog_var::in, list(prog_var)::in, purity::in,
|
|
cons_id::out, hlds_goal::out, qual_info::in, qual_info::out) is det.
|
|
|
|
construct_field_access_function_call(AccessType, Context, MainContext,
|
|
SubContext, FieldName, RetArg, Args, Purity, Functor, Goal,
|
|
!QualInfo) :-
|
|
field_access_function_name(AccessType, FieldName, FuncName),
|
|
list.length(Args, Arity),
|
|
Functor = cons(FuncName, Arity, cons_id_dummy_type_ctor),
|
|
make_atomic_unification(RetArg, rhs_functor(Functor, no, Args),
|
|
Context, MainContext, SubContext, Purity, Goal, !QualInfo).
|
|
|
|
maybe_parse_field_list(Term, VarSet, FieldNames) :-
|
|
% The value of ContextPieces does not matter, since we succeed
|
|
% only if it is not used.
|
|
%
|
|
% We could construct a dummy VarSet as well, if needed.
|
|
ContextPieces = [],
|
|
parse_field_list(Term, VarSet, ContextPieces, MaybeFieldNames),
|
|
MaybeFieldNames = ok1(FieldNames).
|
|
|
|
parse_field_list(Term, VarSet, ContextPieces, MaybeFieldNames) :-
|
|
(
|
|
Term = term.functor(term.atom("^"),
|
|
[FieldNameTerm, OtherFieldNamesTerm], _)
|
|
->
|
|
( try_parse_sym_name_and_args(FieldNameTerm, FieldName, Args) ->
|
|
parse_field_list(OtherFieldNamesTerm, VarSet, ContextPieces,
|
|
MaybeFieldNamesTail),
|
|
(
|
|
MaybeFieldNamesTail = error1(_),
|
|
MaybeFieldNames = MaybeFieldNamesTail
|
|
;
|
|
MaybeFieldNamesTail = ok1(FieldNamesTail),
|
|
MaybeFieldNames = ok1([FieldName - Args | FieldNamesTail])
|
|
)
|
|
;
|
|
Spec = make_field_list_error(VarSet,
|
|
get_term_context(FieldNameTerm), Term, ContextPieces),
|
|
MaybeFieldNames = error1([Spec])
|
|
)
|
|
;
|
|
( try_parse_sym_name_and_args(Term, FieldName, Args) ->
|
|
MaybeFieldNames = ok1([FieldName - Args])
|
|
;
|
|
Spec = make_field_list_error(VarSet, get_term_context(Term), Term,
|
|
ContextPieces),
|
|
MaybeFieldNames = error1([Spec])
|
|
)
|
|
).
|
|
|
|
:- func make_field_list_error(prog_varset, term.context, prog_term,
|
|
list(format_component)) = error_spec.
|
|
|
|
make_field_list_error(VarSet, Context, Term, ContextPieces) = Spec :-
|
|
TermStr = mercury_term_to_string(VarSet, no, Term),
|
|
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
|
|
words("Error: expected field name at term"),
|
|
quote(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(Pieces)])]).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "field_access.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module field_access.
|
|
%-----------------------------------------------------------------------------%
|