mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 22:35:41 +00:00
46a67b0b48
Estimated hours taken: 16
Branches: main
When the typechecker finds highly ambiguous overloading, print what symbols
were overloaded, and where they occurred. Without this information, it is
very hard to fix the error if the predicate body is at all large.
Fix some software engineering problems encountered during this process.
Modify some predicates in error_util in order to simplify their typical usage.
Change the type_ctor type to be not simply a sym_name - int pair but a type
with its own identifying type constructor. Change several other types that
were also sym_name - int pairs (mode_id, inst_id, item_name, module_qual.id
and the related simple_call_id) to have their own function symbols too.
compiler/typecheck_info.m:
Add a field to the typecheck_info structure that records the overloaded
symbols encountered.
compiler/typecheck.m:
When processing ambiguous predicate and function symbols, record this
fact in the typecheck_info.
Add a field to the cons_type_info structure to make this possible.
compiler/typecheck_errors.m:
When printing the message about highly ambiguous overloading,
what the overloaded symbols were and where they occurred.
compiler/error_util.m:
Make error_msg_specs usable with plain in and out modes by separating
out the capability requiring special modes (storing a higher order
value in a function symbol) into its own, rarely used type.
Make component_list_to_line_pieces a bit more flexible.
compiler/prog_data.m:
compiler/module_qual.m:
compiler/recompilation.m:
Change the types listed above from being equivalence types (pairs)
to being proper discriminated union types.
compiler/*.m:
Conform to the changes above.
In some cases, simplify the code's use of error_util.
tests/warnings/ambiguous_overloading.{m,exp}:
Greatly extend this test case to test the new functionality.
tests/recompilation/*.err_exp.2
Reflect the fact that the expected messages now use the standard
error_util way of quoting sym_name/arity pairs.
774 lines
30 KiB
Mathematica
774 lines
30 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2001, 2003-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: prog_util.
|
|
% Main author: fjh.
|
|
|
|
% Various utility predicates acting on the parse tree data structure defined
|
|
% in prog_data.m and prog_item.m
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_util.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_item.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Given a symbol name, return its unqualified name.
|
|
%
|
|
:- pred unqualify_name(sym_name::in, string::out) is det.
|
|
|
|
% sym_name_get_module_name(SymName, ModName):
|
|
%
|
|
% Given a symbol name, return the module qualifiers(s).
|
|
% Fails if the symbol is unqualified.
|
|
%
|
|
:- pred sym_name_get_module_name(sym_name::in, module_name::out) is semidet.
|
|
|
|
% sym_name_get_module_name(SymName, DefaultModName, ModName):
|
|
%
|
|
% Given a symbol name, return the module qualifier(s).
|
|
% If the symbol is unqualified, then return the specified default
|
|
% module name.
|
|
%
|
|
:- pred sym_name_get_module_name(sym_name::in, module_name::in,
|
|
module_name::out) is det.
|
|
|
|
% match_sym_name(PartialSymName, CompleteSymName):
|
|
%
|
|
% Succeeds iff there is some sequence of module qualifiers
|
|
% which when prefixed to PartialSymName gives CompleteSymName.
|
|
%
|
|
:- pred match_sym_name(sym_name::in, sym_name::in) is semidet.
|
|
|
|
% remove_sym_name_prefix(SymName0, Prefix, SymName)
|
|
% succeeds iff
|
|
% SymName and SymName0 have the same module qualifier
|
|
% and the unqualified part of SymName0 has the given prefix
|
|
% and the unqualified part of SymName is the unqualified
|
|
% part of SymName0 with the prefix removed.
|
|
%
|
|
:- pred remove_sym_name_prefix(sym_name, string, sym_name).
|
|
:- mode remove_sym_name_prefix(in, in, out) is semidet.
|
|
:- mode remove_sym_name_prefix(out, in, in) is det.
|
|
|
|
% remove_sym_name_suffix(SymName0, Suffix, SymName)
|
|
% succeeds iff
|
|
% SymName and SymName0 have the same module qualifier
|
|
% and the unqualified part of SymName0 has the given suffix
|
|
% and the unqualified part of SymName is the unqualified
|
|
% part of SymName0 with the suffix removed.
|
|
%
|
|
:- pred remove_sym_name_suffix(sym_name::in, string::in, sym_name::out)
|
|
is semidet.
|
|
|
|
% add_sym_name_suffix(SymName0, Suffix, SymName)
|
|
% succeeds iff
|
|
% SymName and SymName0 have the same module qualifier
|
|
% and the unqualified part of SymName is the unqualified
|
|
% part of SymName0 with the suffix added.
|
|
%
|
|
:- pred add_sym_name_suffix(sym_name::in, string::in, sym_name::out) is det.
|
|
|
|
% transform_sym_base_name(TransformFunc, SymName0) = SymName
|
|
% succeeds iff
|
|
% SymName and SymName0 have the same module qualifier
|
|
% and the unqualified part of SymName is the result of applying
|
|
% TransformFunc to the unqualified part of SymName0.
|
|
%
|
|
:- func transform_sym_base_name(func(string) = string, sym_name) = sym_name.
|
|
|
|
% Given a possible module qualified sym_name and a list of
|
|
% argument types and a context, construct a term. This is
|
|
% used to construct types.
|
|
%
|
|
:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
|
|
term(T)::out) is det.
|
|
|
|
:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
|
|
prog_context::in, term(T)::out) is det.
|
|
|
|
% Given a sym_name return the top level qualifier of that name.
|
|
%
|
|
:- func outermost_qualifier(sym_name) = string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% adjust_func_arity(PredOrFunc, FuncArity, PredArity).
|
|
%
|
|
% We internally store the arity as the length of the argument
|
|
% list including the return value, which is one more than the
|
|
% arity of the function reported in error messages.
|
|
%
|
|
:- pred adjust_func_arity(pred_or_func, int, int).
|
|
:- mode adjust_func_arity(in, in, out) is det.
|
|
:- mode adjust_func_arity(in, out, in) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
|
|
% Line, Counter, SymName).
|
|
%
|
|
% Create a predicate name with context, e.g. for introduced
|
|
% lambda or deforestation predicates.
|
|
%
|
|
:- pred make_pred_name(module_name::in, string::in, maybe(pred_or_func)::in,
|
|
string::in, new_pred_id::in, sym_name::out) is det.
|
|
|
|
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
|
|
% Line, Counter, SymName).
|
|
%
|
|
% Create a predicate name with context, e.g. for introduced
|
|
% lambda or deforestation predicates.
|
|
%
|
|
:- pred make_pred_name_with_context(module_name::in, string::in,
|
|
pred_or_func::in, string::in, int::in, int::in, sym_name::out) is det.
|
|
|
|
:- type new_pred_id
|
|
---> counter(int, int) % Line number, Counter
|
|
; type_subst(tvarset, type_subst)
|
|
; unused_args(list(int)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% A pred declaration may contains just types, as in
|
|
% :- pred list.append(list(T), list(T), list(T)).
|
|
% or it may contain both types and modes, as in
|
|
% :- pred list.append(list(T)::in, list(T)::in, list(T)::output).
|
|
%
|
|
% This predicate takes the argument list of a pred declaration, splits it
|
|
% into two separate lists for the types and (if present) the modes.
|
|
|
|
:- type maybe_modes == maybe(list(mer_mode)).
|
|
|
|
:- pred split_types_and_modes(list(type_and_mode)::in, list(mer_type)::out,
|
|
maybe_modes::out) is det.
|
|
|
|
:- pred split_type_and_mode(type_and_mode::in, mer_type::out,
|
|
maybe(mer_mode)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Perform a substitution on a goal.
|
|
%
|
|
:- pred rename_in_goal(prog_var::in, prog_var::in,
|
|
goal::in, goal::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Various predicates for accessing the cons_id type.
|
|
|
|
% Given a cons_id and a list of argument terms, convert it into a
|
|
% term. Fails if the cons_id is a pred_const, or type_ctor_info_const.
|
|
%
|
|
:- pred cons_id_and_args_to_term(cons_id::in, list(term(T))::in, term(T)::out)
|
|
is semidet.
|
|
|
|
% Get the arity of a cons_id, aborting on pred_const and
|
|
% type_ctor_info_const.
|
|
%
|
|
:- func cons_id_arity(cons_id) = arity.
|
|
|
|
% Get the arity of a cons_id. Return a `no' on those cons_ids
|
|
% where cons_id_arity/2 would normally abort.
|
|
%
|
|
:- func cons_id_maybe_arity(cons_id) = maybe(arity).
|
|
|
|
% The reverse conversion - make a cons_id for a functor.
|
|
% Given a const and an arity for the functor, create a cons_id.
|
|
%
|
|
:- func make_functor_cons_id(const, arity) = cons_id.
|
|
|
|
% Another way of making a cons_id from a functor.
|
|
% Given the name, argument types, and type_ctor of a functor,
|
|
% create a cons_id for that functor.
|
|
%
|
|
:- func make_cons_id(sym_name, list(constructor_arg), type_ctor) = cons_id.
|
|
|
|
% Another way of making a cons_id from a functor.
|
|
% Given the name, argument types, and type_ctor of a functor,
|
|
% create a cons_id for that functor.
|
|
%
|
|
% Differs from make_cons_id in that (a) it requires the sym_name
|
|
% to be already module qualified, which means that it does not
|
|
% need the module qualification of the type, (b) it can compute the
|
|
% arity from any list of the right length.
|
|
%
|
|
:- func make_cons_id_from_qualified_sym_name(sym_name, list(_)) = cons_id.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% make_n_fresh_vars(Name, N, VarSet0, Vars, VarSet):
|
|
% `Vars' is a list of `N' fresh variables allocated from
|
|
% `VarSet0'. The variables will be named "<Name>1", "<Name>2",
|
|
% "<Name>3", and so on, where <Name> is the value of `Name'.
|
|
% `VarSet' is the resulting varset.
|
|
%
|
|
:- pred make_n_fresh_vars(string::in, int::in, list(var(T))::out,
|
|
varset(T)::in, varset(T)::out) is det.
|
|
|
|
% Given the list of predicate arguments for a predicate that
|
|
% is really a function, split that list into the function arguments
|
|
% and the function return type.
|
|
%
|
|
:- pred pred_args_to_func_args(list(T)::in, list(T)::out, T::out) is det.
|
|
|
|
% Get the last two arguments from the list, failing if there
|
|
% aren't at least two arguments.
|
|
%
|
|
:- pred get_state_args(list(T)::in, list(T)::out, T::out, T::out) is semidet.
|
|
|
|
% Get the last two arguments from the list, aborting if there
|
|
% aren't at least two arguments.
|
|
%
|
|
:- pred get_state_args_det(list(T)::in, list(T)::out, T::out, T::out) is det.
|
|
|
|
% Parse a term of the form `Head :- Body', treating a term not in that form
|
|
% as `Head :- true'.
|
|
%
|
|
:- pred parse_rule_term(term.context::in, term(T)::in, term(T)::out,
|
|
term(T)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Add new type variables for those introduced by a type qualification.
|
|
%
|
|
:- pred get_new_tvars(list(tvar)::in, tvarset::in, tvarset::in, tvarset::out,
|
|
tvar_name_map::in, tvar_name_map::out,
|
|
tvar_renaming::in, tvar_renaming::out) is det.
|
|
|
|
% substitute_vars(Vars0, Subst, Vars):
|
|
%
|
|
% Apply substitution `Subst' (which must only rename vars) to `Vars0',
|
|
% and return the result in `Vars'.
|
|
%
|
|
:- pred substitute_vars(list(var(T))::in, substitution(T)::in,
|
|
list(var(T))::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% We need to "unparse" the sym_name to construct the properly
|
|
% module qualified term.
|
|
%
|
|
:- func sym_name_and_args_to_term(sym_name, list(term(T)), prog_context) =
|
|
term(T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.prog_io.
|
|
:- import_module parse_tree.prog_out.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
unqualify_name(unqualified(PredName), PredName).
|
|
unqualify_name(qualified(_ModuleName, PredName), PredName).
|
|
|
|
sym_name_get_module_name(unqualified(_), _) :- fail.
|
|
sym_name_get_module_name(qualified(ModuleName, _), ModuleName).
|
|
|
|
sym_name_get_module_name(unqualified(_), ModuleName, ModuleName).
|
|
sym_name_get_module_name(qualified(ModuleName, _PredName), _, ModuleName).
|
|
|
|
construct_qualified_term(qualified(Module, Name), Args, Context, Term) :-
|
|
construct_qualified_term(Module, [], Context, ModuleTerm),
|
|
UnqualifiedTerm = term.functor(term.atom(Name), Args, Context),
|
|
Term = term.functor(term.atom("."),
|
|
[ModuleTerm, UnqualifiedTerm], Context).
|
|
construct_qualified_term(unqualified(Name), Args, Context, Term) :-
|
|
Term = term.functor(term.atom(Name), Args, Context).
|
|
|
|
construct_qualified_term(SymName, Args, Term) :-
|
|
term.context_init(Context),
|
|
construct_qualified_term(SymName, Args, Context, Term).
|
|
|
|
outermost_qualifier(unqualified(Name)) = Name.
|
|
outermost_qualifier(qualified(Module, _Name)) = outermost_qualifier(Module).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
adjust_func_arity(predicate, Arity, Arity).
|
|
adjust_func_arity(function, Arity - 1, Arity).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
split_types_and_modes(TypesAndModes, Types, MaybeModes) :-
|
|
split_types_and_modes_2(TypesAndModes, yes, Types, Modes, Result),
|
|
( Result = yes ->
|
|
MaybeModes = yes(Modes)
|
|
;
|
|
MaybeModes = no
|
|
).
|
|
|
|
:- pred split_types_and_modes_2(list(type_and_mode)::in, bool::in,
|
|
list(mer_type)::out, list(mer_mode)::out, bool::out) is det.
|
|
|
|
% T = type, M = mode, TM = combined type and mode
|
|
split_types_and_modes_2([], Result, [], [], Result).
|
|
split_types_and_modes_2([TM|TMs], Result0, [T|Ts], [M|Ms], Result) :-
|
|
split_type_and_mode(TM, Result0, T, M, Result1),
|
|
split_types_and_modes_2(TMs, Result1, Ts, Ms, Result).
|
|
|
|
% If a pred declaration specifies modes for some but not all of the
|
|
% arguments, then the modes are ignored - should this be an error instead?
|
|
% trd: this should never happen because prog_io.m will detect these cases.
|
|
%
|
|
:- pred split_type_and_mode(type_and_mode::in, bool::in,
|
|
mer_type::out, mer_mode::out, bool::out) is det.
|
|
|
|
split_type_and_mode(type_only(T), _, T, (free -> free), no).
|
|
split_type_and_mode(type_and_mode(T,M), R, T, M, R).
|
|
|
|
split_type_and_mode(type_only(T), T, no).
|
|
split_type_and_mode(type_and_mode(T,M), T, yes(M)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
rename_in_goal(OldVar, NewVar, Goal0 - Context, Goal - Context) :-
|
|
rename_in_goal_expr(OldVar, NewVar, Goal0, Goal).
|
|
|
|
:- pred rename_in_goal_expr(prog_var::in, prog_var::in,
|
|
goal_expr::in, goal_expr::out) is det.
|
|
|
|
rename_in_goal_expr(OldVar, NewVar, conj_expr(GoalA0, GoalB0),
|
|
conj_expr(GoalA, GoalB)) :-
|
|
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
|
|
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
|
|
rename_in_goal_expr(OldVar, NewVar, par_conj_expr(GoalA0, GoalB0),
|
|
par_conj_expr(GoalA, GoalB)) :-
|
|
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
|
|
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
|
|
rename_in_goal_expr(_OldVar, _NewVar, true_expr, true_expr).
|
|
rename_in_goal_expr(OldVar, NewVar, disj_expr(GoalA0, GoalB0),
|
|
disj_expr(GoalA, GoalB)) :-
|
|
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
|
|
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
|
|
rename_in_goal_expr(_Var, _NewVar, fail_expr, fail_expr).
|
|
rename_in_goal_expr(OldVar, NewVar, not_expr(Goal0), not_expr(Goal)) :-
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar, some_expr(Vars0, Goal0),
|
|
some_expr(Vars, Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar, some_state_vars_expr(Vars0, Goal0),
|
|
some_state_vars_expr(Vars, Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar, all_expr(Vars0, Goal0),
|
|
all_expr(Vars, Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar, all_state_vars_expr(Vars0, Goal0),
|
|
all_state_vars_expr(Vars, Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar,
|
|
promise_purity_expr(Implicit, Purity, Goal0),
|
|
promise_purity_expr(Implicit, Purity, Goal)) :-
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar,
|
|
promise_equivalent_solutions_expr(Vars0, DotSVars0, ColonSVars0,
|
|
Goal0),
|
|
promise_equivalent_solutions_expr(Vars, DotSVars, ColonSVars,
|
|
Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
|
|
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar,
|
|
promise_equivalent_solution_sets_expr(Vars0, DotSVars0, ColonSVars0,
|
|
Goal0),
|
|
promise_equivalent_solution_sets_expr(Vars, DotSVars, ColonSVars,
|
|
Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
|
|
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar,
|
|
promise_equivalent_solution_arbitrary_expr(Vars0,
|
|
DotSVars0, ColonSVars0, Goal0),
|
|
promise_equivalent_solution_arbitrary_expr(Vars,
|
|
DotSVars, ColonSVars, Goal)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
|
|
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
|
|
rename_in_goal(OldVar, NewVar, Goal0, Goal).
|
|
rename_in_goal_expr(OldVar, NewVar, implies_expr(GoalA0, GoalB0),
|
|
implies_expr(GoalA, GoalB)) :-
|
|
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
|
|
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
|
|
rename_in_goal_expr(OldVar, NewVar, equivalent_expr(GoalA0, GoalB0),
|
|
equivalent_expr(GoalA, GoalB)) :-
|
|
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
|
|
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
|
|
rename_in_goal_expr(OldVar, NewVar,
|
|
if_then_else_expr(Vars0, StateVars0, Cond0, Then0, Else0),
|
|
if_then_else_expr(Vars, StateVars, Cond, Then, Else)) :-
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars),
|
|
rename_in_vars(OldVar, NewVar, StateVars0, StateVars),
|
|
rename_in_goal(OldVar, NewVar, Cond0, Cond),
|
|
rename_in_goal(OldVar, NewVar, Then0, Then),
|
|
rename_in_goal(OldVar, NewVar, Else0, Else).
|
|
rename_in_goal_expr(OldVar, NewVar, call_expr(SymName, Terms0, Purity),
|
|
call_expr(SymName, Terms, Purity)) :-
|
|
term.substitute_list(Terms0, OldVar, term.variable(NewVar), Terms).
|
|
rename_in_goal_expr(OldVar, NewVar, unify_expr(TermA0, TermB0, Purity),
|
|
unify_expr(TermA, TermB, Purity)) :-
|
|
term.substitute(TermA0, OldVar, term.variable(NewVar), TermA),
|
|
term.substitute(TermB0, OldVar, term.variable(NewVar), TermB).
|
|
|
|
:- pred rename_in_vars(prog_var::in, prog_var::in,
|
|
list(prog_var)::in, list(prog_var)::out) is det.
|
|
|
|
rename_in_vars(_, _, [], []).
|
|
rename_in_vars(OldVar, NewVar, [Var0 | Vars0], [Var | Vars]) :-
|
|
( Var0 = OldVar ->
|
|
Var = NewVar
|
|
;
|
|
Var = Var0
|
|
),
|
|
rename_in_vars(OldVar, NewVar, Vars0, Vars).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% match_sym_name(PartialSymName, CompleteSymName):
|
|
%
|
|
% Succeeds iff there is some sequence of module qualifiers
|
|
% which when prefixed to PartialSymName gives CompleteSymName.
|
|
%
|
|
match_sym_name(qualified(Module1, Name), qualified(Module2, Name)) :-
|
|
match_sym_name(Module1, Module2).
|
|
match_sym_name(unqualified(Name), unqualified(Name)).
|
|
match_sym_name(unqualified(Name), qualified(_, Name)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
remove_sym_name_prefix(qualified(Module, Name0), Prefix,
|
|
qualified(Module, Name)) :-
|
|
string.append(Prefix, Name, Name0).
|
|
remove_sym_name_prefix(unqualified(Name0), Prefix, unqualified(Name)) :-
|
|
string.append(Prefix, Name, Name0).
|
|
|
|
remove_sym_name_suffix(qualified(Module, Name0), Suffix,
|
|
qualified(Module, Name)) :-
|
|
string.remove_suffix(Name0, Suffix, Name).
|
|
remove_sym_name_suffix(unqualified(Name0), Suffix, unqualified(Name)) :-
|
|
string.remove_suffix(Name0, Suffix, Name).
|
|
|
|
add_sym_name_suffix(qualified(Module, Name0), Suffix,
|
|
qualified(Module, Name)) :-
|
|
string.append(Name0, Suffix, Name).
|
|
add_sym_name_suffix(unqualified(Name0), Suffix, unqualified(Name)) :-
|
|
string.append(Name0, Suffix, Name).
|
|
|
|
transform_sym_base_name(TransformFunc, qualified(Module, Name0)) =
|
|
qualified(Module, TransformFunc(Name0)).
|
|
transform_sym_base_name(TransformFunc, unqualified(Name0)) =
|
|
unqualified(TransformFunc(Name0)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_pred_name_with_context(ModuleName, Prefix,
|
|
PredOrFunc, PredName, Line, Counter, SymName) :-
|
|
make_pred_name(ModuleName, Prefix, yes(PredOrFunc), PredName,
|
|
counter(Line, Counter), SymName).
|
|
|
|
make_pred_name(ModuleName, Prefix, MaybePredOrFunc, PredName,
|
|
NewPredId, SymName) :-
|
|
(
|
|
MaybePredOrFunc = yes(PredOrFunc),
|
|
(
|
|
PredOrFunc = predicate,
|
|
PFS = "pred"
|
|
;
|
|
PredOrFunc = function,
|
|
PFS = "func"
|
|
)
|
|
;
|
|
MaybePredOrFunc = no,
|
|
PFS = "pred_or_func"
|
|
),
|
|
(
|
|
NewPredId = counter(Line, Counter),
|
|
string.format("%d__%d", [i(Line), i(Counter)], PredIdStr)
|
|
;
|
|
NewPredId = type_subst(VarSet, TypeSubst),
|
|
SubstToString = (pred(SubstElem::in, SubstStr::out) is det :-
|
|
SubstElem = Var - Type,
|
|
varset.lookup_name(VarSet, Var, VarName),
|
|
TypeString = mercury_type_to_string(VarSet, no, Type),
|
|
string.append_list([VarName, " = ", TypeString], SubstStr)
|
|
),
|
|
list_to_string(SubstToString, TypeSubst, PredIdStr)
|
|
;
|
|
NewPredId = unused_args(Args),
|
|
list_to_string(int_to_string, Args, PredIdStr)
|
|
),
|
|
|
|
string.format("%s__%s__%s__%s",
|
|
[s(Prefix), s(PFS), s(PredName), s(PredIdStr)], Name),
|
|
SymName = qualified(ModuleName, Name).
|
|
|
|
:- pred list_to_string(pred(T, string)::in(pred(in, out) is det),
|
|
list(T)::in, string::out) is det.
|
|
|
|
list_to_string(Pred, List, String) :-
|
|
list_to_string_2(Pred, List, Strings, ["]"]),
|
|
string.append_list(["[" | Strings], String).
|
|
|
|
:- pred list_to_string_2(pred(T, string)::in(pred(in, out) is det),
|
|
list(T)::in, list(string)::out, list(string)::in) is det.
|
|
|
|
list_to_string_2(_, []) --> [].
|
|
list_to_string_2(Pred, [T | Ts]) -->
|
|
{ call(Pred, T, String) },
|
|
[String],
|
|
( { Ts = [] } ->
|
|
[]
|
|
;
|
|
[", "],
|
|
list_to_string_2(Pred, Ts)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
cons_id_and_args_to_term(int_const(Int), [], Term) :-
|
|
term.context_init(Context),
|
|
Term = term.functor(term.integer(Int), [], Context).
|
|
cons_id_and_args_to_term(float_const(Float), [], Term) :-
|
|
term.context_init(Context),
|
|
Term = term.functor(term.float(Float), [], Context).
|
|
cons_id_and_args_to_term(string_const(String), [], Term) :-
|
|
term.context_init(Context),
|
|
Term = term.functor(term.string(String), [], Context).
|
|
cons_id_and_args_to_term(cons(SymName, _Arity), Args, Term) :-
|
|
construct_qualified_term(SymName, Args, Term).
|
|
|
|
cons_id_arity(cons(_, Arity)) = Arity.
|
|
cons_id_arity(int_const(_)) = 0.
|
|
cons_id_arity(string_const(_)) = 0.
|
|
cons_id_arity(float_const(_)) = 0.
|
|
cons_id_arity(pred_const(_, _)) =
|
|
unexpected(this_file, "cons_id_arity: can't get arity of pred_const").
|
|
cons_id_arity(type_ctor_info_const(_, _, _)) =
|
|
unexpected(this_file,
|
|
"cons_id_arity: can't get arity of type_ctor_info_const").
|
|
cons_id_arity(base_typeclass_info_const(_, _, _, _)) =
|
|
unexpected(this_file, "cons_id_arity: " ++
|
|
"can't get arity of base_typeclass_info_const").
|
|
cons_id_arity(type_info_cell_constructor(_)) =
|
|
unexpected(this_file, "cons_id_arity: " ++
|
|
"can't get arity of type_info_cell_constructor").
|
|
cons_id_arity(typeclass_info_cell_constructor) =
|
|
unexpected(this_file, "cons_id_arity: " ++
|
|
"can't get arity of typeclass_info_cell_constructor").
|
|
cons_id_arity(tabling_pointer_const(_)) =
|
|
unexpected(this_file,
|
|
"cons_id_arity: can't get arity of tabling_pointer_const").
|
|
cons_id_arity(deep_profiling_proc_layout(_)) =
|
|
unexpected(this_file, "cons_id_arity: " ++
|
|
"can't get arity of deep_profiling_proc_layout").
|
|
cons_id_arity(table_io_decl(_)) =
|
|
unexpected(this_file, "cons_id_arity: can't get arity of table_io_decl").
|
|
|
|
cons_id_maybe_arity(cons(_, Arity)) = yes(Arity).
|
|
cons_id_maybe_arity(int_const(_)) = yes(0).
|
|
cons_id_maybe_arity(string_const(_)) = yes(0).
|
|
cons_id_maybe_arity(float_const(_)) = yes(0).
|
|
cons_id_maybe_arity(pred_const(_, _)) = no.
|
|
cons_id_maybe_arity(type_ctor_info_const(_, _, _)) = no.
|
|
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _)) = no.
|
|
cons_id_maybe_arity(type_info_cell_constructor(_)) = no.
|
|
cons_id_maybe_arity(typeclass_info_cell_constructor) = no.
|
|
cons_id_maybe_arity(tabling_pointer_const(_)) = no.
|
|
cons_id_maybe_arity(deep_profiling_proc_layout(_)) = no.
|
|
cons_id_maybe_arity(table_io_decl(_)) = no.
|
|
|
|
make_functor_cons_id(term.atom(Name), Arity) = cons(unqualified(Name), Arity).
|
|
make_functor_cons_id(term.integer(Int), _) = int_const(Int).
|
|
make_functor_cons_id(term.string(String), _) = string_const(String).
|
|
make_functor_cons_id(term.float(Float), _) = float_const(Float).
|
|
|
|
make_cons_id(SymName0, Args, TypeCtor) = cons(SymName, Arity) :-
|
|
% Use the module qualifier on the SymName, if there is one,
|
|
% otherwise use the module qualifier on the Type, if there is one,
|
|
% otherwise leave it unqualified.
|
|
% XXX is that the right thing to do?
|
|
(
|
|
SymName0 = qualified(_, _),
|
|
SymName = SymName0
|
|
;
|
|
SymName0 = unqualified(ConsName),
|
|
(
|
|
TypeCtor = type_ctor(unqualified(_), _),
|
|
SymName = SymName0
|
|
;
|
|
TypeCtor = type_ctor(qualified(TypeModule, _), _),
|
|
SymName = qualified(TypeModule, ConsName)
|
|
)
|
|
),
|
|
list.length(Args, Arity).
|
|
|
|
make_cons_id_from_qualified_sym_name(SymName, Args) = cons(SymName, Arity) :-
|
|
list.length(Args, Arity).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_n_fresh_vars(BaseName, N, Vars, VarSet0, VarSet) :-
|
|
make_n_fresh_vars_2(BaseName, 0, N, Vars, VarSet0, VarSet).
|
|
|
|
:- pred make_n_fresh_vars_2(string::in, int::in, int::in, list(var(T))::out,
|
|
varset(T)::in, varset(T)::out) is det.
|
|
|
|
make_n_fresh_vars_2(BaseName, N, Max, Vars, !VarSet) :-
|
|
( N = Max ->
|
|
Vars = []
|
|
;
|
|
N1 = N + 1,
|
|
varset.new_var(!.VarSet, Var, !:VarSet),
|
|
string.int_to_string(N1, Num),
|
|
string.append(BaseName, Num, VarName),
|
|
varset.name_var(!.VarSet, Var, VarName, !:VarSet),
|
|
Vars = [Var | Vars1],
|
|
make_n_fresh_vars_2(BaseName, N1, Max, Vars1, !VarSet)
|
|
).
|
|
|
|
pred_args_to_func_args(PredArgs, FuncArgs, FuncReturn) :-
|
|
list.length(PredArgs, NumPredArgs),
|
|
NumFuncArgs = NumPredArgs - 1,
|
|
( list.split_list(NumFuncArgs, PredArgs, FuncArgs0, [FuncReturn0]) ->
|
|
FuncArgs = FuncArgs0,
|
|
FuncReturn = FuncReturn0
|
|
;
|
|
unexpected(this_file,
|
|
"pred_args_to_func_args: function missing return value?")
|
|
).
|
|
|
|
get_state_args(Args0, Args, State0, State) :-
|
|
list.reverse(Args0, RevArgs0),
|
|
RevArgs0 = [State, State0 | RevArgs],
|
|
list.reverse(RevArgs, Args).
|
|
|
|
get_state_args_det(Args0, Args, State0, State) :-
|
|
( get_state_args(Args0, Args1, State0A, StateA) ->
|
|
Args = Args1,
|
|
State0 = State0A,
|
|
State = StateA
|
|
;
|
|
unexpected(this_file, "get_state_args_det")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_rule_term(Context, RuleTerm, HeadTerm, GoalTerm) :-
|
|
( RuleTerm = term.functor(term.atom(":-"), [HeadTerm0, GoalTerm0], _) ->
|
|
HeadTerm = HeadTerm0,
|
|
GoalTerm = GoalTerm0
|
|
;
|
|
HeadTerm = RuleTerm,
|
|
GoalTerm = term.functor(term.atom("true"), [], Context)
|
|
).
|
|
|
|
get_new_tvars([], _, !TVarSet, !TVarNameMap, !TVarRenaming).
|
|
get_new_tvars([TVar | TVars], VarSet, !TVarSet, !TVarNameMap, !TVarRenaming) :-
|
|
( map.contains(!.TVarRenaming, TVar) ->
|
|
true
|
|
;
|
|
( varset.search_name(VarSet, TVar, TVarName) ->
|
|
( map.search(!.TVarNameMap, TVarName, TVarSetVar) ->
|
|
svmap.det_insert(TVar, TVarSetVar, !TVarRenaming)
|
|
;
|
|
varset.new_var(!.TVarSet, NewTVar, !:TVarSet),
|
|
varset.name_var(!.TVarSet, NewTVar, TVarName, !:TVarSet),
|
|
svmap.det_insert(TVarName, NewTVar, !TVarNameMap),
|
|
svmap.det_insert(TVar, NewTVar, !TVarRenaming)
|
|
)
|
|
;
|
|
varset.new_var(!.TVarSet, NewTVar, !:TVarSet),
|
|
svmap.det_insert(TVar, NewTVar, !TVarRenaming)
|
|
)
|
|
),
|
|
get_new_tvars(TVars, VarSet, !TVarSet, !TVarNameMap, !TVarRenaming).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
substitute_vars(Vars0, Subst, Vars) :-
|
|
Vars = list.map(substitute_var(Subst), Vars0).
|
|
|
|
:- func substitute_var(substitution(T), var(T)) = var(T).
|
|
|
|
substitute_var(Subst, Var0) = Var :-
|
|
term.apply_substitution(term.variable(Var0), Subst, Term),
|
|
( Term = term.variable(Var1) ->
|
|
Var = Var1
|
|
;
|
|
unexpected(this_file, "substitute_var: invalid substitution")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
sym_name_and_args_to_term(unqualified(Name), Xs, Context) =
|
|
term.functor(term.atom(Name), Xs, Context).
|
|
|
|
sym_name_and_args_to_term(qualified(ModuleNames, Name), Xs, Context) =
|
|
sym_name_and_term_to_term(ModuleNames,
|
|
term.functor(term.atom(Name), Xs, Context), Context).
|
|
|
|
:- func sym_name_and_term_to_term(module_specifier, term(T), prog_context) =
|
|
term(T).
|
|
|
|
sym_name_and_term_to_term(unqualified(ModuleName), Term, Context) =
|
|
term.functor(
|
|
term.atom("."),
|
|
[term.functor(term.atom(ModuleName), [], Context), Term],
|
|
Context
|
|
).
|
|
sym_name_and_term_to_term(qualified(ModuleNames, ModuleName), Term, Context) =
|
|
term.functor(
|
|
term.atom("."),
|
|
[sym_name_and_term_to_term(
|
|
ModuleNames,
|
|
term.functor(term.atom(ModuleName), [], Context),
|
|
Context),
|
|
Term],
|
|
Context
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "prog_util.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module prog_util.
|
|
%-----------------------------------------------------------------------------%
|