Files
mercury/compiler/inst_user.m
Zoltan Somogyi dde8c1f396 Delete mer_inst's free/1 functor.
This functor was intended to have the same semantics as free/0, while
containing the type of the value it was applied to. However, commit
87e7e3bafa, the commit in which Fergus
introduced this function symbol, also contained an "XXX temporary hack"
in which the code that was supposed to create a value using this function
symbol when propagating a type into a free/0 inst, just ignored the type,
and left the inst as free/0. THIS TEMPORARY HACK HAS REMAINED IN THE CODE
SINCE 1994.

In a few places, we did hand-create insts using free/1 for code created
by the compiler itself. However, as far as I can tell, no free/1 inst
ever described any code read in from source files. This meant that
any code in switch arms for free/1 in switches on insts was never tested
in any meaningful sense. And predicates such as inst_merge_4, which
processed several kinds of insts without doing a complete switch on insts,
simply lacked code handle free/1 at all.

This diff deletes the free/1 function symbol. It does so NOT because
the type stored as its argument is not useful, but because it is useful
NOT JUST for free insts, but for ALL insts. This means that any mechanism
for providing information about the type of the value that an inst applies to
should work for all insts. This can be done

- either by passing along the type with every inst, and stepping into
  the argument types of each argument of a function symbol as we process
  bound insts, in every operation that operates on insts that needs
  type information.

- or by including a type in ALL the function symbols of the inst type.
  (We could do this either by adding a maybe(mer_type) field to each
  function symbol, which would be "no" before the propagate-types-
  into-modes pass, or by adding just a mer_type field, which would
  be a special dummy value before that pass. I (zs) prefer the latter,
  and so would juliensf.)

The second option would involve reintroducing a free/1 function symbol
into the inst type, but this would replace the existing free/0
function symbol, and it would inherit all the code that currently
handles free/0, NOT the code being deleted by this diff for handling
the *current* free/1.

The first option would be easier to implement if only one or maybe two
operations needed type info, the second would be both easier to implement
and more efficient if more operations needed that info.

compiler/prog_data.m:
    Delete free/1.

compiler/add_mode.m:
compiler/add_mutable_aux_preds.m:
compiler/comp_unit_interface.m:
compiler/dep_par_conj.m:
compiler/direct_arg_in_out.m:
compiler/equiv_type_hlds.m:
compiler/error_msg_inst.m:
compiler/float_regs.m:
compiler/hlds_code_util.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_statistics.m:
compiler/inst_abstract_unify.m:
compiler/inst_check.m:
compiler/inst_match.m:
compiler/inst_merge.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_user.m:
compiler/inst_util.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/mode_top_functor.m:
compiler/modecheck_coerce.m:
compiler/modecheck_util.m:
compiler/modes.m:
compiler/module_qual.qualify_items.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_to_term.m:
compiler/pd_util.m:
compiler/prog_mode.m:
compiler/prog_rep.m:
compiler/recompilation.usage.m:
compiler/types_into_modes.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
    Conform to the change above.
2023-07-22 12:26:55 +02:00

