mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-18 07:15:19 +00:00
Code Issues Projects Releases Wiki Activity
Files
9f68c330f079d778a28e7e59162ad5d08d188d83
mercury/compiler/prog_mode.m
Zoltan Somogyi b3fa535100 A rewrite of the state variable transformation from the ground up. 
Estimated hours taken: 60
Branches: main

A rewrite of the state variable transformation from the ground up.

The initial aim was to avoid situations (encountered in the g12 project)
in which the old state variable transformation generated code that
did not satisfy the mode checker, due to unnecessary unifications.
The new system tries hard to minimize the number of unifications added to the
program. It does this by relying extensively on the idea that in a branched
structure such as an disjunction, if two branches both update the same state
variable, and the variables representing the last state of the state variable
in the two branches are (say) X and Y, and we pick X to represent the current
state after the disjunction, then we don't have to put the assignment X := Y
into the second branch; instead, we can RENAME Y to X in that branch.
To avoid renaming a goal several times (for itself, for its parent, for its
grandparent etc), we delay all renamings until the end, when we do it all
in one traversal.

The old state var system was opaque and hard to understand, partly because
its basic operations did different things in different contexts. The new system
is a much more direct expression of the intuitive meaning of state variables;
it keeps track of their state much as the programmer writing the original code
would. It should therefore be significantly easier to understand and to modify
in the future.

The new system can also detect more kinds of errors in the use of state
variables. For example it can discover that some branches of a disjunction or
if-then-else set the initial value of a state variable and some do not.
This is ok if the non-setting-branch cannot succeed; if it can, then it is
a bug. We therefore generate messages about such branches, but print them
only if mode analysis finds a bug in the procedure, since in that case,
the lack of initialization may be the cause of the bug.

doc/reference_manual.texi:
	Replaced an old example that didn't know what it was talking about,
	and thoroughly confused the issue of what is legal use of state
	variables and what is not.

compiler/state_var.m:
	Rewrite this module along the lines mentioned above.

compiler/options.m:
	Add two new options. One, warn-state-var-shadowing, controls whether
	we generate warnings for one state var shadowing another (which
	G12 has lots of). The other, --allow-defn-for-builtins, is for
	developers only; it is needed to bootstrap changes that add new
	builtins. I needed this for a form of the state variable transformation
	that used calls to a new builtin predicate to copy the values of state
	variables in branches that did not modify them, even though other
	branches did. I ultimately used unifications to do this copying,
	for reasons documented in state_var.m.

compiler/add_clause.m:
compiler/add_pragma.m:
	Respect the new --allow-defn-for-builtins option.
	(Previously, we changed the code that now looks up the value of the
	option.)

doc/user_guide.texi:
	Document the --warn-state-var-shadowing option.

	Fix some old documentation about dump options.

compiler/simplify.m:
	Fix an old oversight: list the predicates in table_builtin.m that may
	have calls introduced to them by table_gen.m.

compiler/superhomogeneous.m:
compiler/field_access.m:
compiler/add_clause.m:
compiler/goal_expr_to_goal.m:
	Together with state_var.m, these modules contain the transformation
	from the parse tree to the HLDS. Since the change to state_var.m
	involves significant changes in its interface (such as separating out
	the persistent and location-dependent aspects of the information needed
	by the state variable transformation), and needing callbacks at
	different points than the old transformation, these modules had to
	change extensively as well to conform.

	goal_expr_to_goal.m is a new module carved out of add_clause.m.
	It deserves a module of its own because its code has a significantly
	different purpose than add_clause.m. The two separate modules each
	have much better cohesion than the old conjoined module did.

	In superhomogeneous.m, replace two predicates that did the same thing
	with one predicate.

compiler/make_hlds.m:
compiler/notes/compiler_design.html.m:
	Mention the new module.

compiler/hlds_goal.m:
	Add a mechanism to do the kind of incremental renaming that the state
	variable transformation needs.

	Add some utility predicates needed by the new code in other modules.

compiler/hlds_clause.m:
compiler/hlds_pred.m:
	Add an extra piece of information to clauses and proc_infos:
	a list of informational messages generated by the state variable
	transformation about some branches of branched goals not giving initial
	values to some state variables, while other branches do.

	The state variable transformation fills in this field in clauses
	where relevant.

compiler/clause_to_proc.m:
	Copy this list of messages from clauses to proc_infos.

compiler/modes.m:
	When generating an error message for a procedure, include this list
	of messages from the state var transformation in the output.

compiler/handle_options.m:
	Add a dump alias for debugging the state var transformation.

compiler/hlds_out_goal.m:
	Add a predicate that is useful in trace messages when debugging
	the compiler.

