mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-13 21:04:00 +00:00
Code Issues Projects Releases Wiki Activity
Files
9eea60f5bf6259a9d99a17bac56884652a14d8ba
mercury/compiler/inst_graph.m
Zoltan Somogyi 15aa457e12 Delete $module arg from calls to unexpected.
2018-04-07 18:25:43 +10:00

463 lines
16 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2007, 2009-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: 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.
:- 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 parse_tree.prog_out.
:- 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, !InstGraph) :-
map.det_insert(Var, node(map.init, top_level), !InstGraph).
set_parent(Parent, Child, !InstGraph) :-
map.lookup(!.InstGraph, Child, node(Functors, MaybeParent0)),
(
MaybeParent0 = top_level,
map.det_update(Child, node(Functors, parent(Parent)), !InstGraph)
;
MaybeParent0 = parent(_),
unexpected($pred, "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
;
( if Arg `set.member` Seen then
fail
else
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 :-
( if Arg `set.member` Seen then
LAcc = LAcc0
else
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 :-
( if Arg `set.member` Seen then
LAccA = LAccA0,
LAccB = LAccB0
else
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,
( if map.member(FunctorsA, ConsId, ArgsA) then
( if map.is_empty(FunctorsB) then
list.member(V0, ArgsA),
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA, SeenB,
V0, B, V, W)
else
map.search(FunctorsB, ConsId, ArgsB),
corresponding_members(ArgsA, ArgsB, V0, W0),
corresponding_nodes_2(InstGraphA, InstGraphB, SeenA, SeenB,
V0, W0, V, W)
)
else
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,
Renaming) :-
varset.merge_renaming_without_names(VarSet0, NewVarSet, VarSet, Renaming),
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, Renaming, Args)),
Functors0, Functors),
Node = node(Functors, MaybeParent),
map.lookup(Renaming, Var0, Var),
map.det_insert(Var, Node, IG0, 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),
io.write_string(cons_id_and_arity_to_string(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(
% 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_inst_graph :: inst_graph,
% Vars that appear in the head of the mode declaration
% constraint.
interface_vars :: list(prog_var),
% Varset used for interface_inst_graph.
interface_varset :: prog_varset,
% Inst graph derived from the body of the predicate.
implementation_inst_graph :: inst_graph
).
inst_graph_info_init = inst_graph_info(InstGraph, [], VarSet, InstGraph) :-
varset.init(VarSet),
map.init(InstGraph).
%-----------------------------------------------------------------------------%
:- end_module hlds.inst_graph.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink