mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
625ec287f1
compiler/prog_type_construct.m:
New module for constructing types.
compiler/prog_type_repn.m:
New module for testing things related to type representation.
compiler/prog_type_scan.m:
New module for gather type vars in types.
compiler/prog_type_test.m:
New module containing simple tests on types.
compiler/prog_type_unify.m:
New module for testing whether two types unify, or whether
one type subsumes another.
compiler/prog_type.m:
Delete the code moved to the new modules.
compiler/parse_tree.m:
Include the new modules.
compiler/notes/compiler_design.html:
Document the new modules.
compiler/*.m:
Conform to the changes above, by adjusting imports as needed,
and by deleting any explicit module qualifications that
this diff makes obsolete.
541 lines
20 KiB
Mathematica
541 lines
20 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2001-2002, 2004-2012 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: hhf.m.
|
|
% Author: dmo.
|
|
%
|
|
% 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_clauses.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.inst_graph.
|
|
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred convert_pred_to_hhf(io.text_output_stream::in, bool::in, pred_id::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
:- pred convert_clauses_info_to_hhf(bool::in, module_info::in,
|
|
clauses_info::in, clauses_info::out, inst_graph::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_test.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module solutions.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
convert_pred_to_hhf(ProgressStream, Simple, PredId, !ModuleInfo, !IO) :-
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
( if pred_info_is_imported(PredInfo0) then
|
|
% AAA
|
|
% PredInfo2 = PredInfo0
|
|
pred_info_get_clauses_info(PredInfo0, ClausesInfo),
|
|
clauses_info_get_headvar_list(ClausesInfo, HeadVars),
|
|
clauses_info_get_var_table(ClausesInfo, VarTable),
|
|
some [!IG] (
|
|
pred_info_get_inst_graph_info(PredInfo0, !:IG),
|
|
inst_graph.init(HeadVars, InstGraph),
|
|
!IG ^ implementation_inst_graph := InstGraph,
|
|
!IG ^ interface_inst_graph := InstGraph,
|
|
!IG ^ interface_vars := HeadVars,
|
|
!IG ^ interface_var_table := VarTable,
|
|
pred_info_set_inst_graph_info(!.IG, PredInfo0, PredInfo2)
|
|
)
|
|
else
|
|
maybe_write_pred_progress_message(ProgressStream, !.ModuleInfo,
|
|
"Calculating HHF and inst graph for", PredId, !IO),
|
|
|
|
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
|
|
convert_clauses_info_to_hhf(Simple, !.ModuleInfo, ClausesInfo0,
|
|
ClausesInfo, ImplementationInstGraph),
|
|
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
|
|
some [!IG] (
|
|
pred_info_get_inst_graph_info(PredInfo1, !:IG),
|
|
!IG ^ implementation_inst_graph := ImplementationInstGraph,
|
|
|
|
% AAA only for non-imported preds with no mode decls.
|
|
clauses_info_get_headvar_list(ClausesInfo, HeadVars),
|
|
clauses_info_get_var_table(ClausesInfo, VarTable),
|
|
!IG ^ interface_inst_graph := ImplementationInstGraph,
|
|
solutions(
|
|
(pred(V::out) is nondet :-
|
|
list.member(V0, HeadVars),
|
|
inst_graph.reachable(ImplementationInstGraph,
|
|
V0, V)
|
|
), InterfaceVars),
|
|
!IG ^ interface_vars := InterfaceVars,
|
|
!IG ^ interface_var_table := VarTable,
|
|
|
|
pred_info_set_inst_graph_info(!.IG, PredInfo1, PredInfo2)
|
|
)
|
|
),
|
|
|
|
% pred_info_get_markers(PredInfo2, Markers),
|
|
% ( if check_marker(Markers, infer_modes) then
|
|
% % No mode declarations. If not imported, use implementation
|
|
% % inst_graph.
|
|
% % ...
|
|
% else
|
|
% pred_info_clauses_info(PredInfo2, ClausesInfo2),
|
|
% clauses_info_get_headvars(ClausesInfo2, HeadVars),
|
|
% clauses_info_get_varset(ClausesInfo2, VarSet),
|
|
% inst_graph.init(HeadVars, InterfaceInstGraph),
|
|
% InstGraphInfo0 = ( (PredInfo2 ^ inst_graph_info)
|
|
% ^ interface_inst_graph := InterfaceInstGraph )
|
|
% ^ interface_varset := VarSet,
|
|
% map.foldl(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).
|
|
|
|
convert_clauses_info_to_hhf(Simple, ModuleInfo, !ClausesInfo, InstGraph) :-
|
|
clauses_info_get_var_table(!.ClausesInfo, VarTable0),
|
|
var_table_vars(VarTable0, Vars0),
|
|
inst_graph.init(Vars0, InstGraph0),
|
|
Info0 = hhf_info(ModuleInfo, InstGraph0, VarTable0),
|
|
|
|
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
|
|
clauses_info_clauses(Clauses0, ItemNumbers, !ClausesInfo),
|
|
|
|
(
|
|
% % For simple mode checking we do not give the inst_graph any
|
|
% % structure.
|
|
% Simple = yes,
|
|
% Clauses = Clauses0,
|
|
% Info1 = Info0
|
|
%;
|
|
% Simple = no,
|
|
list.map_foldl(convert_clause_to_hhf(HeadVars),
|
|
Clauses0, Clauses, Info0, Info1)
|
|
),
|
|
|
|
set_clause_list(Clauses, ClausesRep),
|
|
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
|
|
|
|
complete_inst_graph(Info1, Info),
|
|
% XXX Comment out the above line for incomplete, quick checking.
|
|
% Info = Info1,
|
|
|
|
Info = hhf_info(_, InstGraph1, VarTable),
|
|
(
|
|
Simple = yes,
|
|
var_table_vars(VarTable, Vars),
|
|
inst_graph.init(Vars, 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_var_table(VarTable, !ClausesInfo).
|
|
|
|
:- type hhf_info
|
|
---> hhf_info(
|
|
hhfi_module_info :: module_info,
|
|
hhfi_inst_graph :: inst_graph,
|
|
hhfi_var_table :: var_table
|
|
).
|
|
|
|
:- pred convert_clause_to_hhf(list(prog_var)::in, clause::in, clause::out,
|
|
hhf_info::in, hhf_info::out) is det.
|
|
|
|
convert_clause_to_hhf(_HeadVars, Clause0, Clause, !HI) :-
|
|
Goal0 = Clause0 ^ clause_body,
|
|
Goal0 = hlds_goal(_, GoalInfo0),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo0),
|
|
convert_goal_to_hhf(NonLocals, Goal0, Goal, !HI),
|
|
Clause = Clause0 ^ clause_body := Goal.
|
|
% XXX We probably need to requantify, but doing so stuffs up the
|
|
% inst_graph.
|
|
|
|
:- pred convert_goal_to_hhf(set_of_progvar::in, hlds_goal::in, hlds_goal::out,
|
|
hhf_info::in, hhf_info::out) is det.
|
|
|
|
convert_goal_to_hhf(NonLocals, Goal0, Goal, !HI) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred goal_use_own_nonlocals(hlds_goal::in, hlds_goal::out,
|
|
hhf_info::in, hhf_info::out) is det.
|
|
|
|
goal_use_own_nonlocals(Goal0, Goal, !HI) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
NonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred convert_goal_expr_to_hhf(set_of_progvar::in, hlds_goal_info::in,
|
|
hlds_goal_expr::in, hlds_goal_expr::out, hhf_info::in, hhf_info::out)
|
|
is det.
|
|
|
|
convert_goal_expr_to_hhf(NonLocals, GoalInfo, GoalExpr0, GoalExpr, !HI) :-
|
|
(
|
|
GoalExpr0 = unify(Var, RHS, Mode, Unif, Context),
|
|
convert_unify_to_hhf(RHS, NonLocals, GoalInfo, Var, Mode, Unif,
|
|
Context, GoalExpr, !HI)
|
|
;
|
|
GoalExpr0 = plain_call(_, _, _, _, _, _),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = generic_call(_, _, _, _, _),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
list.map_foldl(convert_goal_to_hhf(NonLocals), Goals0, Goals1, !HI),
|
|
(
|
|
ConjType = plain_conj,
|
|
flatten_conj(Goals1, Goals)
|
|
;
|
|
ConjType = parallel_conj,
|
|
Goals = Goals1
|
|
),
|
|
GoalExpr = conj(ConjType, Goals)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
list.map_foldl(goal_use_own_nonlocals, Goals0, Goals, !HI),
|
|
GoalExpr = disj(Goals)
|
|
;
|
|
GoalExpr0 = switch(_, _, _),
|
|
unexpected($pred, "switch")
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
convert_goal_to_hhf(NonLocals, SubGoal0, SubGoal, !HI),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
convert_goal_to_hhf(NonLocals, SubGoal0, SubGoal, !HI),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
GoalExpr0 = if_then_else(Vs, Cond0, Then0, Else0),
|
|
convert_goal_to_hhf(NonLocals, Cond0, Cond, !HI),
|
|
Then0 = hlds_goal(ThenExpr0, ThenInfo),
|
|
ThenNonLocals = goal_info_get_nonlocals(ThenInfo),
|
|
convert_goal_expr_to_hhf(ThenNonLocals, ThenInfo, ThenExpr0, ThenExpr,
|
|
!HI),
|
|
Then = hlds_goal(ThenExpr, ThenInfo),
|
|
Else0 = hlds_goal(ElseExpr0, ElseInfo),
|
|
ElseNonLocals = goal_info_get_nonlocals(ElseInfo),
|
|
convert_goal_expr_to_hhf(ElseNonLocals, ElseInfo, ElseExpr0, ElseExpr,
|
|
!HI),
|
|
Else = hlds_goal(ElseExpr, ElseInfo),
|
|
GoalExpr = if_then_else(Vs, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
|
|
:- pred convert_unify_to_hhf(unify_rhs::in, set_of_progvar::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.
|
|
|
|
convert_unify_to_hhf(RHS0, NonLocals, GoalInfo0, X, Mode, Unif, Context,
|
|
GoalExpr, !HI) :-
|
|
(
|
|
RHS0 = rhs_lambda_goal(A, B, C, D, E, F, G, LambdaGoal0),
|
|
convert_goal_to_hhf(NonLocals, LambdaGoal0, LambdaGoal, !HI),
|
|
RHS = rhs_lambda_goal(A, B, C, D, E, F, G, LambdaGoal),
|
|
GoalExpr = unify(X, RHS, Mode, Unif, Context)
|
|
;
|
|
RHS0 = rhs_var(_),
|
|
GoalExpr = unify(X, RHS0, Mode, Unif, Context)
|
|
;
|
|
RHS0 = rhs_functor(ConsId0, IsExistConstruct, ArgsA),
|
|
qualify_cons_id(ArgsA, ConsId0, _, ConsId),
|
|
InstGraph0 = !.HI ^ hhfi_inst_graph,
|
|
map.lookup(InstGraph0, X, node(Functors0, MaybeParent)),
|
|
( if map.search(Functors0, ConsId, ArgsB) then
|
|
make_unifications(ArgsA, ArgsB, GoalInfo0, Mode, Unif, Context,
|
|
Unifications),
|
|
Args = ArgsB
|
|
else
|
|
add_unifications(ArgsA, NonLocals, GoalInfo0, Mode, Unif, Context,
|
|
Args, Unifications, !HI),
|
|
InstGraph1 = !.HI ^ hhfi_inst_graph,
|
|
map.det_insert(ConsId, Args, Functors0, Functors),
|
|
map.det_update(X, node(Functors, MaybeParent),
|
|
InstGraph1, InstGraph2),
|
|
list.foldl(inst_graph.set_parent(X), Args, InstGraph2, InstGraph),
|
|
!HI ^ hhfi_inst_graph := InstGraph
|
|
),
|
|
GINonlocals0 = goal_info_get_nonlocals(GoalInfo0),
|
|
GINonlocals = set_of_var.union(GINonlocals0, list_to_set(Args)),
|
|
goal_info_set_nonlocals(GINonlocals, GoalInfo0, GoalInfo),
|
|
RHS = rhs_functor(ConsId, IsExistConstruct, Args),
|
|
UnifyGoalExpr = unify(X, RHS, Mode, Unif, Context),
|
|
UnifyGoal = hlds_goal(UnifyGoalExpr, GoalInfo),
|
|
GoalExpr = conj(plain_conj, [UnifyGoal | Unifications])
|
|
).
|
|
|
|
:- pred make_unifications(list(prog_var)::in, list(prog_var)::in,
|
|
hlds_goal_info::in, unify_mode::in, unification::in, unify_context::in,
|
|
list(hlds_goal)::out) is det.
|
|
|
|
make_unifications([], [], _, _, _, _, []).
|
|
make_unifications([_ | _], [], _, _, _, _, _) :-
|
|
unexpected($pred, "length mismatch (1)").
|
|
make_unifications([], [_ | _], _, _, _, _, _) :-
|
|
unexpected($pred, "length mismatch (2)").
|
|
make_unifications([A | As], [B | Bs], GI0, M, U, C,
|
|
[hlds_goal(unify(A, rhs_var(B), M, U, C), GI) | Us]) :-
|
|
GINonlocals0 = goal_info_get_nonlocals(GI0),
|
|
set_of_var.insert_list([A, B], GINonlocals0, GINonlocals),
|
|
goal_info_set_nonlocals(GINonlocals, GI0, GI),
|
|
make_unifications(As, Bs, GI0, M, U, C, Us).
|
|
|
|
:- pred add_unifications(list(prog_var)::in, set_of_progvar::in,
|
|
hlds_goal_info::in, unify_mode::in, unification::in, unify_context::in,
|
|
list(prog_var)::out, list(hlds_goal)::out,
|
|
hhf_info::in, hhf_info::out) is det.
|
|
|
|
add_unifications([], _, _, _, _, _, [], [], !HI).
|
|
add_unifications([A | As], NonLocals, GI0, M, U, C, [V | Vs], Goals, !HI) :-
|
|
add_unifications(As, NonLocals, GI0, M, U, C, Vs, Goals0, !HI),
|
|
InstGraph0 = !.HI ^ hhfi_inst_graph,
|
|
( if
|
|
(
|
|
map.lookup(InstGraph0, A, Node),
|
|
Node = node(_, parent(_))
|
|
;
|
|
set_of_var.member(NonLocals, A)
|
|
)
|
|
then
|
|
VarTable0 = !.HI ^ hhfi_var_table,
|
|
lookup_var_entry(VarTable0, A, EntryA),
|
|
EntryV = EntryA ^ vte_name := "",
|
|
add_var_entry(EntryV, V, VarTable0, VarTable),
|
|
map.init(Empty),
|
|
map.det_insert(V, node(Empty, top_level), InstGraph0, InstGraph),
|
|
!HI ^ hhfi_var_table := VarTable,
|
|
!HI ^ hhfi_inst_graph := InstGraph,
|
|
GINonlocals0 = goal_info_get_nonlocals(GI0),
|
|
set_of_var.insert(V, GINonlocals0, GINonlocals),
|
|
goal_info_set_nonlocals(GINonlocals, GI0, GI),
|
|
Goals = [hlds_goal(unify(A, rhs_var(V), M, U, C), GI) | Goals0]
|
|
else
|
|
V = A,
|
|
Goals = Goals0
|
|
).
|
|
|
|
:- pred complete_inst_graph(hhf_info::in, hhf_info::out) is det.
|
|
|
|
complete_inst_graph(!HI) :-
|
|
InstGraph0 = !.HI ^ hhfi_inst_graph,
|
|
map.keys(InstGraph0, Vars),
|
|
list.foldl(complete_inst_graph_node(Vars), Vars, !HI).
|
|
|
|
:- pred complete_inst_graph_node(list(prog_var)::in,
|
|
prog_var::in, hhf_info::in, hhf_info::out) is det.
|
|
|
|
complete_inst_graph_node(BaseVars, Var, !HI) :-
|
|
ModuleInfo = !.HI ^ hhfi_module_info,
|
|
VarTable0 = !.HI ^ hhfi_var_table,
|
|
lookup_var_type(VarTable0, Var, Type),
|
|
( if
|
|
type_constructors(ModuleInfo, Type, Constructors),
|
|
type_to_ctor(Type, TypeCtor)
|
|
then
|
|
TypeCtor = type_ctor(TypeCtorSymName, _),
|
|
(
|
|
TypeCtorSymName = unqualified(_),
|
|
unexpected($pred, "unqualified TypeCtorSymName")
|
|
;
|
|
TypeCtorSymName = qualified(TypeCtorModuleName, _)
|
|
),
|
|
list.foldl(
|
|
maybe_add_cons_id(Var, BaseVars, TypeCtor, TypeCtorModuleName),
|
|
Constructors, !HI)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred maybe_add_cons_id(prog_var::in, list(prog_var)::in,
|
|
type_ctor::in, module_name::in, constructor::in,
|
|
hhf_info::in, hhf_info::out) is det.
|
|
|
|
maybe_add_cons_id(Var, BaseVars, TypeCtor, TypeCtorModuleName, Ctor, !HI) :-
|
|
Ctor = ctor(_, _, Name, Args, Arity, _),
|
|
SymName = qualified(TypeCtorModuleName, unqualify_name(Name)),
|
|
ConsId = cons(SymName, Arity, TypeCtor),
|
|
map.lookup(!.HI ^ hhfi_inst_graph, Var, node(Functors0, MaybeParent)),
|
|
( if map.contains(Functors0, ConsId) then
|
|
true
|
|
else
|
|
list.map_foldl(add_cons_id(Var, BaseVars), Args, NewVars, !HI),
|
|
map.det_insert(ConsId, NewVars, Functors0, Functors),
|
|
!HI ^ hhfi_inst_graph :=
|
|
map.det_update(!.HI ^ hhfi_inst_graph, Var,
|
|
node(Functors, MaybeParent))
|
|
).
|
|
|
|
:- pred add_cons_id(prog_var::in, list(prog_var)::in,
|
|
constructor_arg::in, prog_var::out, hhf_info::in, hhf_info::out) is det.
|
|
|
|
add_cons_id(Var, BaseVars, Arg, NewVar, !HI) :-
|
|
ArgType = Arg ^ arg_type,
|
|
!.HI = hhf_info(ModuleInfo, InstGraph0, VarTable0),
|
|
( if
|
|
find_var_with_type(Var, ArgType, InstGraph0, VarTable0,
|
|
BaseVars, NewVar0)
|
|
then
|
|
NewVar = NewVar0
|
|
else
|
|
IsDummy = is_type_a_dummy(ModuleInfo, ArgType),
|
|
NewVarEntry = vte("", ArgType, IsDummy),
|
|
add_var_entry(NewVarEntry, NewVar, VarTable0, VarTable),
|
|
map.init(Empty),
|
|
map.det_insert(NewVar, node(Empty, parent(Var)),
|
|
InstGraph0, InstGraph),
|
|
!:HI = hhf_info(ModuleInfo, InstGraph, VarTable),
|
|
complete_inst_graph_node(BaseVars, NewVar, !HI)
|
|
).
|
|
|
|
:- pred find_var_with_type(prog_var::in, mer_type::in, inst_graph::in,
|
|
var_table::in, list(prog_var)::in, prog_var::out) is semidet.
|
|
|
|
find_var_with_type(Var0, Type, InstGraph, VarTable, BaseVars, Var) :-
|
|
lookup_var_type(VarTable, Var0, Type0),
|
|
( if same_type(Type0, Type) then
|
|
Var = Var0
|
|
else
|
|
map.lookup(InstGraph, Var0, node(_, parent(Var1))),
|
|
\+ Var1 `list.member` BaseVars,
|
|
find_var_with_type(Var1, Type, InstGraph, VarTable, BaseVars, Var)
|
|
).
|
|
|
|
:- pred same_type(mer_type::in, mer_type::in) is semidet.
|
|
|
|
same_type(A0, B0) :-
|
|
A = strip_kind_annotation(A0),
|
|
B = strip_kind_annotation(B0),
|
|
same_type_2(A, B).
|
|
|
|
:- pred same_type_2(non_kinded_type::in, non_kinded_type::in) is semidet.
|
|
|
|
same_type_2(type_variable(_, _), type_variable(_, _)).
|
|
same_type_2(defined_type(Name, ArgsA, _), defined_type(Name, ArgsB, _)) :-
|
|
same_type_list(ArgsA, ArgsB).
|
|
same_type_2(builtin_type(BuiltinType), builtin_type(BuiltinType)).
|
|
same_type_2(higher_order_type(PorF, ArgsA, HOInstInfo, Purity, EvalMethod),
|
|
higher_order_type(PorF, ArgsB, HOInstInfo, Purity, EvalMethod)) :-
|
|
same_type_list(ArgsA, ArgsB).
|
|
same_type_2(tuple_type(ArgsA, _), tuple_type(ArgsB, _)) :-
|
|
same_type_list(ArgsA, ArgsB).
|
|
same_type_2(apply_n_type(_, ArgsA, _), apply_n_type(_, ArgsB, _)) :-
|
|
same_type_list(ArgsA, ArgsB).
|
|
|
|
:- pred same_type_list(list(mer_type)::in, list(mer_type)::in) is semidet.
|
|
|
|
same_type_list([], []).
|
|
same_type_list([A | As], [B | Bs]) :-
|
|
same_type(A, B),
|
|
same_type_list(As, Bs).
|
|
|
|
%------------------------------------------------------------------------%
|
|
|
|
% % Add the information from the procedure's mode declaration
|
|
% % to the inst_graph.
|
|
% :- pred process_proc(module_info::in, list(prog_var)::in, proc_id::in,
|
|
% proc_info::in, inst_graph::out, prog_varset::out) is det.
|
|
%
|
|
% process_proc(ModuleInfo, HeadVars, _ProcId, ProcInfo, Info0, Info) :-
|
|
% proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
%
|
|
% mode_list_get_initial_insts(ArgModes, ModuleInfo, InstsI),
|
|
% assoc_list.from_corresponding_lists(HeadVars, InstsI, VarInstsI),
|
|
% list.foldl(process_arg(ModuleInfo), VarInstsI, Info0, Info),
|
|
%
|
|
% mode_list_get_final_insts(ArgModes, ModuleInfo, InstsF),
|
|
% assoc_list.from_corresponding_lists(HeadVars, InstsF, VarInstsF),
|
|
% list.foldl(process_arg(ModuleInfo), VarInstsF, Info0, Info).
|
|
%
|
|
% :- pred process_arg(module_info::in, pair(prog_var, inst)::in,
|
|
% inst_graph_info::in, inst_graph_info::out) is det.
|
|
%
|
|
% process_arg(ModuleInfo, Var - Inst, Info0, Info) :-
|
|
% map.init(Seen0),
|
|
% process_arg_inst(ModuleInfo, Var, Seen0, Inst, Info0, Info).
|
|
%
|
|
% :- pred 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.
|
|
%
|
|
% process_arg_inst(ModuleInfo, Var, Seen0, Inst0, Info0, Info) :-
|
|
% ( if Inst0 = defined_inst(InstName) then
|
|
% map.det_insert(Seen0, InstName, Var, Seen),
|
|
% inst_lookup(ModuleInfo, InstName, Inst),
|
|
% process_arg_inst(Inst, ModuleInfo, Var, Seen, Info0, Info)
|
|
% else if Inst0 = bound(_, BoundInsts) then
|
|
% list.foldl(process_bound_inst(ModuleInfo, Var, Seen0),
|
|
% BoundInts, Info0, Info)
|
|
% else
|
|
% Info = Info0
|
|
% ).
|
|
%
|
|
% :- pred 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.
|
|
|
|
%------------------------------------------------------------------------%
|
|
:- end_module hlds.hhf.
|
|
%------------------------------------------------------------------------%
|