422 lines
18 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2015 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.
%-----------------------------------------------------------------------------%
%
% This module preprocesses user-defined insts in the inst table,
% recording the results of the possible tests on those insts in the values
% expansions of the user-named insts themselves. It is better to do this
% once and for all than potentially many, many, many times during mode
% analysis.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.inst_user.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- pred pretest_user_inst_table(module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_mode_type_prop.
:- import_module hlds.hlds_inst_mode.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
:- import_module list.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- type maybe_user_inst
---> user_inst_being_processed
; processed_user_inst(hlds_inst_defn).
:- type maybe_inst_defns_map == map(inst_ctor, maybe_user_inst).
pretest_user_inst_table(!ModuleInfo) :-
module_info_get_inst_table(!.ModuleInfo, InstTable0),
inst_table_get_user_insts(InstTable0, UserInstTable0),
map.to_sorted_assoc_list(UserInstTable0, UserInstDefns0),
pretest_user_inst_defns(!.ModuleInfo, UserInstDefns0, [], UserInstTable0,
map.init, MaybeInstDefnsMap),
map.to_sorted_assoc_list(MaybeInstDefnsMap, MaybeInstDefns),
record_user_inst_results(MaybeInstDefns, UserInstDefns),
map.from_sorted_assoc_list(UserInstDefns, UserInstTable),
inst_table_set_user_insts(UserInstTable, InstTable0, InstTable),
module_info_set_inst_table(InstTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred pretest_user_inst_defns(module_info::in,
assoc_list(inst_ctor, hlds_inst_defn)::in,
assoc_list(inst_ctor, hlds_inst_defn)::in,
map(inst_ctor, hlds_inst_defn)::in,
map(inst_ctor, maybe_user_inst)::in, map(inst_ctor, maybe_user_inst)::out)
is det.
pretest_user_inst_defns(ModuleInfo, [], DelayedInstDefnPairs, UserInstTable0,
!MaybeInstDefnsMap) :-
(
DelayedInstDefnPairs = []
;
DelayedInstDefnPairs = [_ | _],
pretest_user_inst_defns(ModuleInfo, DelayedInstDefnPairs,
[], UserInstTable0, !MaybeInstDefnsMap)
).
pretest_user_inst_defns(ModuleInfo, [InstDefnPair | InstDefnPairs],
!.DelayedInstDefnPairs, UserInstTable0, !MaybeInstDefnsMap) :-
InstDefnPair = InstCtor - InstDefn,
( if map.search(!.MaybeInstDefnsMap, InstCtor, MaybeUserInst) then
(
MaybeUserInst = user_inst_being_processed,
!:DelayedInstDefnPairs = [InstDefnPair | !.DelayedInstDefnPairs]
;
MaybeUserInst = processed_user_inst(_)
)
else
pretest_user_inst_defn(ModuleInfo, InstCtor, InstDefn, UserInstTable0,
!MaybeInstDefnsMap)
),
pretest_user_inst_defns(ModuleInfo, InstDefnPairs, !.DelayedInstDefnPairs,
UserInstTable0, !MaybeInstDefnsMap).
:- pred pretest_user_inst_defn(module_info::in,
inst_ctor::in, hlds_inst_defn::in, map(inst_ctor, hlds_inst_defn)::in,
map(inst_ctor, maybe_user_inst)::in, map(inst_ctor, maybe_user_inst)::out)
is det.
pretest_user_inst_defn(ModuleInfo, InstCtor, InstDefn0, UserInstTable0,
!MaybeInstDefnsMap) :-
InstDefn0 = hlds_inst_defn(InstVarSet, InstParams, InstBody0,
IFTC, Context, Status),
InstBody0 = eqv_inst(Inst0),
(
InstParams = [_ | _],
map.det_insert(InstCtor, processed_user_inst(InstDefn0),
!MaybeInstDefnsMap)
;
InstParams = [],
map.det_insert(InstCtor, user_inst_being_processed,
!MaybeInstDefnsMap),
pretest_inst(Inst0, Inst1, UserInstTable0, _, _, _, _, _,
!MaybeInstDefnsMap),
( if
Inst1 = bound(_, _, _),
( IFTC = iftc_applicable_declared(InstTypeCtor)
; IFTC = iftc_applicable_known([InstTypeCtor])
),
InstTypeCtor = type_ctor(TypeCtorSymName, TypeCtorArity),
TypeCtorArity = 0
then
Type = defined_type(TypeCtorSymName, [], kind_star),
propagate_unchecked_type_into_bound_inst(ModuleInfo, Type,
Inst1, Inst)
else
Inst = Inst1
),
InstBody = eqv_inst(Inst),
InstDefn = hlds_inst_defn(InstVarSet, InstParams, InstBody,
IFTC, Context, Status),
map.det_update(InstCtor, processed_user_inst(InstDefn),
!MaybeInstDefnsMap)
).
:- pred pretest_inst(mer_inst::in, mer_inst::out,
map(inst_ctor, hlds_inst_defn)::in,
inst_result_groundness::out, inst_result_contains_any::out,
inst_result_contains_inst_names::out, inst_result_contains_inst_vars::out,
inst_result_contains_types::out,
map(inst_ctor, maybe_user_inst)::in, map(inst_ctor, maybe_user_inst)::out)
is det.
pretest_inst(Inst0, Inst, UserInstTable0, Groundness, ContainsAny,
ContainsInstNames, ContainsInstVars, ContainsTypes,
!MaybeInstDefnsMap) :-
(
Inst0 = free,
Groundness = inst_result_is_not_ground,
ContainsAny = inst_result_does_not_contain_any,
ContainsInstNames = inst_result_contains_inst_names_known(set.init),
ContainsInstVars = inst_result_contains_inst_vars_known(set.init),
ContainsTypes = inst_result_contains_types_known(set.init),
Inst = Inst0
;
Inst0 = ground(_Uniq, _HOInstInfo),
Groundness = inst_result_is_ground,
ContainsAny = inst_result_does_not_contain_any,
ContainsInstNames = inst_result_contains_inst_names_known(set.init),
ContainsInstVars = inst_result_contains_inst_vars_known(set.init),
ContainsTypes = inst_result_contains_types_known(set.init),
Inst = Inst0
;
Inst0 = any(_Uniq, _HOInstInfo),
Groundness = inst_result_is_not_ground,
ContainsAny = inst_result_does_contain_any,
ContainsInstNames = inst_result_contains_inst_names_known(set.init),
ContainsInstVars = inst_result_contains_inst_vars_known(set.init),
ContainsTypes = inst_result_contains_types_known(set.init),
Inst = Inst0
;
Inst0 = not_reached,
% These should be generated only by the compiler.
unexpected($pred, "Inst0 = not_reached")
;
Inst0 = inst_var(_InstVar),
% We should invoke pretest_inst only for inst definitions that
% do NOT have parameters.
unexpected($pred, "Inst0 = inst_var")
;
Inst0 = constrained_inst_vars(InstVars, SubInst0),
pretest_inst(SubInst0, SubInst, UserInstTable0,
Groundness, ContainsAny, ContainsInstNames, ContainsInstVars0,
ContainsTypes, !MaybeInstDefnsMap),
combine_contains_inst_vars_results(
inst_result_contains_inst_vars_known(InstVars),
ContainsInstVars0, ContainsInstVars),
Inst = constrained_inst_vars(InstVars, SubInst)
;
Inst0 = defined_inst(_InstName),
% XXX We should look up InstName, and record the result of testing it.
Groundness = inst_result_groundness_unknown,
ContainsAny = inst_result_contains_any_unknown,
ContainsInstNames = inst_result_contains_inst_names_unknown,
% pretest_inst is called only on inst definitions with no parameters,
% so there can be no inst variables.
ContainsInstVars = inst_result_contains_inst_vars_known(set.init),
ContainsTypes = inst_result_contains_types_unknown,
Inst = Inst0
;
Inst0 = bound(Uniq, _TestResults0, BoundInsts0),
pretest_bound_insts(BoundInsts0, BoundInsts, UserInstTable0,
inst_result_is_ground, Groundness,
inst_result_does_not_contain_any, ContainsAny,
inst_result_contains_inst_names_known(set.init), ContainsInstNames,
inst_result_contains_inst_vars_known(set.init), ContainsInstVars,
inst_result_contains_types_known(set.init), ContainsTypes,
!MaybeInstDefnsMap),
TestResults = inst_test_results(Groundness,
ContainsAny, ContainsInstNames, ContainsInstVars,
ContainsTypes, inst_result_no_type_ctor_propagated),
Inst = bound(Uniq, TestResults, BoundInsts)
).
:- pred pretest_bound_insts(list(bound_inst)::in, list(bound_inst)::out,
map(inst_ctor, hlds_inst_defn)::in,
inst_result_groundness::in, inst_result_groundness::out,
inst_result_contains_any::in, inst_result_contains_any::out,
inst_result_contains_inst_names::in, inst_result_contains_inst_names::out,
inst_result_contains_inst_vars::in, inst_result_contains_inst_vars::out,
inst_result_contains_types::in, inst_result_contains_types::out,
map(inst_ctor, maybe_user_inst)::in, map(inst_ctor, maybe_user_inst)::out)
is det.
pretest_bound_insts([], [], _UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap).
pretest_bound_insts([BoundInst0 | BoundInsts0], [BoundInst | BoundInsts],
UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap) :-
BoundInst0 = bound_functor(ConsId, ArgInsts0),
pretest_bound_inst_args(ArgInsts0, ArgInsts, UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap),
BoundInst = bound_functor(ConsId, ArgInsts),
pretest_bound_insts(BoundInsts0, BoundInsts, UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap).
:- pred pretest_bound_inst_args(list(mer_inst)::in, list(mer_inst)::out,
map(inst_ctor, hlds_inst_defn)::in,
inst_result_groundness::in, inst_result_groundness::out,
inst_result_contains_any::in, inst_result_contains_any::out,
inst_result_contains_inst_names::in, inst_result_contains_inst_names::out,
inst_result_contains_inst_vars::in, inst_result_contains_inst_vars::out,
inst_result_contains_types::in, inst_result_contains_types::out,
map(inst_ctor, maybe_user_inst)::in, map(inst_ctor, maybe_user_inst)::out)
is det.
pretest_bound_inst_args([], [], _UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap).
pretest_bound_inst_args([ArgInst0 | ArgInsts0], [ArgInst | ArgInsts],
UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap) :-
pretest_inst(ArgInst0, ArgInst, UserInstTable0,
ArgGroundness, ArgContainsAny, ArgContainsInstNames,
ArgContainsInstVars, ArgContainsTypes, !MaybeInstDefnsMap),
combine_groundness_results(ArgGroundness, !Groundness),
combine_contains_any_results(ArgContainsAny, !ContainsAny),
combine_contains_inst_names_results(ArgContainsInstNames,
!ContainsInstNames),
combine_contains_inst_vars_results(ArgContainsInstVars,
!ContainsInstVars),
combine_contains_types_results(ArgContainsTypes, !ContainsTypes),
pretest_bound_inst_args(ArgInsts0, ArgInsts, UserInstTable0,
!Groundness, !ContainsAny, !ContainsInstNames, !ContainsInstVars,
!ContainsTypes, !MaybeInstDefnsMap).
:- pred combine_groundness_results(inst_result_groundness::in,
inst_result_groundness::in, inst_result_groundness::out) is det.
combine_groundness_results(GroundnessA, GroundnessB, Groundness) :-
(
GroundnessA = inst_result_is_not_ground,
Groundness = inst_result_is_not_ground
;
GroundnessA = inst_result_is_ground,
Groundness = GroundnessB
;
GroundnessA = inst_result_groundness_unknown,
(
GroundnessB = inst_result_is_not_ground,
Groundness = inst_result_is_not_ground
;
( GroundnessB = inst_result_is_ground
; GroundnessB = inst_result_groundness_unknown
),
Groundness = inst_result_groundness_unknown
)
).
:- pred combine_contains_any_results(inst_result_contains_any::in,
inst_result_contains_any::in, inst_result_contains_any::out) is det.
combine_contains_any_results(ContainsAnyA, ContainsAnyB, ContainsAny) :-
(
ContainsAnyA = inst_result_does_contain_any,
ContainsAny = inst_result_does_contain_any
;
ContainsAnyA = inst_result_does_not_contain_any,
ContainsAny = ContainsAnyB
;
ContainsAnyA = inst_result_contains_any_unknown,
(
ContainsAnyB = inst_result_does_contain_any,
ContainsAny = inst_result_does_contain_any
;
( ContainsAnyB = inst_result_does_not_contain_any
; ContainsAnyB = inst_result_contains_any_unknown
),
ContainsAny = inst_result_contains_any_unknown
)
).
:- pred combine_contains_inst_names_results(
inst_result_contains_inst_names::in, inst_result_contains_inst_names::in,
inst_result_contains_inst_names::out) is det.
combine_contains_inst_names_results(ContainsInstNamesA, ContainsInstNamesB,
ContainsInstNames) :-
(
ContainsInstNamesA = inst_result_contains_inst_names_unknown,
ContainsInstNames = inst_result_contains_inst_names_unknown
;
ContainsInstNamesA = inst_result_contains_inst_names_known(InstNamesA),
(
ContainsInstNamesB = inst_result_contains_inst_names_unknown,
ContainsInstNames = inst_result_contains_inst_names_unknown
;
ContainsInstNamesB =
inst_result_contains_inst_names_known(InstNamesB),
set.union(InstNamesA, InstNamesB, InstNames),
ContainsInstNames =
inst_result_contains_inst_names_known(InstNames)
)
).
:- pred combine_contains_inst_vars_results(
inst_result_contains_inst_vars::in, inst_result_contains_inst_vars::in,
inst_result_contains_inst_vars::out) is det.
combine_contains_inst_vars_results(ContainsInstVarsA, ContainsInstVarsB,
ContainsInstVars) :-
(
ContainsInstVarsA = inst_result_contains_inst_vars_unknown,
ContainsInstVars = inst_result_contains_inst_vars_unknown
;
ContainsInstVarsA = inst_result_contains_inst_vars_known(InstVarsA),
(
ContainsInstVarsB = inst_result_contains_inst_vars_unknown,
ContainsInstVars = inst_result_contains_inst_vars_unknown
;
ContainsInstVarsB =
inst_result_contains_inst_vars_known(InstVarsB),
set.union(InstVarsA, InstVarsB, InstVars),
ContainsInstVars =
inst_result_contains_inst_vars_known(InstVars)
)
).
:- pred combine_contains_types_results(inst_result_contains_types::in,
inst_result_contains_types::in, inst_result_contains_types::out) is det.
combine_contains_types_results(ContainsTypesA, ContainsTypesB,
ContainsTypes) :-
(
ContainsTypesA = inst_result_contains_types_unknown,
ContainsTypes = inst_result_contains_types_unknown
;
ContainsTypesA = inst_result_contains_types_known(TypesA),
(
ContainsTypesB = inst_result_contains_types_unknown,
ContainsTypes = inst_result_contains_types_unknown
;
ContainsTypesB = inst_result_contains_types_known(TypesB),
set.union(TypesA, TypesB, Types),
ContainsTypes = inst_result_contains_types_known(Types)
)
).
%-----------------------------------------------------------------------------%
:- pred record_user_inst_results(assoc_list(inst_ctor, maybe_user_inst)::in,
assoc_list(inst_ctor, hlds_inst_defn)::out) is det.
record_user_inst_results([], []).
record_user_inst_results([MaybeInstPair | MaybeInstPairs],
[InstDefnPair | InstDefnPairs]) :-
MaybeInstPair = InstCtor - MaybeUserInst,
(
MaybeUserInst = user_inst_being_processed,
unexpected($pred, "MaybeUserInst = user_inst_being_processed")
;
MaybeUserInst = processed_user_inst(UserInstDefn)
),
InstDefnPair = InstCtor - UserInstDefn,
record_user_inst_results(MaybeInstPairs, InstDefnPairs).
%-----------------------------------------------------------------------------%
% :- pred output_user_inst_pair(pair(inst_ctor, hlds_inst_defn)::in,
% io::di, io::uo) is det.
%
% output_user_inst_pair(InstCtor - InstDefn, !IO) :-
% InstCtor = inst_ctor(SymName, Arity),
% io.write_string(sym_name_to_string(SymName), !IO),
% io.write_string("/", !IO),
% io.write_int(Arity, !IO),
% io.write_string(" -> ", !IO),
% InstDefn = hlds_inst_defn(_VarSet, _Params, InstBody,
% _MaybeMatchingTypeCtors, _Context, _Status),
% io.write(InstBody, !IO),
% io.nl(!IO),
% io.nl(!IO).
%-----------------------------------------------------------------------------%
:- end_module check_hlds.inst_user.
%-----------------------------------------------------------------------------%