[m-rev.] diff/for review: constraint based mode analysis (part 1)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Dec 16 13:52:43 AEDT 2004
This diff still has a bunch of XXXs in it. However, Richard needs it
accessible, and experience has shown that work on a side branch is hard
even for someone who has done 252, which Richard hasn't yet :-)
The objective is to have Richard's work replace the robdd based modules,
which should get rid of most of the XXXs.
Although the diff is big, it is almost all additions, and almost no
modifications. Constraint based mode analysis has very little interaction
with the rest of the compiler, at least as of now.
Zoltan.
Move changes in the compiler on the mode-constraints branch onto the trunk.
constraint based mode analysis.
compiler/top_level.m:
Add the new package mode_robdd.
compiler/check_hlds.m:
Add the new modules within the check_hlds.m package:
mode_constraints, mode_constraint_robdd and mode_ordering.
compiler/hlds.m:
Add the new modules within the hlds.m package, hhf and inst_graph.
compiler/hhf.m:
This new module implements the transformation from our usual
superhomogeneous form to the hyperhomogeneous form required by
constraint based mode analysis.
compiler/inst_graph.m:
This new module computes the instantiation graphs required by
constraint based mode analysis.
compiler/hlds_goal.m:
Add an extra slot into goal_infos for use by constraint based mode
analysis, and the predicates required to manipulate it.
compiler/hlds_pred.m:
Add two extra slots into pred_infos and one extra slot into proc_infos
for use by constraint based mode analysis, and the predicates
required to manipulate them.
compiler/mercury_compile.m:
Invoke the constraint based mode analysis pass if the options call for
it.
compiler/mode_constraints.m:
This new module implements the top level of the constraint based
mode analysis algorithm: it finds the constraints and adds them
to the constraint store, and invokes other modules to find solutions
and process them.
compiler/mode_ordering.m:
This new module processes solutions of constraint systems by
trying to find execution orders for conjunctions that are consistent
with the assignment of producers represented by a such a solution.
compiler/mode_constraint_robdd.m:
This new module provides a useful interface to operations on robdds
used for constraint based mode analysis. The actual implementation
uses one or two of the mode_robdd.X.m modules.
compiler/mode_robdd.check.m:
This new module invokes two of the modules below and compares their
results. If one of the modules is known to be good, this is useful
for debugging the other.
compiler/mode_robdd.r.m:
compiler/mode_robdd.tfeir.m:
compiler/mode_robdd.tfeirn.m:
compiler/mode_robdd.tfer.m:
compiler/mode_robdd.tfern.m:
compiler/mode_robdd.tfr.m:
These new modules each implement robdd based constraint solvers.
They differ in the amount of information they keep in the robdd
versus how much information they keep in Mercury data structures.
The naming scheme assigns a letter to each kind of information
we are concerned about, and includes that letter in the name the
Mercury data structure has a separate field for that kind of
information. The mapping is:
r: robdd (present in all variants)
tf: variables known to be true or false
e: variable equivalences
i: variable implications.
n: normalization
Normally only one of these would be linked in, or two if
mode_robdd.check.m is being used to compare two of these modules.
compiler/mode_robdd.equiv_vars.m:
This module implements utility operations involving sets of equivalent
variables.
compiler/mode_robdd.implications.m:
This module implements utility operations involving implications
among variables.
compiler/goal_path.m:
Add a variant of an existing predicate needed by constraint based mode
analysis.
compiler/hlds_out.m:
Print out the components added to the HLDS by this change if the
appropriate signal character is present in the revelant option.
compiler/handle_options.m:
Add the signal for printing mode constraints to the names of the usual
dumping aliases. They have no effect unless constraint based mode
analysis is enabled.
compiler/options.m:
Add the options controlling the experimental mode constraints pass.
doc/user_guide.texi:
Document the options controlling the experimental mode constraints
pass for implementors.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.5
diff -u -b -r1.5 check_hlds.m
--- compiler/check_hlds.m 14 Jun 2004 04:15:57 -0000 1.5
+++ compiler/check_hlds.m 28 Jun 2004 02:28:57 -0000
@@ -37,9 +37,12 @@
:- include_module delay_info.
:- include_module inst_match.
:- include_module inst_util.
+ :- include_module mode_constraint_robdd.
+ :- include_module mode_constraints.
:- include_module mode_debug.
:- include_module mode_errors.
:- include_module mode_info.
+ :- include_module mode_ordering.
:- include_module mode_util.
:- include_module modecheck_call.
:- include_module modecheck_unify.
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.20
diff -u -b -r1.20 goal_path.m
--- compiler/goal_path.m 7 Jun 2004 09:06:39 -0000 1.20
+++ compiler/goal_path.m 28 Jun 2004 02:28:58 -0000
@@ -13,12 +13,30 @@
:- interface.
+:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
+:- import_module bool.
+
:- pred goal_path__fill_slots(module_info::in, proc_info::in, proc_info::out)
is det.
+ % Fill in the goal_paths for goals in the clauses_info of the predicate.
+ % Clauses are given goal paths `disj(1)', ..., `disj(N)'. If the bool
+ % argument is true then the goal paths are stored in a form where any
+ % prefix consisting of `disj(_)', `neg', `exist(_)' and `ite_else'
+ % components is removed. This is used to optimise the constraint-based
+ % mode analysis where the instantiatedness of a variable at such a goal
+ % path is always equivalent to its instantiatedness at the parent goal
+ % path.
+
+:- pred goal_path__fill_slots_in_clauses(module_info::in, bool::in,
+ pred_info::in, pred_info::out) is det.
+
+:- pred goal_path__fill_slots_in_goal(hlds_goal::in, vartypes::in,
+ module_info::in, hlds_goal::out) is det.
+
:- implementation.
:- import_module check_hlds__type_util.
@@ -30,25 +48,63 @@
:- type slot_info
---> slot_info(
- vartypes,
- module_info
+ vartypes :: vartypes,
+ module_info :: module_info,
+ omit_mode_equiv_prefix :: bool
).
goal_path__fill_slots(ModuleInfo, !Proc) :-
- % The ModuleInfo argument is there just for passes_aux
proc_info_goal(!.Proc, Goal0),
proc_info_vartypes(!.Proc, VarTypes),
- SlotInfo = slot_info(VarTypes, ModuleInfo),
- fill_goal_slots(Goal0, [], SlotInfo, Goal),
+ goal_path__fill_slots_in_goal(Goal0, VarTypes, ModuleInfo, Goal),
proc_info_set_goal(Goal, !Proc).
+goal_path__fill_slots_in_clauses(ModuleInfo, OmitModeEquivPrefix, !PredInfo) :-
+ pred_info_clauses_info(!.PredInfo, ClausesInfo0),
+ clauses_info_clauses(ClausesInfo0, Clauses0),
+ clauses_info_vartypes(ClausesInfo0, VarTypes),
+ SlotInfo = slot_info(VarTypes, ModuleInfo, OmitModeEquivPrefix),
+ list__map_foldl(fill_slots_in_clause(SlotInfo), Clauses0, Clauses,
+ 1, _),
+ clauses_info_set_clauses(Clauses, ClausesInfo0, ClausesInfo),
+ pred_info_set_clauses_info(ClausesInfo, !PredInfo).
+
+:- pred fill_slots_in_clause(slot_info::in, clause::in, clause::out,
+ int::in, int::out) is det.
+
+fill_slots_in_clause(SlotInfo, Clause0, Clause, ClauseNum, ClauseNum + 1) :-
+ Clause0 = clause(ProcIds, Goal0, Lang, Context),
+ fill_goal_slots(Goal0, [disj(ClauseNum)], SlotInfo, Goal),
+ Clause = clause(ProcIds, Goal, Lang, Context).
+
+goal_path__fill_slots_in_goal(Goal0, VarTypes, ModuleInfo, Goal) :-
+ SlotInfo = slot_info(VarTypes, ModuleInfo, no),
+ fill_goal_slots(Goal0, [], SlotInfo, Goal).
+
:- pred fill_goal_slots(hlds_goal::in, goal_path::in, slot_info::in,
hlds_goal::out) is det.
fill_goal_slots(Expr0 - Info0, Path0, SlotInfo, Expr - Info) :-
- goal_info_set_goal_path(Info0, Path0, Info),
+ OmitModeEquivPrefix = SlotInfo ^ omit_mode_equiv_prefix,
+ (
+ OmitModeEquivPrefix = yes,
+ list__takewhile(mode_equiv_step, Path0, _, Path)
+ ;
+ OmitModeEquivPrefix = no,
+ Path = Path0
+ ),
+ goal_info_set_goal_path(Info0, Path, Info),
fill_expr_slots(Expr0, Info, Path0, SlotInfo, Expr).
+:- pred mode_equiv_step(goal_path_step::in) is semidet.
+
+mode_equiv_step(Step) :-
+ ( Step = disj(_)
+ ; Step = neg
+ ; Step = exist(_)
+ ; Step = ite_else
+ ).
+
:- pred fill_expr_slots(hlds_goal_expr::in, hlds_goal_info::in, goal_path::in,
slot_info::in, hlds_goal_expr::out) is det.
@@ -61,7 +117,8 @@
fill_disj_slots(Goals0, Path0, 0, SlotInfo, Goals).
fill_expr_slots(switch(Var, B, Cases0), _, Path0, SlotInfo,
switch(Var, B, Cases)) :-
- SlotInfo = slot_info(VarTypes, ModuleInfo),
+ VarTypes = SlotInfo ^ vartypes,
+ ModuleInfo = SlotInfo ^ module_info,
map__lookup(VarTypes, Var, Type),
(
type_util__switch_type_num_functors(ModuleInfo, Type,
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.211
diff -u -b -r1.211 handle_options.m
--- compiler/handle_options.m 8 Dec 2004 08:05:18 -0000 1.211
+++ compiler/handle_options.m 9 Dec 2004 01:09:34 -0000
@@ -1979,9 +1979,9 @@
:- pred convert_dump_alias(string::in, string::out) is semidet.
-convert_dump_alias("ALL", "abcdfgilmnprstuvCDIMPTU").
-convert_dump_alias("all", "abcdfgilmnprstuvCMPT").
-convert_dump_alias("allD", "abcdfgilmnprstuvCDMPT").
+convert_dump_alias("ALL", "abcdfgilmnprstuvBCDIMPTU").
+convert_dump_alias("all", "abcdfgilmnprstuvBCMPT").
+convert_dump_alias("allD", "abcdfgilmnprstuvBCDMPT").
convert_dump_alias("most", "bcdfgilmnprstuvP").
convert_dump_alias("trans", "bcdglmnstuv").
convert_dump_alias("codegen", "dfnprsu").
Index: compiler/hhf.m
===================================================================
RCS file: compiler/hhf.m
diff -N compiler/hhf.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/hhf.m 16 Dec 2004 00:58:02 -0000
@@ -0,0 +1,470 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2002 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.
+%-----------------------------------------------------------------------------%
+%
+% Convert superhomogeneous form to hyperhomogeneous form and output an
+% inst graph for the predicate based on this transformation.
+%
+% Hyperhomogeneous form and the transformation are documented in
+% David Overton's PhD thesis.
+
+:- module hlds__hhf.
+
+:- interface.
+
+:- import_module hlds__hlds_pred.
+:- import_module hlds__hlds_module.
+:- import_module hlds__inst_graph.
+
+:- import_module io, bool.
+
+:- pred hhf__process_pred(bool::in, pred_id::in, module_info::in,
+ module_info::out, io__state::di, io__state::uo) is det.
+
+:- pred hhf__process_clauses_info(bool::in, module_info::in, clauses_info::in,
+ clauses_info::out, inst_graph::out) is det.
+
+:- implementation.
+
+:- import_module parse_tree__prog_data.
+:- import_module check_hlds__type_util.
+:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__passes_aux.
+:- import_module hlds__quantification.
+:- import_module parse_tree__prog_util.
+
+:- import_module term, varset, map, list, set, std_util, require.
+
+hhf__process_pred(Simple, PredId, !ModuleInfo, !IO) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+ ( pred_info_is_imported(PredInfo0) ->
+ % AAA
+ % PredInfo2 = PredInfo0
+ pred_info_clauses_info(PredInfo0, ClausesInfo),
+ clauses_info_headvars(ClausesInfo, HeadVars),
+ clauses_info_varset(ClausesInfo, VarSet),
+ IGI0 = PredInfo0 ^ inst_graph_info,
+ inst_graph__init(HeadVars, InstGraph),
+ IGI1 = IGI0 ^ implementation_inst_graph := InstGraph,
+ IGI2 = IGI1 ^ interface_inst_graph := InstGraph,
+ IGI3 = IGI2 ^ interface_vars := HeadVars,
+ IGI4 = IGI3 ^ interface_varset := VarSet,
+ PredInfo2 = PredInfo0 ^ inst_graph_info := IGI4
+ ;
+ write_pred_progress_message(
+ "% Calculating HHF and inst graph for ",
+ PredId, !.ModuleInfo, !IO),
+
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ hhf__process_clauses_info(Simple, !.ModuleInfo, ClausesInfo0,
+ ClausesInfo, ImplementationInstGraph),
+ pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
+ IGI0 = PredInfo1 ^ inst_graph_info,
+ IGI1 = IGI0 ^ implementation_inst_graph :=
+ ImplementationInstGraph,
+
+ % AAA only for non-imported preds with no mode decls.
+ clauses_info_headvars(ClausesInfo, HeadVars),
+ clauses_info_varset(ClausesInfo, VarSet),
+ IGI2 = IGI1 ^ interface_inst_graph := ImplementationInstGraph,
+ solutions((pred(V::out) is nondet :-
+ list__member(V0, HeadVars),
+ inst_graph__reachable(ImplementationInstGraph,
+ V0, V)
+ ), InterfaceVars),
+ IGI3 = IGI2 ^ interface_vars := InterfaceVars,
+ IGI = IGI3 ^ interface_varset := VarSet,
+
+ PredInfo2 = PredInfo1 ^ inst_graph_info := IGI
+ ),
+
+% pred_info_get_markers(PredInfo2, Markers),
+% ( check_marker(Markers, infer_modes) ->
+% % No mode declarations. If not imported, use implementation
+% % inst_graph.
+% % ...
+% ;
+% pred_info_clauses_info(PredInfo2, ClausesInfo2),
+% clauses_info_headvars(ClausesInfo2, HeadVars),
+% clauses_info_varset(ClausesInfo2, VarSet),
+% inst_graph__init(HeadVars, InterfaceInstGraph),
+% InstGraphInfo0 = ( (PredInfo2 ^ inst_graph_info)
+% ^ interface_inst_graph := InterfaceInstGraph )
+% ^ interface_varset := VarSet,
+% map__foldl(hhf__process_proc(ModuleInfo0, HeadVars),
+% Procedures, InstGraphInfo0, InstGraphInfo1),
+%
+% % Calculate interface vars.
+% solutions((pred(V::out) is nondet :-
+% list__member(V0, HeadVars),
+% inst_graph__reachable(InstGraph, V0, V)
+% ), InterfaceVars),
+% InstGraphInfo = InstGraphInfo1 ^ interface_vars :=
+% InterfaceVars,
+%
+% PredInfo = PredInfo2 ^ inst_graph_info := InstGraphInfo
+% ),
+
+ PredInfo = PredInfo2, % AAA
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
+
+hhf__process_clauses_info(Simple, ModuleInfo, !ClausesInfo, InstGraph) :-
+ clauses_info_varset(!.ClausesInfo, VarSet0),
+ clauses_info_vartypes(!.ClausesInfo, VarTypes0),
+ inst_graph__init(VarTypes0 ^ keys, InstGraph0),
+ Info0 = hhf_info(InstGraph0, VarSet0, VarTypes0),
+
+ clauses_info_headvars(!.ClausesInfo, HeadVars),
+ clauses_info_clauses(!.ClausesInfo, Clauses0),
+
+ (
+ % % For simple mode checking we do not give the inst_graph any
+ % % structure.
+ % Simple = yes,
+ % Clauses = Clauses0,
+ % Info1 = Info0
+ %;
+ % Simple = no,
+ list__map_foldl(hhf__process_clause(HeadVars),
+ Clauses0, Clauses, Info0, Info1)
+ ),
+
+ clauses_info_set_clauses(Clauses, !ClausesInfo),
+
+ complete_inst_graph(ModuleInfo, Info1, Info),
+ % XXX Comment out the above line for incomplete, quick checking.
+ % Info = Info1,
+
+ Info = hhf_info(InstGraph1, VarSet, VarTypes),
+ ( Simple = yes, inst_graph__init(VarTypes ^ keys, InstGraph)
+ ; Simple = no, InstGraph = InstGraph1
+ ),
+
+ % XXX do we need this (it slows things down a lot (i.e. uses 50%
+ % of the runtime).
+ % varset__vars(VarSet1, Vars1),
+ % varset__ensure_unique_names(Vars1, "_", VarSet1, VarSet),
+
+ clauses_info_set_varset(VarSet, !ClausesInfo),
+ clauses_info_set_vartypes(VarTypes, !ClausesInfo).
+
+:- type hhf_info
+ ---> hhf_info(
+ inst_graph :: inst_graph,
+ varset :: prog_varset,
+ vartypes :: vartypes
+ ).
+
+:- pred hhf__process_clause(list(prog_var)::in, clause::in, clause::out,
+ hhf_info::in, hhf_info::out) is det.
+
+hhf__process_clause(_HeadVars, clause(ProcIds, Goal0, Lang, Context),
+ clause(ProcIds, Goal, Lang, Context), !HI) :-
+ Goal0 = _ - GoalInfo0,
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+
+ hhf__goal(NonLocals, Goal0, Goal, !HI).
+% XXX We probably need to requantify, but it stuffs up the inst_graph to do
+% that.
+% VarSet1 = !.HI ^ varset,
+% VarTypes1 = !.HI ^ vartypes,
+% implicitly_quantify_clause_body(HeadVars, Goal1, VarSet1, VarTypes1,
+% Goal, VarSet, VarTypes, _Warnings),
+% !:HI = !.HI varset := VarSet,
+% !:HI = !.HI vartypes := VarTypes.
+
+:- pred hhf__goal(set(prog_var)::in, hlds_goal::in, hlds_goal::out,
+ hhf_info::in, hhf_info::out) is det.
+
+hhf__goal(NonLocals, GoalExpr0 - GoalInfo, GoalExpr - GoalInfo, !HI) :-
+ hhf__goal_expr(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI).
+
+:- pred hhf__goal_use_own_nonlocals(hlds_goal::in, hlds_goal::out,
+ hhf_info::in, hhf_info::out) is det.
+
+hhf__goal_use_own_nonlocals(GoalExpr0 - GoalInfo, GoalExpr - GoalInfo, !HI) :-
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
+ hhf__goal_expr(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI).
+
+:- pred hhf__goal_expr(set(prog_var)::in, hlds_goal_info::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, hhf_info::in, hhf_info::out)
+ is det.
+
+hhf__goal_expr(NonLocals, _, conj(Goals0), conj(Goals), !HI) :-
+ list__map_foldl(hhf__goal(NonLocals), Goals0, Goals1, !HI),
+ flatten_conj(Goals1, Goals).
+hhf__goal_expr(_, _, call(A, B, C, D, E, F), call(A, B, C, D, E, F), !HI).
+hhf__goal_expr(_, _, generic_call(A, B, C, D), generic_call(A, B, C, D), !HI).
+hhf__goal_expr(_, _, switch(_, _, _), _, !HI) :-
+ error("hhf_goal_expr: found switch").
+hhf__goal_expr(_, _, foreign_proc(A,B,C,D,E,F), foreign_proc(A,B,C,D,E,F),
+ !HI).
+hhf__goal_expr(_, _, shorthand(_), _, !HI) :-
+ error("hhf_goal_expr: found shorthand").
+hhf__goal_expr(NonLocals, _, some(A, B, Goal0), some(A, B, Goal), !HI) :-
+ hhf__goal(NonLocals, Goal0, Goal, !HI).
+hhf__goal_expr(_, _, disj(Goals0), disj(Goals), !HI) :-
+ list__map_foldl(hhf__goal_use_own_nonlocals, Goals0, Goals, !HI).
+hhf__goal_expr(NonLocals, _, not(Goal0), not(Goal), !HI) :-
+ hhf__goal(NonLocals, Goal0, Goal, !HI).
+hhf__goal_expr(NonLocals, _, if_then_else(Vs, Cond0, Then0, Else0),
+ if_then_else(Vs, Cond, Then, Else), !HI) :-
+ hhf__goal(NonLocals, Cond0, Cond, !HI),
+ Then0 = ThenExpr0 - ThenInfo,
+ goal_info_get_nonlocals(ThenInfo, ThenNonLocals),
+ hhf__goal_expr(ThenNonLocals, ThenInfo, ThenExpr0, ThenExpr, !HI),
+ Then = ThenExpr - ThenInfo,
+ Else0 = ElseExpr0 - ElseInfo,
+ goal_info_get_nonlocals(ElseInfo, ElseNonLocals),
+ hhf__goal_expr(ElseNonLocals, ElseInfo, ElseExpr0, ElseExpr, !HI),
+ Else = ElseExpr - ElseInfo.
+hhf__goal_expr(NonLocals, _, par_conj(Goals0), par_conj(Goals), !HI) :-
+ list__map_foldl(hhf__goal(NonLocals), Goals0, Goals, !HI).
+hhf__goal_expr(NonLocals, GoalInfo, unify(Var, RHS, Mode, Unif, Context),
+ GoalExpr, !HI) :-
+ hhf__unify(RHS, NonLocals, GoalInfo, Var, Mode, Unif, Context,
+ GoalExpr, !HI).
+
+:- pred hhf__unify(unify_rhs::in, set(prog_var)::in, hlds_goal_info::in,
+ prog_var::in, unify_mode::in, unification::in, unify_context::in,
+ hlds_goal_expr::out, hhf_info::in, hhf_info::out) is det.
+
+hhf__unify(var(Y), _, _, X, Mode, Unif, Context, GoalExpr, !HI) :-
+ GoalExpr = unify(X, var(Y), Mode, Unif, Context).
+hhf__unify(lambda_goal(A,B,C,D,E,F,G,H,LambdaGoal0), NonLocals, _, X, Mode,
+ Unif, Context, GoalExpr, !HI) :-
+ hhf__goal(NonLocals, LambdaGoal0, LambdaGoal, !HI),
+ GoalExpr = unify(X, lambda_goal(A,B,C,D,E,F,G,H,LambdaGoal), Mode,
+ Unif, Context).
+hhf__unify(functor(ConsId0, IsExistConstruct, ArgsA), NonLocals, GoalInfo0,
+ X, Mode, Unif, Context, GoalExpr, !HI) :-
+ TypeOfX = !.HI ^ vartypes ^ det_elem(X),
+ qualify_cons_id(TypeOfX, ArgsA, ConsId0, _, ConsId),
+ InstGraph0 = !.HI ^ inst_graph,
+ map__lookup(InstGraph0, X, node(Functors0, MaybeParent)),
+ ( map__search(Functors0, ConsId, ArgsB) ->
+ hhf__make_unifications(ArgsA, ArgsB, GoalInfo0, Mode, Unif,
+ Context, Unifications),
+ Args = ArgsB
+ ;
+ hhf__add_unifications(ArgsA, NonLocals, GoalInfo0, Mode, Unif,
+ Context, Args, Unifications, !HI),
+ InstGraph1 = !.HI ^ inst_graph,
+ map__det_insert(Functors0, ConsId, Args, Functors),
+ map__det_update(InstGraph1, X, node(Functors, MaybeParent),
+ InstGraph2),
+ list__foldl(inst_graph__set_parent(X), Args, InstGraph2,
+ InstGraph),
+ !:HI = !.HI ^ inst_graph := InstGraph
+ ),
+ goal_info_get_nonlocals(GoalInfo0, GINonlocals0),
+ GINonlocals = GINonlocals0 `set__union` list_to_set(Args),
+ goal_info_set_nonlocals(GoalInfo0, GINonlocals, GoalInfo),
+ UnifyGoal = unify(X, functor(ConsId, IsExistConstruct, Args),
+ Mode, Unif, Context) - GoalInfo,
+ GoalExpr = conj([UnifyGoal | Unifications]).
+
+:- pred hhf__make_unifications(list(prog_var)::in, list(prog_var)::in,
+ hlds_goal_info::in, unify_mode::in, unification::in, unify_context::in,
+ hlds_goals::out) is det.
+
+hhf__make_unifications([], [], _, _, _, _, []).
+hhf__make_unifications([_|_], [], _, _, _, _, _) :-
+ error("hhf_make_unifications: length mismatch").
+hhf__make_unifications([], [_|_], _, _, _, _, _) :-
+ error("hhf_make_unifications: length mismatch").
+hhf__make_unifications([A | As], [B | Bs], GI0, M, U, C,
+ [unify(A, var(B), M, U, C) - GI | Us]) :-
+ goal_info_get_nonlocals(GI0, GINonlocals0),
+ GINonlocals = GINonlocals0 `set__insert` A `set__insert` B,
+ goal_info_set_nonlocals(GI0, GINonlocals, GI),
+ hhf__make_unifications(As, Bs, GI0, M, U, C, Us).
+
+:- pred hhf__add_unifications(list(prog_var)::in, set(prog_var)::in,
+ hlds_goal_info::in, unify_mode::in, unification::in, unify_context::in,
+ list(prog_var)::out, hlds_goals::out, hhf_info::in, hhf_info::out)
+ is det.
+
+hhf__add_unifications([], _, _, _, _, _, [], [], !HI).
+hhf__add_unifications([A | As], NonLocals, GI0, M, U, C, [V | Vs], Goals,
+ !HI) :-
+ hhf__add_unifications(As, NonLocals, GI0, M, U, C, Vs, Goals0, !HI),
+ InstGraph0 = !.HI ^ inst_graph,
+ (
+ (
+ map__lookup(InstGraph0, A, Node),
+ Node = node(_, parent(_))
+ ;
+ A `member` NonLocals
+ )
+ ->
+ VarSet0 = !.HI ^ varset,
+ VarTypes0 = !.HI ^ vartypes,
+ varset__new_var(VarSet0, V, VarSet),
+ map__lookup(VarTypes0, A, Type),
+ map__det_insert(VarTypes0, V, Type, VarTypes),
+ map__init(Empty),
+ map__det_insert(InstGraph0, V, node(Empty, top_level),
+ InstGraph),
+ !:HI = !.HI ^ varset := VarSet,
+ !:HI = !.HI ^ vartypes := VarTypes,
+ !:HI = !.HI ^ inst_graph := InstGraph,
+ goal_info_get_nonlocals(GI0, GINonlocals0),
+ GINonlocals = GINonlocals0 `set__insert` V,
+ goal_info_set_nonlocals(GI0, GINonlocals, GI),
+ Goals = [unify(A, var(V), M, U, C) - GI | Goals0]
+ ;
+ V = A,
+ Goals = Goals0
+ ).
+
+:- pred flatten_conj(hlds_goals::in, hlds_goals::out) is det.
+
+flatten_conj([], []).
+flatten_conj([Goal | Goals0], Goals) :-
+ flatten_conj(Goals0, Goals1),
+ ( Goal = conj(SubGoals) - _ ->
+ list__append(SubGoals, Goals1, Goals)
+ ;
+ Goals = [Goal | Goals1]
+ ).
+
+:- pred complete_inst_graph(module_info::in, hhf_info::in, hhf_info::out)
+ is det.
+
+complete_inst_graph(ModuleInfo, !HI) :-
+ InstGraph0 = !.HI ^ inst_graph,
+ map__keys(InstGraph0, Vars),
+ list__foldl(complete_inst_graph_node(ModuleInfo, Vars), Vars, !HI).
+
+:- pred complete_inst_graph_node(module_info::in, list(prog_var)::in,
+ prog_var::in, hhf_info::in, hhf_info::out) is det.
+
+complete_inst_graph_node(ModuleInfo, BaseVars, Var, !HI) :-
+ VarTypes0 = !.HI ^ vartypes,
+ (
+ map__search(VarTypes0, Var, Type),
+ type_constructors(Type, ModuleInfo, Constructors),
+ type_to_ctor_and_args(Type, TypeId, _)
+ ->
+ list__foldl(
+ maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeId),
+ Constructors, !HI)
+ ;
+ true
+ ).
+
+:- pred maybe_add_cons_id(prog_var::in, module_info::in, list(prog_var)::in,
+ type_ctor::in, constructor::in, hhf_info::in, hhf_info::out) is det.
+
+maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeId, Ctor, !HI) :-
+ Ctor = ctor(_, _, Name, Args),
+ ConsId = make_cons_id(Name, Args, TypeId),
+ map__lookup(!.HI ^ inst_graph, Var, node(Functors0, MaybeParent)),
+ ( map__contains(Functors0, ConsId) ->
+ true
+ ;
+ list__map_foldl(add_cons_id(Var, ModuleInfo, BaseVars),
+ Args, NewVars, !HI),
+ map__det_insert(Functors0, ConsId, NewVars, Functors),
+ !:HI = !.HI ^ inst_graph :=
+ map__det_update(!.HI ^ inst_graph, Var,
+ node(Functors, MaybeParent))
+ ).
+
+:- pred add_cons_id(prog_var::in, module_info::in, list(prog_var)::in,
+ constructor_arg::in, prog_var::out, hhf_info::in, hhf_info::out)
+ is det.
+
+add_cons_id(Var, ModuleInfo, BaseVars, Arg, NewVar, !HI) :-
+ Arg = _ - ArgType,
+ !.HI = hhf_info(InstGraph0, VarSet0, VarTypes0),
+ (
+ find_var_with_type(Var, ArgType, InstGraph0, VarTypes0,
+ BaseVars, NewVar0)
+ ->
+ NewVar = NewVar0
+ ;
+ varset__new_var(VarSet0, NewVar, VarSet),
+ map__det_insert(VarTypes0, NewVar, ArgType, VarTypes),
+ map__init(Empty),
+ map__det_insert(InstGraph0, NewVar, node(Empty, parent(Var)),
+ InstGraph),
+ !:HI = hhf_info(InstGraph, VarSet, VarTypes),
+ complete_inst_graph_node(ModuleInfo, BaseVars, NewVar, !HI)
+ ).
+
+:- pred find_var_with_type(prog_var::in, (type)::in, inst_graph::in,
+ vartypes::in, list(prog_var)::in, prog_var::out) is semidet.
+
+find_var_with_type(Var0, Type, InstGraph, VarTypes, BaseVars, Var) :-
+ (
+ map__search(VarTypes, Var0, Type0),
+ same_type(Type0, Type)
+ ->
+ Var = Var0
+ ;
+ map__lookup(InstGraph, Var0, node(_, parent(Var1))),
+ \+ Var1 `list__member` BaseVars,
+ find_var_with_type(Var1, Type, InstGraph, VarTypes, BaseVars,
+ Var)
+ ).
+
+:- pred same_type((type)::in, (type)::in) is semidet.
+
+same_type(term__variable(_), term__variable(_)).
+same_type(term__functor(Const, ArgsA, _), term__functor(Const, ArgsB, _)) :-
+ list__same_length(ArgsA, ArgsB),
+ all [A, B] (
+ corresponding_members(ArgsA, ArgsB, A, B)
+ =>
+ same_type(A, B)
+ ).
+
+%------------------------------------------------------------------------%
+
+% % Add the information from the procedure's mode declaration
+% % to the inst_graph.
+% :- pred hhf__process_proc(module_info::in, list(prog_var)::in, proc_id::in,
+% proc_info::in, inst_graph::out, prog_varset::out) is det.
+%
+% hhf__process_proc(ModuleInfo, HeadVars, _ProcId, ProcInfo, Info0, Info) :-
+% proc_info_argmodes(ProcInfo, ArgModes),
+%
+% mode_list_get_initial_insts(ArgModes, ModuleInfo, InstsI),
+% assoc_list__from_corresponding_lists(HeadVars, InstsI, VarInstsI),
+% list__foldl(hhf__process_arg(ModuleInfo), VarInstsI, Info0, Info),
+%
+% mode_list_get_final_insts(ArgModes, ModuleInfo, InstsF),
+% assoc_list__from_corresponding_lists(HeadVars, InstsF, VarInstsF),
+% list__foldl(hhf__process_arg(ModuleInfo), VarInstsF, Info0, Info).
+%
+% :- pred hhf__process_arg(module_info::in, pair(prog_var, inst)::in,
+% inst_graph_info::in, inst_graph_info::out) is det.
+%
+% hhf__process_arg(ModuleInfo, Var - Inst, Info0, Info) :-
+% map__init(Seen0),
+% hhf__process_arg_inst(ModuleInfo, Var, Seen0, Inst, Info0, Info).
+%
+% :- pred hhf__process_arg_inst(module_info::in, prog_var::in,
+% map(inst_name, prog_var)::in, inst::in, inst_graph_info::in,
+% inst_graph_info::out) is det.
+%
+% hhf__process_arg_inst(ModuleInfo, Var, Seen0, Inst0, Info0, Info) :-
+% ( Inst0 = defined_inst(InstName) ->
+% map__det_insert(Seen0, InstName, Var, Seen),
+% inst_lookup(ModuleInfo, InstName, Inst),
+% hhf__process_arg_inst(Inst, ModuleInfo, Var, Seen, Info0, Info)
+% ; Inst0 = bound(_, BoundInsts) ->
+% list__foldl(hhf__process_bound_inst(ModuleInfo, Var, Seen0),
+% BoundInts, Info0, Info)
+% ;
+% Info = Info0
+% ).
+%
+% :- pred hhf__process_bound_inst(module_info::in, prog_var::in,
+% map(inst_name, prog_var)::in, bound_inst::in,
+% inst_graph_info::in, inst_graph_info::out) is det.
Index: compiler/hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds.m,v
retrieving revision 1.214
diff -u -b -r1.214 hlds.m
--- compiler/hlds.m 14 Jun 2004 04:16:05 -0000 1.214
+++ compiler/hlds.m 28 Jun 2004 02:28:59 -0000
@@ -21,6 +21,7 @@
:- include_module hlds_llds.
:- include_module hlds_module.
:- include_module hlds_pred.
+:- include_module inst_graph.
:- include_module instmap.
:- include_module special_pred.
@@ -28,6 +29,7 @@
:- include_module make_hlds.
:- include_module make_tags.
:- include_module quantification.
+:- include_module hhf.
% Modules for pretty-printing it.
:- include_module hlds_out.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.119
diff -u -b -r1.119 hlds_goal.m
--- compiler/hlds_goal.m 19 Oct 2004 22:13:48 -0000 1.119
+++ compiler/hlds_goal.m 6 Dec 2004 05:02:42 -0000
@@ -311,7 +311,6 @@
% polymorphism.m strips off
% the `new ' prefix from
% existentially typed constructions.
-
rhs_args :: list(prog_var)
)
; lambda_goal(
@@ -703,6 +702,40 @@
:- pred goal_info_set_code_gen_info(hlds_goal_info::in,
hlds_goal_code_gen_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_get_occurring_vars(hlds_goal_info::in, set(prog_var)::out)
+ is det.
+:- pred goal_info_get_producing_vars(hlds_goal_info::in, set(prog_var)::out)
+ is det.
+:- pred goal_info_get_consuming_vars(hlds_goal_info::in, set(prog_var)::out)
+ is det.
+:- pred goal_info_get_make_visible_vars(hlds_goal_info::in, set(prog_var)::out)
+ is det.
+:- pred goal_info_get_need_visible_vars(hlds_goal_info::in, set(prog_var)::out)
+ is det.
+
+:- pred goal_info_set_occurring_vars(hlds_goal_info::in, set(prog_var)::in,
+ hlds_goal_info::out) is det.
+:- pred goal_info_set_producing_vars(hlds_goal_info::in, set(prog_var)::in,
+ hlds_goal_info::out) is det.
+:- pred goal_info_set_consuming_vars(hlds_goal_info::in, set(prog_var)::in,
+ hlds_goal_info::out) is det.
+:- pred goal_info_set_make_visible_vars(hlds_goal_info::in, set(prog_var)::in,
+ hlds_goal_info::out) is det.
+:- pred goal_info_set_need_visible_vars(hlds_goal_info::in, set(prog_var)::in,
+ hlds_goal_info::out) is det.
+
+:- func producing_vars(hlds_goal_info) = set(prog_var).
+:- func 'producing_vars :='(hlds_goal_info, set(prog_var)) = hlds_goal_info.
+
+:- func consuming_vars(hlds_goal_info) = set(prog_var).
+:- func 'consuming_vars :='(hlds_goal_info, set(prog_var)) = hlds_goal_info.
+
+:- func make_visible_vars(hlds_goal_info) = set(prog_var).
+:- func 'make_visible_vars :='(hlds_goal_info, set(prog_var)) = hlds_goal_info.
+
+:- func need_visible_vars(hlds_goal_info) = set(prog_var).
+:- func 'need_visible_vars :='(hlds_goal_info, set(prog_var)) = hlds_goal_info.
+
:- pred goal_get_nonlocals(hlds_goal::in, set(prog_var)::out) is det.
:- pred goal_info_add_features(list(goal_feature)::in,
@@ -1278,9 +1311,31 @@
% The path to this goal from the root in
% reverse order.
+ maybe_mode_constraint_info :: maybe(mode_constraint_goal_info),
+
code_gen_info :: hlds_goal_code_gen_info
).
+:- type mode_constraint_goal_info --->
+ mode_constraint_goal_info(
+ mci_occurring_vars :: set(prog_var),
+ % Inst_graph nodes that are reachable from
+ % variables that occur in the goal.
+
+ mci_producing_vars :: set(prog_var),
+ % Inst_graph nodes produced by this goal.
+
+ mci_consuming_vars :: set(prog_var),
+ % Inst_graph nodes consumed by this goal.
+
+ mci_make_visible_vars :: set(prog_var),
+ % Variables that this goal makes visible.
+
+ mci_need_visible_vars :: set(prog_var)
+ % Variables that this goal need to be visible
+ % before it is executed.
+ ).
+
:- pragma inline(goal_info_init/1).
goal_info_init(GoalInfo) :-
Detism = erroneous,
@@ -1289,7 +1344,7 @@
term__context_init(Context),
set__init(Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- Features, [], no_code_gen_info).
+ Features, [], no, no_code_gen_info).
:- pragma inline(goal_info_init/2).
goal_info_init(Context, GoalInfo) :-
@@ -1298,18 +1353,18 @@
set__init(NonLocals),
set__init(Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- Features, [], no_code_gen_info).
+ Features, [], no, no_code_gen_info).
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, GoalInfo) :-
term__context_init(Context),
purity_features(Purity, _, Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- list_to_set(Features), [], no_code_gen_info).
+ list_to_set(Features), [], no, no_code_gen_info).
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context, GoalInfo) :-
purity_features(Purity, _, Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- list_to_set(Features), [], no_code_gen_info).
+ list_to_set(Features), [], no, no_code_gen_info).
goal_info_get_determinism(GoalInfo, GoalInfo ^ determinism).
goal_info_get_instmap_delta(GoalInfo, GoalInfo ^ instmap_delta).
@@ -1319,6 +1374,41 @@
goal_info_get_goal_path(GoalInfo, GoalInfo ^ goal_path).
goal_info_get_code_gen_info(GoalInfo, GoalInfo ^ code_gen_info).
+goal_info_get_occurring_vars(GoalInfo, OccurringVars) :-
+ ( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
+ OccurringVars = MCI ^ mci_occurring_vars
+ ;
+ OccurringVars = set__init
+ ).
+
+goal_info_get_producing_vars(GoalInfo, ProducingVars) :-
+ ( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
+ ProducingVars = MCI ^ mci_producing_vars
+ ;
+ ProducingVars = set__init
+ ).
+
+goal_info_get_consuming_vars(GoalInfo, ConsumingVars) :-
+ ( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
+ ConsumingVars = MCI ^ mci_consuming_vars
+ ;
+ ConsumingVars = set__init
+ ).
+
+goal_info_get_make_visible_vars(GoalInfo, MakeVisibleVars) :-
+ ( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
+ MakeVisibleVars = MCI ^ mci_make_visible_vars
+ ;
+ MakeVisibleVars = set__init
+ ).
+
+goal_info_get_need_visible_vars(GoalInfo, NeedVisibleVars) :-
+ ( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
+ NeedVisibleVars = MCI ^ mci_need_visible_vars
+ ;
+ NeedVisibleVars = set__init
+ ).
+
goal_info_set_determinism(GoalInfo0, Determinism,
GoalInfo0 ^ determinism := Determinism).
goal_info_set_instmap_delta(GoalInfo0, InstMapDelta,
@@ -1340,6 +1430,95 @@
% non-locals when structure reuse is not being performed.
goal_info_set_code_gen_nonlocals(GoalInfo0, NonLocals, GoalInfo) :-
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo).
+
+goal_info_set_occurring_vars(GoalInfo0, OccurringVars, GoalInfo) :-
+ ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+ MCI = MCI0 ^ mci_occurring_vars := OccurringVars
+ ;
+ set__init(ProducingVars),
+ set__init(ConsumingVars),
+ set__init(MakeVisibleVars),
+ set__init(NeedVisibleVars),
+ MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
+ ConsumingVars, MakeVisibleVars, NeedVisibleVars)
+ ),
+ GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+
+goal_info_set_producing_vars(GoalInfo0, ProducingVars, GoalInfo) :-
+ ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+ MCI = MCI0 ^ mci_producing_vars := ProducingVars
+ ;
+ set__init(OccurringVars),
+ set__init(ConsumingVars),
+ set__init(MakeVisibleVars),
+ set__init(NeedVisibleVars),
+ MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
+ ConsumingVars, MakeVisibleVars, NeedVisibleVars)
+ ),
+ GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+
+goal_info_set_consuming_vars(GoalInfo0, ConsumingVars, GoalInfo) :-
+ ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+ MCI = MCI0 ^ mci_consuming_vars := ConsumingVars
+ ;
+ set__init(OccurringVars),
+ set__init(ProducingVars),
+ set__init(MakeVisibleVars),
+ set__init(NeedVisibleVars),
+ MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
+ ConsumingVars, MakeVisibleVars, NeedVisibleVars)
+ ),
+ GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+
+goal_info_set_make_visible_vars(GoalInfo0, MakeVisibleVars, GoalInfo) :-
+ ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+ MCI = MCI0 ^ mci_make_visible_vars := MakeVisibleVars
+ ;
+ set__init(OccurringVars),
+ set__init(ProducingVars),
+ set__init(ConsumingVars),
+ set__init(NeedVisibleVars),
+ MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
+ ConsumingVars, MakeVisibleVars, NeedVisibleVars)
+ ),
+ GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+
+goal_info_set_need_visible_vars(GoalInfo0, NeedVisibleVars, GoalInfo) :-
+ ( GoalInfo0 ^ maybe_mode_constraint_info = yes(MCI0) ->
+ MCI = MCI0 ^ mci_need_visible_vars := NeedVisibleVars
+ ;
+ set__init(OccurringVars),
+ set__init(ProducingVars),
+ set__init(ConsumingVars),
+ set__init(MakeVisibleVars),
+ MCI = mode_constraint_goal_info(OccurringVars, ProducingVars,
+ ConsumingVars, MakeVisibleVars, NeedVisibleVars)
+ ),
+ GoalInfo = GoalInfo0 ^ maybe_mode_constraint_info := yes(MCI).
+
+producing_vars(GoalInfo) = ProducingVars :-
+ goal_info_get_producing_vars(GoalInfo, ProducingVars).
+
+'producing_vars :='(GoalInfo0, ProducingVars) = GoalInfo :-
+ goal_info_set_producing_vars(GoalInfo0, ProducingVars, GoalInfo).
+
+consuming_vars(GoalInfo) = ConsumingVars :-
+ goal_info_get_consuming_vars(GoalInfo, ConsumingVars).
+
+'consuming_vars :='(GoalInfo0, ConsumingVars) = GoalInfo :-
+ goal_info_set_consuming_vars(GoalInfo0, ConsumingVars, GoalInfo).
+
+make_visible_vars(GoalInfo) = MakeVisibleVars :-
+ goal_info_get_make_visible_vars(GoalInfo, MakeVisibleVars).
+
+'make_visible_vars :='(GoalInfo0, MakeVisibleVars) = GoalInfo :-
+ goal_info_set_make_visible_vars(GoalInfo0, MakeVisibleVars, GoalInfo).
+
+need_visible_vars(GoalInfo) = NeedVisibleVars :-
+ goal_info_get_need_visible_vars(GoalInfo, NeedVisibleVars).
+
+'need_visible_vars :='(GoalInfo0, NeedVisibleVars) = GoalInfo :-
+ goal_info_set_need_visible_vars(GoalInfo0, NeedVisibleVars, GoalInfo).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.338
diff -u -b -r1.338 hlds_out.m
--- compiler/hlds_out.m 5 Sep 2004 23:52:06 -0000 1.338
+++ compiler/hlds_out.m 16 Dec 2004 01:08:15 -0000
@@ -1384,6 +1384,41 @@
;
true
),
+ ( string__contains_char(Verbose, 'B') ->
+ ProducingVars = GoalInfo ^ producing_vars,
+ set__to_sorted_list(ProducingVars, ProducingVarsList),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% producing vars: ", !IO),
+ mercury_output_vars(ProducingVarsList, VarSet, AppendVarNums,
+ !IO),
+ io__write_string("\n", !IO),
+
+ ConsumingVars = GoalInfo ^ consuming_vars,
+ set__to_sorted_list(ConsumingVars, ConsumingVarsList),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% consuming vars: ", !IO),
+ mercury_output_vars(ConsumingVarsList, VarSet, AppendVarNums,
+ !IO),
+ io__write_string("\n", !IO),
+
+ MakeVisibleVars = GoalInfo ^ make_visible_vars,
+ set__to_sorted_list(MakeVisibleVars, MakeVisibleVarsList),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% make_visible vars: ", !IO),
+ mercury_output_vars(MakeVisibleVarsList, VarSet, AppendVarNums,
+ !IO),
+ io__write_string("\n", !IO),
+
+ NeedVisibleVars = GoalInfo ^ need_visible_vars,
+ set__to_sorted_list(NeedVisibleVars, NeedVisibleVarsList),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% need_visible vars: ", !IO),
+ mercury_output_vars(NeedVisibleVarsList, VarSet, AppendVarNums,
+ !IO),
+ io__write_string("\n", !IO)
+ ;
+ true
+ ),
( string__contains_char(Verbose, 'd') ->
hlds_out__write_indent(Indent, !IO),
io__write_string("% determinism: ", !IO),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.152
diff -u -b -r1.152 hlds_pred.m
--- compiler/hlds_pred.m 19 Nov 2004 05:46:08 -0000 1.152
+++ compiler/hlds_pred.m 16 Dec 2004 01:24:10 -0000
@@ -13,11 +13,14 @@
:- interface.
+:- import_module check_hlds__mode_constraint_robdd.
+:- import_module check_hlds__mode_errors.
:- import_module check_hlds__mode_errors.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_llds.
:- import_module hlds__hlds_module.
+:- import_module hlds__inst_graph.
:- import_module hlds__special_pred.
:- import_module hlds__instmap.
:- import_module libs__globals.
@@ -749,6 +752,18 @@
:- pred pred_info_set_procedures(proc_table::in,
pred_info::in, pred_info::out) is det.
+:- func inst_graph_info(pred_info) = inst_graph_info.
+:- func 'inst_graph_info :='(pred_info, inst_graph_info) = pred_info.
+
+ % Mode information for the arguments of a procedure.
+ % The first map gives the instantiation state on entry of the
+ % node corresponding to the prog_var. The second map gives
+ % the instantation state on exit.
+:- type arg_modes_map == pair(map(prog_var, bool)).
+
+:- func modes(pred_info) = list(arg_modes_map).
+:- func 'modes :='(pred_info, list(arg_modes_map)) = pred_info.
+
% Return a list of all the proc_ids for the valid modes
% of this predicate. This does not include candidate modes
% that were generated during mode inference but which mode
@@ -785,6 +800,11 @@
:- pred pred_info_get_univ_quant_tvars(pred_info::in, existq_tvars::out)
is det.
+:- pred pred_info_proc_info(pred_info::in, proc_id::in, proc_info::out) is det.
+
+:- pred pred_info_set_proc_info(proc_id::in, proc_info::in,
+ pred_info::in, pred_info::out) is det.
+
:- pred pred_info_is_imported(pred_info::in) is semidet.
:- pred pred_info_is_pseudo_imported(pred_info::in) is semidet.
@@ -839,6 +859,8 @@
:- pred pred_info_get_promised_purity(pred_info::in, purity::out) is det.
+:- pred pred_info_infer_modes(pred_info::in) is semidet.
+
:- pred purity_to_markers(purity::in, pred_markers::out) is det.
:- pred terminates_to_markers(terminates::in, pred_markers::out) is det.
@@ -1059,6 +1081,13 @@
% type_info and typeclass_info
% arguments.
+ inst_graph_info :: inst_graph_info,
+ % The predicate's inst graph, for constraint
+ % based mode analysis.
+ modes :: list(arg_modes_map),
+ % Mode information extracted from constraint
+ % based mode analysis.
+
assertions :: set(assert_id),
% List of assertions which
% mention this predicate.
@@ -1095,8 +1124,8 @@
Context, Status, GoalType, Markers, Attributes,
ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
ClassContext, ClassProofs, UnprovenBodyConstraints,
- MaybeUCI, MaybeInstanceConstraints, Assertions,
- User, Indexes, ClausesInfo, Procs).
+ MaybeUCI, MaybeInstanceConstraints, inst_graph_info_init, [],
+ Assertions, User, Indexes, ClausesInfo, Procs).
pred_info_create(ModuleName, SymName, PredOrFunc, Context, Status, Markers,
ArgTypes, TypeVarSet, ExistQVars, ClassContext, Assertions,
@@ -1134,8 +1163,8 @@
Context, Status, clauses, Markers, Attributes,
ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
ClassContext, ClassProofs, UnprovenBodyConstraints,
- MaybeUCI, MaybeInstanceConstraints, Assertions,
- User, Indexes, ClausesInfo, Procs).
+ MaybeUCI, MaybeInstanceConstraints, inst_graph_info_init, [],
+ Assertions, User, Indexes, ClausesInfo, Procs).
hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
@@ -1349,6 +1378,13 @@
^ exist_quant_tvars := ExistQVars)
^ arg_types := ArgTypes.
+pred_info_proc_info(PredInfo, ProcId, ProcInfo) :-
+ ProcInfo = map__lookup(PredInfo ^ procedures, ProcId).
+
+pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo) :-
+ PredInfo = PredInfo0 ^ procedures :=
+ map__set(PredInfo0 ^ procedures, ProcId, ProcInfo).
+
pred_info_is_imported(PredInfo) :-
pred_info_import_status(PredInfo, Status),
( Status = imported(_)
@@ -1488,6 +1524,10 @@
PromisedPurity = (impure)
).
+pred_info_infer_modes(PredInfo) :-
+ pred_info_get_markers(PredInfo, Markers),
+ check_marker(Markers, infer_modes).
+
purity_to_markers(pure, []).
purity_to_markers(semipure, [semipure]).
purity_to_markers(impure, [impure]).
@@ -1865,6 +1905,12 @@
maybe(deep_profile_proc_info)::in,
proc_info::in, proc_info::out) is det.
+:- pred proc_info_head_modes_constraint(proc_info::in, mode_constraint::out)
+ is det.
+
+:- pred proc_info_set_head_modes_constraint(mode_constraint::in,
+ proc_info::in, proc_info::out) is det.
+
% See also proc_info_interface_code_model in code_model.m.
:- pred proc_info_interface_determinism(proc_info::in, determinism::out)
is det.
@@ -2015,6 +2061,7 @@
maybe_declared_head_modes :: maybe(list(mode)),
% declared modes of arguments.
actual_head_modes :: list(mode),
+ maybe_head_modes_constraint :: maybe(mode_constraint),
head_var_caller_liveness :: maybe(list(is_live)),
% Liveness (in the mode analysis sense)
% of the arguments in the caller; says
@@ -2163,7 +2210,7 @@
map__init(TVarsMap),
map__init(TCVarsMap),
NewProc = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars,
- InstVarSet, DeclaredModes, Modes, MaybeArgLives,
+ InstVarSet, DeclaredModes, Modes, no, MaybeArgLives,
MaybeDet, InferredDet, ClauseBody, CanProcess, ModeErrors,
TVarsMap, TCVarsMap, eval_normal,
proc_sub_info(no, no, IsAddressTaken, StackSlots,
@@ -2175,17 +2222,18 @@
StackSlots, ArgInfo, Liveness, ProcInfo) :-
ModeErrors = [],
ProcInfo = proc_info(Context, BodyVarSet, BodyTypes, HeadVars,
- InstVarSet, no, HeadModes, HeadLives,
+ InstVarSet, no, HeadModes, no, HeadLives,
DeclaredDetism, InferredDetism, Goal, CanProcess, ModeErrors,
TVarMap, TCVarsMap, eval_normal,
proc_sub_info(ArgSizes, Termination, IsAddressTaken,
StackSlots, ArgInfo, Liveness, no, no, no, no)).
-proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet, HeadModes,
- Detism, Goal, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
- proc_info_create(Context, VarSet, VarTypes, HeadVars,
- InstVarSet, HeadModes, yes(Detism), Detism, Goal,
- TVarMap, TCVarsMap, IsAddressTaken, ProcInfo).
+proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet,
+ HeadModes, Detism, Goal, TVarMap, TCVarsMap,
+ IsAddressTaken, ProcInfo) :-
+ proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet,
+ HeadModes, yes(Detism), Detism, Goal, TVarMap, TCVarsMap,
+ IsAddressTaken, ProcInfo).
proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet, HeadModes,
MaybeDeclaredDetism, Detism, Goal, TVarMap, TCVarsMap,
@@ -2195,7 +2243,7 @@
MaybeHeadLives = no,
ModeErrors = [],
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
- InstVarSet, no, HeadModes, MaybeHeadLives,
+ InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
TVarMap, TCVarsMap, eval_normal,
proc_sub_info(no, no, IsAddressTaken,
@@ -2271,6 +2319,18 @@
PI ^ proc_sub_info ^ maybe_table_info := MTI).
proc_info_set_maybe_deep_profile_info(DPI, PI,
PI ^ proc_sub_info ^ maybe_deep_profile_proc_info := DPI).
+
+proc_info_head_modes_constraint(ProcInfo, HeadModesConstraint) :-
+ MaybeHeadModesConstraint = ProcInfo ^ maybe_head_modes_constraint,
+ (
+ MaybeHeadModesConstraint = yes(HeadModesConstraint)
+ ;
+ MaybeHeadModesConstraint = no,
+ error("proc_info_head_modes_constraint: no constraint")
+ ).
+
+proc_info_set_head_modes_constraint(HMC, ProcInfo,
+ ProcInfo ^ maybe_head_modes_constraint := yes(HMC)).
proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap) :-
proc_info_headvars(ProcInfo, HeadVars),
Index: compiler/inst_graph.m
===================================================================
RCS file: compiler/inst_graph.m
diff -N compiler/inst_graph.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/inst_graph.m 15 Dec 2004 21:50:45 -0000
@@ -0,0 +1,437 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2003 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 list, map, io.
+
+:- 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, Acc0, 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, Acc0, 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 corresponding_nodes(inst_graph::in, prog_var::in, prog_var::in,
+ prog_var::out, prog_var::out) is multi.
+
+:- pred 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__state::di, io__state::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_data.
+:- import_module hlds__hlds_out.
+
+:- import_module require, set, std_util, varset, term, term_io.
+
+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)
+ ;
+ error("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 `member` Seen ->
+ fail
+ ;
+ descendant_2(InstGraph, Seen `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 `member` Seen ->
+ LAcc = LAcc0
+ ;
+ foldl_reachable_aux(P,
+ InstGraph, Arg, Seen `insert` Arg,
+ LAcc0, LAcc)
+ )
+ ), Args, MAcc0, MAcc)
+ ), Functors, !Acc).
+
+foldl_reachable_from_list(P, InstGraph, Vars) -->
+ list__foldl(foldl_reachable(P, InstGraph), Vars).
+
+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 `member` Seen ->
+ LAccA = LAccA0,
+ LAccB = LAccB0
+ ;
+ foldl_reachable_aux2(P,
+ InstGraph, Arg, Seen `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).
+
+corresponding_nodes(InstGraph, A, B, V, W) :-
+ corresponding_nodes(InstGraph, InstGraph, A, B, V, W).
+
+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 `member` SeenA0, B `member` SeenB0 ),
+
+ map__lookup(InstGraphA, A, node(FunctorsA, _)),
+ map__lookup(InstGraphB, B, node(FunctorsB, _)),
+
+ SeenA = SeenA0 `insert` A,
+ SeenB = SeenB0 `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),
+ 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(
+ pred(_::in, term__variable(V)::in, V::out) is semidet,
+ Sub0, Sub1)
+ ->
+ Sub = Sub1
+ ;
+ error("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(
+ (pred(_::in, 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__state::di, io__state::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__state::di, io__state::uo) is det.
+
+dump_functor(VarSet, ConsId, Args, !IO) :-
+ io__write_string("%%\t", !IO),
+ hlds_out__write_cons_id(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__state::di, io__state::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).
+
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.316
diff -u -b -r1.316 mercury_compile.m
--- compiler/mercury_compile.m 20 Oct 2004 09:44:57 -0000 1.316
+++ compiler/mercury_compile.m 16 Dec 2004 01:07:26 -0000
@@ -49,6 +49,7 @@
:- import_module check_hlds__purity.
:- import_module check_hlds__polymorphism.
:- import_module check_hlds__modes.
+:- import_module check_hlds__mode_constraints.
:- import_module check_hlds__switch_detection.
:- import_module check_hlds__cse_detection.
:- import_module check_hlds__det_analysis.
@@ -166,7 +167,7 @@
% library modules
:- import_module int, list, map, set, std_util, require, string, bool, dir.
:- import_module library, getopt, set_bbbtree, term, varset, assoc_list.
-:- import_module gc.
+:- import_module gc, benchmarking.
:- import_module pprint.
%-----------------------------------------------------------------------------%
@@ -2203,6 +2204,11 @@
mercury_compile__maybe_polymorphism(Verbose, Stats, !HLDS, !IO),
mercury_compile__maybe_dump_hlds(!.HLDS, 30, "polymorphism", !IO),
+ mercury_compile__maybe_mode_constraints(Verbose, Stats,
+ !.HLDS, HHF_HLDS, !IO),
+ mercury_compile__maybe_dump_hlds(HHF_HLDS, 33, "mode_constraints",
+ !IO),
+
mercury_compile__modecheck(Verbose, Stats, !HLDS,
FoundModeError, UnsafeToContinue, !IO),
mercury_compile__maybe_dump_hlds(!.HLDS, 35, "modecheck", !IO),
@@ -2727,7 +2733,9 @@
mercury_compile__modecheck(Verbose, Stats, !HLDS, FoundModeError,
UnsafeToContinue, !IO) :-
module_info_num_errors(!.HLDS, NumErrors0),
- modecheck(!HLDS, UnsafeToContinue, !IO),
+ maybe_benchmark_modes((pred(H0::in, {H,U}::out, di, uo) is det -->
+ modecheck(H0, H, U)),
+ "modecheck", !.HLDS, {!:HLDS, UnsafeToContinue}, !IO),
module_info_num_errors(!.HLDS, NumErrors),
( NumErrors \= NumErrors0 ->
FoundModeError = yes,
@@ -2740,6 +2748,45 @@
"% Program is mode-correct.\n", !IO)
),
maybe_report_stats(Stats, !IO).
+
+:- pred mercury_compile__maybe_mode_constraints(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+mercury_compile__maybe_mode_constraints(Verbose, Stats, !HLDS, !IO) :-
+ globals__io_lookup_bool_option(mode_constraints, ModeConstraints, !IO),
+ ( ModeConstraints = yes ->
+ maybe_write_string(Verbose,
+ "% Dumping mode constraints...\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+ maybe_benchmark_modes(mode_constraints__process_module,
+ "mode-constraints", !HLDS, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ true
+ ).
+
+:- pred maybe_benchmark_modes(pred(T1, T2, io, io)::in(pred(in, out, di, uo)
+ is det), string::in, T1::in, T2::out, io::di, io::uo) is det.
+
+maybe_benchmark_modes(Pred, Stage, A0, A, !IO) :-
+ globals__io_lookup_bool_option(benchmark_modes, BenchmarkModes, !IO),
+ ( BenchmarkModes = yes ->
+ globals__io_lookup_int_option(benchmark_modes_repeat, Repeats,
+ !IO),
+ io__format("%s %d ", [s(Stage), i(Repeats)], !IO),
+ promise_only_solution_io(do_io_benchmark(Pred, Repeats, A0),
+ A - Time, !IO),
+ io__format("%d ms\n", [i(Time)], !IO)
+ ;
+ Pred(A0, A, !IO)
+ ).
+
+:- pred do_io_benchmark(pred(T1, T2, io, io)::in(pred(in, out, di, uo) is det),
+ int::in, T1::in, pair(T2, int)::out, io::di, io::uo) is cc_multi.
+
+do_io_benchmark(Pred, Repeats, A0, A - Time, !IO) :-
+ benchmark_det_io(Pred, A0, A, !IO, Repeats, Time).
:- pred mercury_compile__detect_switches(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/mode_constraint_robdd.m
===================================================================
RCS file: compiler/mode_constraint_robdd.m
diff -N compiler/mode_constraint_robdd.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/mode_constraint_robdd.m 26 Oct 2003 09:35:37 -0000
@@ -0,0 +1,400 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2003 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: mode_constraint_robdd.m
+% Main author: dmo
+%
+% This module provides an abstraction layer on top of the ROBDD library modules.
+% It provides for the possibility of storing the constraints in a more
+% convenient structure (but less efficient), in addition to the ROBDD.
+% This might be desirable for viewing the constraints in a human-readable
+% form or for outputting them to the SICStus clpb solver.
+%
+% Whether this extra information is stored is controlled by the `debug/0'
+% predicate.
+
+:- module check_hlds__mode_constraint_robdd.
+:- interface.
+
+:- import_module parse_tree__prog_data.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_pred.
+:- import_module mode_robdd.
+
+:- import_module stack, set, map, bool, robdd, term, io.
+
+:- type mc_type.
+
+:- type mode_constraint == mode_robdd(mc_type).
+:- type mode_constraint_var == var(mc_type).
+:- type mode_constraint_vars == vars(mc_type).
+:- type mode_constraint_info.
+:- type threshold.
+
+:- func init_mode_constraint_info(bool) = mode_constraint_info.
+:- func 'pred_id :='(mode_constraint_info, pred_id) = mode_constraint_info.
+
+:- type rep_var
+ ---> in(prog_var)
+ ; out(prog_var)
+ ; prog_var `at` goal_path.
+
+% Lookup a var in the mode_constraint_info. If the var is not found, insert it.
+:- pred mode_constraint_var(rep_var::in, mode_constraint_var::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+:- pred mode_constraint_var(pred_id::in, rep_var::in, mode_constraint_var::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+% Functional version of the above. If the var is not found, abort.
+:- func mode_constraint_var(mode_constraint_info, rep_var) =
+ mode_constraint_var.
+
+:- pred enter_lambda_goal(goal_path::in, mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- pred leave_lambda_goal(mode_constraint_info::in, mode_constraint_info::out)
+ is det.
+
+ % lambda_path extends the idea of the goal_path to allow describing the
+ % location of a goal within nested lambda goals.
+:- type lambda_path == stack(goal_path).
+
+ % Describes a var, its pred-id and lambda-nesting level.
+ % XXX think up a better name for this.
+:- type prog_var_and_level.
+
+:- pred get_prog_var_level(prog_var::in, prog_var_and_level::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+:- pred set_level_from_var(prog_var_and_level::in,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+ % Return the current max var for later use by restrict_threshold.
+:- pred save_threshold(threshold::out, mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- func restrict_threshold(threshold, mode_constraint) = mode_constraint.
+
+:- func restrict_filter(pred(rep_var), mode_constraint_info,
+ mode_constraint) = mode_constraint.
+:- mode restrict_filter(pred(in) is semidet, in, in) = out is det.
+
+:- pred save_min_var_for_pred(pred_id::in, mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- pred save_max_var_for_pred(pred_id::in, mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- pred get_interesting_vars_for_pred(pred_id::in,
+ set(mode_constraint_var)::out, mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+ % Set the input_nodes field of the mode_constraint_info and make sure
+ % the zero_var is constrained to be zero in the mode_constraint.
+:- pred set_input_nodes(mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+:- pred set_simple_mode_constraints(mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- pred unset_simple_mode_constraints(mode_constraint_info::in,
+ mode_constraint_info::out) is det.
+
+:- pred using_simple_mode_constraints(mode_constraint_info::in,
+ mode_constraint_info::out) is semidet.
+
+% Remove the comments here and on the definition if you want to debug
+% the mode constraint system.
+%
+% :- pred dump_mode_constraints(module_info::in, pred_info::in, inst_graph::in,
+% mode_constraint::in, mode_constraint_info::in,
+% io__state::di, io__state::uo) is det.
+%
+% :- pred dump_constraints(module_info::in, prog_varset::in,
+% mode_constraint::in, io__state::di, io__state::uo) is det.
+
+:- pred robdd_to_dot(mode_constraint::in, prog_varset::in,
+ mode_constraint_info::in, string::in, io__state::di, io__state::uo)
+ is det.
+
+% A prodvars_map maps each subgoal to the set of variables produced
+% by that subgoal.
+
+:- type prodvars_map == map(lambda_path, set(prog_var)).
+
+:- func atomic_prodvars_map(mode_constraint, mode_constraint_info) =
+ prodvars_map.
+
+:- implementation.
+
+:- import_module mode_robdd__tfeir.
+:- import_module mode_robdd__tfeirn.
+:- import_module mode_robdd__check.
+
+:- import_module std_util, bool, list, term, varset, map, require, term_io.
+:- import_module bimap, assoc_list, string, stack, sparse_bitset, robdd.
+
+:- type mc_type ---> mc_type.
+
+:- type mode_constraint_info --->
+ mode_constraint_info(
+ varset :: varset(mc_type),
+ varmap :: mode_constraint_varmap,
+ pred_id :: pred_id,
+ lambda_path :: lambda_path,
+ min_vars :: map(pred_id, mode_constraint_var),
+ max_vars :: map(pred_id, mode_constraint_var),
+ input_nodes :: sparse_bitset(prog_var),
+ zero_var :: robdd_var,
+ % A var that is always zero.
+ simple_constraints :: bool
+ % Are we using the simplified constraint model.
+ ).
+
+:- type threshold ---> threshold(mode_constraint_var).
+
+init_mode_constraint_info(Simple) = Info :-
+ VarSet0 = varset__init,
+ varset__new_var(VarSet0, ZeroVar, VarSet),
+ PredId = hlds_pred__initial_pred_id,
+ Info = mode_constraint_info(VarSet, bimap__init, PredId, stack__init,
+ map__init, map__init, sparse_bitset__init, ZeroVar, Simple).
+
+:- type robdd_var == var(mc_type).
+
+:- type mode_constraint_varmap == bimap(varmap_key, robdd_var).
+
+ % Key for looking up robdd_vars.
+ % `pred_id' is the predicate the variable belongs to.
+ % `lambda_path' describes the location of the lambda_goal
+ % we are referring to.
+:- type varmap_key ---> key(rep_var, pred_id, lambda_path).
+
+mode_constraint_var(RepVar0, RobddVar, Info0, Info) :-
+ mode_constraint_var(Info0 ^ pred_id, RepVar0, RobddVar, Info0, Info).
+
+mode_constraint_var(PredId, RepVar0, RobddVar, Info0, Info) :-
+ (
+ RepVar0 = ProgVar `at` _,
+ Info0 ^ input_nodes `contains` ProgVar
+ ->
+ % This RepVar must be false since the corresponding input var
+ % is true. We can just return the zero var.
+ RobddVar = Info0 ^ zero_var,
+ Info = Info0
+ ;
+ RepVar = RepVar0,
+ LambdaPath = Info0 ^ lambda_path,
+ Key = key(RepVar, PredId, LambdaPath),
+ ( bimap__search(Info0 ^ varmap, Key, RobddVar0) ->
+ RobddVar = RobddVar0,
+ Info = Info0
+ ;
+ varset__new_var(Info0 ^ varset, RobddVar, NewVarSet),
+ bimap__set(Info0 ^ varmap, Key, RobddVar, NewVarMap),
+ Info = (Info0 ^ varset := NewVarSet)
+ ^ varmap := NewVarMap
+ )
+ ).
+
+mode_constraint_var(Info, RepVar) = bimap__lookup(Info ^ varmap, Key) :-
+ Key = key(RepVar, Info ^ pred_id, Info ^ lambda_path).
+
+enter_lambda_goal(GoalPath) -->
+ LambdaPath0 =^ lambda_path,
+ ^ lambda_path := stack__push(LambdaPath0, GoalPath).
+
+leave_lambda_goal -->
+ LambdaPath0 =^ lambda_path,
+ { stack__pop_det(LambdaPath0, _GoalPath, LambdaPath) },
+ ^ lambda_path := LambdaPath.
+
+:- type prog_var_and_level
+ ---> prog_var_and_level(
+ prog_var,
+ pred_id,
+ lambda_path
+ ).
+
+get_prog_var_level(Var, prog_var_and_level(Var, PredId, LambdaPath)) -->
+ PredId =^ pred_id,
+ LambdaPath =^ lambda_path.
+
+set_level_from_var(prog_var_and_level(_Var, PredId, LambdaPath)) -->
+ ^ pred_id := PredId,
+ ^ lambda_path := LambdaPath.
+
+save_threshold(threshold(varset__max_var(VarSet))) -->
+ VarSet =^ varset.
+
+restrict_threshold(threshold(Threshold), Constraint) =
+ restrict_threshold(Threshold, ensure_normalised(Constraint)).
+
+restrict_filter(P0, Info, M) = restrict_filter(P, ensure_normalised(M)) :-
+ P = (pred(MCV::in) is semidet :-
+ bimap__reverse_lookup(Info ^ varmap, key(RV, PredId, _), MCV),
+ ( PredId \= Info ^ pred_id ; P0(RV) )
+ ).
+
+save_min_var_for_pred(PredId) -->
+ save_threshold(threshold(Threshold)),
+ MinVars0 =^ min_vars,
+ { map__set(MinVars0, PredId, Threshold, MinVars) },
+ ^ min_vars := MinVars.
+
+save_max_var_for_pred(PredId) -->
+ save_threshold(threshold(Threshold)),
+ MaxVars0 =^ max_vars,
+ { map__set(MaxVars0, PredId, Threshold, MaxVars) },
+ ^ max_vars := MaxVars.
+
+get_interesting_vars_for_pred(PredId, Vars) -->
+ MinVars =^ min_vars,
+ MaxVars =^ max_vars,
+ VarSet =^ varset,
+ { Vars = ( set__sorted_list_to_set `compose`
+ list__filter((pred(V::in) is semidet :-
+ compare(<, map__lookup(MinVars, PredId), V),
+ \+ compare(<, map__lookup(MaxVars, PredId), V))) `compose`
+ varset__vars
+ )(VarSet) }.
+
+set_input_nodes(Constraint0, Constraint, Info0, Info) :-
+ VarMap = Info0 ^ varmap,
+ LambdaPath = Info0 ^ lambda_path,
+ PredId = Info0 ^ pred_id,
+ bimap__ordinates(VarMap, Keys),
+ Constraint1 = ensure_normalised(Constraint0),
+ solutions((pred(ProgVar::out) is nondet :-
+ member(Key, Keys),
+ Key = key(in(ProgVar), PredId, LambdaPath),
+ bimap__lookup(VarMap, Key, RobddVar),
+ var_entailed(Constraint1, RobddVar)
+ ), InputNodes),
+ Info = Info0 ^ input_nodes := sorted_list_to_set(InputNodes),
+ Constraint = Constraint0 ^ not_var(Info ^ zero_var).
+
+set_simple_mode_constraints -->
+ ^ simple_constraints := yes.
+
+unset_simple_mode_constraints -->
+ ^ simple_constraints := no.
+
+using_simple_mode_constraints -->
+ yes =^ simple_constraints.
+
+% dump_mode_constraints(_ModuleInfo, _PredInfo, _InstGraph, ROBDD, Info) -->
+% { AL = (list__sort `compose`
+% assoc_list__reverse_members `compose`
+% bimap__to_assoc_list)(Info ^ varmap) },
+% list__foldl((pred((MCV - key(RV, _, _))::in, di, uo) is det -->
+% print(MCV), write_string("\t"), print(RV), nl), AL),
+%
+% nl,
+% flush_output,
+%
+% print_robdd(ROBDD),
+%
+% nl,
+% flush_output.
+%
+% dump_constraints(_ModuleInfo, _VarSet, ROBDD) -->
+% { robdd__size(ROBDD, Nodes, Depth) },
+% io__format("Nodes: %d \tDepth: %d\n", [i(Nodes), i(Depth)]),
+% flush_output.
+
+:- pred dump_mode_constraint_var(prog_varset::in, rep_var::in,
+ io__state::di, io__state::uo) is det.
+
+dump_mode_constraint_var(VarSet, in(V)) -->
+ { varset__lookup_name(VarSet, V, Name) },
+ io__write_string(Name),
+ io__write_string("_in").
+dump_mode_constraint_var(VarSet, out(V)) -->
+ { varset__lookup_name(VarSet, V, Name) },
+ io__write_string(Name),
+ io__write_string("_out").
+dump_mode_constraint_var(VarSet, V `at` Path0) -->
+ { varset__lookup_name(VarSet, V, Name) },
+ io__write_string(Name),
+ io__write_char('_'),
+ { list__reverse(Path0, Path) },
+ list__foldl(dump_goal_path_step, Path).
+
+:- pred dump_goal_path_step(goal_path_step::in,
+ io__state::di, io__state::uo) is det.
+
+dump_goal_path_step(conj(N)) -->
+ io__write_char('c'),
+ io__write_int(N).
+dump_goal_path_step(disj(N)) -->
+ io__write_char('d'),
+ io__write_int(N).
+dump_goal_path_step(switch(N, _)) -->
+ io__write_char('s'),
+ io__write_int(N).
+dump_goal_path_step(ite_cond) -->
+ io__write_char('c').
+dump_goal_path_step(ite_then) -->
+ io__write_char('t').
+dump_goal_path_step(ite_else) -->
+ io__write_char('e').
+dump_goal_path_step(neg) -->
+ io__write_char('n').
+dump_goal_path_step(exist(_)) -->
+ io__write_char('q').
+dump_goal_path_step(first) -->
+ io__write_char('f').
+dump_goal_path_step(later) -->
+ io__write_char('l').
+
+robdd_to_dot(Constraint, ProgVarSet, Info, FileName) -->
+ robdd_to_dot(Constraint ^ robdd, P, FileName),
+ { VarMap = Info ^ varmap },
+ { P = (pred(RobddVar::in, di, uo) is det -->
+ { bimap__reverse_lookup(VarMap, key(RepVar, PredId, LambdaPath),
+ RobddVar) },
+ dump_mode_constraint_var(ProgVarSet, RepVar),
+ io__write_string(" "),
+ { pred_id_to_int(PredId, PredIdNum) },
+ io__write_int(PredIdNum),
+ io__write_string(" "),
+ io__write_int(stack__depth(LambdaPath)),
+ io__write_string(" ("),
+ io__write_int(term__var_to_int(RobddVar)),
+ io__write_string(")")
+ )}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+atomic_prodvars_map(Constraint, MCInfo) =
+ (
+ some_vars(VarsEntailed) =
+ vars_entailed(ensure_normalised(Constraint))
+ ->
+ list__foldl((func(MCVar, PVM) =
+ (
+ bimap__reverse_lookup(MCInfo ^ varmap, Key, MCVar),
+ Key = key(RepVar, PredId, LambdaPath0),
+ PredId = MCInfo ^ pred_id,
+ RepVar = ProgVar `at` GoalPath,
+ LambdaPath = stack__push(LambdaPath0, GoalPath)
+ ->
+ ( Vs = map__search(PVM, LambdaPath) ->
+ map__det_update(PVM, LambdaPath,
+ Vs `insert` ProgVar)
+ ;
+ map__det_insert(PVM, LambdaPath,
+ make_singleton_set(ProgVar))
+ )
+ ;
+ PVM
+ )
+ ), to_sorted_list(VarsEntailed), map__init)
+ ;
+ func_error("atomic_prodvars_map: zero constraint")
+ ).
Index: compiler/mode_constraints.m
===================================================================
RCS file: compiler/mode_constraints.m
diff -N compiler/mode_constraints.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/mode_constraints.m 16 Dec 2004 01:06:29 -0000
@@ -0,0 +1,1970 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2003 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: mode_constraint.m
+% Main author: dmo
+%
+% This module implements the top level of the algorithm described in the
+% paper "Constraint-based mode analysis of Mercury" by David Overton,
+% Zoltan Somogyi and Peter Stuckey. That paper is the main documentation
+% of the concepts behind the algorithm as well as the algorithm itself.
+
+:- module check_hlds__mode_constraints.
+:- interface.
+
+:- import_module hlds__hlds_module.
+:- import_module io.
+
+:- pred mode_constraints__process_module(module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module check_hlds__goal_path.
+:- import_module check_hlds__mode_constraint_robdd.
+:- import_module check_hlds__mode_ordering.
+:- import_module check_hlds__mode_util.
+:- import_module hlds__hhf.
+:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_pred.
+:- import_module hlds__inst_graph.
+:- import_module hlds__passes_aux.
+:- import_module libs__globals.
+:- import_module libs__options.
+:- import_module mode_robdd.
+:- import_module mode_robdd__check.
+:- import_module mode_robdd__tfeir.
+:- import_module mode_robdd__tfeirn.
+:- import_module parse_tree__prog_data.
+:- import_module parse_tree__prog_mode.
+:- import_module transform_hlds__dependency_graph.
+
+:- import_module list, map, std_util, bool, set, multi_map, require, int.
+:- import_module robdd, term, string, assoc_list, sparse_bitset.
+:- import_module varset, term_io.
+:- import_module gc.
+
+% :- import_module unsafe.
+
+:- typeclass has_mc_info(T) where [
+ func mc_info(T) = mode_constraint_info,
+ func 'mc_info :='(T, mode_constraint_info) = T
+].
+
+:- typeclass has_module_info(T) where [
+ func module_info(T) = module_info,
+ func 'module_info :='(T, module_info) = T
+].
+
+:- typeclass has_ho_modes(T) where [
+ func ho_modes(T) = ho_modes,
+ func 'ho_modes :='(T, ho_modes) = T
+].
+
+mode_constraints__process_module(!ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ globals__io_lookup_bool_option(simple_mode_constraints, Simple, !IO),
+ list__foldl2(hhf__process_pred(Simple), PredIds, !ModuleInfo, !IO),
+
+ get_predicate_sccs(!.ModuleInfo, SCCs),
+
+ % Stage 1: Process SCCs bottom-up to determine variable producers.
+ list__foldl3(mode_constraints__process_scc(Simple), SCCs,
+ !ModuleInfo, map__init, PredConstraintMap, !IO),
+
+ % Stage 2: Process SCCs top-down to determine execution order of
+ % conjuctions and which modes are needed for each predicate.
+ mode_ordering(PredConstraintMap, list__reverse(SCCs),
+ !ModuleInfo, !IO),
+
+ % Stage 3, which would turn the results of the mode analysis into goal
+ % annotations that the rest of the compiler can understand, doesn't
+ % exist yet. The whole point of this way of doing mode analysis is
+ % to gain extra expressive power (e.g. partially instantiated data
+ % structures), and the rest of the compiler doesn't handle the extra
+ % expressive power yet.
+
+ clear_caches(!IO).
+
+:- pred mode_constraints__process_scc(bool::in, list(pred_id)::in,
+ module_info::in, module_info::out,
+ pred_constraint_map::in, pred_constraint_map::out,
+ io__state::di, io__state::uo) is det.
+
+mode_constraints__process_scc(Simple, SCC, !ModuleInfo, !PredConstraintMap,
+ !IO) :-
+ ModeConstraint0 = one,
+ ModeConstraintInfo0 = init_mode_constraint_info(Simple),
+ list__foldl2(number_robdd_variables_in_pred, SCC, !ModuleInfo,
+ ModeConstraintInfo0, ModeConstraintInfo1),
+
+ save_threshold(Threshold, ModeConstraintInfo1, ModeConstraintInfo2),
+ mode_constraints__process_scc_pass_1(SCC, SCC, !ModuleInfo,
+ ModeConstraint0, ModeConstraint1,
+ ModeConstraintInfo2, ModeConstraintInfo, !IO),
+
+ ModeConstraint2 = restrict_threshold(Threshold, ModeConstraint1),
+ ModeConstraint = ensure_normalised(ModeConstraint2),
+ mode_constraints__process_scc_pass_2(SCC, ModeConstraint,
+ ModeConstraintInfo, !ModuleInfo, !IO),
+
+ !:PredConstraintMap = list__foldl((func(PredId, PCM) =
+ map__det_insert(PCM, PredId,
+ pci(ModeConstraint,
+ ModeConstraintInfo ^ pred_id := PredId))
+ ), SCC, !.PredConstraintMap).
+
+ % clear_caches(!IO).
+
+:- type number_robdd_info
+ ---> number_robdd_info(
+ n_mc_info :: mode_constraint_info,
+ n_module_info :: module_info,
+ vartypes :: vartypes
+ ).
+
+:- instance has_mc_info(number_robdd_info) where [
+ func(mc_info/1) is n_mc_info,
+ func('mc_info :='/2) is 'n_mc_info :='
+].
+
+:- instance has_module_info(number_robdd_info) where [
+ func(module_info/1) is n_module_info,
+ func('module_info :='/2) is 'n_module_info :='
+].
+
+:- pred update_mc_info(pred(T, mode_constraint_info, mode_constraint_info),
+ T, C, C) <= has_mc_info(C).
+:- mode update_mc_info(pred(out, in, out) is det, out, in, out) is det.
+
+update_mc_info(P, R, !C) :-
+ MCInfo0 = !.C ^ mc_info,
+ P(R, MCInfo0, MCInfo),
+ !:C = !.C ^ mc_info := MCInfo.
+
+:- pred update_mc_info(pred(mode_constraint_info, mode_constraint_info),
+ C, C) <= has_mc_info(C).
+:- mode update_mc_info(pred(in, out) is det, in, out) is det.
+:- mode update_mc_info(pred(in, out) is semidet, in, out) is semidet.
+
+update_mc_info(P, !C) :-
+ MCInfo0 = !.C ^ mc_info,
+ P(MCInfo0, MCInfo),
+ !:C = !.C ^ mc_info := MCInfo.
+
+:- pred update_md_info(pred(T, mode_decl_info, mode_decl_info), T, C, C)
+ <= (has_mc_info(C), has_ho_modes(C)).
+:- mode update_md_info(pred(out, in, out) is det, out, in, out) is det.
+
+update_md_info(P, R, !C) :-
+ MCInfo0 = !.C ^ mc_info,
+ HOModes0 = !.C ^ ho_modes,
+ MDInfo0 = mode_decl_info(MCInfo0, HOModes0),
+ P(R, MDInfo0, MDInfo),
+ !:C = !.C ^ mc_info := MDInfo ^ mc_info,
+ !:C = !.C ^ ho_modes := MDInfo ^ ho_modes.
+
+ % Assign a number to all the ROBDD variables that we want to keep at
+ % the end of the analysis.
+ % This allows us to use `restrict_threshold' during the analysis
+ % to remove all unwanted variables.
+ % `Restrict_threshold' is much faster than using `robdd__filter'
+ % or `robdd__restrict'.
+:- pred number_robdd_variables_in_pred(pred_id::in, module_info::in,
+ module_info::out, mode_constraint_info::in, mode_constraint_info::out)
+ is det.
+
+number_robdd_variables_in_pred(PredId, !ModuleInfo, !MCI) :-
+ !:MCI = !.MCI ^ pred_id := PredId,
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+
+ save_min_var_for_pred(PredId, !MCI),
+
+ % Variables in each branch of a branched goal are always equivalent.
+ % Likewise, a variable in a negated or existentially quantified goal
+ % will always be equivalent to the variable in the parent goal. This
+ % means we can use the same mode_constraint_var for each of these
+ % equivalent variables, avoiding adding lots of equivalence constraints
+ % to the ROBDD. This is a good thing since equivalence constraints tend
+ % to cause exponential explosions in ROBDDs. We achieve this by passing
+ % `OmitModeEquivPrefix = yes' to `goal_path__fill_slots_in_clauses'.
+
+ OmitModeEquivPrefix = yes,
+ goal_path__fill_slots_in_clauses(!.ModuleInfo, OmitModeEquivPrefix,
+ PredInfo0, PredInfo1),
+
+ pred_info_clauses_info(PredInfo1, ClausesInfo0),
+ clauses_info_headvars(ClausesInfo0, HeadVars),
+ InstGraph = PredInfo1 ^ inst_graph_info ^ implementation_inst_graph,
+ inst_graph__foldl_reachable_from_list(
+ ( pred(V::in, S0::in, S::out) is det :-
+ mode_constraint_var(in(V), _, S0, S1),
+ mode_constraint_var(out(V), _, S1, S2),
+ mode_constraint_var(V `at` [], _, S2, S)
+ ), InstGraph, HeadVars, !MCI),
+
+ ( pred_info_is_imported(PredInfo0) ->
+ true
+ ;
+ clauses_info_clauses(ClausesInfo0, Clauses0),
+ clauses_info_vartypes(ClausesInfo0, VarTypes),
+ NRInfo0 = number_robdd_info(!.MCI, !.ModuleInfo, VarTypes),
+
+ list__map_foldl(
+ (pred(Clause0::in, Clause::out, S0::in, S::out)
+ is det :-
+ Clause0 = clause(A, Goal0, C, D),
+ number_robdd_variables_in_goal(InstGraph,
+ set__init, _, Goal0, Goal, S0, S),
+ Clause = clause(A, Goal, C, D)
+ ), Clauses0, Clauses, NRInfo0, NRInfo),
+
+ !:MCI = NRInfo ^ mc_info,
+ clauses_info_set_clauses(Clauses, ClausesInfo0, ClausesInfo),
+ pred_info_set_clauses_info(ClausesInfo, PredInfo1, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
+ ),
+ save_max_var_for_pred(PredId, !MCI).
+
+:- pred number_robdd_variables_in_goal(inst_graph::in,
+ set(prog_var)::in, set(prog_var)::out, hlds_goal::in, hlds_goal::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_in_goal(InstGraph, ParentNonLocals, Occurring,
+ GoalExpr0 - GoalInfo0, GoalExpr - GoalInfo, !RInfo) :-
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ goal_info_get_goal_path(GoalInfo0, GoalPath),
+ number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals,
+ NonLocals, Occurring, GoalExpr0, GoalExpr, !RInfo),
+ goal_info_set_occurring_vars(GoalInfo0, Occurring, GoalInfo).
+
+:- pred number_robdd_variables_in_goal_2(inst_graph::in, goal_path::in,
+ set(prog_var)::in, set(prog_var)::in, set(prog_var)::out,
+ hlds_goal_expr::in, hlds_goal_expr::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ conj(Goals0), conj(Goals), !RInfo) :-
+ number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
+ Goals0, Goals, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ disj(Goals0), disj(Goals), !RInfo) :-
+ number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
+ Goals0, Goals, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ switch(V, CF, Cases0), switch(V, CF, Cases), !RInfo) :-
+ number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring,
+ Cases0, Cases, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ not(Goal0), not(Goal), !RInfo) :-
+ number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring,
+ Goal0, Goal, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ some(V, CR, Goal0), some(V, CR, Goal), !RInfo) :-
+ number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring,
+ Goal0, Goal, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ if_then_else(Vs, Cond0, Then0, Else0),
+ if_then_else(Vs, Cond, Then, Else), !RInfo) :-
+ number_robdd_variables_in_goal(InstGraph, NonLocals, OccCond,
+ Cond0, Cond, !RInfo),
+ number_robdd_variables_in_goal(InstGraph, NonLocals, OccThen,
+ Then0, Then, !RInfo),
+ number_robdd_variables_in_goal(InstGraph, NonLocals, OccElse,
+ Else0, Else, !RInfo),
+ Occurring = OccCond `set__union` OccThen `set__union` OccElse.
+number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
+ par_conj(Goals0), par_conj(Goals), !RInfo) :-
+ number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
+ Goals0, Goals, !RInfo).
+number_robdd_variables_in_goal_2(_, _, _, _, _, shorthand(_), _, !RInfo) :-
+ error("number_robdd_variables_in_goal_2: shorthand").
+
+number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
+ Occurring, GoalExpr, GoalExpr, !RInfo) :-
+ GoalExpr = call(_, _, Args, _, _, _),
+ number_robdd_variables_at_goal_path(InstGraph, GoalPath,
+ ParentNonLocals, Args, Occurring, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
+ Occurring, GoalExpr, GoalExpr, !RInfo) :-
+ GoalExpr = generic_call(_, Args, _, _),
+ number_robdd_variables_at_goal_path(InstGraph, GoalPath,
+ ParentNonLocals, Args, Occurring, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
+ Occurring, GoalExpr0, GoalExpr, !RInfo) :-
+ GoalExpr0 = unify(VarL, RHS0, _, _, _),
+ number_robdd_variables_in_rhs(InstGraph, GoalPath, Vars, RHS0, RHS,
+ !RInfo),
+ GoalExpr = GoalExpr0 ^ unify_rhs := RHS,
+ number_robdd_variables_at_goal_path(InstGraph, GoalPath,
+ ParentNonLocals, [VarL | Vars], Occurring, !RInfo).
+number_robdd_variables_in_goal_2(InstGraph, GoalPath, ParentNonLocals, _,
+ Occurring, GoalExpr, GoalExpr, !RInfo) :-
+ GoalExpr = foreign_proc(_, _, _, Args, _, _),
+ ArgVars = list__map(foreign_arg_var, Args),
+ number_robdd_variables_at_goal_path(InstGraph, GoalPath,
+ ParentNonLocals, ArgVars, Occurring, !RInfo).
+
+:- pred number_robdd_variables_in_rhs(inst_graph::in, goal_path::in,
+ list(prog_var)::out, unify_rhs::in, unify_rhs::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_in_rhs(_, _, Vars, !RHS, !NRInfo) :-
+ !.RHS = var(VarR),
+ Vars = [VarR].
+number_robdd_variables_in_rhs(_, _, Vars, !RHS, !NRInfo) :-
+ !.RHS = functor(_, _, Args),
+ Vars = Args.
+number_robdd_variables_in_rhs(InstGraph, GoalPath, Vars, !RHS, !NRInfo) :-
+ !.RHS = lambda_goal(_, _, _, _, LambdaNonLocals, LambdaVars, _, _,
+ LambdaGoal0),
+ Vars = LambdaNonLocals,
+ VarTypes = !.NRInfo ^ vartypes,
+ ModuleInfo = !.NRInfo ^ module_info,
+ goal_path__fill_slots_in_goal(LambdaGoal0, VarTypes, ModuleInfo,
+ LambdaGoal1),
+ update_mc_info(enter_lambda_goal(GoalPath), !NRInfo),
+
+ % Number arguments to the lambda goal, i.e. the nonlocals and the
+ % lambda-quantified variables.
+ LambdaHeadVars = LambdaNonLocals `list__append` LambdaVars,
+ update_mc_info(pred(in, out) is det -->
+ inst_graph__foldl_reachable_from_list(
+ ( pred(V::in, in, out) is det -->
+ mode_constraint_var(in(V), _),
+ mode_constraint_var(out(V), _),
+ mode_constraint_var(V `at` [], _)
+ ), InstGraph, LambdaHeadVars), !NRInfo),
+
+ % Number variables within the lambda goal.
+ number_robdd_variables_in_goal(InstGraph, set__init, _Occurring,
+ LambdaGoal1, LambdaGoal, !NRInfo),
+
+ update_mc_info(leave_lambda_goal, !NRInfo),
+ !:RHS = !.RHS ^ rhs_lambda_goal := LambdaGoal.
+
+:- pred number_robdd_variables_at_goal_path(inst_graph::in, goal_path::in,
+ set(prog_var)::in, list(prog_var)::in, set(prog_var)::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_at_goal_path(InstGraph, GoalPath, ParentNonLocals,
+ Vars0, Occurring, !NRInfo) :-
+ solutions_set(inst_graph__reachable_from_list(InstGraph, Vars0),
+ Occurring),
+ Vars = set__to_sorted_list(ParentNonLocals `set__union`
+ set__list_to_set(Vars0)),
+ % XXX We may be able to make this more efficient.
+ inst_graph__foldl_reachable_from_list(
+ (pred(V::in, S0::in, S::out) is det :-
+ update_mc_info(mode_constraint_var(V `at` GoalPath),
+ _, S0, S)
+ ), InstGraph, Vars, !NRInfo).
+
+:- pred number_robdd_variables_in_goals(inst_graph::in, set(prog_var)::in,
+ set(prog_var)::out, hlds_goals::in, hlds_goals::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_in_goals(_, _, Occurring, [], [], !RInfo) :-
+ set__init(Occurring).
+number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
+ [Goal0 | Goals0], [Goal | Goals], !RInfo) :-
+ number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring0,
+ Goal0, Goal, !RInfo),
+ number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring1,
+ Goals0, Goals, !RInfo),
+ Occurring = Occurring0 `set__union` Occurring1.
+
+:- pred number_robdd_variables_in_cases(inst_graph::in, set(prog_var)::in,
+ set(prog_var)::out, list(case)::in, list(case)::out,
+ number_robdd_info::in, number_robdd_info::out) is det.
+
+number_robdd_variables_in_cases(_, _, Occurring, [], [], !RInfo) :-
+ set__init(Occurring).
+number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring,
+ [case(C, Goal0) | Cases0], [case(C, Goal) | Cases], !RInfo) :-
+ number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring0,
+ Goal0, Goal, !RInfo),
+ number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring1,
+ Cases0, Cases, !RInfo),
+ Occurring = Occurring0 `set__union` Occurring1 .
+
+:- pred mode_constraints__process_scc_pass_1(list(pred_id)::in,
+ list(pred_id)::in, module_info::in,
+ module_info::out, mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out,
+ io__state::di, io__state::uo) is det.
+
+mode_constraints__process_scc_pass_1([], _, !ModuleInfo,
+ !ModeConstraint, !ModeConstraintInfo, !IO).
+mode_constraints__process_scc_pass_1([PredId | PredIds], SCC,
+ !ModuleInfo, !ModeConstraint, !ModeConstraintInfo, !IO) :-
+ !:ModeConstraintInfo = !.ModeConstraintInfo ^ pred_id := PredId,
+ mode_constraints__process_pred(PredId, SCC, !ModuleInfo,
+ !ModeConstraint, !ModeConstraintInfo, !IO),
+ mode_constraints__process_scc_pass_1(PredIds, SCC, !ModuleInfo,
+ !ModeConstraint, !ModeConstraintInfo, !IO).
+
+:- pred mode_constraints__process_scc_pass_2(list(pred_id)::in,
+ mode_constraint::in, mode_constraint_info::in, module_info::in,
+ module_info::out, io__state::di, io__state::uo) is det.
+
+mode_constraints__process_scc_pass_2([], _, _, !ModuleInfo, !IO).
+mode_constraints__process_scc_pass_2([PredId | PredIds], ModeConstraint,
+ ModeConstraintInfo, !ModuleInfo, !IO) :-
+ mode_constraints__process_pred_2(PredId, ModeConstraint,
+ ModeConstraintInfo ^ pred_id := PredId, !ModuleInfo, !IO),
+ mode_constraints__process_scc_pass_2(PredIds, ModeConstraint,
+ ModeConstraintInfo, !ModuleInfo, !IO).
+
+:- pred mode_constraints__process_pred(pred_id::in, list(pred_id)::in,
+ module_info::in, module_info::out, mode_constraint::in,
+ mode_constraint::out, mode_constraint_info::in,
+ mode_constraint_info::out, io__state::di, io__state::uo) is det.
+
+mode_constraints__process_pred(PredId, SCC, !ModuleInfo, !ModeConstraint,
+ !ModeConstraintInfo, !IO) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+ write_pred_progress_message("% Calculating mode constraints for ",
+ PredId, !.ModuleInfo, !IO),
+ io__flush_output(!IO),
+
+ InstGraph = PredInfo0 ^ inst_graph_info ^ implementation_inst_graph,
+ pred_info_procedures(PredInfo0, ProcTable0),
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ clauses_info_headvars(ClausesInfo0, HeadVars),
+
+ HOModes0 = map__init,
+ ( ( map__is_empty(ProcTable0) ; pred_info_infer_modes(PredInfo0) ) ->
+ DeclConstraint = one,
+ HOModes = HOModes0,
+ PredInfo1 = PredInfo0
+ ;
+ ModeDeclInfo0 = mode_decl_info(!.ModeConstraintInfo, HOModes0),
+ map__map_foldl2(
+ mode_constraints__mode_decl_to_constraint(!.ModuleInfo,
+ InstGraph, HeadVars, PredInfo0),
+ ProcTable0, ProcTable,
+ zero, DeclConstraint, ModeDeclInfo0, ModeDeclInfo),
+ !:ModeConstraintInfo = ModeDeclInfo ^ mc_info,
+ HOModes = ModeDeclInfo ^ ho_modes,
+ pred_info_set_procedures(ProcTable, PredInfo0, PredInfo1)
+ ),
+ !:ModeConstraint = !.ModeConstraint * DeclConstraint,
+ set_input_nodes(!ModeConstraint, !ModeConstraintInfo),
+
+ % clauses_info_varset(ClausesInfo0, ProgVarSet),
+ % pred_id_to_int(PredId, PredIdInt),
+ % robdd_to_dot(DeclConstraint, ProgVarSet, ModeConstraintInfo1,
+ % format("mode_decl_%d.dot", [i(PredIdInt)]), !IO),
+ % robdd_to_dot(ModeConstraint1, ProgVarSet, ModeConstraintInfo1,
+ % format("mode_constraint1_%d.dot", [i(PredIdInt)]), !IO),
+ % io__flush_output(!IO),
+
+ ( pred_info_is_imported(PredInfo1) ->
+ PredInfo = PredInfo1
+ ;
+
+ mode_constraints__process_clauses_info(!.ModuleInfo, SCC,
+ ClausesInfo0, ClausesInfo, InstGraph, HOModes,
+ !ModeConstraint, !ModeConstraintInfo, !IO),
+ pred_info_set_clauses_info(ClausesInfo,
+ PredInfo1, PredInfo)
+ ),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
+
+:- pred mode_constraints__process_pred_2(pred_id::in, mode_constraint::in,
+ mode_constraint_info::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
+
+mode_constraints__process_pred_2(PredId, ModeConstraint, ModeConstraintInfo0,
+ !ModuleInfo, !IO) :-
+
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+ InstGraph = PredInfo0 ^ inst_graph_info ^ implementation_inst_graph,
+ pred_info_clauses_info(PredInfo0, ClausesInfo),
+ clauses_info_headvars(ClausesInfo, HeadVars),
+
+ % DMO document this better
+ % XXX Needed for analysing calls. May want to store the constraint
+ % as an ROBDD instead.
+ solutions(arg_modes_map(HeadVars, InstGraph, ModeConstraint,
+ ModeConstraintInfo0), Modes),
+ PredInfo = PredInfo0 ^ modes := Modes,
+ % PredInfo = PredInfo0,
+
+ % DEBUGGING CODE
+ % dump_mode_constraints(!.ModuleInfo, PredInfo0, InstGraph,
+ % ModeConstraint, ModeConstraintInfo0),
+ % io__flush_output(!IO),
+ %
+ % list__foldl((pred(M - _::in, di, uo) is det -->
+ % map__foldl((pred(_MV::in, Val::in, di, uo) is det -->
+ % io__write_string(Val = yes -> "1 " ; "0 ")
+ % ), M),
+ % io__nl
+ % ), Modes),
+ %
+ % io__nl(!IO),
+ %
+ % solutions(inst_graph__reachable_from_list(InstGraph, HeadVars),
+ % ReachVars),
+ % list__map_foldl((pred(PV::in, MV::out, in, out) is det -->
+ % mode_constraint_var(in(PV), MV)
+ % ), ReachVars, InVars, ModeConstraintInfo0, ModeConstraintInfo),
+ %
+ % InVarConstraint = restrict_filter((pred(in(V)::in) is semidet :-
+ % list__member(V, ReachVars)),
+ % ModeConstraintInfo, ModeConstraint),
+ % aggregate(fundamental_mode(set__list_to_set(InVars), InVarConstraint),
+ % (pred(M::in, di, uo) is det -->
+ % map__foldl((pred(_MV::in, Val::in, di, uo) is det -->
+ % io__write_string(Val = yes -> "1 " ; "0 ")
+ % ), M),
+ % io__nl
+ % ), !IO),
+
+ % DMO justify or delete
+ % split_constraint_into_modes(PredId, HeadVars, InstGraph,
+ % ModeConstraint, _ProcConstraints, ModeConstraintInfo0,
+ % ModeConstraintInfo),
+
+ % DEBUGGING CODE
+ % clauses_info_varset(ClausesInfo, ProgVarSet),
+ % pred_info_name(PredInfo, Name),
+ % robdd_to_dot(ModeConstraint, ProgVarSet, ModeConstraintInfo,
+ % Name `string__append` ".dot", !IO),
+ % io__flush_output(!IO),
+
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
+
+:- type goal_constraints_info
+ ---> goal_constraints_info(
+ g_module_info :: module_info,
+ scc :: list(pred_id),
+ inst_graph :: inst_graph,
+ headvars :: list(prog_var),
+ prog_varset :: prog_varset,
+ atomic_goals :: set(goal_path),
+ g_mc_info :: mode_constraint_info,
+ g_ho_modes :: ho_modes,
+ ho_calls :: ho_calls
+ ).
+
+:- instance has_mc_info(goal_constraints_info) where [
+ func(mc_info/1) is g_mc_info,
+ func('mc_info :='/2) is 'g_mc_info :='
+].
+
+:- instance has_module_info(goal_constraints_info) where [
+ func(module_info/1) is g_module_info,
+ func('module_info :='/2) is 'g_module_info :='
+].
+
+:- instance has_ho_modes(goal_constraints_info) where [
+ func(ho_modes/1) is g_ho_modes,
+ func('ho_modes :='/2) is 'g_ho_modes :='
+].
+
+:- type ho_modes ==
+ multi_map(prog_var_and_level, list(mode)).
+
+:- type ho_calls ==
+ multi_map(prog_var_and_level, pair(goal_path, list(prog_var))).
+
+:- pred get_var(rep_var::in, mode_constraint_var::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+get_var(RepVar, MCVar, !GCInfo) :-
+ update_mc_info(mode_constraint_var(RepVar), MCVar, !GCInfo).
+
+:- pred get_var(pred_id::in, rep_var::in, mode_constraint_var::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+get_var(PredId, RepVar, MCVar, !GCInfo) :-
+ update_mc_info(mode_constraint_var(PredId, RepVar), MCVar, !GCInfo).
+
+:- pred save_thresh(threshold::out, goal_constraints_info::in,
+ goal_constraints_info::out) is det.
+
+save_thresh(Thresh, !GCInfo) :-
+ update_mc_info(save_threshold, Thresh, !GCInfo).
+
+:- pred add_atomic_goal(goal_path::in, goal_constraints_info::in,
+ goal_constraints_info::out) is det.
+
+add_atomic_goal(GoalPath, !GCInfo) :-
+ AtomicGoals = !.GCInfo ^ atomic_goals,
+ !:GCInfo = !.GCInfo ^ atomic_goals :=
+ AtomicGoals `set__insert` GoalPath.
+
+:- type mode_decl_info
+ ---> mode_decl_info(
+ d_mc_info :: mode_constraint_info,
+ d_ho_modes :: ho_modes
+ ).
+
+:- instance has_mc_info(mode_decl_info) where [
+ func(mc_info/1) is d_mc_info,
+ func('mc_info :='/2) is 'd_mc_info :='
+].
+
+:- instance has_ho_modes(mode_decl_info) where [
+ func(ho_modes/1) is d_ho_modes,
+ func('ho_modes :='/2) is 'd_ho_modes :='
+].
+
+ % Convert a procedure's arg_modes to a constraint.
+:- pred mode_constraints__mode_decl_to_constraint(module_info::in,
+ inst_graph::in, list(prog_var)::in, pred_info::in, proc_id::in,
+ proc_info::in, proc_info::out,
+ mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__mode_decl_to_constraint(ModuleInfo, InstGraph, HeadVars,
+ _PredInfo, _ProcId, !ProcInfo, !Constraint, !Info) :-
+ mode_constraints__process_mode_decl_for_proc(ModuleInfo,
+ InstGraph, HeadVars,
+ false_var(initial), true_var(initial), yes,
+ false_var(final), true_var(final), no,
+ !.ProcInfo, zero, DeclConstraint, !Info),
+
+ % proc_id_to_int(ProcId, ProcIdInt),
+ % pred_info_name(PredInfo, Name),
+ % pred_info_clauses_info(PredInfo, ClausesInfo),
+ % clauses_info_varset(ClausesInfo, ProgVarSet),
+ % unsafe_perform_io(robdd_to_dot(DeclConstraint, ProgVarSet,
+ % Info ^ mc_info, Name ++ int_to_string(ProcIdInt) ++ ".dot")),
+
+ !:Constraint = !.Constraint + DeclConstraint,
+ proc_info_set_head_modes_constraint(DeclConstraint, !ProcInfo).
+
+:- pred mode_constraints__process_mode_decl_for_proc(module_info::in,
+ inst_graph::in, list(prog_var)::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in,
+ proc_info::in, mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__process_mode_decl_for_proc(ModuleInfo, InstGraph, HeadVars,
+ InitialFree, InitialBound, InitialHO,
+ FinalFree, FinalBound, FinalHO,
+ ProcInfo, !Constraint, !MDI) :-
+ % proc_info_declared_argmodes(ProcInfo, ArgModes),
+ proc_info_argmodes(ProcInfo, ArgModes),
+ mode_constraints__process_mode_decl(ModuleInfo, InstGraph, HeadVars,
+ InitialFree, InitialBound, InitialHO,
+ FinalFree, FinalBound, FinalHO,
+ ArgModes, !Constraint, !MDI).
+
+:- pred mode_constraints__process_mode_decl(module_info::in,
+ inst_graph::in, list(prog_var)::in, constrain_var::in(constrain_var),
+ constrain_var::in(constrain_var), bool::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in, list(mode)::in, mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__process_mode_decl(ModuleInfo, InstGraph, HeadVars,
+ InitialFree, InitialBound, InitialHO,
+ FinalFree, FinalBound, FinalHO, ArgModes, !Constraint, !MDI) :-
+ assoc_list__from_corresponding_lists(HeadVars, ArgModes, VarModes),
+ list__foldl2(mode_constraints__process_arg_modes(ModuleInfo, InstGraph,
+ InitialFree, InitialBound, InitialHO,
+ FinalFree, FinalBound, FinalHO),
+ VarModes, one, NewConstraint, !MDI),
+ !:Constraint = !.Constraint + NewConstraint.
+
+:- pred mode_constraints__process_arg_modes(module_info::in, inst_graph::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in,
+ pair(prog_var, mode)::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__process_arg_modes(ModuleInfo, InstGraph,
+ InitialFree, InitialBound, InitialHO,
+ FinalFree, FinalBound, FinalHO,
+ Var - Mode, !Constraint, !MDI) :-
+ mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
+ mode_constraints__process_inst(ModuleInfo, InstGraph,
+ InitialFree, InitialBound, InitialHO, InitialInst,
+ set__init, Var, !Constraint, !MDI),
+ mode_constraints__process_inst(ModuleInfo, InstGraph,
+ FinalFree, FinalBound, FinalHO, FinalInst,
+ set__init, Var, !Constraint, !MDI).
+
+:- func initial(prog_var) = rep_var.
+
+initial(Var) = in(Var).
+
+:- func final(prog_var) = rep_var.
+
+final(Var) = out(Var).
+
+:- func goal_path(goal_path, prog_var) = rep_var.
+
+goal_path(Path, Var) = Var `at` Path.
+
+:- pred true_var(func(prog_var) = rep_var, prog_var, mode_constraint,
+ mode_constraint, mode_constraint_info, mode_constraint_info).
+:- mode true_var(func(in) = out is det, in, in, out, in, out) is det.
+
+true_var(F, V, !C, !MCI) :-
+ mode_constraint_var(F(V), CV, !MCI),
+ !:C = !.C ^ var(CV).
+
+:- pred false_var(func(prog_var) = rep_var, prog_var, mode_constraint,
+ mode_constraint, mode_constraint_info, mode_constraint_info).
+:- mode false_var(func(in) = out is det, in, in, out, in, out) is det.
+
+false_var(F, V, !C, !MCI) :-
+ mode_constraint_var(F(V), CV, !MCI),
+ !:C = !.C ^ not_var(CV).
+
+:- pred ignore(prog_var::in, mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+ignore(_, !C, !MCI).
+
+:- pred call_in(goal_path::in, prog_var::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+call_in(Path, Var, !C, !MCI) :-
+ mode_constraint_var(Var `at` Path, VarGP, !MCI),
+ mode_constraint_var(out(Var), VarOut, !MCI),
+ !:C = !.C ^ not_var(VarGP) ^ var(VarOut).
+
+:- pred call_out(goal_path::in, prog_var::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+call_out(Path, Var, C0, C, !MCI) :-
+ mode_constraint_var(Var `at` Path, VarGP, !MCI),
+ C1 = C0 ^ var(VarGP),
+ ( C1 \= zero ->
+ C = C1
+ ;
+ C = C0
+ ).
+
+:- type constrain_var == pred(prog_var, mode_constraint, mode_constraint,
+ mode_constraint_info, mode_constraint_info).
+:- inst constrain_var = (pred(in, in, out, in, out) is det).
+
+:- pred mode_constraints__process_inst(module_info::in, inst_graph::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in, (inst)::in, set(prog_var)::in, prog_var::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__process_inst(ModuleInfo, InstGraph, Free, Bound, DoHO, Inst,
+ Seen, Var, !Constraint, !MDI) :-
+ ( Var `set__member` Seen ->
+ true
+ ;
+ ( Inst = defined_inst(InstName) ->
+ inst_lookup(ModuleInfo, InstName, Inst1),
+ mode_constraints__process_inst(ModuleInfo, InstGraph,
+ Free, Bound, DoHO, Inst1, Seen, Var,
+ !Constraint, !MDI)
+ ;
+ mode_constraints__do_process_inst(ModuleInfo,
+ InstGraph, Free, Bound, DoHO, Inst,
+ Seen, Var, !Constraint, !MDI)
+ )
+ ).
+
+:- pred mode_constraints__do_process_inst(module_info::in, inst_graph::in,
+ constrain_var::in(constrain_var), constrain_var::in(constrain_var),
+ bool::in, (inst)::in, set(prog_var)::in, prog_var::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_decl_info::in, mode_decl_info::out) is det.
+
+mode_constraints__do_process_inst(ModuleInfo, InstGraph, Free, Bound, DoHO,
+ Inst, Seen, Var, !Constraint, !MDI) :-
+ update_mc_info((pred(C::out, S0::in, S::out) is det :-
+ (
+ ( Inst = any(_)
+ ; Inst = bound(_, _)
+ ; Inst = ground(_, _)
+ )
+ ->
+ Bound(Var, !.Constraint, C, S0, S)
+ ;
+ ( Inst = free ; Inst = free(_) )
+ ->
+ Free(Var, !.Constraint, C, S0, S)
+ ;
+ C = !.Constraint,
+ S = S0
+ )), !:Constraint, !MDI),
+
+ map__lookup(InstGraph, Var, node(Functors, _)),
+ map__foldl2(
+ (pred(ConsId::in, Vs::in, C0::in, C::out, S0::in, S::out)
+ is det :-
+ ( Inst = bound(_, BIs) ->
+ ( cons_id_in_bound_insts(ConsId, BIs, Insts) ->
+ assoc_list__from_corresponding_lists(Vs,
+ Insts, VarInsts),
+ list__foldl2((pred((V - I)::in, C1::in, C2::out,
+ T0::in, T::out) is det :-
+ mode_constraints__process_inst(
+ ModuleInfo, InstGraph,
+ Free, Bound, DoHO, I,
+ Seen `set__insert` Var,
+ V, C1, C2, T0, T)
+ ), VarInsts, C0, C, S0, S)
+ ;
+ C = C0,
+ S = S0
+ )
+ ;
+ list__foldl2(mode_constraints__process_inst(
+ ModuleInfo, InstGraph, Free, Bound, DoHO, Inst,
+ Seen `set__insert` Var), Vs, C0, C, S0, S)
+ )), Functors, !Constraint, !MDI),
+
+ (
+ DoHO = yes,
+ Inst = ground(_, higher_order(pred_inst_info(_, ArgModes, _)))
+ ->
+ HoModes0 = !.MDI ^ ho_modes,
+ update_mc_info(get_prog_var_level(Var), VarLevel, !MDI),
+ multi_map__set(HoModes0, VarLevel, ArgModes, HoModes),
+ !:MDI = !.MDI ^ ho_modes := HoModes
+ ;
+ true
+ ).
+
+:- pred mode_constraints__process_clauses_info(module_info::in,
+ list(pred_id)::in, clauses_info::in, clauses_info::out, inst_graph::in,
+ ho_modes::in, mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out, io__state::di,
+ io__state::uo) is det.
+
+mode_constraints__process_clauses_info(ModuleInfo, SCC, !ClausesInfo,
+ InstGraph, HOModes0, !Constraint, !ConstraintInfo, !IO) :-
+ clauses_info_varset(!.ClausesInfo, VarSet0),
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ ( VeryVerbose = yes ->
+ inst_graph__dump(InstGraph, VarSet0, !IO)
+ ;
+ true
+ ),
+
+ clauses_info_headvars(!.ClausesInfo, HeadVars),
+ map__foldl2(input_output_constraints(HeadVars, InstGraph),
+ InstGraph, !Constraint, !ConstraintInfo),
+
+ clauses_info_clauses(!.ClausesInfo, Clauses),
+ list__map(pred(clause(_, Goal, _, _)::in, Goal::out) is det, Clauses,
+ Goals),
+ DisjGoal = disj(Goals),
+ EmptyGoalPath = [],
+ AtomicGoals0 = set__init,
+ Info0 = goal_constraints_info(ModuleInfo, SCC, InstGraph, HeadVars,
+ VarSet0, AtomicGoals0, !.ConstraintInfo, HOModes0,
+ map__init),
+ NonLocals = set__list_to_set(HeadVars),
+ GoalVars = set__sorted_list_to_set(map__sorted_keys(InstGraph)),
+
+ goal_constraints_2(EmptyGoalPath, NonLocals, GoalVars, _CanSucceed,
+ DisjGoal, _, !Constraint, Info0, Info1),
+
+ % DMO justify this or eliminate it
+ % constrict_to_vars(HeadVars, GoalVars, [], !Constraint,
+ % Info1, Info2),
+ Info2 = Info1,
+
+ % robdd_to_dot(!.Constraint, Info2 ^ prog_varset,
+ % Info2 ^ mc_info, "before_higher_order.dot, !IO"),
+ % io__flush_output(!IO),
+
+ higher_order_call_constraints(!Constraint, Info2, Info),
+
+ % robdd_to_dot(!.Constraint, Info ^ prog_varset,
+ % Info ^ mc_info, "after_higher_order.dot", !IO),
+ % io__flush_output(!IO),
+
+ clauses_info_set_varset(Info ^ prog_varset, !ClausesInfo),
+ !:ConstraintInfo = Info ^ mc_info.
+
+ % 1.2.1 Input output constraints.
+ % These constraints relate the relationships between the above
+ % variables and relationships of boundedness on input and output.
+:- pred input_output_constraints(list(prog_var)::in, inst_graph::in,
+ prog_var::in, inst_graph__node::in,
+ mode_constraint::in, mode_constraint::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+input_output_constraints(HeadVars, InstGraph, V, Node, !Constraint, !MCI) :-
+ % For each node V not reachable from an argument node, add
+ % Vin = 0
+ inst_graph__top_level_node(InstGraph, V, TopLevel),
+ mode_constraint_var(in(V), V_in, !MCI),
+ mode_constraint_var(out(V), V_out, !MCI),
+ mode_constraint_var(V `at` [], V_, !MCI),
+ ( TopLevel `member` HeadVars ->
+ % For each variable V in the instantiation graph, add
+ % (Vout = Vin + V), ~(Vin * V)
+ !:Constraint = !.Constraint ^
+ io_constraint(V_in, V_out, V_)
+ ;
+ !:Constraint = !.Constraint ^
+ not_var(V_in) ^ eq_vars(V_out, V_)
+ ),
+
+ % For each node V in the graph with child f with child W, add
+ % Wout -> Vout, Win -> Vin
+ Node = node(Functors, _),
+ map__values(Functors, Children0),
+ list__condense(Children0, Children),
+ list__foldl2((pred(W::in, Cs0::in, Cs::out, S0::in, S::out) is det :-
+ ( W = V ->
+ Cs = Cs0,
+ S = S0
+ ;
+ mode_constraint_var(in(W), W_in, S0, S1),
+ mode_constraint_var(out(W), W_out, S1, S),
+ Cs = Cs0 ^ imp_vars(W_out, V_out)
+ ^ imp_vars(W_in, V_in)
+ )
+ ), Children, !Constraint, !MCI).
+
+:- type can_succeed == bool.
+
+:- pred goal_constraints(set(prog_var)::in, can_succeed::out, hlds_goal::in,
+ hlds_goal::out, mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+goal_constraints(ParentNonLocals, CanSucceed, GoalExpr0 - GoalInfo0,
+ GoalExpr - GoalInfo, !Constraint, !GCInfo) :-
+ ( goal_is_atomic(GoalExpr0) ->
+ add_atomic_goal(GoalPath, !GCInfo)
+ ;
+ true
+ ),
+
+ goal_info_get_goal_path(GoalInfo0, GoalPath),
+ goal_info_get_occurring_vars(GoalInfo0, Vars),
+
+ % Number the vars we want to keep for this goal.
+ % XXX
+ list__foldl((pred(V::in, S0::in, S::out) is det :-
+ get_var(V `at` GoalPath, _, S0, S)
+ ), set__to_sorted_list(Vars), !GCInfo),
+ save_thresh(Threshold, !GCInfo),
+
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+
+ InstGraph = !.GCInfo ^ inst_graph,
+ NonLocalReachable = solutions_set(inst_graph__reachable_from_list(
+ InstGraph, to_sorted_list(NonLocals))),
+ LocalVars = Vars `difference` NonLocalReachable,
+
+ ( update_mc_info(using_simple_mode_constraints, !GCInfo) ->
+ % With simple mode constraints, it is more efficient to do this
+ % constraint before doing the goal constraints.
+ constrain_local_vars(LocalVars, GoalPath, !Constraint, !GCInfo)
+ ;
+ true
+ ),
+
+ goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed, GoalExpr0,
+ GoalExpr, !Constraint, !GCInfo),
+
+ ( update_mc_info(using_simple_mode_constraints, !GCInfo) ->
+ true
+ ;
+ constrain_local_vars(LocalVars, GoalPath, !Constraint, !GCInfo)
+ ),
+
+ % DEBUGGING CODE
+ % ModuleInfo = !GCInfo ^ module_info,
+ % ProgVarset = !GCInfo ^ prog_varset,
+ % functor(GoalExpr, Functor, _),
+ % unsafe_perform_io(io__format("\nFunctor: %s\n", [s(Functor)])),
+ % unsafe_perform_io(dump_constraints(ModuleInfo, ProgVarset,
+ % !.Constraint)),
+
+ % DMO document
+ % constrict_to_vars(set__to_sorted_list(NonLocals), Vars,
+ % GoalPath, !Constraint, !GCInfo)
+
+ % DEBUGGING CODE
+ % size(Constraint1, NumNodes1, Depth1),
+ % unsafe_perform_io(io__format(
+ % "Pre restrict Size: %d, Depth: %d\n",
+ % [i(NumNodes1), i(Depth1)])),
+ % unsafe_perform_io(io__flush_output),
+
+ !:Constraint = restrict_threshold(Threshold, !.Constraint),
+
+ % DEBUGGING CODE
+ % size(Constraint2, NumNodes2, Depth2),
+ % unsafe_perform_io(io__format(
+ % "Post restrict Size: %d, Depth: %d\n",
+ % [i(NumNodes2), i(Depth2)])),
+ % unsafe_perform_io(io__flush_output),
+
+ constrain_non_occurring_vars(CanSucceed, ParentNonLocals, Vars,
+ GoalPath, !Constraint, !GCInfo),
+
+ % DEBUGGING CODE
+ % unsafe_perform_io(dump_constraints(ModuleInfo, ProgVarset,
+ % !.Constraint)),
+ % goal_info_set_mode_constraint(GoalInfo0, !.Constraint, GoalInfo).
+
+ GoalInfo = GoalInfo0.
+
+% :- pragma promise_pure(goal_constraints_2/9).
+
+:- pred goal_constraints_2(goal_path::in, set(prog_var)::in,
+ set(prog_var)::in, can_succeed::out, hlds_goal_expr::in,
+ hlds_goal_expr::out, mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+goal_constraints_2(GoalPath, NonLocals, _, CanSucceed, conj(Goals0),
+ conj(Goals), !Constraint, !GCInfo) :-
+ multi_map__init(Usage0),
+
+ Usage = list__foldl(func(G, U0) =
+ list__foldl((func(V, U1) = U :-
+ multi_map__set(U1, V, goal_path(G), U)),
+ set__to_sorted_list(vars(G)), U0),
+ Goals0, Usage0),
+
+ known_vars(ensure_normalised(!.Constraint), KnownTrue, KnownFalse),
+
+ % Generate conj constraints for known vars first since these should be
+ % more efficient and provide lots of useful information for the subgoal
+ % constraints.
+ conj_constraints(yes, KnownTrue, KnownFalse, GoalPath, Usage,
+ !Constraint, !GCInfo),
+
+ conj_subgoal_constraints(NonLocals, CanSucceed, !Constraint,
+ Goals0, Goals, !GCInfo),
+
+ % Generate the rest of the constraints.
+ conj_constraints(no, KnownTrue, KnownFalse, GoalPath, Usage,
+ !Constraint, !GCInfo).
+
+goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed, disj(Goals0),
+ disj(Goals), !Constraint, !GCInfo) :-
+ disj_constraints(NonLocals, CanSucceed, !Constraint, Goals0, Goals,
+ [], DisjunctPaths, !GCInfo),
+ list__foldl2((pred(V::in, Cons0::in, Cons::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ list__foldl2((pred(Path::in, C0::in, C::out, in, out) is det -->
+ get_var(V `at` Path, VPath),
+ { C = C0 ^ eq_vars(Vgp, VPath) }
+ ), DisjunctPaths, Cons0, Cons)
+ ), set__to_sorted_list(Vars), !Constraint, !GCInfo).
+
+goal_constraints_2(GoalPath, _NonLocals, _, CanSucceed, GoalExpr0, GoalExpr,
+ !Constraint, !GCInfo) :-
+ GoalExpr0 = unify(Var, RHS0, _, _, _),
+ unify_constraints(Var, GoalPath, RHS0, RHS, !Constraint, !GCInfo),
+ GoalExpr = GoalExpr0 ^ unify_rhs := RHS,
+ CanSucceed = yes. % XXX Can we be more precise here?
+
+goal_constraints_2(GoalPath, _NonLocals, _, CanSucceed, GoalExpr, GoalExpr,
+ !Constraint, !GCInfo) :-
+ GoalExpr = call(PredId, _, Args, _, _, _),
+ SCC = !.GCInfo ^ scc,
+ InstGraph = !.GCInfo ^ inst_graph,
+ ModuleInfo = !.GCInfo ^ module_info,
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+
+ CanSucceed = ( pred_can_succeed(PredInfo) -> yes ; no ),
+
+ ( PredId `list__member` SCC ->
+ % This is a recursive call.
+ % XXX we currently assume that all recursive calls are to the
+ % same mode of the predicate.
+ pred_info_clauses_info(PredInfo, ClausesInfo),
+ clauses_info_headvars(ClausesInfo, HeadVars),
+ call_constraints(GoalPath, PredId, HeadVars, Args,
+ !Constraint, !GCInfo)
+ ;
+ % This is a non-recursive call.
+ ( pred_has_mode_decl(ModuleInfo, PredId) ->
+ % The predicate has mode declarations so use them
+ % to obtain the constraints for the call.
+
+ pred_info_procedures(PredInfo, ProcTable),
+ map__values(ProcTable, ProcInfos),
+ update_md_info((pred(C::out, S0::in, S::out) is det :-
+ list__foldl2(
+ mode_constraints__process_mode_decl_for_proc(
+ ModuleInfo, InstGraph, Args,
+ ignore,
+ call_in(GoalPath), no,
+ false_var(goal_path(GoalPath)),
+ call_out(GoalPath), yes
+ ), ProcInfos, zero, C, S0, S)),
+ CallConstraint, !GCInfo)
+
+ ;
+ % The called predicate is from a lower (i.e. already
+ % mode-analysed) SCC, but does not have any mode
+ % declarations.
+ ArgModes = PredInfo ^ modes,
+ PredInstGraph = PredInfo ^ inst_graph_info
+ ^ interface_inst_graph,
+ pred_info_clauses_info(PredInfo, PredClausesInfo),
+ clauses_info_headvars(PredClausesInfo, PredHeadVars),
+ solutions((pred((V - W)::out) is nondet :-
+ inst_graph__corresponding_nodes_from_lists(
+ PredInstGraph, InstGraph, PredHeadVars,
+ Args, V, W)
+ ), CorrespondingNodes),
+ list__foldl2((pred(ArgMap::in, Cn0::in, Cn::out,
+ S0::in, S::out) is det :-
+ ArgMap = InArgs - OutArgs,
+ list__foldl2((pred((V - W)::in, C0::in, C::out,
+ T0::in, T::out) is det :-
+ get_var(W `at` GoalPath, Wgp, T0, T1),
+ get_var(out(W), Wout, T1, T),
+ ( map__lookup(InArgs, V, yes) ->
+ C = C0 ^ var(Wout)
+ ^ not_var(Wgp)
+ ; map__lookup(OutArgs, V, yes) ->
+ C = C0 ^ var(Wgp)
+ ;
+ C = C0 ^ not_var(Wgp)
+ )
+ ), CorrespondingNodes, one, Cn1, S0, S),
+ Cn = Cn0 + Cn1
+ ), ArgModes, zero, CallConstraint, !GCInfo)
+ % XXX ArgModes is [] for `odd' - why?
+ ),
+ !:Constraint = !.Constraint * CallConstraint
+ ).
+
+goal_constraints_2(GoalPath, _NonLocals, _Vars, CanSucceed, GoalExpr, GoalExpr,
+ !Constraint, !GCInfo) :-
+ GoalExpr = generic_call(GenericCall, Args, _Modes, _Det),
+ % Note: `_Modes' is invalid for higher-order calls at this point.
+ (
+ GenericCall = higher_order(Var, _, _, _),
+ generic_call_constrain_var(Var, GoalPath, !Constraint,
+ !GCInfo),
+
+ % Record that the argument vars need to be constrained
+ % once we know the higher order mode of the Var we are calling.
+ HoCalls0 = !.GCInfo ^ ho_calls,
+ update_mc_info(get_prog_var_level(Var), VarLevel, !GCInfo),
+ multi_map__set(HoCalls0, VarLevel, GoalPath - Args, HoCalls),
+ !:GCInfo = !.GCInfo ^ ho_calls := HoCalls,
+
+ CanSucceed = yes % XXX should check this
+ ;
+ GenericCall = class_method(Var, _, _, _),
+ generic_call_constrain_var(Var, GoalPath, !Constraint,
+ !GCInfo),
+ error("mode_constraints.m: class_method call in clause")
+ ;
+ GenericCall = unsafe_cast,
+ error("mode_constraints.m: unsafe_cast call NYI")
+ ;
+ GenericCall = aditi_builtin(_, _),
+ error("mode_constraints.m: aditi_builtin call NYI")
+ ).
+
+goal_constraints_2(_,_,_,_,switch(_,_,_),_,_,_,_,_) :-
+ error("mode_constraints.goal_constraints_2: switch (should be disj)").
+
+goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed,
+ not(Goal0), not(Goal), !Constraint, !GCInfo) :-
+ goal_constraints(NonLocals, _, Goal0, Goal, !Constraint, !GCInfo),
+
+ CanSucceed = yes,
+
+ list__foldl2((pred(V::in, C0::in, C::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ get_var(V `at` goal_path(Goal), Vneg),
+ { C = C0 ^ eq_vars(Vgp, Vneg) }
+ ), set__to_sorted_list(Vars), !Constraint, !GCInfo),
+
+ % Make sure the negation doesn't bind any nonlocal variables.
+ negation_constraints(GoalPath, NonLocals, !Constraint, !GCInfo).
+
+goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed, some(A, B, Goal0),
+ some(A, B, Goal), !Constraint, !GCInfo) :-
+ goal_constraints(NonLocals, CanSucceed, Goal0, Goal, !Constraint,
+ !GCInfo),
+
+ list__foldl2((pred(V::in, C0::in, C::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ get_var(V `at` goal_path(Goal), Vexist),
+ { C = C0 ^ eq_vars(Vgp, Vexist) }
+ ), set__to_sorted_list(Vars), !Constraint, !GCInfo).
+
+goal_constraints_2(GoalPath, NonLocals, Vars, CanSucceed,
+ if_then_else(IteNonLocals, Cond0, Then0, Else0),
+ if_then_else(IteNonLocals, Cond, Then, Else),
+ !Constraint, !GCInfo) :-
+
+ % Make sure that the condition doesn't bind any variables that are
+ % non-local to the if-then-else.
+ negation_constraints(goal_path(Cond0), NonLocals,
+ !Constraint, !GCInfo),
+
+ goal_constraints(NonLocals, CanSucceedC, Cond0, Cond, !Constraint,
+ !GCInfo),
+ goal_constraints(NonLocals, CanSucceedT, Then0, Then, !Constraint,
+ !GCInfo),
+ goal_constraints(NonLocals, CanSucceedE, Else0, Else, !Constraint,
+ !GCInfo),
+
+ CanSucceed = (CanSucceedC `and` CanSucceedT) `or` CanSucceedE,
+
+ InstGraph = !.GCInfo ^ inst_graph,
+ NonLocalReachable = solutions(inst_graph__reachable_from_list(
+ InstGraph, to_sorted_list(NonLocals))),
+
+ % Make sure variables have the same bindings in both the then and else
+ % branches.
+ list__foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
+ get_var(V `at` GoalPath, Vgp, S0, S1),
+ get_var(V `at` goal_path(Then0), Vthen, S1, S2),
+ get_var(V `at` goal_path(Else0), Velse, S2, S),
+ C = C0 ^ eq_vars(Vgp, Vthen) ^ eq_vars(Vgp, Velse)
+ ), NonLocalReachable, !Constraint, !GCInfo),
+
+ % Make sure variables are bound in at most one of the cond and then
+ % goals.
+ list__foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
+ get_var(V `at` goal_path(Cond0), Vcond, S0, S1),
+ get_var(V `at` goal_path(Then0), Vthen, S1, S),
+ C = C0 ^ not_both(Vcond, Vthen)
+ ), set__to_sorted_list(vars(Cond0) `set__union` vars(Then0)),
+ !Constraint, !GCInfo),
+
+ % Local variables bound in cond, then or else should be treated as
+ % though they are bound in the ite as well. (Although all such
+ % variables will be local to the ite, the _out constraints still need to
+ % be satisfied.)
+ Locals = to_sorted_list(
+ Vars `difference` sorted_list_to_set(NonLocalReachable)),
+ list__foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
+ get_var(V `at` goal_path(Cond), Vcond, S0, S1),
+ get_var(V `at` goal_path(Then), Vthen, S1, S2),
+ get_var(V `at` goal_path(Else), Velse, S2, S3),
+ get_var(V `at` GoalPath, Vgp, S3, S),
+ Vs = list_to_set([Vcond, Vthen, Velse]),
+ C = C0 ^ disj_vars_eq(Vs, Vgp)
+ ), Locals, !Constraint, !GCInfo).
+
+goal_constraints_2(_,_,_,_,foreign_proc(_,_,_,_,_,_),_,_,_,_,_) :-
+ error("mode_constraints.goal_constraints_2: foreign_proc NYI").
+goal_constraints_2(_,_,_,_,par_conj(_),_,_,_,_,_) :-
+ error("mode_constraints.goal_constraints_2: par_conj NYI").
+goal_constraints_2(_,_,_,_,shorthand(_),_,_,_,_,_) :-
+ error("mode_constraints.goal_constraints_2: shorthand").
+
+ % Constraints for the conjunction. If UseKnownVars = yes, generate
+ % constraints only for the vars in KnownVars, otherwise generate
+ % constraints only for the vars _not_ is KnownVars.
+:- pred conj_constraints(bool::in, mode_constraint_vars::in,
+ mode_constraint_vars::in, goal_path::in,
+ multi_map(prog_var, goal_path)::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+conj_constraints(UseKnownVars, KnownTrue, KnownFalse, GoalPath, UsageMap,
+ !Constraint, !GCInfo) :-
+ UsageList = map__to_assoc_list(UsageMap), % XXX needed for deep profiler
+ list__foldl2(conj_constraints_process_var(UseKnownVars,
+ KnownTrue, KnownFalse, GoalPath),
+ UsageList, !Constraint, !GCInfo).
+
+:- pred conj_constraints_process_var(bool::in, mode_constraint_vars::in,
+ mode_constraint_vars::in, goal_path::in,
+ pair(prog_var, list(goal_path))::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+conj_constraints_process_var(UseKnownVars, KnownTrue, KnownFalse, GoalPath,
+ Var - Paths, !Constraint, !GCInfo) :-
+ list__map_foldl((pred(P::in, CV::out, in, out) is det -->
+ get_var(Var `at` P, CV)
+ ), Paths, ConstraintVars, !GCInfo),
+ get_var(Var `at` GoalPath, VConj, !GCInfo),
+ ConstraintVarSet = list_to_set(ConstraintVars),
+
+ % If UseKnownVars = yes we want to only generate the constraints
+ % which are 2-sat. If UseKnownVars = no, we generate the other
+ % constraints.
+ ( KnownFalse `contains` VConj ->
+ ( UseKnownVars = yes ->
+ !:Constraint = !.Constraint ^
+ conj_not_vars(ConstraintVarSet)
+ ;
+ true
+ )
+ ; KnownTrue `contains` VConj ->
+ ( ConstraintVars = [] ->
+ !:Constraint = zero
+ ; ConstraintVars = [ConstraintVar] ->
+ ( UseKnownVars = yes ->
+ !:Constraint = !.Constraint
+ ^ var(ConstraintVar)
+ ;
+ true
+ )
+ ; ConstraintVars = [ConstraintVar1, ConstraintVar2] ->
+ ( UseKnownVars = yes ->
+ !:Constraint = !.Constraint
+ ^ neq_vars(ConstraintVar1,
+ ConstraintVar2)
+ ;
+ true
+ )
+ ;
+ ( UseKnownVars = yes ->
+ true
+ ;
+ !:Constraint = !.Constraint
+ ^ at_most_one_of(ConstraintVarSet)
+ ^ disj_vars_eq(ConstraintVarSet, VConj)
+ )
+ )
+ ;
+ ( UseKnownVars = yes ->
+ true
+ ;
+ !:Constraint = !.Constraint
+ ^ at_most_one_of(ConstraintVarSet)
+ ^ disj_vars_eq(ConstraintVarSet, VConj)
+ )
+ ).
+
+:- pred conj_subgoal_constraints(set(prog_var)::in, can_succeed::out,
+ mode_constraint::in, mode_constraint::out,
+ hlds_goals::in, hlds_goals::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+conj_subgoal_constraints(_, yes, !Constraint, [], [], !GCInfo).
+conj_subgoal_constraints(NonLocals, CanSucceed, !Constraint,
+ [Goal0 | Goals0], [Goal | Goals], !GCInfo) :-
+ goal_constraints(NonLocals, CanSucceed0, Goal0, Goal, !Constraint,
+ !GCInfo),
+ conj_subgoal_constraints(NonLocals, CanSucceed1, !Constraint,
+ Goals0, Goals, !GCInfo),
+ CanSucceed = CanSucceed0 `bool__and` CanSucceed1.
+
+:- pred disj_constraints(set(prog_var)::in, can_succeed::out,
+ mode_constraint::in, mode_constraint::out,
+ hlds_goals::in, hlds_goals::out,
+ list(goal_path)::in, list(goal_path)::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+disj_constraints(_, no, !Constraint, [], [], Paths, Paths, !GCInfo).
+disj_constraints(NonLocals, CanSucceed, !Constraint,
+ [Goal0 | Goals0], [Goal | Goals], Paths0, Paths, !GCInfo) :-
+ goal_constraints(NonLocals, CanSucceed0, Goal0, Goal,
+ !Constraint, !GCInfo),
+ disj_constraints(NonLocals, CanSucceed1, !Constraint,
+ Goals0, Goals, [goal_path(Goal) | Paths0], Paths, !GCInfo),
+ CanSucceed = CanSucceed0 `bool__or` CanSucceed1.
+
+ % See 1.2.3 The literals themselves
+:- pred unify_constraints(prog_var::in, goal_path::in, unify_rhs::in,
+ unify_rhs::out, mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+unify_constraints(A, GoalPath, RHS, RHS, !Constraint, !GCInfo) :-
+ RHS = var(B),
+ InstGraph = !.GCInfo ^ inst_graph,
+ Generator =
+ (pred((V - W)::out) is multi :-
+ inst_graph__corresponding_nodes(InstGraph, A, B, V, W)
+ ),
+ Accumulator =
+ (pred((V - W)::in, C0::in, C::out, S0::in, S::out) is det :-
+ get_var(out(V), Vout, S0, S1),
+ get_var(out(W), Wout, S1, S2),
+ get_var(V `at` GoalPath, Vgp, S2, S3),
+ get_var(W `at` GoalPath, Wgp, S3, S),
+ C = C0 ^ eq_vars(Vout, Wout) ^ not_both(Vgp, Wgp)
+ ),
+ aggregate2(Generator, Accumulator, !Constraint, !GCInfo),
+ get_var(out(A), Aout, !GCInfo),
+ !:Constraint = !.Constraint ^ var(Aout),
+
+ HoModes0 = !.GCInfo ^ ho_modes,
+ update_mc_info(share_ho_modes(A, B, HoModes0), HoModes, !GCInfo),
+ !:GCInfo = !.GCInfo ^ ho_modes := HoModes.
+
+unify_constraints(A, GoalPath, RHS, RHS, !Constraint, !GCInfo) :-
+ RHS = functor(_ConsId, _IsExistConstruct, Args),
+ get_var(out(A), Aout, !GCInfo),
+ !:Constraint = !.Constraint ^ var(Aout),
+ ( update_mc_info(using_simple_mode_constraints, !GCInfo) ->
+ % In the simple system a var-functor unification must be either
+ % a construction or a deconstruction.
+ list__map_foldl(
+ ( pred(ProgVar::in, RepVar::out, S0::in, S::out)
+ is det :-
+ get_var(ProgVar `at` GoalPath, RepVar, S0, S)
+ ), Args, ArgsGp0, !GCInfo),
+ ArgsGp = list_to_set(ArgsGp0),
+ get_var(A `at` GoalPath, Agp, !GCInfo),
+ ( remove_least(ArgsGp, Arg1gp, ArgsGp1) ->
+ !:Constraint = !.Constraint
+ ^ neq_vars(Arg1gp, Agp)
+ ^ fold(eq_vars(Arg1gp), ArgsGp1)
+ ;
+ !:Constraint = !.Constraint
+ )
+ %{ Constraint = Constraint1 *
+ % ( one ^ var(Agp) ^ conj_not_vars(ArgsGp)
+ % + one ^ not_var(Agp) ^ conj_vars(ArgsGp)
+ % ) }
+ ;
+ InstGraph = !.GCInfo ^ inst_graph,
+ inst_graph__foldl_reachable_from_list2(
+ ( pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
+ ( V \= A ->
+ get_var(V `at` GoalPath, Vgp, S0, S),
+ C = C0 ^ not_var(Vgp)
+ ;
+ C = C0,
+ S = S0
+ )
+ ), InstGraph, Args, !Constraint, !GCInfo)
+ ).
+
+unify_constraints(Var, GoalPath, RHS0, RHS, !Constraint, !GCInfo) :-
+ RHS0 = lambda_goal(_, _, _, _, NonLocals, LambdaVars, Modes, _, Goal0),
+ InstGraph = !.GCInfo ^ inst_graph,
+
+ % Variable Var is made ground by this goal.
+ inst_graph__foldl_reachable2(
+ ( pred(V::in, Cn0::in, Cn::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ { Cn = Cn0 ^ var(Vgp) }
+ ), InstGraph, Var, !Constraint, !GCInfo),
+
+ % The lambda NonLocals are not bound by this goal.
+ inst_graph__foldl_reachable_from_list2(
+ ( pred(V::in, Cn0::in, Cn::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ { Cn = Cn0 ^ not_var(Vgp) }
+ ), InstGraph, NonLocals, !Constraint, !GCInfo),
+
+ % Record the higher-order mode of this lambda goal.
+ HoModes0 = !.GCInfo ^ ho_modes,
+ update_mc_info(get_prog_var_level(Var), VarLevel, !GCInfo),
+ multi_map__set(HoModes0, VarLevel, Modes, HoModes),
+ !:GCInfo = !.GCInfo ^ ho_modes := HoModes,
+
+ % Analyse the lambda goal.
+ update_mc_info(enter_lambda_goal(GoalPath), !GCInfo),
+
+ % XXX rather than adding `in' modes for lambda nonlocals we
+ % should just place a constraint `V_prod = 0' for all nodes
+ % reachable from these variables in the lambda goal.
+ ArgModes = list__duplicate(length(NonLocals), in_mode) ++ Modes,
+ LambdaHeadVars = NonLocals ++ LambdaVars,
+ ModuleInfo = !.GCInfo ^ module_info,
+ update_md_info(mode_constraints__process_mode_decl(ModuleInfo,
+ InstGraph, LambdaHeadVars, false_var(initial),
+ true_var(initial), yes, false_var(final), true_var(final), no,
+ ArgModes, zero), DeclConstraint, !GCInfo),
+ !:Constraint = !.Constraint * DeclConstraint,
+
+ % XXX This will put constraints on variables that do not occur in
+ % the lambda goal. These constraints will be removed at the next
+ % restrict, but it would be more efficient not to put them in in the
+ % first place.
+
+ % DEBUGGING CODE
+ % size(!.Constraint, NumNodes3, Depth3, _),
+ % unsafe_perform_io(io__format(
+ % "Pre lambda Size: %d, Depth: %d\n",
+ % [i(NumNodes3), i(Depth3)])),
+
+ update_mc_info((pred(C::out, S0::in, S::out) is det :-
+ map__foldl2(
+ input_output_constraints(LambdaHeadVars,
+ InstGraph),
+ InstGraph, !.Constraint, C, S0, S)
+ ), !:Constraint, !GCInfo),
+
+ % DEBUGGING CODE
+ % size(!.Constraint, NumNodes5, Depth5, _),
+ % unsafe_perform_io(io__format(
+ % "lambda io_constraints Size: %d, Depth: %d\n",
+ % [i(NumNodes5), i(Depth5)])),
+
+ goal_constraints(set__init, _CanSucceed, Goal0, Goal, !Constraint,
+ !GCInfo),
+
+ % DEBUGGING CODE
+ % size(Constraint, NumNodes, Depth),
+ % unsafe_perform_io(io__format(
+ % "post lambda Size: %d, Depth: %d\n",
+ % [i(NumNodes), i(Depth)])),
+
+ update_mc_info(leave_lambda_goal, !GCInfo),
+ RHS = RHS0 ^ rhs_lambda_goal := Goal.
+
+:- pred call_constraints(goal_path::in, pred_id::in, list(prog_var)::in,
+ list(prog_var)::in, mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+call_constraints(GoalPath, PredId, HeadVars, Args, !Constraint, !GCInfo) :-
+ InstGraph = !.GCInfo ^ inst_graph,
+ Generator =
+ (pred((V - W)::out) is nondet :-
+ corresponding_members(HeadVars, Args, X, Y),
+ inst_graph__corresponding_nodes(InstGraph, X, Y, V, W)
+ ),
+ Accumulator =
+ (pred((V - W)::in, C0::in, C::out, S0::in, S::out) is det :-
+ get_var(PredId, V `at` [], V_, S0, S1),
+ get_var(W `at` GoalPath, Wgp, S1, S2),
+ get_var(PredId, in(V), Vin, S2, S3),
+ get_var(out(W), Wout, S3, S),
+ C = C0 ^ eq_vars(V_, Wgp) ^ imp_vars(Vin, Wout)
+ ),
+ aggregate2(Generator, Accumulator, !Constraint, !GCInfo).
+
+:- pred higher_order_call_constraints(mode_constraint::in,
+ mode_constraint::out, goal_constraints_info::in,
+ goal_constraints_info::out) is det.
+
+higher_order_call_constraints(Constraint0, Constraint, !GCInfo) :-
+ HoModes = !.GCInfo ^ ho_modes,
+ HoCalls = !.GCInfo ^ ho_calls,
+ ModuleInfo = !.GCInfo ^ module_info,
+ InstGraph = !.GCInfo ^ inst_graph,
+ update_md_info(
+ (pred(Constraint1::out, in, out) is det -->
+ map__foldl2(
+ (pred(HoVarLevel::in, Calls::in, Cons0::in, Cons::out,
+ in, out) is det -->
+ update_mc_info(set_level_from_var(HoVarLevel)),
+ ( { map__search(HoModes, HoVarLevel, ArgModesList) } ->
+ list__foldl2(
+ (pred((GoalPath - Args)::in, C0::in, C::out,
+ in, out) is det -->
+ list__foldl2(
+ mode_constraints__process_mode_decl(
+ ModuleInfo, InstGraph, Args, ignore,
+ call_in(GoalPath), no,
+ false_var(goal_path(GoalPath)),
+ call_out(GoalPath), no
+ ), ArgModesList, zero, C1),
+ { C = C0 * C1 } ),
+ Calls, Cons0, Cons)
+ ;
+ { Cons = Cons0 }
+ )
+ ), HoCalls, Constraint0, Constraint1)),
+ Constraint, !GCInfo).
+
+:- pred negation_constraints(goal_path::in, set(prog_var)::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+negation_constraints(GoalPath, NonLocals, !Constraint, !GCInfo) :-
+ InstGraph = !.GCInfo ^ inst_graph,
+ inst_graph__foldl_reachable_from_list2(
+ (pred(V::in, C0::in, C::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ { C = C0 ^ not_var(Vgp) }
+ ), InstGraph, to_sorted_list(NonLocals),
+ !Constraint, !GCInfo).
+
+:- pred generic_call_constrain_var(prog_var::in, goal_path::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+generic_call_constrain_var(Var, GoalPath, !Constraint, !GCInfo) :-
+ InstGraph = !.GCInfo ^ inst_graph,
+ inst_graph__foldl_reachable2(
+ ( pred(V::in, C0::in, C::out, in, out) is det -->
+ get_var(out(V), Vout),
+ get_var(V `at` GoalPath, Vgp),
+ { C = C0 ^ var(Vout) ^ not_var(Vgp) }
+ ), InstGraph, Var, !Constraint, !GCInfo).
+
+:- pred constrict_to_vars(list(prog_var)::in, set(prog_var)::in, goal_path::in,
+ mode_constraint::in, mode_constraint::out, goal_constraints_info::in,
+ goal_constraints_info::out) is det.
+
+constrict_to_vars(NonLocals, GoalVars, GoalPath, !Constraint, !Info) :-
+ !:Constraint = restrict_filter(keep_var(NonLocals, GoalVars, GoalPath,
+ !.Info ^ atomic_goals, !.Info ^ inst_graph), !.Info ^ mc_info,
+ !.Constraint).
+
+:- pred keep_var(list(prog_var)::in, set(prog_var)::in, goal_path::in,
+ set(goal_path)::in, inst_graph::in, rep_var::in) is semidet.
+
+keep_var(_, _, _, AtomicGoals, _, _V `at` GoalPath) :-
+ set__member(GoalPath, AtomicGoals).
+keep_var(NonLocals, GoalVars, GoalPath, _AtomicGoals, InstGraph, RepVar) :-
+ (
+ ( RepVar = in(V)
+ ; RepVar = out(V)
+ ; RepVar = V `at` _
+ ),
+ set__member(V, GoalVars)
+ )
+ =>
+ (
+ list__member(NonLocal, NonLocals),
+ inst_graph__reachable(InstGraph, NonLocal, V),
+ \+ (
+ RepVar = _ `at` GoalPath1,
+ list__remove_suffix(GoalPath1, GoalPath, [_|_])
+ )
+ ).
+
+:- type sccs == list(list(pred_id)).
+
+:- pred get_predicate_sccs(module_info::in, sccs::out) is det.
+
+get_predicate_sccs(ModuleInfo, SCCs) :-
+ % Obtain the SCCs for the module.
+ dependency_graph__build_pred_dependency_graph(ModuleInfo, no, DepInfo),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs0),
+
+ % Remove predicates that have mode declarations and place them in
+ % their own ``SCC'' at the end of the list.
+ % Predicates with mode declarations do not need to be processed with
+ % the rest of their SCC since the mode declaration can be used in any
+ % calls to them. Such predicates should be processed last to take
+ % advantage of mode info inferred from other predicates.
+ extract_mode_decl_preds(ModuleInfo, [], SCCs0, SCCs1),
+
+ % We add imported preds to the end of the SCC list, one SCC per pred.
+ % This allows a constraint to be created for each imported pred
+ % based on its mode declarations.
+ add_imported_preds(ModuleInfo, SCCs1, SCCs).
+
+:- pred extract_mode_decl_preds(module_info::in, sccs::in, sccs::in, sccs::out)
+ is det.
+
+extract_mode_decl_preds(_ModuleInfo, DeclaredPreds, [], DeclaredPreds).
+extract_mode_decl_preds(ModuleInfo, DeclaredPreds0, [SCC0 | SCCs0], SCCs) :-
+ list__filter(pred_has_mode_decl(ModuleInfo), SCC0, Declared, SCC),
+ ( Declared = [] ->
+ DeclaredPreds = DeclaredPreds0
+ ;
+ list__foldl((pred(Pred::in, Preds0::in, Preds::out) is det :-
+ Preds = [[Pred] | Preds0]
+ ), Declared, DeclaredPreds0, DeclaredPreds)
+ ),
+ extract_mode_decl_preds(ModuleInfo, DeclaredPreds, SCCs0, SCCs1),
+ ( SCC = [] ->
+ SCCs = SCCs1
+ ;
+ SCCs = [SCC | SCCs1]
+ ).
+
+:- pred pred_has_mode_decl(module_info::in, pred_id::in) is semidet.
+
+pred_has_mode_decl(ModuleInfo, PredId) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ \+ pred_info_infer_modes(PredInfo).
+
+:- pred add_imported_preds(module_info::in, sccs::in, sccs::out) is det.
+
+add_imported_preds(ModuleInfo, SCCs0, SCCs) :-
+ module_info_predids(ModuleInfo, PredIds),
+ list__filter_map((pred(PredId::in, [PredId]::out) is semidet :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_is_imported(PredInfo)
+ ), PredIds, ImportedPredIds),
+ SCCs = SCCs0 ++ ImportedPredIds.
+
+:- pred cons_id_in_bound_insts(cons_id::in, list(bound_inst)::in,
+ list(inst)::out) is semidet.
+
+cons_id_in_bound_insts(ConsId, [functor(ConsId0, Insts0) | BIs], Insts) :-
+ ( equivalent_cons_ids(ConsId0, ConsId) ->
+ Insts = Insts0
+ ;
+ cons_id_in_bound_insts(ConsId, BIs, Insts)
+ ).
+
+:- pred equivalent_cons_ids(cons_id, cons_id).
+:- mode equivalent_cons_ids(in, in) is semidet.
+
+equivalent_cons_ids(ConsIdA, ConsIdB) :-
+ (
+ ConsIdA = cons(NameA, ArityA),
+ ConsIdB = cons(NameB, ArityB)
+ ->
+ ArityA = ArityB,
+ equivalent_sym_names(NameA, NameB)
+ ;
+ ConsIdA = ConsIdB
+ ).
+
+:- pred equivalent_sym_names(sym_name, sym_name).
+:- mode equivalent_sym_names(in, in) is semidet.
+
+equivalent_sym_names(unqualified(S), unqualified(S)).
+equivalent_sym_names(qualified(_, S), unqualified(S)).
+equivalent_sym_names(unqualified(S), qualified(_, S)).
+equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :-
+ equivalent_sym_names(QualA, QualB).
+
+%------------------------------------------------------------------------%
+
+% For local variables, V_ must be equivalent to Vgp.
+
+:- pred constrain_local_vars(set(prog_var)::in, goal_path::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+constrain_local_vars(Locals, GoalPath, !Constraint, !GCInfo) :-
+ list__foldl2((pred(V::in, C0::in, C::out, in, out) is det -->
+ get_var(V `at` GoalPath, Vgp),
+ get_var(out(V), Vout),
+ ( update_mc_info(using_simple_mode_constraints) ->
+ % For simple_mode_constraints, local variables must all be
+ % bound within the goal.
+ { C = C0 ^ var(Vgp) ^ var(Vout) }
+ ;
+ { C = C0 ^ eq_vars(Vgp, Vout) }
+ )
+ ), to_sorted_list(Locals), !Constraint, !GCInfo).
+
+:- pred constrain_non_occurring_vars(can_succeed::in, set(prog_var)::in,
+ set(prog_var)::in, goal_path::in,
+ mode_constraint::in, mode_constraint::out,
+ goal_constraints_info::in, goal_constraints_info::out) is det.
+
+constrain_non_occurring_vars(no, _, _, _, !Constraint, !GCInfo).
+constrain_non_occurring_vars(yes, ParentNonLocals, OccurringVars, GoalPath,
+ !Constraint, !GCInfo) :-
+ InstGraph = !.GCInfo ^ inst_graph,
+ Generator =
+ (pred(V::out) is nondet :-
+ set__member(U, ParentNonLocals),
+ inst_graph__reachable(InstGraph, U, V),
+ \+ set__member(V, OccurringVars)
+ ),
+ Accumulator =
+ (pred(V::in, Vs0::in, Vs::out, in, out) is det -->
+ get_var(V `at` GoalPath, VGP),
+ { Vs = Vs0 `insert` VGP }
+ ),
+ aggregate2(Generator, Accumulator, empty_vars_set, NonOccurringVars,
+ !GCInfo),
+ !:Constraint = !.Constraint ^ conj_not_vars(NonOccurringVars).
+
+% aggregate2((pred(V::out) is nondet :-
+% set__member(U, ParentNonLocals),
+% inst_graph__reachable(InstGraph, U, V),
+% \+ set__member(V, OccurringVars)
+% ), (pred(V::in, C0::in, C::out, in, out) is det -->
+% get_var(V `at` GoalPath, VGP),
+% { C = C0 ^ not_var(VGP) }
+% ), Constraint0, Constraint).
+
+%------------------------------------------------------------------------%
+
+:- pred share_ho_modes(prog_var::in, prog_var::in, ho_modes::in, ho_modes::out,
+ mode_constraint_info::in, mode_constraint_info::out) is det.
+
+share_ho_modes(VarA, VarB, HoModes0, HoModes, !MCI) :-
+ get_prog_var_level(VarA, A, !MCI),
+ get_prog_var_level(VarB, B, !MCI),
+ ( map__search(HoModes0, A, AModes) ->
+ ( map__search(HoModes0, B, BModes) ->
+ Modes = list__sort_and_remove_dups(
+ AModes `list__append` BModes),
+ map__det_update(HoModes0, A, Modes, HoModes1),
+ map__det_update(HoModes1, B, Modes, HoModes)
+ ;
+ map__det_insert(HoModes0, B, AModes, HoModes)
+ )
+ ; map__search(HoModes0, B, BModes) ->
+ map__det_insert(HoModes0, A, BModes, HoModes)
+ ;
+ HoModes = HoModes0
+ ).
+
+%------------------------------------------------------------------------%
+%------------------------------------------------------------------------%
+
+:- pred arg_modes_map(list(prog_var)::in, inst_graph::in, mode_constraint::in,
+ mode_constraint_info::in, arg_modes_map::out) is nondet.
+
+arg_modes_map(HeadVars, InstGraph, Constraint0, Info0, ArgModes) :-
+ solutions(inst_graph__reachable_from_list(InstGraph, HeadVars), Vars),
+ list__map_foldl((pred(PV::in, (MV - in(PV))::out, in, out) is det -->
+ mode_constraint_var(in(PV), MV)), Vars, InVars, Info0, Info1),
+ list__map_foldl((pred(PV::in, (MV - out(PV))::out, in, out) is det -->
+ mode_constraint_var(out(PV), MV)), Vars, OutVars, Info0, Info1),
+ MVars = list__sort_and_remove_dups(InVars `list__append` OutVars),
+ MVarKeys = assoc_list__keys(MVars),
+ Constraint = restrict_filter(
+ (pred(V::in) is semidet :- list__member(V, MVarKeys)),
+ ensure_normalised(Constraint0)),
+ ArgModes0 = map__init - map__init,
+ list__foldl2(arg_modes_map_2, MVars, Constraint, _,
+ ArgModes0, ArgModes).
+
+:- pred arg_modes_map_2(pair(mode_constraint_var, rep_var)::in,
+ mode_constraint::in, mode_constraint::out,
+ arg_modes_map::in, arg_modes_map::out) is nondet.
+
+arg_modes_map_2(MV - RV, Constraint0, Constraint, ArgModes0, ArgModes) :-
+ (
+ Constraint = var_restrict_true(MV, Constraint0),
+ Bool = yes
+ ;
+ Constraint = var_restrict_false(MV, Constraint0),
+ Bool = no
+ ),
+ Constraint \= zero,
+ ArgModes0 = InModes0 - OutModes0,
+ (
+ RV = in(PV),
+ ArgModes = map__det_insert(InModes0, PV, Bool) - OutModes0
+ ;
+ RV = out(PV),
+ ArgModes = InModes0 - map__det_insert(OutModes0, PV, Bool)
+ ).
+
+% :- type labelling == map(mode_constraint_var, bool).
+%
+% :- pred labelling(set(mode_constraint_var)::in, mode_constraint::in,
+% labelling::out) is nondet.
+%
+% labelling(Vs, Constraint, Map) :-
+% labelling(Vs, Constraint, TrueVars, FalseVars),
+% Map = true_false_sets_to_labelling_map(TrueVars, FalseVars).
+%
+% % Return a ``fundamental mode'' (i.e. non-implied mode) for the given
+% % mode constraint. This is calculated by computing a minimal model for
+% % the initial insts of the head variables of the predicate.
+% :- pred fundamental_mode(set(mode_constraint_var)::in, mode_constraint::in,
+% mode_constraint::out) is nondet.
+%
+% fundamental_mode(Vs, Constraint0, Constraint) :-
+% minimal_model(Vs, Constraint0, TrueVars, FalseVars),
+%
+% % XXX There's probably a more efficient way to do this.
+% Constraint = Constraint0 * conj_vars(TrueVars) *
+% (~disj_vars(FalseVars)).
+%
+% :- func true_false_sets_to_labelling_map(set(mode_constraint_var),
+% set(mode_constraint_var)) = labelling.
+%
+% true_false_sets_to_labelling_map(TrueVars, FalseVars) =
+% list__foldl(func(V, M) = map__det_insert(M, V, no),
+% set__to_sorted_list(FalseVars),
+% list__foldl(func(V, M) = map__det_insert(M, V, yes),
+% set__to_sorted_list(TrueVars), map__init)).
+%
+% % implied_mode(L0, L1) is true iff mode L0 is implied by mode L1.
+% :- pred implied_mode(labelling::in, labelling::in) is semidet.
+%
+% implied_mode(L0, L1) :-
+% all [V] ( map__member(L1, V, yes) => map__lookup(L0, V, yes) ).
+%
+% :- pred split_constraint_into_modes(pred_id::in, list(prog_var)::in,
+% inst_graph::in, mode_constraint::in, list(labelling)::out,
+% mode_constraint_info::in, mode_constraint_info::out) is det.
+%
+% split_constraint_into_modes(PredId, HeadVars, InstGraph, ModeConstraint0,
+% Labellings) -->
+% { solutions(inst_graph__reachable_from_list(InstGraph, HeadVars),
+% ReachVars) },
+% list__map_foldl((pred(PV::in, MV::out, in, out) is det -->
+% mode_constraint_var(in(PV), MV)
+% ), ReachVars, InVars),
+%
+% get_interesting_vars_for_pred(PredId, InterestingVars),
+% { solutions((pred(Labelling::out) is nondet :-
+% fundamental_mode(set__list_to_set(InVars), ModeConstraint0,
+% ModeConstraint1),
+% labelling(InterestingVars, ModeConstraint1, Labelling)
+% ), Labellings) }.
+
+%------------------------------------------------------------------------%
+%------------------------------------------------------------------------%
+
+:- func goal_path(hlds_goal) = goal_path.
+
+goal_path(_ - GoalInfo) = GoalPath :-
+ goal_info_get_goal_path(GoalInfo, GoalPath).
+
+:- func vars(hlds_goal) = set(prog_var).
+
+vars(_ - GoalInfo) = OccurringVars :-
+ goal_info_get_occurring_vars(GoalInfo, OccurringVars).
+
+%------------------------------------------------------------------------%
+
+ % A predicate can succeed if at least one of its procedures
+ % can succeed.
+:- pred pred_can_succeed(pred_info::in) is semidet.
+
+pred_can_succeed(PredInfo) :-
+ pred_info_procedures(PredInfo, ProcTable),
+ some [ProcInfo] (
+ map__member(ProcTable, _ProcId, ProcInfo),
+ proc_can_succeed(ProcInfo)
+ ).
+
+ % A procedure can possibly succeed if it has no declared determinism or
+ % it has a declared determinism that allows more than zero solutions.
+ % (This is a conservative approximation since we can't use the results
+ % of determinism inference -- it hasn't been run yet.)
+:- pred proc_can_succeed(proc_info::in) is semidet.
+
+proc_can_succeed(ProcInfo) :-
+ proc_info_declared_determinism(ProcInfo, MaybeDet),
+ (
+ MaybeDet = no
+ ;
+ MaybeDet = yes(Detism),
+ determinism_components(Detism, _, SolnCount),
+ SolnCount \= at_most_zero
+ ).
+
+%------------------------------------------------------------------------%
+
+% DEBUGGING CODE
+%
+% :- impure pred conj_to_dot(mode_constraint::in, prog_varset::in,
+% mode_constraint_info::in, io__state::di, io__state::uo) is det.
+%
+% conj_to_dot(MC, VS, CI) -->
+% robdd_to_dot(MC, VS, CI, string__format("conj%d.dot", [i(conjnum)])).
+%
+% :- impure func conjnum = int.
+%
+% :- pragma foreign_code("C",
+% "
+% static MR_Integer conjnum = 0;
+% ").
+%
+% :- pragma foreign_proc("C",
+% conjnum = (N::out),
+% [will_not_call_mercury],
+% "
+% N = conjnum++;
+% ").
+
+%------------------------------------------------------------------------%
Index: compiler/mode_ordering.m
===================================================================
RCS file: compiler/mode_ordering.m
diff -N compiler/mode_ordering.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/mode_ordering.m 16 Dec 2004 01:01:23 -0000
@@ -0,0 +1,553 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2004 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: mode_constraint.m
+% Main author: dmo
+%
+
+:- module check_hlds__mode_ordering.
+
+:- interface.
+
+:- import_module check_hlds__mode_constraint_robdd.
+:- import_module hlds__hlds_module.
+:- import_module hlds__hlds_pred.
+:- import_module hlds__inst_graph.
+
+:- import_module io, list, map.
+
+:- type pred_constraint_info --->
+ pci( % pci: pred_constrain_info
+ mode_constraint,
+ mode_constraint_info
+ ).
+
+:- type pred_constraint_map == map(pred_id, pred_constraint_info).
+
+% Given a top-down list of predicate SCCs, attempt to schedule goals for mode
+% of each predicate, and determine which modes are needed for each predicate.
+
+:- pred mode_ordering(pred_constraint_map::in, list(list(pred_id))::in,
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
+
+:- pred mode_ordering__proc(inst_graph::in, mode_constraint::in,
+ mode_constraint_info::in, module_info::in, pred_constraint_map::in,
+ proc_info::in, proc_info::out) is det.
+
+:- implementation.
+
+:- import_module check_hlds__clause_to_proc.
+:- import_module check_hlds__mode_constraint_robdd.
+:- import_module hlds__hlds_goal.
+:- import_module mode_robdd.
+:- import_module mode_robdd__check.
+:- import_module mode_robdd__tfeir.
+:- import_module mode_robdd__tfeirn.
+:- import_module parse_tree__prog_data.
+
+:- import_module set, stack, std_util, require, relation, assoc_list.
+
+mode_ordering(PredConstraintMap, SCCs, !ModuleInfo, !IO) :-
+ list__foldl(mode_ordering__scc(PredConstraintMap), SCCs, !ModuleInfo),
+ report_mode_errors(!.ModuleInfo, !IO).
+
+:- pred mode_ordering__scc(pred_constraint_map::in, list(pred_id)::in,
+ module_info::in, module_info::out) is det.
+
+mode_ordering__scc(PredConstraintMap, SCC, !ModuleInfo) :-
+ copy_module_clauses_to_procs(SCC, !ModuleInfo),
+ list__foldl(mode_ordering__pred(PredConstraintMap, SCC), SCC,
+ !ModuleInfo).
+
+:- pred mode_ordering__pred(pred_constraint_map::in, list(pred_id)::in,
+ pred_id::in, module_info::in, module_info::out) is det.
+
+mode_ordering__pred(PredConstraintMap, _SCC, PredId, !ModuleInfo) :-
+ % XXX Mode inference NYI.
+ RequestedProcsMap0 = map__init,
+
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+ lookup_pred_constraint(PredConstraintMap, PredId,
+ ModeConstraint0, ModeConstraintInfo),
+ ( pred_info_infer_modes(PredInfo0) ->
+ ( map__search(RequestedProcsMap0, PredId, RequestedProcs) ->
+ list__foldl(mode_ordering__infer_proc(ModeConstraint0,
+ ModeConstraintInfo, !.ModuleInfo,
+ PredConstraintMap),
+ RequestedProcs, PredInfo0, PredInfo)
+ ;
+ % XXX Maybe we should remove the predicate from the
+ % module_info here since it is not used.
+ PredInfo = PredInfo0
+ )
+ ;
+ ProcIds = pred_info_non_imported_procids(PredInfo0),
+ list__foldl(mode_ordering__check_proc(ModeConstraint0,
+ ModeConstraintInfo, !.ModuleInfo,
+ PredConstraintMap),
+ ProcIds, PredInfo0, PredInfo)
+ ),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
+
+:- pred mode_ordering__infer_proc(mode_constraint::in,
+ mode_constraint_info::in, module_info::in, pred_constraint_map::in,
+ mode_constraint::in, pred_info::in, pred_info::out) is det.
+
+mode_ordering__infer_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
+ PredConstraintMap, ModeDeclConstraint, PredInfo0, PredInfo) :-
+ pred_info_create_proc_info_for_mode_decl_constraint(PredInfo0,
+ ModeDeclConstraint, ProcId, PredInfo1),
+ mode_ordering__check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
+ PredConstraintMap, ProcId, PredInfo1, PredInfo).
+
+:- pred mode_ordering__check_proc(mode_constraint::in,
+ mode_constraint_info::in, module_info::in, pred_constraint_map::in,
+ proc_id::in, pred_info::in, pred_info::out) is det.
+
+mode_ordering__check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
+ PredConstraintMap, ProcId, PredInfo0, PredInfo) :-
+ pred_info_proc_info(PredInfo0, ProcId, ProcInfo0),
+ proc_info_head_modes_constraint(ProcInfo0, ModeDeclConstraint),
+ Constraint = Constraint0 * ModeDeclConstraint,
+ InstGraph = PredInfo0 ^ inst_graph_info ^ implementation_inst_graph,
+ mode_ordering__proc(InstGraph, Constraint, ModeConstraintInfo,
+ ModuleInfo, PredConstraintMap, ProcInfo0, ProcInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo).
+
+% Perform mode ordering for a procedure. The ModeConstraint must be constrained
+% to contain just the mode information for this procedure.
+
+mode_ordering__proc(InstGraph, ModeConstraint, ModeConstraintInfo, ModuleInfo,
+ PredConstraintMap, !ProcInfo) :-
+ Info0 = mode_ordering__info(InstGraph,
+ atomic_prodvars_map(ModeConstraint, ModeConstraintInfo),
+ stack__init, ModuleInfo, PredConstraintMap),
+ proc_info_goal(!.ProcInfo, Goal0),
+ mode_ordering__goal(Goal0, Goal, Info0, _Info),
+ proc_info_set_goal(Goal, !ProcInfo).
+
+:- type mode_ordering__info
+ ---> mode_ordering__info(
+ inst_graph :: inst_graph,
+ prodvars_map :: prodvars_map,
+ lambda_nesting :: lambda_path,
+ module_info :: module_info,
+ pred_constraint_map :: pred_constraint_map
+ ).
+
+:- pred enter_lambda_goal(goal_path::in, mode_ordering__info::in,
+ mode_ordering__info::out) is det.
+
+enter_lambda_goal(GoalPath, !MOI) :-
+ LambdaNesting0 = !.MOI ^ lambda_nesting,
+ !:MOI = !.MOI ^ lambda_nesting
+ := stack__push(LambdaNesting0, GoalPath).
+
+:- pred leave_lambda_goal(mode_ordering__info::in, mode_ordering__info::out)
+ is det.
+
+leave_lambda_goal(!MOI) :-
+ LambdaNesting0 = !.MOI ^ lambda_nesting,
+ stack__pop_det(LambdaNesting0, _, LambdaNesting),
+ !:MOI = !.MOI ^ lambda_nesting := LambdaNesting.
+
+:- pred mode_ordering__goal(hlds_goal::in, hlds_goal::out,
+ mode_ordering__info::in, mode_ordering__info::out) is det.
+
+mode_ordering__goal(GoalExpr0 - GoalInfo0, GoalExpr - GoalInfo, !MOI) :-
+ mode_ordering__goal_2(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !MOI).
+
+:- pred mode_ordering__goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
+ hlds_goal_info::in, hlds_goal_info::out,
+ mode_ordering__info::in, mode_ordering__info::out) is det.
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = conj(Goals0),
+ Goal = conj(Goals),
+ list__map_foldl(mode_ordering__goal, Goals0, Goals1, !MOI),
+ mode_ordering__conj(Goals1, Goals),
+ union_mode_vars_sets(Goals, GoalInfo0, GoalInfo1),
+ ConsVars = GoalInfo1 ^ consuming_vars,
+ GoalInfo2 = GoalInfo1 ^ consuming_vars :=
+ ConsVars `difference` GoalInfo1 ^ producing_vars,
+ NeedVars = GoalInfo2 ^ need_visible_vars,
+ GoalInfo = GoalInfo2 ^ need_visible_vars :=
+ NeedVars `difference` GoalInfo2 ^ make_visible_vars.
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = call(PredId, _, Args, _, _, _),
+ Goal = Goal0 ^ call_proc_id := ProcId,
+ set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo1, !MOI),
+ MakeVisibleVars = list_to_set(Args) `intersect` ProdVars,
+
+ find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI),
+ NeedVisibleVars = list_to_set(Args) `intersect` ConsumingVars,
+
+ goal_info_set_consuming_vars(GoalInfo1, ConsumingVars, GoalInfo2),
+ goal_info_set_make_visible_vars(GoalInfo2, MakeVisibleVars,
+ GoalInfo3),
+ goal_info_set_need_visible_vars(GoalInfo3, NeedVisibleVars,
+ GoalInfo).
+
+mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+ Goal0 = generic_call(_GenericCall0, _Args, _Modes0, _Det),
+ error("mode_ordering__goal_2: generic_call NYI").
+
+mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+ Goal0 = switch(_Var, _CanFail0, _Cases0),
+ error("mode_ordering__goal_2: switch").
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = unify(VarA, RHS0, UnifyMode, Unification0, Context),
+ Goal = unify(VarA, RHS, UnifyMode, Unification, Context),
+ set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo1, !MOI),
+ InstGraph = !.MOI ^ inst_graph,
+ (
+ RHS0 = var(VarB),
+ RHS = RHS0,
+ ( ProdVars `contains` VarA ->
+ Unification = assign(VarA, VarB),
+ MakeVisibleVars = make_singleton_set(VarA),
+ NeedVisibleVars = make_singleton_set(VarB)
+ ; ProdVars `contains` VarB ->
+ Unification = assign(VarB, VarA),
+ MakeVisibleVars = make_singleton_set(VarB),
+ NeedVisibleVars = make_singleton_set(VarA)
+ ;
+ Unification = simple_test(VarA, VarB),
+ % XXX may be complicated unify -- need to check.
+ MakeVisibleVars = set__init,
+ NeedVisibleVars = list_to_set([VarA, VarB])
+ ),
+ ConsumingVars = solutions_set((pred(Var::out) is nondet :-
+ inst_graph__corresponding_nodes(InstGraph, VarA, VarB,
+ VarC, VarD),
+ ( ProdVars `contains` VarC ->
+ Var = VarD
+ ; ProdVars `contains` VarD ->
+ Var = VarC
+ ;
+ fail
+ )))
+ ;
+ RHS0 = functor(_ConsId, _IsExistConstruct, ArgVars),
+ RHS = RHS0,
+ ( ProdVars `contains` VarA ->
+ % Unification = construct(VarA, ConsId, ArgVars,
+ % _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
+ Unification = Unification0, % XXX
+ ConsumingVars = set__init,
+ MakeVisibleVars = list_to_set([VarA | ArgVars]),
+ NeedVisibleVars = set__init
+ ;
+ % Unification = deconstruct(VarA, ConsId, ArgVars,
+ % _UniModes, _CanFail, _CanCGC),
+ Unification = Unification0, % XXX
+ ConsumingVars = make_singleton_set(VarA),
+ MakeVisibleVars = list_to_set(ArgVars),
+ NeedVisibleVars = make_singleton_set(VarA)
+ )
+ ;
+ % Unification = construct(VarA, _ConsId, _ArgVars,
+ % _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
+ Unification = Unification0, % XXX
+ RHS0 = lambda_goal(A, B, C, D, NonLocals, LambdaVars, Modes0,
+ H, SubGoal0),
+ Modes = Modes0, % XXX
+ RHS = lambda_goal(A, B, C, D, NonLocals, LambdaVars, Modes,
+ H, SubGoal),
+
+ goal_info_get_goal_path(GoalInfo1, GoalPath),
+ enter_lambda_goal(GoalPath, !MOI),
+ mode_ordering__goal(SubGoal0, SubGoal, !MOI),
+ leave_lambda_goal(!MOI),
+
+ ConsumingVars = solutions_set(
+ inst_graph__reachable_from_list(InstGraph, NonLocals)),
+ MakeVisibleVars = make_singleton_set(VarA),
+ NeedVisibleVars = list_to_set(NonLocals)
+ ),
+ goal_info_set_consuming_vars(GoalInfo1, ConsumingVars, GoalInfo2),
+ goal_info_set_make_visible_vars(GoalInfo2, MakeVisibleVars,
+ GoalInfo3),
+ goal_info_set_need_visible_vars(GoalInfo3, NeedVisibleVars,
+ GoalInfo).
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = disj(Goals0),
+ Goal = disj(Goals),
+ list__map_foldl(mode_ordering__goal, Goals0, Goals, !MOI),
+ mode_ordering__disj(Goals, GoalInfo0, GoalInfo).
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = not(SubGoal0),
+ Goal = not(SubGoal),
+ mode_ordering__goal(SubGoal0, SubGoal, !MOI),
+ goal_info_copy_mode_var_sets(SubGoal ^ snd, GoalInfo0, GoalInfo).
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = some(Vars, CanRemove, SubGoal0),
+ Goal = some(Vars, CanRemove, SubGoal),
+ mode_ordering__goal(SubGoal0, SubGoal, !MOI),
+ goal_info_copy_mode_var_sets(SubGoal ^ snd, GoalInfo0, GoalInfo).
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = if_then_else(Locals, Cond0, Then0, Else0),
+ Goal = if_then_else(Locals, Cond, Then, Else),
+ mode_ordering__goal(Cond0, Cond, !MOI),
+ mode_ordering__goal(Then0, Then, !MOI),
+ mode_ordering__goal(Else0, Else, !MOI),
+ % XXX Ned to make sure that Cond can be scheduled before Then and Else.
+
+ union_mode_vars_sets([Cond, Then], GoalInfo0, GoalInfo1),
+ ConsVars = GoalInfo1 ^ consuming_vars,
+ GoalInfo2 = GoalInfo1 ^ consuming_vars :=
+ ConsVars `difference` GoalInfo1 ^ producing_vars,
+ NeedVars = GoalInfo2 ^ need_visible_vars,
+ GoalInfo3 = GoalInfo2 ^ need_visible_vars :=
+ NeedVars `difference` GoalInfo2 ^ make_visible_vars,
+
+ combine_mode_vars_sets(Else ^ snd, GoalInfo3, GoalInfo).
+
+mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+ Goal0 = foreign_proc(_, _, _, _, _, _),
+ error("mode_ordering__goal_2: pragma_foreign_code NYI").
+
+mode_ordering__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !MOI) :-
+ Goal0 = par_conj(Goals0),
+ Goal = par_conj(Goals),
+ list__map_foldl(mode_ordering__goal, Goals0, Goals, !MOI),
+ union_mode_vars_sets(Goals, GoalInfo0, GoalInfo).
+
+mode_ordering__goal_2(Goal0, _, _, _, !MOI) :-
+ Goal0 = shorthand(_),
+ error("mode_ordering__goal_2: shorthand").
+
+:- pred mode_ordering__disj(hlds_goals::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+mode_ordering__disj([], !GoalInfo).
+mode_ordering__disj([_ - GI | Goals], !GoalInfo) :-
+ goal_info_copy_mode_var_sets(GI, !GoalInfo),
+ list__foldl(mode_ordering__disj_2, Goals, !GoalInfo).
+
+:- pred mode_ordering__disj_2(hlds_goal::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+mode_ordering__disj_2(_ - GI, !GoalInfo) :-
+ combine_mode_vars_sets(GI, !GoalInfo).
+
+:- pred combine_mode_vars_sets(hlds_goal_info::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+combine_mode_vars_sets(GI) -->
+ ProdVars0 =^ producing_vars,
+ ConsumVars0 =^ consuming_vars,
+ MakeVisibleVars0 =^ make_visible_vars,
+ NeedVisibleVars0 =^ need_visible_vars,
+
+ ^producing_vars := ProdVars0 `intersect` GI^producing_vars,
+ ^consuming_vars := ConsumVars0 `union` GI^consuming_vars,
+ ^make_visible_vars := MakeVisibleVars0 `intersect` GI^make_visible_vars,
+ ^need_visible_vars := NeedVisibleVars0 `union` GI^need_visible_vars.
+
+:- pred union_mode_vars_sets(hlds_goals::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+union_mode_vars_sets(Goals) -->
+ list__foldl((pred(Goal::in, in, out) is det -->
+ ProdVars0 =^ producing_vars,
+ ConsumVars0 =^ consuming_vars,
+ MakeVisibleVars0 =^ make_visible_vars,
+ NeedVisibleVars0 =^ need_visible_vars,
+ { Goal = _ - GI },
+
+ ^producing_vars := ProdVars0 `union` GI^producing_vars,
+ ^consuming_vars := ConsumVars0 `union` GI^consuming_vars,
+ ^make_visible_vars := MakeVisibleVars0 `union` GI^make_visible_vars,
+ ^need_visible_vars := NeedVisibleVars0 `union` GI^need_visible_vars
+ ), Goals).
+
+:- pred goal_info_copy_mode_var_sets(hlds_goal_info::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+goal_info_copy_mode_var_sets(GI) -->
+ ^ producing_vars := GI^producing_vars,
+ ^ consuming_vars := GI^consuming_vars,
+ ^ make_visible_vars := GI^make_visible_vars,
+ ^ need_visible_vars := GI^need_visible_vars.
+
+:- pred mode_ordering__conj(hlds_goals::in, hlds_goals::out) is det.
+
+mode_ordering__conj(Goals0, Goals) :-
+ GoalMap = list__foldl((func(G, GM) = map__det_insert(GM, Index, G) :-
+ (
+ G = _ - GI,
+ goal_info_get_goal_path(GI, GP),
+ GP = [conj(Index0) | _]
+ ->
+ Index = Index0
+ ;
+ error("mode_ordering__conj: goal_path error")
+ )), Goals0, map__init),
+
+ ProdMap =
+ map__foldl((func(I, G, PM0) =
+ list__foldl((func(V, PM1) = map__det_insert(PM1, V, I)),
+ set__to_sorted_list(G ^ snd ^ producing_vars), PM0)
+ ), GoalMap, map__init),
+
+ MakeVisMap =
+ map__foldl((func(I, G, MVM0) =
+ list__foldl((func(V, MVM1) = map__set(MVM1, V, I)),
+ % XXX disjunction required!
+ set__to_sorted_list(G ^ snd ^ make_visible_vars), MVM0)
+ ), GoalMap, map__init),
+
+ Relation = map__foldl((func(I, G, R0) = R :-
+ GI = G ^ snd,
+ relation__add_element(R0, I, Key0, R1),
+ R2 = list__foldl((func(V, R10) = R12 :-
+ ( Index1 = map__search(ProdMap, V) ->
+ relation__add_element(R10, Index1, Key1, R11),
+ relation__add(R11, Key1, Key0, R12)
+ ;
+ R12 = R10
+ )
+ ), set__to_sorted_list(GI ^ consuming_vars), R1),
+ R = list__foldl((func(V, R20) = R22 :-
+ ( Index2 = map__search(MakeVisMap, V) ->
+ relation__add_element(R20, Index2, Key2, R21),
+ relation__add(R21, Key2, Key0, R22)
+ ;
+ R22 = R20
+ )
+ ), set__to_sorted_list(GI ^ need_visible_vars), R2)
+ ), GoalMap, relation__init),
+
+ ( relation__tsort(Relation, TSort) ->
+ Goals = map__apply_to_list(TSort, GoalMap)
+ ;
+ % XXX Report a mode error for this.
+ error("mode_ordering__conj: Cycle in goal dependencies.")
+ ).
+
+:- pred set_atomic_prod_vars(set(prog_var)::out, hlds_goal_info::in,
+ hlds_goal_info::out, mode_ordering__info::in,
+ mode_ordering__info::out) is det.
+
+set_atomic_prod_vars(ProdVars, GoalInfo0, GoalInfo) -->
+ LambdaNesting =^ lambda_nesting,
+ AtomicProdVars =^ prodvars_map,
+ { goal_info_get_goal_path(GoalInfo0, GoalPath) },
+ { ProdVars = ( map__search(AtomicProdVars,
+ stack__push(LambdaNesting, GoalPath), ProdVars0)
+ ->
+ ProdVars0
+ ;
+ set__init
+ )},
+ { goal_info_set_producing_vars(GoalInfo0, ProdVars, GoalInfo) }.
+
+:- pred pred_info_create_proc_info_for_mode_decl_constraint(pred_info::in,
+ mode_constraint::in, proc_id::out, pred_info::out) is det.
+
+pred_info_create_proc_info_for_mode_decl_constraint(PredInfo0,
+ _ModeDeclConstraint, ProcId, PredInfo) :-
+ ( semidet_succeed ->
+ % XXX
+ error("NYI: pred_info_create_proc_info_for_mode_decl_constraint")
+ ;
+ % XXX keep det checker happy.
+ PredInfo = PredInfo0,
+ ProcId = initial_proc_id
+ ).
+
+:- pred find_matching_proc(pred_id::in, list(prog_var)::in, set(prog_var)::in,
+ proc_id::out, set(prog_var)::out, mode_ordering__info::in,
+ mode_ordering__info::out) is det.
+
+find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars) -->
+ ModuleInfo =^ module_info,
+ CallerInstGraph =^ inst_graph,
+ PredConstraintMap =^ pred_constraint_map,
+ { lookup_pred_constraint(PredConstraintMap, PredId, _, MCInfo) },
+
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ { CalleeInstGraph = PredInfo^inst_graph_info^interface_inst_graph },
+ { pred_info_procedures(PredInfo, ProcTable) },
+ { map__to_assoc_list(ProcTable, ProcList) },
+ (
+ { find_matching_proc_2(ProcList, ProdVars, Args,
+ CallerInstGraph, CalleeInstGraph, MCInfo, ProcId0,
+ ConsumingVars0) }
+ ->
+ { ProcId = ProcId0 },
+ { ConsumingVars = ConsumingVars0 }
+ ;
+ { pred_info_infer_modes(PredInfo) }
+ ->
+ % XXX We are inferring modes for the called predicate. Need to
+ % add a new mode to the requested procs map.
+ { error("find_matching_proc: infer_modes NYI") }
+ ;
+ % If we get here, it means there is a mode error which should
+ % have been picked up by the constraints pass but was missed
+ % some how.
+ { error("find_matching_proc: unexpected mode error") }
+ ).
+
+:- pred find_matching_proc_2(assoc_list(proc_id, proc_info)::in,
+ set(prog_var)::in, list(prog_var)::in, inst_graph::in, inst_graph::in,
+ mode_constraint_info::in, proc_id::out, set(prog_var)::out) is semidet.
+
+find_matching_proc_2([ProcId0 - ProcInfo | ProcList], ProdVars, Args,
+ CallerInstGraph, CalleeInstGraph, MCInfo, ProcId,
+ ConsumingVars) :-
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_head_modes_constraint(ProcInfo, Constraint0),
+ Constraint = ensure_normalised(Constraint0),
+ (
+ all [X, Y] inst_graph__corresponding_nodes_from_lists(
+ CallerInstGraph, CalleeInstGraph, Args, HeadVars, X, Y)
+ =>
+ (
+ ProdVars `contains` X
+ <=>
+ (
+ var_entailed(Constraint,
+ mode_constraint_var(MCInfo, out(Y))),
+ \+ var_entailed(Constraint,
+ mode_constraint_var(MCInfo, in(Y)))
+ )
+ )
+ ->
+ ProcId = ProcId0,
+ ConsumingVars = solutions_set(pred(X::out) is nondet :-
+ some [Y] (
+ inst_graph__corresponding_nodes_from_lists(CallerInstGraph,
+ CalleeInstGraph, Args, HeadVars, X, Y),
+ var_entailed(Constraint, mode_constraint_var(MCInfo, in(Y)))
+ ))
+ ;
+ find_matching_proc_2(ProcList, ProdVars, Args, CallerInstGraph,
+ CalleeInstGraph, MCInfo, ProcId, ConsumingVars)
+ ).
+
+:- pred report_mode_errors(module_info::in, io__state::di, io__state::uo)
+ is det.
+
+report_mode_errors(_) --> [].
+ % XXX
+ %io__stderr_stream(StdErr),
+ %io__write_string(StdErr, "Mode error reporting NYI").
+
+:- pred lookup_pred_constraint(pred_constraint_map::in, pred_id::in,
+ mode_constraint::out, mode_constraint_info::out) is det.
+
+lookup_pred_constraint(PCM, PredId, MC, MCInfo) :-
+ map__lookup(PCM, PredId, pci(MC, MCInfo)).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list