compiler/hlds_out_pred.m:
	Print goal path and goal id information in clauses as well as
	proc_infos, since the state var transformation now uses goal ids.

compiler/prog_item.m:
	In lists of quantified vars in scope headers, separate out the vars
	introduced as !S from those introduced as !.S and !:S. This makes it
	easier for the state var transformation to handle them.

	Document that we expect lists of quantified variables and state
	variables to contain no duplicates. The state var transformation
	is slightly simpler if we impose this requirement, and quantifying
	a variable twice in the same scope does not make sense, and is
	therefore almost certainly an error.

compiler/prog_io_util.m:
	Generate error messages when a variable or state variable IS
	listed twice in the same quantification list.

	Factor out some code used to generate error messages.

compiler/typecheck.m:
	Conform to the changes above.

	Break a very large predicate into two smaller pieces.

compiler/add_class.m:
compiler/add_pragma.m:
compiler/add_pred.m:
compiler/assertion.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/goal_path.m:
compiler/goal_util.m:
compiler/headvar_names.m:
compiler/hhf.m:
compiler/hlds_out_module.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/mercury_to_mercury.m:
compiler/module_imports.m:
compiler/module_qual.m:
compiler/post_typecheck.m:
compiler/prog_io_goal.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
	Conform to the changes above.

compiler/mode_constraints.m:
compiler/modules.m:
compiler/structure_reuse.analysis.m:
	Avoid the warnings we now generate about one state variable shadowing
	another.

browser/declarative_user.m:
compiler/hlds_out_util.m:
compiler/ordering_mode_constraints.m:
compiler/table_gen.m:
deep_profiler/read_profile.m:
	Improve programming style.

library/require.m:
	Add expect_not, a negated version of expect.

library/varset.m:
	Return lists of new variables in order, not reverse order.

mdbcomp/mdbcomp.goal_path.m:
compiler/prog_mode.m:
	Add a utility predicate.

tests/debugger/tailrec1.exp:
tests/invalid/any_passed_as_ground.err_exp:
tests/invalid/bad_sv_unify_msg.err_exp:
tests/invalid/state_vars_test1.err_exp:
tests/invalid/state_vars_test4.err_exp:
tests/invalid/try_bad_params.err_exp:
tests/invalid/try_detism.err_exp:
tests/invalid/purity/impure_pred_t1_fixed.err_exp:
tests/invalid/purity/impure_pred_t2.err_exp:
	Update the expected outputs of these test cases to account for
	incidental changes in variable numbers and goal paths after this
	change.

tests/general/state_vars_tests.{m,exp}:
	Remove the code that expected the state var transformation to do
	something that was actually AGAINST the reference manual: treating
	the step from the condition to the then part of an if-then-else
	expression (not a goal) as a sequence point.

tests/general/state_vars_trace.m:
	Add a test case that is not enabled yet, since we don't pass it.

tests/hard_coded/bit_buffer_test.m:
	Fix a bug in the test itself: the introduction of a state var twice
	in the same scope.

tests/hard_coded/try_syntax_6.m:
	Avoid a warning about state var shadowing.

tests/hard_coded/if_then_else_expr_state_var.{m,exp}:
	A new test to check the proper handling of state vars in if-then-else
	expressions.

tests/hard_coded/Mmakefile:
	Enable the new test.
2011-03-07 03:59:43 +00:00

