mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
f70b5d6de7
The new --warn-unneeded-initial-statevar option asks the compiler
to warn about code such as
pred_a(!.X, ...) :-
... code that uses !.X, but does not update it ...
In this case, the preferred fix is to just replace all occurrences
of !.X with X.
The new --warn-unneeded-final-statevar option asks the compiler
to warn about code such as
pred_a(!X, ...) :-
... code that maybe uses !.X, but does not update it ...
In this case, the preferred fix also involves replacing all occurrences
of !.X with X, but it also involves either deleting the argument
containing !:X (the best option), or, if there is some reason why
the predicate's signature must stay unchanged, to replace !:X with X as well.
And if the clause body does not actually refer to either !.X or !:X, then
*both* arguments represented by !X should be deleted.
The first option is a style warning; the second option, due to the
signature change it may call for, is a non-style warning.
Both options have a version whose name adds a "-lambda" suffix, and which
does the same warnings for the heads of lambda expressions, not clauses.
Note that several of the modules below, including some that help to implement
the warnings, also contain code changes that result from *acting* on
the new warnings, e.g. by deleting unneeded statevar arguments.
Other, similar changes will also come after this diff is committed.
compiler/options.m:
doc/user_guide.texi:
Document the new options.
compiler/state_var.m:
Gather the information needed to decide what code merits the new warnings.
Do so in three stages:
- when processing the head of a clause or of a lambda expression,
- when processing the body goal of that clause or lambda expression,
- when finishing up the processing of the clause or lambda expression.
Add a predicate to generate the warnings for lambda expressions.
Do not generate the warnings for clauses. This is because whether or not
we want to warn about state vars in some clauses depends on the properties
of *other* clauses of the same predicate, and state_var.m has access
to only one clause at a time. Instead,
- return the info needed by the warning-generating code in pre_typecheck.m
(one of the first passes we execute after adding all clauses
to the HLDS), and
- we export some functionality for use by that code.
Switch to a convention for naming the program variables corresponding
to the middle (non-initial, non-final) versions of state variables
whose output is affected by changes in the code of the clause body goal
only if they involve that specific state variable.
Give some predicates more descriptive names.
compiler/make_hlds.m:
Make state_var.m and its new functionality visible from outside
the make_hlds package.
compiler/add_clause.m:
Record the information gathered by state_var.m in each clause.
compiler/hlds_clauses.m:
Add a slot to each clause for this information.
Give some predicates more descriptive names.
compiler/headvar_names.m:
Use the contents of the new slots to detect whether any clauses
have unused state vars, and if so, return the chosen consensus names
of the head vars to the code of pre_typecheck.m, which uses this info
as part of the implementation of the new warnings.
compiler/pre_typecheck.m:
Implement the new warnings.
compiler/mercury_compile_front_end.m:
Record the warnings that pre_typecheck.m can now return.
compiler/error_spec.m:
compiler/write_error_spec.m:
Add unsigned versions of the format pieces involving ints, for use
by the new code in pre_typecheck.m, and implement them.
compiler/hlds_out_util.m:
compiler/maybe_util.m:
Move two related types from hlds_out_util.m to maybe_util.m,
in order to allow pre_typecheck.m to use one of them.
compiler/hlds_args.m:
Add a new utility function for use by the new code above.
compiler/foreign.m:
Act on the new warnings by deleting the long-unused predicates
being warned about.
compiler/post_typecheck.m:
Speed up this traversal. (I originally thought to implement
the new warnings in this pass.)
compiler/add_foreign_proc.m:
compiler/add_pragma.m:
compiler/add_pragma_tabling.m:
compiler/add_pragma_type_spec.m:
compiler/add_pred.m:
compiler/add_type.m:
compiler/build_mode_constraints.m:
compiler/call_gen.m:
compiler/check_typeclass.m:
compiler/clause_to_proc.m:
compiler/code_loc_dep.m:
compiler/delay_info.m:
compiler/delay_partial_inst.m:
compiler/dense_switch.m:
compiler/det_check_goal.m:
compiler/det_infer_goal.m:
compiler/disj_gen.m:
compiler/du_type_layout.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/hlds_dependency_graph.m:
compiler/hlds_out_pred.m:
compiler/hlds_pred.m:
compiler/hlds_rtti.m:
compiler/inst_merge.m:
compiler/instance_method_clauses.m:
compiler/intermod.m:
compiler/interval.m:
compiler/ite_gen.m:
compiler/lookup_switch.m:
compiler/make_hlds_passes.m:
compiler/mark_tail_calls.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mode_errors.m:
compiler/parse_string_format.m:
compiler/passes_aux.m:
compiler/polymorphism.m:
compiler/polymorphism_info.m:
compiler/polymorphism_type_info.m:
compiler/pragma_c_gen.m:
compiler/prop_mode_constraints.m:
compiler/purity.m:
compiler/quantification.m:
compiler/simplify_goal_call.m:
compiler/simplify_goal_conj.m:
compiler/string_switch.m:
compiler/superhomogeneous.m:
compiler/switch_gen.m:
compiler/tag_switch.m:
compiler/type_constraints.m:
compiler/typecheck.m:
compiler/typecheck_clauses.m:
compiler/typecheck_coerce.m:
compiler/typecheck_error_unify.m:
compiler/unify_gen_deconstruct.m:
compiler/unify_proc.m:
compiler/var_origins.m:
Conform to the changes above, and/or act on the new warnings.
browser/diff.m:
library/bit_buffer.m:
library/getopt.m:
library/getopt_io.m:
library/io.error_util.m:
library/io.file.m:
library/mercury_term_lexer.m:
library/parsing_utils.m:
library/pretty_printer.m:
library/robdd.m:
library/rtti_implementation.m:
library/string.builder.m:
library/string.parse_runtime.m:
mdbcomp/feedback.m:
Act on the new warnings.
tests/hard_coded/sv_nested_closures.m:
Change this test's code to avoid the new warnings, since
(if --halt-at-warn is ever enabled) the warnings would interfere
with its job .
tests/invalid/bug197.err_exp:
tests/invalid/bug487.err_exp:
tests/invalid/nullary_ho_func_error.err_exp:
tests/invalid/try_detism.err_exp:
tests/warnings/singleton_test_state_var.err_exp:
Expect variable names for the middle versions of state vars
using the new naming scheme.
727 lines
28 KiB
Mathematica
727 lines
28 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2006-2007, 2010, 2012 The University of Melbourne.
|
|
% Copyright (C) 2015, 2018-2019, 2024-2025 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: hlds_args.m.
|
|
% Main authors: juliensf.
|
|
%
|
|
% This module defines the part of the HLDS that deals with procedure and call
|
|
% site arguments. (See comments at the head of polymorphism.m for further
|
|
% details.)
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_args.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This type represents the arguments to a predicate symbol, or
|
|
% the arguments and result of a function symbol. The arguments may be
|
|
% variables, types, modes, etc, depending on the context.
|
|
%
|
|
% Rather than keep all arguments in a single list, we retain information
|
|
% about the origin of each argument (such as whether it was introduced
|
|
% by polymorphism.m to hold a type_info). This simplifies the processing
|
|
% in polymorphism.m, and also abstracts away the specific calling
|
|
% convention that we use.
|
|
%
|
|
:- type proc_arg_vector(T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Create a new proc_arg_vector from the given list.
|
|
% If the first argument is `function' then the last element in the
|
|
% list is used to set the return value field of the proc_arg_vector.
|
|
%
|
|
:- func proc_arg_vector_init(pred_or_func, list(T)) = proc_arg_vector(T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Access predicates for the proc_arg_vector structure
|
|
%
|
|
|
|
:- func proc_arg_vector_get_instance_type_infos(proc_arg_vector(T))
|
|
= list(T).
|
|
:- func proc_arg_vector_get_instance_typeclass_infos(proc_arg_vector(T))
|
|
= list(T).
|
|
:- func proc_arg_vector_get_univ_type_infos(proc_arg_vector(T)) = list(T).
|
|
:- func proc_arg_vector_get_exist_type_infos(proc_arg_vector(T)) = list(T).
|
|
:- func proc_arg_vector_get_univ_typeclass_infos(proc_arg_vector(T)) = list(T).
|
|
:- func proc_arg_vector_get_exist_typeclass_infos(proc_arg_vector(T))
|
|
= list(T).
|
|
:- func proc_arg_vector_get_user_args(proc_arg_vector(T)) = list(T).
|
|
:- func proc_arg_vector_get_maybe_ret_value(proc_arg_vector(T)) = maybe(T).
|
|
|
|
:- pred proc_arg_vector_set_instance_type_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_instance_typeclass_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_univ_type_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_exist_type_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_univ_typeclass_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_exist_typeclass_infos(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_user_args(list(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
:- pred proc_arg_vector_set_maybe_ret_value(maybe(T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
|
|
% Return the user args *and* the function result, if any.
|
|
%
|
|
:- func proc_arg_vector_get_user_visible_args(proc_arg_vector(T)) = list(T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Utility predicates that operate on proc_arg_vectors.
|
|
%
|
|
|
|
% Return a list of the items in a arg_vector. The order of the list
|
|
% corresponds to that required by the calling conventions.
|
|
% See comments at the head of polymorphism.m for details.
|
|
% If the arg_vector is for a function, then the last element in the list
|
|
% will correspond to the function return value.
|
|
%
|
|
:- func proc_arg_vector_to_list(proc_arg_vector(T)) = list(T).
|
|
|
|
% Return the set of items in an arg_vector.
|
|
%
|
|
:- func proc_arg_vector_to_set(proc_arg_vector(T)) = set(T).
|
|
|
|
% Apply a renaming to an arg_vector.
|
|
% Useful for renaming variables etc.
|
|
%
|
|
:- pred apply_renaming_to_proc_arg_vector(map(T, T)::in,
|
|
proc_arg_vector(T)::in, proc_arg_vector(T)::out) is det.
|
|
|
|
% proc_arg_vector_partition_poly_args(Vec, PolyArgs, NonPolyArgs):
|
|
%
|
|
% Partition the argument vector into two lists depending on whether
|
|
% something was introduced by the polymorphism transformation or not.
|
|
%
|
|
:- pred proc_arg_vector_partition_poly_args(proc_arg_vector(T)::in,
|
|
list(T)::out, list(T)::out) is det.
|
|
|
|
% proc_arg_vector_member(Vector, V):
|
|
%
|
|
% Succeeds iff V is a member of the argument vector `Vector'.
|
|
%
|
|
:- pred proc_arg_vector_member(proc_arg_vector(T)::in, T::in) is semidet.
|
|
|
|
% Partition the given arg_vector into a list of arguments and
|
|
% a function return value. Throws an exception if the arg_vector does
|
|
% not correspond to a function.
|
|
%
|
|
:- pred proc_arg_vector_to_func_args(proc_arg_vector(T)::in,
|
|
list(T)::out, T::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Higher-order operations on proc_arg_vectors.
|
|
%
|
|
|
|
%
|
|
% NOTE these higher-order operations all work in a similar fashion
|
|
% to their counterparts in library/list.m.
|
|
|
|
:- func proc_arg_vector_map(func(T) = U, proc_arg_vector(T)) =
|
|
proc_arg_vector(U).
|
|
|
|
:- pred proc_arg_vector_map(pred(T, U)::in(pred(in, out) is det),
|
|
proc_arg_vector(T)::in, proc_arg_vector(U)::out) is det.
|
|
|
|
:- pred proc_arg_vector_map_corresponding(
|
|
pred(T, U, V)::in(pred(in, in, out) is det),
|
|
proc_arg_vector(T)::in, proc_arg_vector(U)::in, proc_arg_vector(V)::out)
|
|
is det.
|
|
|
|
:- pred proc_arg_vector_all_true(pred(T)::in(pred(in) is semidet),
|
|
proc_arg_vector(T)::in) is semidet.
|
|
|
|
:- pred proc_arg_vector_map_corresponding_foldl2(
|
|
pred(A, B, C, D, D, E, E)::in(pred(in, in, out, in, out, in, out) is det),
|
|
proc_arg_vector(A)::in, proc_arg_vector(B)::in, proc_arg_vector(C)::out,
|
|
D::in, D::out, E::in, E::out) is det.
|
|
|
|
:- pred proc_arg_vector_foldl3_corresponding(
|
|
pred(A, B, C, C, D, D, E, E)
|
|
::in(pred(in, in, in, out, in, out, in, out) is det),
|
|
proc_arg_vector(A)::in, proc_arg_vector(B)::in,
|
|
C::in, C::out, D::in, D::out, E::in, E::out) is det.
|
|
|
|
:- pred proc_arg_vector_foldl2_corresponding3(
|
|
pred(A, B, C, D, D, E, E)
|
|
::in(pred(in, in, in, in, out, in, out) is det),
|
|
proc_arg_vector(A)::in, proc_arg_vector(B)::in, proc_arg_vector(C)::in,
|
|
D::in, D::out, E::in, E::out) is det.
|
|
|
|
:- pred proc_arg_vector_foldl3_corresponding3(
|
|
pred(A, B, C, D, D, E, E, F, F)
|
|
::in(pred(in, in, in, in, out, in, out, in, out) is det),
|
|
proc_arg_vector(A)::in, proc_arg_vector(B)::in, proc_arg_vector(C)::in,
|
|
D::in, D::out, E::in, E::out, F::in, F::out) is det.
|
|
|
|
:- pred proc_arg_vector_foldl4_corresponding3(
|
|
pred(A, B, C, D, D, E, E, F, F, G, G)
|
|
::in(pred(in, in, in, in, out, in, out, in, out, in, out) is det),
|
|
proc_arg_vector(A)::in, proc_arg_vector(B)::in, proc_arg_vector(C)::in,
|
|
D::in, D::out, E::in, E::out, F::in, F::out, G::in, G::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff related to the polymorphism pass.
|
|
%
|
|
|
|
% This type represents those arguments of a predicate or function
|
|
% symbol that are introduced by the polymorphism transformation.
|
|
% The arguments may be variables, types, modes, etc, depending on the
|
|
% context.
|
|
%
|
|
% Values of this type are used to pass around intermediate values
|
|
% during the polymorphism transformation.
|
|
%
|
|
:- type poly_arg_vector(T).
|
|
|
|
:- func poly_arg_vector_init = poly_arg_vector(T).
|
|
|
|
:- pred poly_arg_vector_set_instance_type_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
:- pred poly_arg_vector_set_instance_typeclass_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
:- pred poly_arg_vector_set_univ_type_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
:- pred poly_arg_vector_set_exist_type_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
:- pred poly_arg_vector_set_univ_typeclass_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
:- pred poly_arg_vector_set_exist_typeclass_infos(list(T)::in,
|
|
poly_arg_vector(T)::in, poly_arg_vector(T)::out) is det.
|
|
|
|
% Convert a poly_arg_vector into a list.
|
|
% XXX ARGVEC - this is only temporary until the proc_info structure use
|
|
% proc_arg_vectors. We should then provide a predicate that merges a
|
|
% poly_arg_vector with a proc_arg_vector.
|
|
%
|
|
:- func poly_arg_vector_to_list(poly_arg_vector(T)) = list(T).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_type.
|
|
% Required for apply_partial_map_to_list.
|
|
% XXX That should really live in a different module.
|
|
|
|
:- import_module require.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The first six fields are set by the polymorphism pass.
|
|
%
|
|
:- type proc_arg_vector(T)
|
|
---> proc_arg_vector(
|
|
% Type_infos for the unconstrained type variables in an
|
|
% instance declaration in the order which they first appear
|
|
% in the instance arguments. For procedures that are not
|
|
% class methods, this will always be the empty list.
|
|
pav_instance_type_infos :: list(T),
|
|
|
|
% Typeclass_infos for the class constraints on an instance
|
|
% declaration, in the order in which they appear in the
|
|
% declaration. For procedures that are not class methods,
|
|
% this will always be the empty list.
|
|
pav_instance_typeclass_infos :: list(T),
|
|
|
|
% Type_infos for unconstrained universally quantified type
|
|
% variables, in the order in which they first appear in the
|
|
% argument types.
|
|
pav_univ_type_infos :: list(T),
|
|
|
|
% Type_infos for unconstrained existentially quantified type
|
|
% variables, in the order that the type variables first
|
|
% appear in the argument types.
|
|
pav_exist_type_infos :: list(T),
|
|
|
|
% Typeclass_infos for universally quantified constraints
|
|
% in the order in which the constraints appear in the class
|
|
% context.
|
|
pav_univ_typeclass_infos :: list(T),
|
|
|
|
% Typeclass_infos for existentially quantified constraints
|
|
% in the order in which the constraints appear in the class
|
|
% context.
|
|
pav_exist_typeclass_infos :: list(T),
|
|
|
|
% The original procedure arguments.
|
|
% XXX Plus at the moment any arguments that may be
|
|
% introduced by transformations performed by the compiler.
|
|
% Eventually these should be separated out.
|
|
pav_user_args :: list(T),
|
|
|
|
% For predicates this field is no; for functions
|
|
% it corresponds to the function's return value.
|
|
pav_maybe_ret_value :: maybe(T)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
proc_arg_vector_init(PredOrFunc, Args0) = ArgVec :-
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
Args = Args0,
|
|
MaybeRetVal = no
|
|
;
|
|
PredOrFunc = pf_function,
|
|
list.det_split_last(Args0, Args, RetVal),
|
|
MaybeRetVal = yes(RetVal)
|
|
),
|
|
ArgVec = proc_arg_vector([], [], [], [], [], [], Args, MaybeRetVal).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
proc_arg_vector_get_instance_type_infos(V)
|
|
= V ^ pav_instance_type_infos.
|
|
proc_arg_vector_get_instance_typeclass_infos(V)
|
|
= V ^ pav_instance_typeclass_infos.
|
|
proc_arg_vector_get_univ_type_infos(V)
|
|
= V ^ pav_univ_type_infos.
|
|
proc_arg_vector_get_exist_type_infos(V)
|
|
= V ^ pav_exist_type_infos.
|
|
proc_arg_vector_get_univ_typeclass_infos(V)
|
|
= V ^ pav_univ_typeclass_infos.
|
|
proc_arg_vector_get_exist_typeclass_infos(V)
|
|
= V ^ pav_exist_typeclass_infos.
|
|
proc_arg_vector_get_user_args(V)
|
|
= V ^ pav_user_args.
|
|
proc_arg_vector_get_maybe_ret_value(V)
|
|
= V ^ pav_maybe_ret_value.
|
|
|
|
proc_arg_vector_set_instance_type_infos(ITI, !V) :-
|
|
!V ^ pav_instance_type_infos := ITI.
|
|
proc_arg_vector_set_instance_typeclass_infos(ITCI, !V) :-
|
|
!V ^ pav_instance_typeclass_infos := ITCI.
|
|
proc_arg_vector_set_univ_type_infos(UTI, !V) :-
|
|
!V ^ pav_univ_type_infos := UTI.
|
|
proc_arg_vector_set_exist_type_infos(ETI, !V) :-
|
|
!V ^ pav_exist_type_infos := ETI.
|
|
proc_arg_vector_set_univ_typeclass_infos(UTCI, !V) :-
|
|
!V ^ pav_univ_typeclass_infos := UTCI.
|
|
proc_arg_vector_set_exist_typeclass_infos(ETCI, !V) :-
|
|
!V ^ pav_exist_typeclass_infos := ETCI.
|
|
proc_arg_vector_set_user_args(UA, !V) :-
|
|
!V ^ pav_user_args := UA.
|
|
proc_arg_vector_set_maybe_ret_value(RV, !V) :-
|
|
!V ^ pav_maybe_ret_value := RV.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
proc_arg_vector_get_user_visible_args(ArgVec) = UserVisibleArgs :-
|
|
OrigArgs = ArgVec ^ pav_user_args,
|
|
MaybeReturnValue = ArgVec ^ pav_maybe_ret_value,
|
|
AnyReturnValues = get_any_return_values(MaybeReturnValue),
|
|
UserVisibleArgs = OrigArgs ++ AnyReturnValues.
|
|
|
|
proc_arg_vector_to_list(ArgVec) = List :-
|
|
ArgVec = proc_arg_vector(InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs, MaybeReturnValue),
|
|
AnyReturnValues = get_any_return_values(MaybeReturnValue),
|
|
list.condense([InstanceTypeInfos,
|
|
InstanceTypeClassInfos,
|
|
UnivTypeInfos,
|
|
ExistTypeInfos,
|
|
UnivTypeClassInfos,
|
|
ExistTypeClassInfos,
|
|
OrigArgs,
|
|
AnyReturnValues], List).
|
|
|
|
:- func get_any_return_values(maybe(T)) = list(T).
|
|
|
|
get_any_return_values(MaybeReturnValue) = AnyReturnValues :-
|
|
( MaybeReturnValue = yes(Value), AnyReturnValues = [Value]
|
|
; MaybeReturnValue = no, AnyReturnValues = []
|
|
).
|
|
|
|
proc_arg_vector_to_set(ArgVec) = Set :-
|
|
List = proc_arg_vector_to_list(ArgVec),
|
|
Set = set.list_to_set(List).
|
|
|
|
apply_renaming_to_proc_arg_vector(Renaming, ArgVec0, ArgVec) :-
|
|
ArgVec0 = proc_arg_vector(InstanceTypeInfos0, InstanceTypeClassInfos0,
|
|
UnivTypeInfos0, ExistTypeInfos0, UnivTypeClassInfos0,
|
|
ExistTypeClassInfos0, OrigArgs0, MaybeRetValue0),
|
|
apply_partial_map_to_list(Renaming, InstanceTypeInfos0, InstanceTypeInfos),
|
|
apply_partial_map_to_list(Renaming, InstanceTypeClassInfos0,
|
|
InstanceTypeClassInfos),
|
|
apply_partial_map_to_list(Renaming, UnivTypeInfos0, UnivTypeInfos),
|
|
apply_partial_map_to_list(Renaming, ExistTypeInfos0, ExistTypeInfos),
|
|
apply_partial_map_to_list(Renaming, UnivTypeClassInfos0,
|
|
UnivTypeClassInfos),
|
|
apply_partial_map_to_list(Renaming, ExistTypeClassInfos0,
|
|
ExistTypeClassInfos),
|
|
apply_partial_map_to_list(Renaming, OrigArgs0, OrigArgs),
|
|
(
|
|
MaybeRetValue0 = yes(Value0),
|
|
( if map.search(Renaming, Value0, Value) then
|
|
MaybeRetValue = yes(Value)
|
|
else
|
|
MaybeRetValue = yes(Value0)
|
|
)
|
|
;
|
|
MaybeRetValue0 = no,
|
|
MaybeRetValue = no
|
|
),
|
|
ArgVec = proc_arg_vector(InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs, MaybeRetValue).
|
|
|
|
proc_arg_vector_partition_poly_args(ArgVec, PolyArgs, NonPolyArgs) :-
|
|
ArgVec = proc_arg_vector(InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs, MaybeRetValue),
|
|
list.condense([InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos], PolyArgs),
|
|
(
|
|
MaybeRetValue = yes(RetValue),
|
|
NonPolyArgs = OrigArgs ++ [RetValue]
|
|
;
|
|
MaybeRetValue = no,
|
|
NonPolyArgs = OrigArgs
|
|
).
|
|
|
|
proc_arg_vector_member(ArgVec, Var) :-
|
|
ArgVec = proc_arg_vector(InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs, MaybeRetValue),
|
|
( list.member(Var, OrigArgs)
|
|
; MaybeRetValue = yes(Var)
|
|
; list.member(Var, InstanceTypeInfos)
|
|
; list.member(Var, InstanceTypeClassInfos)
|
|
; list.member(Var, UnivTypeInfos)
|
|
; list.member(Var, ExistTypeInfos)
|
|
; list.member(Var, UnivTypeClassInfos)
|
|
; list.member(Var, ExistTypeClassInfos)
|
|
).
|
|
|
|
proc_arg_vector_to_func_args(Vector, FuncArgs, FuncRetVal) :-
|
|
Vector = proc_arg_vector(InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs, MaybeRetValue),
|
|
FuncArgs = list.condense([InstanceTypeInfos, InstanceTypeClassInfos,
|
|
UnivTypeInfos, ExistTypeInfos, UnivTypeClassInfos,
|
|
ExistTypeClassInfos, OrigArgs]),
|
|
(
|
|
MaybeRetValue = yes(FuncRetVal)
|
|
;
|
|
MaybeRetValue = no,
|
|
unexpected($pred, "predicate")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
proc_arg_vector_map(Func, V0) = V :-
|
|
V0 = proc_arg_vector(ITI0, ITCI0, UTI0, ETI0, UTCI0, ETCI0, Args0,
|
|
MaybeRetVal0),
|
|
ITI = list.map(Func, ITI0),
|
|
ITCI = list.map(Func, ITCI0),
|
|
UTI = list.map(Func, UTI0),
|
|
ETI = list.map(Func, ETI0),
|
|
UTCI = list.map(Func, UTCI0),
|
|
ETCI = list.map(Func, ETCI0),
|
|
Args = list.map(Func, Args0),
|
|
(
|
|
MaybeRetVal0 = yes(RetVal0),
|
|
RetVal = Func(RetVal0),
|
|
MaybeRetVal = yes(RetVal)
|
|
;
|
|
MaybeRetVal0 = no,
|
|
MaybeRetVal = no
|
|
),
|
|
V = proc_arg_vector(ITI, ITCI, UTI, ETI, UTCI, ETCI, Args,
|
|
MaybeRetVal).
|
|
|
|
proc_arg_vector_map(Pred, V0, V) :-
|
|
V0 = proc_arg_vector(ITI0, ITCI0, UTI0, ETI0, UTCI0, ETCI0, Args0,
|
|
MaybeRetVal0),
|
|
list.map(Pred, ITI0, ITI),
|
|
list.map(Pred, ITCI0, ITCI),
|
|
list.map(Pred, UTI0, UTI),
|
|
list.map(Pred, ETI0, ETI),
|
|
list.map(Pred, UTCI0, UTCI),
|
|
list.map(Pred, ETCI0, ETCI),
|
|
list.map(Pred, Args0, Args),
|
|
(
|
|
MaybeRetVal0 = yes(RetVal0),
|
|
Pred(RetVal0, RetVal),
|
|
MaybeRetVal = yes(RetVal)
|
|
;
|
|
MaybeRetVal0 = no,
|
|
MaybeRetVal = no
|
|
),
|
|
V = proc_arg_vector(ITI, ITCI, UTI, ETI, UTCI, ETCI, Args,
|
|
MaybeRetVal).
|
|
|
|
proc_arg_vector_map_corresponding(P, A, B, C) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
list.map_corresponding(P, ITIA, ITIB, ITIC),
|
|
list.map_corresponding(P, ITCIA, ITCIB, ITCIC),
|
|
list.map_corresponding(P, UTIA, UTIB, UTIC),
|
|
list.map_corresponding(P, ETIA, ETIB, ETIC),
|
|
list.map_corresponding(P, UTCIA, UTCIB, UTCIC),
|
|
list.map_corresponding(P, ETCIA, ETCIB, ETCIC),
|
|
list.map_corresponding(P, ArgsA, ArgsB, ArgsC),
|
|
(
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
P(RetValA, RetValB, RetValC),
|
|
MaybeRetValC = yes(RetValC)
|
|
;
|
|
MaybeRetValA = yes(_),
|
|
MaybeRetValB = no,
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = yes(_),
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no,
|
|
MaybeRetValC = no
|
|
),
|
|
C = proc_arg_vector(ITIC, ITCIC, UTIC, ETIC, UTCIC, ETCIC, ArgsC,
|
|
MaybeRetValC).
|
|
|
|
proc_arg_vector_all_true(P, V) :-
|
|
V = proc_arg_vector(ITI, ITCI, UTI, ETI, UTCI, ETCI, Args, MaybeRetVal),
|
|
list.all_true(P, ITI),
|
|
list.all_true(P, ITCI),
|
|
list.all_true(P, UTI),
|
|
list.all_true(P, ETI),
|
|
list.all_true(P, UTCI),
|
|
list.all_true(P, ETCI),
|
|
list.all_true(P, Args),
|
|
(
|
|
MaybeRetVal = yes(RetVal),
|
|
P(RetVal)
|
|
;
|
|
MaybeRetVal = no
|
|
).
|
|
|
|
proc_arg_vector_map_corresponding_foldl2(P, A, B, C, !Acc1, !Acc2) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
list.map_corresponding_foldl2(P, ITIA, ITIB, ITIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, ITCIA, ITCIB, ITCIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, UTIA, UTIB, UTIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, ETIA, ETIB, ETIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, UTCIA, UTCIB, UTCIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, ETCIA, ETCIB, ETCIC, !Acc1, !Acc2),
|
|
list.map_corresponding_foldl2(P, ArgsA, ArgsB, ArgsC, !Acc1, !Acc2),
|
|
(
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
P(RetValA, RetValB, RetValC, !Acc1, !Acc2),
|
|
MaybeRetValC = yes(RetValC)
|
|
;
|
|
MaybeRetValA = yes(_),
|
|
MaybeRetValB = no,
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = yes(_),
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no,
|
|
MaybeRetValC = no
|
|
),
|
|
C = proc_arg_vector(ITIC, ITCIC, UTIC, ETIC, UTCIC, ETCIC, ArgsC,
|
|
MaybeRetValC).
|
|
|
|
proc_arg_vector_foldl3_corresponding(P, A, B, !Acc1, !Acc2, !Acc3) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
list.foldl3_corresponding(P, ITIA, ITIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, ITCIA, ITCIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, UTIA, UTIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, ETIA, ETIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, UTCIA, UTCIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, ETCIA, ETCIB, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding(P, ArgsA, ArgsB, !Acc1, !Acc2, !Acc3),
|
|
(
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
P(RetValA, RetValB, !Acc1, !Acc2, !Acc3)
|
|
;
|
|
MaybeRetValA = yes(_),
|
|
MaybeRetValB = no,
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = yes(_),
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
;
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no
|
|
).
|
|
|
|
proc_arg_vector_foldl2_corresponding3(P, A, B, C, !Acc1, !Acc2) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
C = proc_arg_vector(ITIC, ITCIC, UTIC, ETIC, UTCIC, ETCIC, ArgsC,
|
|
MaybeRetValC),
|
|
list.foldl2_corresponding3(P, ITIA, ITIB, ITIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, ITCIA, ITCIB, ITCIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, UTIA, UTIB, UTIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, ETIA, ETIB, ETIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, UTCIA, UTCIB, UTCIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, ETCIA, ETCIB, ETCIC, !Acc1, !Acc2),
|
|
list.foldl2_corresponding3(P, ArgsA, ArgsB, ArgsC, !Acc1, !Acc2),
|
|
( if
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
MaybeRetValC = yes(RetValC)
|
|
then
|
|
P(RetValA, RetValB, RetValC, !Acc1, !Acc2)
|
|
else if
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no,
|
|
MaybeRetValC = no
|
|
then
|
|
true
|
|
else
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
).
|
|
|
|
proc_arg_vector_foldl3_corresponding3(P, A, B, C, !Acc1, !Acc2, !Acc3) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
C = proc_arg_vector(ITIC, ITCIC, UTIC, ETIC, UTCIC, ETCIC, ArgsC,
|
|
MaybeRetValC),
|
|
list.foldl3_corresponding3(P, ITIA, ITIB, ITIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, ITCIA, ITCIB, ITCIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, UTIA, UTIB, UTIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, ETIA, ETIB, ETIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, UTCIA, UTCIB, UTCIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, ETCIA, ETCIB, ETCIC, !Acc1, !Acc2, !Acc3),
|
|
list.foldl3_corresponding3(P, ArgsA, ArgsB, ArgsC, !Acc1, !Acc2, !Acc3),
|
|
( if
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
MaybeRetValC = yes(RetValC)
|
|
then
|
|
P(RetValA, RetValB, RetValC, !Acc1, !Acc2, !Acc3)
|
|
else if
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no,
|
|
MaybeRetValC = no
|
|
then
|
|
true
|
|
else
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
).
|
|
|
|
proc_arg_vector_foldl4_corresponding3(P, A, B, C, !Acc1, !Acc2, !Acc3,
|
|
!Acc4) :-
|
|
A = proc_arg_vector(ITIA, ITCIA, UTIA, ETIA, UTCIA, ETCIA, ArgsA,
|
|
MaybeRetValA),
|
|
B = proc_arg_vector(ITIB, ITCIB, UTIB, ETIB, UTCIB, ETCIB, ArgsB,
|
|
MaybeRetValB),
|
|
C = proc_arg_vector(ITIC, ITCIC, UTIC, ETIC, UTCIC, ETCIC, ArgsC,
|
|
MaybeRetValC),
|
|
list.foldl4_corresponding3(P, ITIA, ITIB, ITIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, ITCIA, ITCIB, ITCIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, UTIA, UTIB, UTIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, ETIA, ETIB, ETIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, UTCIA, UTCIB, UTCIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, ETCIA, ETCIB, ETCIC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
list.foldl4_corresponding3(P, ArgsA, ArgsB, ArgsC, !Acc1, !Acc2, !Acc3,
|
|
!Acc4),
|
|
( if
|
|
MaybeRetValA = yes(RetValA),
|
|
MaybeRetValB = yes(RetValB),
|
|
MaybeRetValC = yes(RetValC)
|
|
then
|
|
P(RetValA, RetValB, RetValC, !Acc1, !Acc2, !Acc3, !Acc4)
|
|
else if
|
|
MaybeRetValA = no,
|
|
MaybeRetValB = no,
|
|
MaybeRetValC = no
|
|
then
|
|
true
|
|
else
|
|
unexpected($pred, "mismatched proc_arg_vectors")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff related to the polymorphism transformation.
|
|
%
|
|
|
|
% Internally we represent a poly_arg_vector as a proc_arg_vector.
|
|
% This ensures that poly_arg_vectors obey the same calling convention
|
|
% w.r.t introduced type_info and typeclass_info arguments that
|
|
% proc_arg_vectors do. For the proc_arg_vectors that are used to represent
|
|
% poly_arg_vectors, we insist that the last two fields are
|
|
% the empty list and `no' respectively.
|
|
%
|
|
:- type poly_arg_vector(T) == proc_arg_vector(T).
|
|
|
|
poly_arg_vector_init = proc_arg_vector_init(pf_predicate, []).
|
|
|
|
poly_arg_vector_set_instance_type_infos(ITI, !A) :-
|
|
proc_arg_vector_set_instance_type_infos(ITI, !A).
|
|
poly_arg_vector_set_instance_typeclass_infos(ITCI, !A) :-
|
|
proc_arg_vector_set_instance_typeclass_infos(ITCI, !A).
|
|
poly_arg_vector_set_univ_type_infos(UTI, !A) :-
|
|
proc_arg_vector_set_univ_type_infos(UTI, !A).
|
|
poly_arg_vector_set_exist_type_infos(ETI, !A) :-
|
|
proc_arg_vector_set_exist_type_infos(ETI, !A).
|
|
poly_arg_vector_set_univ_typeclass_infos(UTCI, !A) :-
|
|
proc_arg_vector_set_univ_typeclass_infos(UTCI, !A).
|
|
poly_arg_vector_set_exist_typeclass_infos(ETCI, !A) :-
|
|
proc_arg_vector_set_exist_typeclass_infos(ETCI, !A).
|
|
|
|
poly_arg_vector_to_list(V) =
|
|
proc_arg_vector_to_list(V).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_args.
|
|
%-----------------------------------------------------------------------------%
|