mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 21:35:49 +00:00
8a28e40c9b
Estimated hours taken: 2 Branches: main Add the predicates sorry, unexpected and expect to library/error.m. compiler/compiler_util.m: library/error.m: Move the predicates sorry, unexpected and expect from compiler_util to error. Put the predicates in error.m into the same order as their declarations. compiler/*.m: Change imports as needed. compiler/lp.m: compiler/lp_rational.m: Change imports as needed, and some minor cleanups. deep_profiler/*.m: Switch to using the new library predicates, instead of calling error directly. Some other minor cleanups. NEWS: Mention the new predicates in the standard library.
480 lines
17 KiB
Mathematica
480 lines
17 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2001-2007, 2009-2010 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: inst_graph.m.
|
|
% Author: dmo.
|
|
%
|
|
% This module defines operations on instantiation graphs. The purpose of the
|
|
% data structure and of the operations on it are defined in chapter 6 of
|
|
% David Overton's PhD thesis.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.inst_graph.
|
|
:- interface.
|
|
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type inst_graph == map(prog_var, node).
|
|
|
|
:- type node
|
|
---> node(
|
|
map(cons_id, list(prog_var)),
|
|
% If the variable that maps to this node occurs on the
|
|
% left hand side of any var-functor unifications,
|
|
% this map gives, for each functor that occurs in such
|
|
% unifications, the identities of the variables
|
|
% chosen by the transformation to hyperhomogeneous form
|
|
% to represent the arguments of that functor inside
|
|
% the cell variable.
|
|
|
|
maybe_parent
|
|
% Specifies whether
|
|
).
|
|
|
|
:- type maybe_parent
|
|
---> top_level
|
|
% The variable in whose node this maybe_parent value occurs
|
|
% doesn't appear on the right hand side of any var-functor
|
|
% unifications.
|
|
|
|
; parent(prog_var).
|
|
% The variable in whose node this maybe_parent value occurs
|
|
% does appear on the right hand side of a var-functor unification:
|
|
% the argument of parent identifies the variable on the left hand
|
|
% side. The definition of hyperhomogeneous form guarantees that
|
|
% this variable is unique.
|
|
|
|
% Initialise an inst_graph. Adds a node for each variable, and
|
|
% initializes each node to have no parents and no children.
|
|
%
|
|
:- pred init(list(prog_var)::in, inst_graph::out) is det.
|
|
|
|
% set_parent(Parent, Child, Graph0, Graph):
|
|
%
|
|
% Sets Parent to be the parent node of Child. Aborts if Child
|
|
% already has a parent.
|
|
%
|
|
:- pred set_parent(prog_var::in, prog_var::in, inst_graph::in, inst_graph::out)
|
|
is det.
|
|
|
|
% top_level_node(InstGraph, VarA, VarB):
|
|
%
|
|
% Succeeds iff VarB is the top_level node reachable from VarA in InstGraph.
|
|
%
|
|
:- pred top_level_node(inst_graph::in, prog_var::in, prog_var::out) is det.
|
|
|
|
% descendant(InstGraph, VarA, VarB):
|
|
%
|
|
% Succeeds iff VarB is a descendant of VarA in InstGraph.
|
|
%
|
|
:- pred descendant(inst_graph::in, prog_var::in, prog_var::out) is nondet.
|
|
|
|
% reachable(InstGraph, VarA, VarB):
|
|
%
|
|
% Succeeds iff VarB is a descendant of VarA in InstGraph,
|
|
% or if VarB *is* VarA.
|
|
%
|
|
:- pred reachable(inst_graph::in, prog_var::in, prog_var::out) is multi.
|
|
|
|
% reachable(InstGraph, Vars, VarB):
|
|
%
|
|
% Succeeds iff VarB is a descendant in InstGraph of any VarA in Vars.
|
|
%
|
|
:- pred reachable_from_list(inst_graph::in, list(prog_var)::in, prog_var::out)
|
|
is nondet.
|
|
|
|
% foldl_reachable(Pred, InstGraph, Var, !Acc):
|
|
%
|
|
% Performs a foldl operation over all variables V for which
|
|
% reachable(InstGraph, Var, V) is true.
|
|
%
|
|
:- pred foldl_reachable(pred(prog_var, T, T)::pred(in, in, out) is det,
|
|
inst_graph::in, prog_var::in, T::in, T::out) is det.
|
|
|
|
% foldl_reachable_from_list(Pred, InstGraph, Vars, !Acc):
|
|
%
|
|
% Performs a foldl operation over all variables V for which
|
|
% reachable_from_list(InstGraph, Vars, V) is true.
|
|
%
|
|
:- pred foldl_reachable_from_list(
|
|
pred(prog_var, T, T)::pred(in, in, out) is det,
|
|
inst_graph::in, list(prog_var)::in, T::in, T::out) is det.
|
|
|
|
% A version of foldl_reachable with two accumulators.
|
|
%
|
|
:- pred foldl_reachable2(
|
|
pred(prog_var, T, T, U, U)::pred(in, in, out, in, out) is det,
|
|
inst_graph::in, prog_var::in, T::in, T::out, U::in, U::out) is det.
|
|
|
|
% A version of foldl_reachable_from_list with two accumulators.
|
|
%
|
|
:- pred foldl_reachable_from_list2(
|
|
pred(prog_var, T, T, U, U)::pred(in, in, out, in, out) is det,
|
|
inst_graph::in, list(prog_var)::in, T::in, T::out, U::in, U::out)
|
|
is det.
|
|
|
|
:- pred same_graph_corresponding_nodes(inst_graph::in,
|
|
prog_var::in, prog_var::in, prog_var::out, prog_var::out) is multi.
|
|
|
|
:- pred two_graphs_corresponding_nodes(inst_graph::in, inst_graph::in,
|
|
prog_var::in, prog_var::in, prog_var::out, prog_var::out) is multi.
|
|
|
|
:- pred corresponding_nodes_from_lists(inst_graph::in, inst_graph::in,
|
|
list(prog_var)::in, list(prog_var)::in, prog_var::out, prog_var::out)
|
|
is nondet.
|
|
|
|
% Merge two inst_graphs by renaming the variables in the second
|
|
% inst_graph. Also return the variable substitution map.
|
|
%
|
|
:- pred merge(inst_graph::in, prog_varset::in, inst_graph::in, prog_varset::in,
|
|
inst_graph::out, prog_varset::out, map(prog_var, prog_var)::out)
|
|
is det.
|
|
|
|
% % Join two inst_graphs together by taking the maximum unrolling
|
|
% % of the type tree of each variable from the two graphs.
|
|
% %
|
|
% :- pred join(inst_graph::in, prog_varset::in, inst_graph::in,
|
|
% prog_varset::in, inst_graph::out, prog_varset::out) is det.
|
|
|
|
% Print the given inst_graph over the given varset in a format
|
|
% suitable for debugging output.
|
|
%
|
|
:- pred dump(inst_graph::in, prog_varset::in, io::di, io::uo) is det.
|
|
|
|
% XXX This should probably go in list.m.
|
|
%
|
|
:- pred corresponding_members(list(T)::in, list(U)::in, T::out, U::out)
|
|
is nondet.
|
|
|
|
% Values of this type are intended to contain all the info related
|
|
% to inst_graphs for a predicate that needs to be stored in the pred_info.
|
|
:- type inst_graph_info.
|
|
|
|
% Create an empty inst_graph_info.
|
|
%
|
|
:- func inst_graph_info_init = inst_graph_info.
|
|
|
|
:- func interface_inst_graph(inst_graph_info) = inst_graph.
|
|
:- func 'interface_inst_graph :='(inst_graph_info, inst_graph) =
|
|
inst_graph_info.
|
|
|
|
:- func interface_vars(inst_graph_info) = list(prog_var).
|
|
:- func 'interface_vars :='(inst_graph_info, list(prog_var)) = inst_graph_info.
|
|
|
|
:- func interface_varset(inst_graph_info) = prog_varset.
|
|
:- func 'interface_varset :='(inst_graph_info, prog_varset) = inst_graph_info.
|
|
|
|
:- func implementation_inst_graph(inst_graph_info) = inst_graph.
|
|
:- func 'implementation_inst_graph :='(inst_graph_info, inst_graph) =
|
|
inst_graph_info.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
:- import_module term_io.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
init(Vars, InstGraph) :-
|
|
map.init(InstGraph0),
|
|
list.foldl(init_var, Vars, InstGraph0, InstGraph).
|
|
|
|
:- pred init_var(prog_var::in, inst_graph::in, inst_graph::out) is det.
|
|
|
|
init_var(Var, InstGraph0, InstGraph) :-
|
|
map.det_insert(InstGraph0, Var, node(map.init, top_level), InstGraph).
|
|
|
|
set_parent(Parent, Child, InstGraph0, InstGraph) :-
|
|
map.lookup(InstGraph0, Child, node(Functors, MaybeParent0)),
|
|
(
|
|
MaybeParent0 = top_level,
|
|
map.det_update(InstGraph0, Child, node(Functors, parent(Parent)),
|
|
InstGraph)
|
|
;
|
|
MaybeParent0 = parent(_),
|
|
unexpected(this_file, "set_parent: node already has parent")
|
|
).
|
|
|
|
top_level_node(InstGraph, Var, TopLevel) :-
|
|
map.lookup(InstGraph, Var, node(_, MaybeParent)),
|
|
(
|
|
MaybeParent = parent(Parent),
|
|
top_level_node(InstGraph, Parent, TopLevel)
|
|
;
|
|
MaybeParent = top_level,
|
|
TopLevel = Var
|
|
).
|
|
|
|
descendant(InstGraph, Var, Descendant) :-
|
|
set.init(Seen),
|
|
descendant_2(InstGraph, Seen, Var, Descendant).
|
|
|
|
:- pred descendant_2(inst_graph::in, set(prog_var)::in, prog_var::in,
|
|
prog_var::out) is nondet.
|
|
|
|
descendant_2(InstGraph, Seen, Var, Descendant) :-
|
|
map.lookup(InstGraph, Var, node(Functors, _)),
|
|
map.member(Functors, _ConsId, Args),
|
|
list.member(Arg, Args),
|
|
(
|
|
Descendant = Arg
|
|
;
|
|
( Arg `set.member` Seen ->
|
|
fail
|
|
;
|
|
descendant_2(InstGraph, Seen `set.insert` Arg, Arg, Descendant)
|
|
)
|
|
).
|
|
|
|
reachable(_InstGraph, Var, Var).
|
|
reachable(InstGraph, Var, Reachable) :-
|
|
descendant(InstGraph, Var, Reachable).
|
|
|
|
reachable_from_list(InstGraph, Vars, Reachable) :-
|
|
list.member(Var, Vars),
|
|
reachable(InstGraph, Var, Reachable).
|
|
|
|
foldl_reachable(P, InstGraph, Var, !Acc) :-
|
|
% A possible alternate implementation:
|
|
% aggregate(reachable(InstGraph, Var), P, !Acc).
|
|
foldl_reachable_aux(P, InstGraph, Var, set.init, !Acc).
|
|
|
|
:- pred foldl_reachable_aux(pred(prog_var, T, T)::pred(in, in, out) is det,
|
|
inst_graph::in, prog_var::in, set(prog_var)::in, T::in, T::out) is det.
|
|
|
|
foldl_reachable_aux(P, InstGraph, Var, Seen, !Acc) :-
|
|
P(Var, !Acc),
|
|
map.lookup(InstGraph, Var, node(Functors, _)),
|
|
map.foldl((pred(_ConsId::in, Args::in, MAcc0::in, MAcc::out) is det :-
|
|
list.foldl((pred(Arg::in, LAcc0::in, LAcc::out) is det :-
|
|
( Arg `set.member` Seen ->
|
|
LAcc = LAcc0
|
|
;
|
|
foldl_reachable_aux(P, InstGraph, Arg, Seen `set.insert` Arg,
|
|
LAcc0, LAcc)
|
|
)
|
|
), Args, MAcc0, MAcc)
|
|
), Functors, !Acc).
|
|
|
|
foldl_reachable_from_list(P, InstGraph, Vars, !Acc) :-
|
|
list.foldl(foldl_reachable(P, InstGraph), Vars, !Acc).
|
|
|
|
foldl_reachable2(P, InstGraph, Var, !Acc1, !Acc2) :-
|
|
% A possible alternate implementation:
|
|
% aggregate2(reachable(InstGraph, Var), P, !Acc1, !Acc2).
|
|
foldl_reachable_aux2(P, InstGraph, Var, set.init, !Acc1, !Acc2).
|
|
|
|
:- pred foldl_reachable_aux2(
|
|
pred(prog_var, T, T, U, U)::pred(in, in, out, in, out) is det,
|
|
inst_graph::in, prog_var::in, set(prog_var)::in, T::in, T::out,
|
|
U::in, U::out) is det.
|
|
|
|
foldl_reachable_aux2(P, InstGraph, Var, Seen, !Acc1, !Acc2) :-
|
|
P(Var, !Acc1, !Acc2),
|
|
map.lookup(InstGraph, Var, node(Functors, _)),
|
|
map.foldl2((pred(_ConsId::in, Args::in, MAcc10::in, MAcc1::out,
|
|
MAcc20::in, MAcc2::out) is det :-
|
|
list.foldl2((pred(Arg::in, LAccA0::in, LAccA::out,
|
|
LAccB0::in, LAccB::out) is det :-
|
|
( Arg `set.member` Seen ->
|
|
LAccA = LAccA0,
|
|
LAccB = LAccB0
|
|
;
|
|
foldl_reachable_aux2(P, InstGraph, Arg, Seen `set.insert` Arg,
|
|
LAccA0, LAccA, LAccB0, LAccB)
|
|
)
|
|
), Args, MAcc10, MAcc1, MAcc20, MAcc2)
|
|
), Functors, !Acc1, !Acc2).
|
|
|
|
foldl_reachable_from_list2(P, InstGraph, Vars, !Acc1, !Acc2) :-
|
|
list.foldl2(foldl_reachable2(P, InstGraph), Vars,
|
|
!Acc1, !Acc2).
|
|
|
|
same_graph_corresponding_nodes(InstGraph, A, B, V, W) :-
|
|
two_graphs_corresponding_nodes(InstGraph, InstGraph, A, B, V, W).
|
|
|
|
two_graphs_corresponding_nodes(InstGraphA, InstGraphB, A, B, V, W) :-
|
|
corresponding_nodes_2(InstGraphA, InstGraphB,
|
|
set.init, set.init, A, B, V, W).
|
|
|
|
:- pred corresponding_nodes_2(inst_graph::in, inst_graph::in,
|
|
set(prog_var)::in, set(prog_var)::in, prog_var::in, prog_var::in,
|
|
prog_var::out, prog_var::out) is multi.
|
|
|
|
corresponding_nodes_2(_, _, _, _, A, B, A, B).
|
|
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA0, SeenB0, A, B, V, W) :-
|
|
not (
|
|
A `set.member` SeenA0,
|
|
B `set.member` SeenB0
|
|
),
|
|
|
|
map.lookup(InstGraphA, A, node(FunctorsA, _)),
|
|
map.lookup(InstGraphB, B, node(FunctorsB, _)),
|
|
|
|
SeenA = SeenA0 `set.insert` A,
|
|
SeenB = SeenB0 `set.insert` B,
|
|
|
|
( map.member(FunctorsA, ConsId, ArgsA) ->
|
|
( map.is_empty(FunctorsB) ->
|
|
list.member(V0, ArgsA),
|
|
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA, SeenB,
|
|
V0, B, V, W)
|
|
;
|
|
map.search(FunctorsB, ConsId, ArgsB),
|
|
corresponding_members(ArgsA, ArgsB, V0, W0),
|
|
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA, SeenB,
|
|
V0, W0, V, W)
|
|
)
|
|
;
|
|
map.member(FunctorsB, _ConsId, ArgsB),
|
|
list.member(W0, ArgsB),
|
|
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA, SeenB,
|
|
A, W0, V, W)
|
|
).
|
|
|
|
corresponding_nodes_from_lists(InstGraphA, InstGraphB, VarsA, VarsB, V, W) :-
|
|
corresponding_members(VarsA, VarsB, A, B),
|
|
two_graphs_corresponding_nodes(InstGraphA, InstGraphB, A, B, V, W).
|
|
|
|
corresponding_members([A | _], [B | _], A, B).
|
|
corresponding_members([_ | As], [_ | Bs], A, B) :-
|
|
corresponding_members(As, Bs, A, B).
|
|
|
|
merge(InstGraph0, VarSet0, NewInstGraph, NewVarSet, InstGraph, VarSet, Sub) :-
|
|
varset.merge_subst_without_names(VarSet0, NewVarSet, VarSet, Sub0),
|
|
(
|
|
map.map_values_only(pred(term.variable(V, _)::in, V::out) is semidet,
|
|
Sub0, Sub1)
|
|
->
|
|
Sub = Sub1
|
|
;
|
|
unexpected(this_file, "merge: non-variable terms in substitution")
|
|
),
|
|
map.foldl((pred(Var0::in, Node0::in, IG0::in, IG::out) is det :-
|
|
Node0 = node(Functors0, MaybeParent),
|
|
map.map_values_only(
|
|
(pred(Args0::in, Args::out) is det :-
|
|
map.apply_to_list(Args0, Sub, Args)),
|
|
Functors0, Functors),
|
|
Node = node(Functors, MaybeParent),
|
|
map.lookup(Sub, Var0, Var),
|
|
map.det_insert(IG0, Var, Node, IG)
|
|
), NewInstGraph, InstGraph0, InstGraph).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% join(InstGraphA, VarSetA, InstGraphB, VarSetB,
|
|
% InstGraph, VarSet) :-
|
|
% solutions((pred(V::out) is nondet :-
|
|
% map.member(InstGraphB, V, node(_, top_level))
|
|
% ), VarsB),
|
|
% list.foldl2(join_nodes(InstGraphB, VarSetB), VarsB, InstGraphA,
|
|
% InstGraph, VarSetA, VarSet).
|
|
%
|
|
% :- pred join_nodes(inst_graph, prog_varset, prog_var, inst_graph, inst_graph,
|
|
% prog_varset, prog_varset).
|
|
% :- mode join_nodes(in, in, in, in, out, in, out) is det.
|
|
%
|
|
% join_nodes(_, _, _, _, _, _, _) :- error("join_nodes: NYI").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
dump(InstGraph, VarSet, !IO) :-
|
|
map.foldl(dump_node(VarSet), InstGraph, !IO).
|
|
|
|
:- pred dump_node(prog_varset::in, prog_var::in, node::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_node(VarSet, Var, Node, !IO) :-
|
|
Node = node(Functors, MaybeParent),
|
|
io.write_string("%% ", !IO),
|
|
term_io.write_variable(Var, VarSet, !IO),
|
|
io.write_string(": ", !IO),
|
|
(
|
|
MaybeParent = parent(Parent),
|
|
term_io.write_variable(Parent, VarSet, !IO)
|
|
;
|
|
MaybeParent = top_level
|
|
),
|
|
io.nl(!IO),
|
|
map.foldl(dump_functor(VarSet), Functors, !IO).
|
|
|
|
:- pred dump_functor(prog_varset::in, cons_id::in, list(prog_var)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_functor(VarSet, ConsId, Args, !IO) :-
|
|
io.write_string("%%\t", !IO),
|
|
write_cons_id_and_arity(ConsId, !IO),
|
|
(
|
|
Args = [_ | _],
|
|
io.write_char('(', !IO),
|
|
io.write_list(Args, ", ", dump_var(VarSet), !IO),
|
|
io.write_char(')', !IO)
|
|
;
|
|
Args = []
|
|
),
|
|
io.nl(!IO).
|
|
|
|
:- pred dump_var(prog_varset::in, prog_var::in, io::di, io::uo) is det.
|
|
|
|
dump_var(VarSet, Var, !IO) :-
|
|
term_io.write_variable(Var, VarSet, !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type inst_graph_info
|
|
---> inst_graph_info(
|
|
interface_inst_graph :: inst_graph,
|
|
% Inst graph derived from the mode
|
|
% declarations, if there are any.
|
|
% If there are no mode declarations
|
|
% for the pred, this is the same as
|
|
% the implementation_inst_graph.
|
|
|
|
interface_vars :: list(prog_var),
|
|
% Vars that appear in the head of the
|
|
% mode declaration constraint.
|
|
|
|
interface_varset :: prog_varset,
|
|
% Varset used for interface_inst_graph.
|
|
|
|
implementation_inst_graph :: inst_graph
|
|
% Inst graph derived from the body of
|
|
% the predicate.
|
|
).
|
|
|
|
inst_graph_info_init = inst_graph_info(InstGraph, [], VarSet, InstGraph) :-
|
|
varset.init(VarSet),
|
|
map.init(InstGraph).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "inst_graph.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module inst_graph.
|
|
%-----------------------------------------------------------------------------%
|