698 lines
26 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2004-2006, 2008-2011 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_mode.m.
% Main author: fjh.
%
% Utility predicates dealing with modes and insts that do not require access
% to the HLDS. (The predicates that do are in mode_util.m.)
%
%-----------------------------------------------------------------------------%
:- module parse_tree.prog_mode.
:- interface.
:- import_module parse_tree.prog_data.
:- import_module list.
%-----------------------------------------------------------------------------%
% Construct a mode corresponding to the standard `in', `out', `uo'
% or `unused' mode.
%
:- pred in_mode(mer_mode::out) is det.
:- func in_mode = mer_mode.
:- func in_mode(mer_inst) = mer_mode.
:- pred out_mode(mer_mode::out) is det.
:- func out_mode = mer_mode.
:- func out_mode(mer_inst) = mer_mode.
:- pred di_mode(mer_mode::out) is det.
:- func di_mode = mer_mode.
:- pred uo_mode(mer_mode::out) is det.
:- func uo_mode = mer_mode.
:- pred mdi_mode(mer_mode::out) is det.
:- func mdi_mode = mer_mode.
:- pred muo_mode(mer_mode::out) is det.
:- func muo_mode = mer_mode.
:- pred unused_mode(mer_mode::out) is det.
:- func unused_mode = mer_mode.
:- func in_any_mode = mer_mode.
:- func out_any_mode = mer_mode.
:- func ground_inst = mer_inst.
:- func free_inst = mer_inst.
:- func any_inst = mer_inst.
:- pred make_std_mode(string::in, list(mer_inst)::in, mer_mode::out) is det.
:- func make_std_mode(string, list(mer_inst)) = mer_mode.
%-----------------------------------------------------------------------------%
% mode_substitute_arg_list(Mode0, Params, Args, Mode) is true iff Mode is
% the mode that results from substituting all occurrences of Params
% in Mode0 with the corresponding value in Args.
%
:- pred mode_substitute_arg_list(mer_mode::in, list(inst_var)::in,
list(mer_inst)::in, mer_mode::out) is det.
% inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes):
%
% Given two lists of corresponding initial and final insts, return
% a list of modes which maps from the initial insts to the final insts.
%
:- pred inst_lists_to_mode_list(list(mer_inst)::in, list(mer_inst)::in,
list(mer_mode)::out) is det.
:- pred insts_to_mode(mer_inst::in, mer_inst::in, mer_mode::out) is det.
%-----------------------------------------------------------------------------%
% inst_substitute_arg_list(Params, Args, Inst0, Inst) is true iff Inst
% is the inst that results from substituting all occurrences of Params
% in Inst0 with the corresponding value in Args.
%
:- pred inst_substitute_arg_list(list(inst_var)::in, list(mer_inst)::in,
mer_inst::in, mer_inst::out) is det.
% inst_list_apply_substitution(Subst, Insts0, Insts) is true
% iff Inst is the inst that results from applying Subst to Insts0.
%
:- pred inst_list_apply_substitution(inst_var_sub::in,
list(mer_inst)::in, list(mer_inst)::out) is det.
% mode_list_apply_substitution(Subst, Modes0, Modes) is true
% iff Mode is the mode that results from applying Subst to Modes0.
%
:- pred mode_list_apply_substitution(inst_var_sub::in,
list(mer_mode)::in, list(mer_mode)::out) is det.
:- pred rename_apart_inst_vars(inst_varset::in, inst_varset::in,
list(mer_mode)::in, list(mer_mode)::out) is det.
% inst_contains_unconstrained_var(Inst) iff Inst includes an
% unconstrained inst variable.
%
:- pred inst_contains_unconstrained_var(mer_inst::in) is semidet.
%-----------------------------------------------------------------------------%
% Given an expanded inst and a cons_id and its arity, return the
% insts of the arguments of the top level functor, failing if the
% inst could not be bound to the functor.
%
:- pred get_arg_insts(mer_inst::in, cons_id::in, arity::in,
list(mer_inst)::out) is semidet.
% Given a (list of) bound_insts, get the corresponding cons_ids.
% The type_ctor, if given,
%
:- pred bound_inst_to_cons_id(type_ctor::in, bound_inst::in,
cons_id::out) is det.
:- pred bound_insts_to_cons_ids(type_ctor::in, list(bound_inst)::in,
list(cons_id)::out) is det.
:- pred mode_id_to_int(mode_id::in, int::out) is det.
% Predicates to make error messages more readable by stripping
% "builtin." module qualifiers from modes.
%
:- pred strip_builtin_qualifier_from_cons_id(cons_id::in, cons_id::out) is det.
:- pred strip_builtin_qualifiers_from_mode_list(list(mer_mode)::in,
list(mer_mode)::out) is det.
:- pred strip_builtin_qualifiers_from_inst_list(list(mer_inst)::in,
list(mer_inst)::out) is det.
:- pred strip_builtin_qualifiers_from_inst(mer_inst::in, mer_inst::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdbcomp.prim_data.
:- import_module map.
:- import_module require.
:- import_module set.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
in_mode(in_mode).
out_mode(out_mode).
di_mode(di_mode).
uo_mode(uo_mode).
mdi_mode(mdi_mode).
muo_mode(muo_mode).
unused_mode(unused_mode).
in_mode = make_std_mode("in", []).
in_mode(I) = make_std_mode("in", [I]).
out_mode = make_std_mode("out", []).
out_mode(I) = make_std_mode("out", [I]).
di_mode = make_std_mode("di", []).
uo_mode = make_std_mode("uo", []).
mdi_mode = make_std_mode("mdi", []).
muo_mode = make_std_mode("muo", []).
unused_mode = make_std_mode("unused", []).
in_any_mode = make_std_mode("in", [any_inst]).
out_any_mode = make_std_mode("out", [any_inst]).
ground_inst = ground(shared, none).
free_inst = free.
any_inst = any(shared, none).
make_std_mode(Name, Args, make_std_mode(Name, Args)).
make_std_mode(Name, Args) = Mode :-
MercuryBuiltin = mercury_public_builtin_module,
QualifiedName = qualified(MercuryBuiltin, Name),
Mode = user_defined_mode(QualifiedName, Args).
%-----------------------------------------------------------------------------%
inst_lists_to_mode_list([], [_ | _], _) :-
unexpected(this_file, "inst_lists_to_mode_list: length mismatch").
inst_lists_to_mode_list([_ | _], [], _) :-
unexpected(this_file, "inst_lists_to_mode_list: length mismatch").
inst_lists_to_mode_list([], [], []).
inst_lists_to_mode_list([Initial | Initials], [Final | Finals],
[Mode | Modes]) :-
insts_to_mode(Initial, Final, Mode),
inst_lists_to_mode_list(Initials, Finals, Modes).
insts_to_mode(Initial, Final, Mode) :-
% Use some abbreviations.
% This is just to make error messages and inferred modes more readable.
( Initial = free, Final = ground(shared, none) ->
make_std_mode("out", [], Mode)
; Initial = free, Final = ground(unique, none) ->
make_std_mode("uo", [], Mode)
; Initial = free, Final = ground(mostly_unique, none) ->
make_std_mode("muo", [], Mode)
; Initial = ground(shared, none), Final = ground(shared, none) ->
make_std_mode("in", [], Mode)
; Initial = ground(unique, none), Final = ground(clobbered, none) ->
make_std_mode("di", [], Mode)
; Initial = ground(mostly_unique, none),
Final = ground(mostly_clobbered, none) ->
make_std_mode("mdi", [], Mode)
; Initial = ground(unique, none), Final = ground(unique, none) ->
make_std_mode("ui", [], Mode)
; Initial = ground(mostly_unique, none),
Final = ground(mostly_unique, none) ->
make_std_mode("mdi", [], Mode)
; Initial = free ->
make_std_mode("out", [Final], Mode)
; Final = ground(clobbered, none) ->
make_std_mode("di", [Initial], Mode)
; Initial = Final ->
make_std_mode("in", [Initial], Mode)
;
Mode = (Initial -> Final)
).
%-----------------------------------------------------------------------------%
mode_substitute_arg_list(Mode0, Params, Args, Mode) :-
(
Params = [],
Mode = Mode0 % optimize common case
;
Params = [_ | _],
map.from_corresponding_lists(Params, Args, Subst),
mode_apply_substitution(Subst, Mode0, Mode)
).
inst_substitute_arg_list(Params, Args, Inst0, Inst) :-
(
Params = [],
Inst = Inst0 % optimize common case
;
Params = [_ | _],
map.from_corresponding_lists(Params, Args, Subst),
inst_apply_substitution(Subst, Inst0, Inst)
).
% mode_apply_substitution(Mode0, Subst, Mode) is true iff
% Mode is the mode that results from apply Subst to Mode0.
%
:- pred mode_apply_substitution(inst_var_sub::in, mer_mode::in, mer_mode::out)
is det.
mode_apply_substitution(Subst, (I0 -> F0), (I -> F)) :-
inst_apply_substitution(Subst, I0, I),
inst_apply_substitution(Subst, F0, F).
mode_apply_substitution(Subst, user_defined_mode(Name, Args0),
user_defined_mode(Name, Args)) :-
inst_list_apply_substitution_2(Subst, Args0, Args).
inst_list_apply_substitution(Subst, Insts0, Insts) :-
( map.is_empty(Subst) ->
Insts = Insts0
;
inst_list_apply_substitution_2(Subst, Insts0, Insts)
).
:- pred inst_list_apply_substitution_2(inst_var_sub::in,
list(mer_inst)::in, list(mer_inst)::out) is det.
inst_list_apply_substitution_2(_, [], []).
inst_list_apply_substitution_2(Subst, [A0 | As0], [A | As]) :-
inst_apply_substitution(Subst, A0, A),
inst_list_apply_substitution_2(Subst, As0, As).
% inst_substitute_arg(Inst0, Subst, Inst) is true iff Inst is the inst that
% results from substituting all occurrences of Param in Inst0 with Arg.
%
:- pred inst_apply_substitution(inst_var_sub::in, mer_inst::in, mer_inst::out)
is det.
inst_apply_substitution(Subst, any(Uniq, HOInstInfo0), Inst) :-
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
Inst = any(Uniq, HOInstInfo).
inst_apply_substitution(_, free, free).
inst_apply_substitution(_, free(T), free(T)).
inst_apply_substitution(Subst, ground(Uniq, HOInstInfo0), Inst) :-
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
Inst = ground(Uniq, HOInstInfo).
inst_apply_substitution(Subst, bound(Uniq, Alts0), bound(Uniq, Alts)) :-
alt_list_apply_substitution(Subst, Alts0, Alts).
inst_apply_substitution(_, not_reached, not_reached).
inst_apply_substitution(Subst, inst_var(Var), Result) :-
( map.search(Subst, Var, Replacement) ->
Result = Replacement
;
Result = inst_var(Var)
).
inst_apply_substitution(Subst, constrained_inst_vars(Vars, Inst0), Result) :-
( set.singleton_set(Vars, Var0) ->
Var = Var0
;
unexpected(this_file,
"inst_apply_substitution: multiple inst_vars found")
),
( map.search(Subst, Var, Replacement) ->
Result = Replacement
% XXX Should probably have a sanity check here that
% Replacement =< Inst0
;
inst_apply_substitution(Subst, Inst0, Result0),
Result = constrained_inst_vars(Vars, Result0)
).
inst_apply_substitution(Subst, defined_inst(InstName0),
defined_inst(InstName)) :-
( inst_name_apply_substitution(Subst, InstName0, InstName1) ->
InstName = InstName1
;
InstName = InstName0
).
inst_apply_substitution(Subst, abstract_inst(Name, Args0),
abstract_inst(Name, Args)) :-
inst_list_apply_substitution_2(Subst, Args0, Args).
% This predicate fails if the inst_name is not one of user_inst,
% typed_inst or typed_ground. The other types of inst_names are just used
% as keys in the inst_table so it does not make sense to apply
% substitutions to them.
%
:- pred inst_name_apply_substitution(inst_var_sub::in,
inst_name::in, inst_name::out) is semidet.
inst_name_apply_substitution(Subst, user_inst(Name, Args0),
user_inst(Name, Args)) :-
inst_list_apply_substitution_2(Subst, Args0, Args).
inst_name_apply_substitution(Subst, typed_inst(T, Inst0),
typed_inst(T, Inst)) :-
inst_name_apply_substitution(Subst, Inst0, Inst).
inst_name_apply_substitution(_, typed_ground(Uniq, T), typed_ground(Uniq, T)).
:- pred alt_list_apply_substitution(inst_var_sub::in,
list(bound_inst)::in, list(bound_inst)::out) is det.
alt_list_apply_substitution(_, [], []).
alt_list_apply_substitution(Subst, [Alt0 | Alts0], [Alt | Alts]) :-
Alt0 = bound_functor(Name, Args0),
inst_list_apply_substitution_2(Subst, Args0, Args),
Alt = bound_functor(Name, Args),
alt_list_apply_substitution(Subst, Alts0, Alts).
:- pred ho_inst_info_apply_substitution(inst_var_sub::in,
ho_inst_info::in, ho_inst_info::out) is det.
ho_inst_info_apply_substitution(_, none, none).
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo) :-
HOInstInfo0 = higher_order(pred_inst_info(PredOrFunc, Modes0, Det)),
mode_list_apply_substitution(Subst, Modes0, Modes),
HOInstInfo = higher_order(pred_inst_info(PredOrFunc, Modes, Det)).
mode_list_apply_substitution(Subst, Modes0, Modes) :-
( map.is_empty(Subst) ->
Modes = Modes0
;
mode_list_apply_substitution_2(Subst, Modes0, Modes)
).
:- pred mode_list_apply_substitution_2(inst_var_sub::in,
list(mer_mode)::in, list(mer_mode)::out) is det.
mode_list_apply_substitution_2(_, [], []).
mode_list_apply_substitution_2(Subst, [A0 | As0], [A | As]) :-
mode_apply_substitution(Subst, A0, A),
mode_list_apply_substitution_2(Subst, As0, As).
%-----------------------------------------------------------------------------%
rename_apart_inst_vars(VarSet, NewVarSet, Modes0, Modes) :-
varset.merge_subst(VarSet, NewVarSet, _, Sub),
list.map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes).
:- pred rename_apart_inst_vars_in_mode(substitution(inst_var_type)::in,
mer_mode::in, mer_mode::out) is det.
rename_apart_inst_vars_in_mode(Sub, I0 -> F0, I -> F) :-
rename_apart_inst_vars_in_inst(Sub, I0, I),
rename_apart_inst_vars_in_inst(Sub, F0, F).
rename_apart_inst_vars_in_mode(Sub, user_defined_mode(Name, Insts0),
user_defined_mode(Name, Insts)) :-
list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
:- pred rename_apart_inst_vars_in_inst(substitution(inst_var_type)::in,
mer_inst::in, mer_inst::out) is det.
rename_apart_inst_vars_in_inst(Sub, any(Uniq, HOInstInfo0),
any(Uniq, HOInstInfo)) :-
(
HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0, Det)),
list.map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes),
HOInstInfo = higher_order(pred_inst_info(PorF, Modes, Det))
;
HOInstInfo0 = none,
HOInstInfo = none
).
rename_apart_inst_vars_in_inst(_, free, free).
rename_apart_inst_vars_in_inst(_, free(T), free(T)).
rename_apart_inst_vars_in_inst(Sub, bound(U, BIs0), bound(U, BIs)) :-
list.map(
(pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out) is det :-
list.map(rename_apart_inst_vars_in_inst(Sub), Is0, Is)),
BIs0, BIs).
rename_apart_inst_vars_in_inst(Sub, ground(Uniq, HOInstInfo0),
ground(Uniq, HOInstInfo)) :-
(
HOInstInfo0 = higher_order(pred_inst_info(PorF, Modes0, Det)),
list.map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes),
HOInstInfo = higher_order(pred_inst_info(PorF, Modes, Det))
;
HOInstInfo0 = none,
HOInstInfo = none
).
rename_apart_inst_vars_in_inst(_, not_reached, not_reached).
rename_apart_inst_vars_in_inst(Sub, inst_var(Var0), inst_var(Var)) :-
( map.search(Sub, Var0, term.variable(Var1, _)) ->
Var = Var1
;
Var = Var0
).
rename_apart_inst_vars_in_inst(Sub, constrained_inst_vars(Vars0, Inst0),
constrained_inst_vars(Vars, Inst)) :-
rename_apart_inst_vars_in_inst(Sub, Inst0, Inst),
Vars = set.map(func(Var0) =
( map.search(Sub, Var0, term.variable(Var, _)) ->
Var
;
Var0
), Vars0).
rename_apart_inst_vars_in_inst(Sub, defined_inst(Name0), defined_inst(Name)) :-
( rename_apart_inst_vars_in_inst_name(Sub, Name0, Name1) ->
Name = Name1
;
Name = Name0
).
rename_apart_inst_vars_in_inst(Sub, abstract_inst(Sym, Insts0),
abstract_inst(Sym, Insts)) :-
list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
:- pred rename_apart_inst_vars_in_inst_name(substitution(inst_var_type)::in,
inst_name::in, inst_name::out) is semidet.
rename_apart_inst_vars_in_inst_name(Sub, user_inst(Sym, Insts0),
user_inst(Sym, Insts)) :-
list.map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts).
rename_apart_inst_vars_in_inst_name(Sub, typed_inst(Type, Name0),
typed_inst(Type, Name)) :-
rename_apart_inst_vars_in_inst_name(Sub, Name0, Name).
rename_apart_inst_vars_in_inst_name(_, typed_ground(U, T), typed_ground(U, T)).
%-----------------------------------------------------------------------------%
inst_contains_unconstrained_var(bound(_Uniqueness, BoundInsts)) :-
list.member(BoundInst, BoundInsts),
BoundInst = bound_functor(_ConsId, ArgInsts),
list.member(ArgInst, ArgInsts),
inst_contains_unconstrained_var(ArgInst).
inst_contains_unconstrained_var(ground(_Uniqueness, GroundInstInfo)) :-
GroundInstInfo = higher_order(PredInstInfo),
PredInstInfo = pred_inst_info(_PredOrFunc, Modes, _Detism),
list.member(Mode, Modes),
(
Mode = (Inst -> _)
;
Mode = (_ -> Inst)
;
Mode = user_defined_mode(_SymName, Insts),
list.member(Inst, Insts)
),
inst_contains_unconstrained_var(Inst).
inst_contains_unconstrained_var(inst_var(_InstVar)).
inst_contains_unconstrained_var(defined_inst(InstName)) :-
(
InstName = user_inst(_, Insts),
list.member(Inst, Insts),
inst_contains_unconstrained_var(Inst)
;
InstName = merge_inst(Inst, _),
inst_contains_unconstrained_var(Inst)
;
InstName = merge_inst(_, Inst),
inst_contains_unconstrained_var(Inst)
;
InstName = unify_inst(_, Inst, _, _),
inst_contains_unconstrained_var(Inst)
;
InstName = unify_inst(_, _, Inst, _),
inst_contains_unconstrained_var(Inst)
;
InstName = ground_inst(InstName1, _, _, _),
inst_contains_unconstrained_var(defined_inst(InstName1))
;
InstName = any_inst(InstName1, _, _, _),
inst_contains_unconstrained_var(defined_inst(InstName1))
;
InstName = shared_inst(InstName1),
inst_contains_unconstrained_var(defined_inst(InstName1))
;
InstName = mostly_uniq_inst(InstName1),
inst_contains_unconstrained_var(defined_inst(InstName1))
;
InstName = typed_inst(_, InstName1),
inst_contains_unconstrained_var(defined_inst(InstName1))
).
inst_contains_unconstrained_var(abstract_inst(_SymName, Insts)) :-
list.member(Inst, Insts),
inst_contains_unconstrained_var(Inst).
%-----------------------------------------------------------------------------%
bound_inst_to_cons_id(TypeCtor, BoundInst, ConsId) :-
BoundInst = bound_functor(ConsId0, _ArgInsts),
( ConsId0 = cons(SymName, Arity, _TypeCtor) ->
ConsId = cons(SymName, Arity, TypeCtor)
;
ConsId = ConsId0
).
bound_insts_to_cons_ids(_, [], []).
bound_insts_to_cons_ids(TypeCtor, [BoundInst | BoundInsts],
[ConsId | ConsIds]) :-
bound_inst_to_cons_id(TypeCtor, BoundInst, ConsId),
bound_insts_to_cons_ids(TypeCtor, BoundInsts, ConsIds).
%-----------------------------------------------------------------------------%
get_arg_insts(not_reached, _ConsId, Arity, ArgInsts) :-
list.duplicate(Arity, not_reached, ArgInsts).
get_arg_insts(ground(Uniq, _PredInst), _ConsId, Arity, ArgInsts) :-
list.duplicate(Arity, ground(Uniq, none), ArgInsts).
get_arg_insts(bound(_Uniq, List), ConsId, Arity, ArgInsts) :-
( get_arg_insts_2(List, ConsId, ArgInsts0) ->
ArgInsts = ArgInsts0
;
% The code is unreachable.
list.duplicate(Arity, not_reached, ArgInsts)
).
get_arg_insts(free, _ConsId, Arity, ArgInsts) :-
list.duplicate(Arity, free, ArgInsts).
get_arg_insts(free(_Type), _ConsId, Arity, ArgInsts) :-
list.duplicate(Arity, free, ArgInsts).
get_arg_insts(any(Uniq, _), _ConsId, Arity, ArgInsts) :-
list.duplicate(Arity, any(Uniq, none), ArgInsts).
:- pred get_arg_insts_2(list(bound_inst)::in, cons_id::in, list(mer_inst)::out)
is semidet.
get_arg_insts_2([BoundInst | BoundInsts], ConsId, ArgInsts) :-
(
BoundInst = bound_functor(FunctorConsId, ArgInsts0),
equivalent_cons_ids(ConsId, FunctorConsId)
->
ArgInsts = ArgInsts0
;
get_arg_insts_2(BoundInsts, ConsId, ArgInsts)
).
% In case we later decide to change the representation of mode_ids.
mode_id_to_int(mode_id(_, X), X).
%-----------------------------------------------------------------------------%
% The interesting part is strip_builtin_qualifier_from_sym_name;
% the rest is basically just recursive traversals.
strip_builtin_qualifiers_from_mode_list(Modes0, Modes) :-
list.map(strip_builtin_qualifiers_from_mode, Modes0, Modes).
:- pred strip_builtin_qualifiers_from_mode(mer_mode::in, mer_mode::out) is det.
strip_builtin_qualifiers_from_mode((Initial0 -> Final0), (Initial -> Final)) :-
strip_builtin_qualifiers_from_inst(Initial0, Initial),
strip_builtin_qualifiers_from_inst(Final0, Final).
strip_builtin_qualifiers_from_mode(user_defined_mode(SymName0, Insts0),
user_defined_mode(SymName, Insts)) :-
strip_builtin_qualifiers_from_inst_list(Insts0, Insts),
strip_builtin_qualifier_from_sym_name(SymName0, SymName).
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId) :-
( ConsId0 = cons(Name0, Arity, TypeCtor) ->
strip_builtin_qualifier_from_sym_name(Name0, Name),
ConsId = cons(Name, Arity, TypeCtor)
;
ConsId = ConsId0
).
:- pred strip_builtin_qualifier_from_sym_name(sym_name::in, sym_name::out)
is det.
strip_builtin_qualifier_from_sym_name(SymName0, SymName) :-
(
SymName0 = qualified(Module, Name),
Module = mercury_public_builtin_module
->
SymName = unqualified(Name)
;
SymName = SymName0
).
strip_builtin_qualifiers_from_inst_list(Insts0, Insts) :-
list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts).
strip_builtin_qualifiers_from_inst(inst_var(V), inst_var(V)).
strip_builtin_qualifiers_from_inst(constrained_inst_vars(Vars, Inst0),
constrained_inst_vars(Vars, Inst)) :-
strip_builtin_qualifiers_from_inst(Inst0, Inst).
strip_builtin_qualifiers_from_inst(not_reached, not_reached).
strip_builtin_qualifiers_from_inst(free, free).
strip_builtin_qualifiers_from_inst(free(Type), free(Type)).
strip_builtin_qualifiers_from_inst(any(Uniq, HOInstInfo0),
any(Uniq, HOInstInfo)) :-
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo).
strip_builtin_qualifiers_from_inst(ground(Uniq, HOInstInfo0),
ground(Uniq, HOInstInfo)) :-
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo).
strip_builtin_qualifiers_from_inst(bound(Uniq, BoundInsts0),
bound(Uniq, BoundInsts)) :-
strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts).
strip_builtin_qualifiers_from_inst(defined_inst(Name0), defined_inst(Name)) :-
strip_builtin_qualifiers_from_inst_name(Name0, Name).
strip_builtin_qualifiers_from_inst(abstract_inst(Name0, Args0),
abstract_inst(Name, Args)) :-
strip_builtin_qualifier_from_sym_name(Name0, Name),
strip_builtin_qualifiers_from_inst_list(Args0, Args).
:- pred strip_builtin_qualifiers_from_bound_inst_list(list(bound_inst)::in,
list(bound_inst)::out) is det.
strip_builtin_qualifiers_from_bound_inst_list(Insts0, Insts) :-
list.map(strip_builtin_qualifiers_from_bound_inst, Insts0, Insts).
:- pred strip_builtin_qualifiers_from_bound_inst(bound_inst::in,
bound_inst::out) is det.
strip_builtin_qualifiers_from_bound_inst(BoundInst0, BoundInst) :-
BoundInst0 = bound_functor(ConsId0, Insts0),
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId),
BoundInst = bound_functor(ConsId, Insts),
list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts).
:- pred strip_builtin_qualifiers_from_inst_name(inst_name::in, inst_name::out)
is det.
strip_builtin_qualifiers_from_inst_name(user_inst(SymName0, Insts0),
user_inst(SymName, Insts)) :-
strip_builtin_qualifier_from_sym_name(SymName0, SymName),
strip_builtin_qualifiers_from_inst_list(Insts0, Insts).
strip_builtin_qualifiers_from_inst_name(merge_inst(InstA0, InstB0),
merge_inst(InstA, InstB)) :-
strip_builtin_qualifiers_from_inst(InstA0, InstA),
strip_builtin_qualifiers_from_inst(InstB0, InstB).
strip_builtin_qualifiers_from_inst_name(unify_inst(Live, InstA0, InstB0, Real),
unify_inst(Live, InstA, InstB, Real)) :-
strip_builtin_qualifiers_from_inst(InstA0, InstA),
strip_builtin_qualifiers_from_inst(InstB0, InstB).
strip_builtin_qualifiers_from_inst_name(
ground_inst(InstName0, Live, Uniq, Real),
ground_inst(InstName, Live, Uniq, Real)) :-
strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
strip_builtin_qualifiers_from_inst_name(
any_inst(InstName0, Live, Uniq, Real),
any_inst(InstName, Live, Uniq, Real)) :-
strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
strip_builtin_qualifiers_from_inst_name(shared_inst(InstName0),
shared_inst(InstName)) :-
strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
strip_builtin_qualifiers_from_inst_name(mostly_uniq_inst(InstName0),
mostly_uniq_inst(InstName)) :-
strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
strip_builtin_qualifiers_from_inst_name(typed_ground(Uniq, Type),
typed_ground(Uniq, Type)).
strip_builtin_qualifiers_from_inst_name(typed_inst(Type, InstName0),
typed_inst(Type, InstName)) :-
strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
:- pred strip_builtin_qualifiers_from_ho_inst_info(ho_inst_info::in,
ho_inst_info::out) is det.
strip_builtin_qualifiers_from_ho_inst_info(none, none).
strip_builtin_qualifiers_from_ho_inst_info(higher_order(Pred0),
higher_order(Pred)) :-
Pred0 = pred_inst_info(PorF, Modes0, Det),
Pred = pred_inst_info(PorF, Modes, Det),
strip_builtin_qualifiers_from_mode_list(Modes0, Modes).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "prog_mode.m".
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink