[m-rev.] diff: change pairs into named types
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon Aug 27 16:19:07 AEST 2007
Estimated hours taken: 1
Branches: main
Change some types that are defined as equivalences for pairs into
named d.u. types.
Fix a bug in with the handling of type class method calls in the
termination analyser. We should not run pass 2 if we encounter
a method call during pass 1.
Add an XXX comment about some other possible bugs of a similar nature.
compiler/prog_data.m:
Define the type arg_size_term/0 as a d.u. type, not a pair.
compiler/term_errors.m:
Define the type termination_error_context/0 as a d.u. type,
not a pair.
Change the semidet predicate indirect_error/1 into a det function
is_indirect_error/1.
Add the function is_fatal_error/1.
(See change to termination.m below.)
compiler/term_pass2.m:
Define the type call_weight_info/0 as a d.u. type, not a pair.
compiler/termination.m:
Move the body of the closure that determines if an error is fatal
into term_errors.m, and make it into a named function that returns
a bool. Use that here. (In the process of doing this I discovered
that the code for handling fatal errors was not handling type
class method calls correctly, they *should* be handled like
higher-order calls. Also, some of the more recently added
termination error categories may not be handled correctly here -
I have added an XXX comment to term_errors.m regarding this.)
compiler/unify_proc.m:
Define the type unify_proc_id/0 as a d.u. type, not a pair.
compiler/goal_store.m:
Define the type stored_goal/0 as a d.u. type, not a pair.
compiler/mode_errors.m:
Define the type merge_error/0 as a d.u. type, not a pair.
compiler/accumulator.m:
compiler/instmap.m:
compiler/mercury_to_mercury.m:
compiler/modecheck_unify.m:
compiler/prog_io_pragma.m:
compiler/term_constr_initial.m:
compiler/term_pass1.m:
compiler/term_traversal.m:
compiler/term_util.m:
Conform to the above changes.
Julien.
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.69
diff -u -r1.69 accumulator.m
--- compiler/accumulator.m 7 Aug 2007 07:09:45 -0000 1.69
+++ compiler/accumulator.m 27 Aug 2007 06:10:32 -0000
@@ -563,8 +563,7 @@
Goal = hlds_goal(_, GoalInfo),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
instmap.apply_instmap_delta(IM0, InstMapDelta, IM),
-
- goal_store_det_insert(Identifier - N, Goal - IM0, GS0, GS).
+ goal_store_det_insert(Identifier - N, stored_goal(Goal, IM0), GS0, GS).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -578,7 +577,7 @@
identify_recursive_calls(PredId, ProcId, GoalStore, Ids) :-
P = (pred(Key::out) is nondet :-
- goal_store_member(GoalStore, Key, Goal - _InstMap),
+ goal_store_member(GoalStore, Key, stored_goal(Goal, _InstMap)),
Key = rec - _,
Goal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _)
),
@@ -779,10 +778,10 @@
before(N - I, K, GoalStore, sets(Before, _, _, _, _, _),
FullyStrict, VarTypes, ModuleInfo) :-
- goal_store_lookup(GoalStore, N - I, LaterGoal - LaterInstMap),
+ goal_store_lookup(GoalStore, N - I, stored_goal(LaterGoal, LaterInstMap)),
(
member_lessthan_goalid(GoalStore, N - I, N - J,
- EarlierGoal - EarlierInstMap),
+ stored_goal(EarlierGoal, EarlierInstMap)),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
)
@@ -801,12 +800,12 @@
assoc(N - I, K, GoalStore, sets(Before, _, _, _, _, _),
FullyStrict, VarTypes, ModuleInfo) :-
- goal_store_lookup(GoalStore, N - I, LaterGoal - LaterInstMap),
+ goal_store_lookup(GoalStore, N - I, stored_goal(LaterGoal, LaterInstMap)),
LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _),
is_associative(PredId, ModuleInfo, Args, _),
(
member_lessthan_goalid(GoalStore, N - I, _N - J,
- EarlierGoal - EarlierInstMap),
+ stored_goal(EarlierGoal, EarlierInstMap)),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
)
@@ -825,12 +824,12 @@
construct(N - I, K, GoalStore, sets(Before, _, _, Construct, _, _),
FullyStrict, VarTypes, ModuleInfo) :-
- goal_store_lookup(GoalStore, N - I, LaterGoal - LaterInstMap),
+ goal_store_lookup(GoalStore, N - I, stored_goal(LaterGoal, LaterInstMap)),
LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo),
Unify = construct(_, _, _, _, _, _, _),
(
member_lessthan_goalid(GoalStore, N - I, _N - J,
- EarlierGoal - EarlierInstMap),
+ stored_goal(EarlierGoal, EarlierInstMap)),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
)
@@ -854,7 +853,7 @@
construct_assoc(N - I, K, GoalStore, sets(Before, Assoc, ConstructAssoc,
_, _, _), FullyStrict, VarTypes, ModuleInfo) :-
- goal_store_lookup(GoalStore, N - I, LaterGoal - LaterInstMap),
+ goal_store_lookup(GoalStore, N - I, stored_goal(LaterGoal, LaterInstMap)),
LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo),
Unify = construct(_, ConsId, _, _, _, _, _),
@@ -862,13 +861,14 @@
FullyStrict, Ancestors),
set.singleton_set(Assoc `intersect` Ancestors, AssocId),
- goal_store_lookup(GoalStore, AssocId, AssocGoal - _AssocInstMap),
+ goal_store_lookup(GoalStore, AssocId,
+ stored_goal(AssocGoal, _AssocInstMap)),
AssocGoal = hlds_goal(plain_call(PredId, _, _, _, _, _), _),
is_associative_construction(ConsId, PredId, ModuleInfo),
(
member_lessthan_goalid(GoalStore, N - I, _N - J,
- EarlierGoal - EarlierInstMap),
+ stored_goal(EarlierGoal, EarlierInstMap)),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
)
@@ -888,12 +888,12 @@
update(N - I, K, GoalStore, sets(Before, _, _, _, _, _),
FullyStrict, VarTypes, ModuleInfo) :-
- goal_store_lookup(GoalStore, N - I, LaterGoal - LaterInstMap),
+ goal_store_lookup(GoalStore, N - I, stored_goal(LaterGoal, LaterInstMap)),
LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _),
is_update(PredId, ModuleInfo, Args, _),
(
member_lessthan_goalid(GoalStore, N - I, _N - J,
- EarlierGoal - EarlierInstMap),
+ stored_goal(EarlierGoal, EarlierInstMap)),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
)
@@ -1082,7 +1082,7 @@
After = Assoc `union` ConstructAssoc `union` Construct,
P = (pred(Id::in, Set0::in, Set::out) is det :-
- goal_store_lookup(GoalStore, Id, Goal - _InstMap),
+ goal_store_lookup(GoalStore, Id, stored_goal(Goal, _InstMap)),
Goal = hlds_goal(_GoalExpr, GoalInfo),
NonLocals = goal_info_get_nonlocals(GoalInfo),
Set = NonLocals `union` Set0
@@ -1171,7 +1171,7 @@
!.Substs = substs(AccVarSubst, RecCallSubst0, AssocCallSubst0,
UpdateSubst),
- lookup_call(GS, Id, Goal - InstMap),
+ lookup_call(GS, Id, stored_goal(Goal, InstMap)),
Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), GoalInfo),
is_associative(PredId, ModuleInfo, Args, AssocInfo),
@@ -1194,7 +1194,7 @@
% associative and not commutative.
(
IsCommutative = yes,
- CSGoal = Goal - InstMap,
+ CSGoal = stored_goal(Goal, InstMap),
Warning = []
;
IsCommutative = no,
@@ -1221,9 +1221,9 @@
),
% Swap the arguments.
[A, B] = set.to_sorted_list(Vars),
- map.from_assoc_list([A-B, B-A], Subst),
+ map.from_assoc_list([A - B, B - A], Subst),
rename_some_vars_in_goal(Subst, Goal, SwappedGoal),
- CSGoal = SwappedGoal - InstMap
+ CSGoal = stored_goal(SwappedGoal, InstMap)
),
process_assoc_set(Ids, GS, OutPrime, ModuleInfo, !Substs,
@@ -1262,7 +1262,7 @@
!VarSet, !VarTypes, StateOutputVars, Accs, BasePairs) :-
!.Substs = substs(AccVarSubst0, RecCallSubst0, AssocCallSubst,
UpdateSubst0),
- lookup_call(GS, Id, Goal - _InstMap),
+ lookup_call(GS, Id, stored_goal(Goal, _InstMap)),
Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _GoalInfo),
is_update(PredId, ModuleInfo, Args, StateVarA - StateVarB),
@@ -1349,7 +1349,7 @@
related(GS, VarTypes, ModuleInfo, Var, Related) :-
solutions.solutions(
(pred(Key::out) is nondet :-
- goal_store_member(GS, Key, Goal - InstMap0),
+ goal_store_member(GS, Key, stored_goal(Goal, InstMap0)),
Key = base - _,
Goal = hlds_goal(_GoalExpr, GoalInfo),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
@@ -1374,15 +1374,15 @@
:- inst hlds_plain_call
---> hlds_goal(plain_call, ground).
:- inst plain_call_goal
- ---> hlds_plain_call - ground.
+ ---> stored_goal(hlds_plain_call, ground).
% Do a goal_store_lookup where the result is known to be a call.
%
:- pred lookup_call(goal_store::in, goal_id::in,
stored_goal::out(plain_call_goal)) is det.
-lookup_call(GoalStore, Id, Call - InstMap) :-
- goal_store_lookup(GoalStore, Id, Goal - InstMap),
+lookup_call(GoalStore, Id, stored_goal(Call, InstMap)) :-
+ goal_store_lookup(GoalStore, Id, stored_goal(Goal, InstMap)),
( Goal = hlds_goal(plain_call(_, _, _, _, _, _), _) ->
Call = Goal
;
@@ -1529,7 +1529,7 @@
create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
HeadToCallSubst, CallToHeadSubst, BaseIds, BasePairs,
Sets, C, CS, OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal) :-
- lookup_call(C, RecCallId, OrigCall - _InstMap),
+ lookup_call(C, RecCallId, stored_goal(OrigCall, _InstMap)),
Call = create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName),
create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst,
BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal),
@@ -1794,9 +1794,9 @@
rename(Ids, Subst, From, Initial) = Final :-
list.foldl(
(pred(Id::in, GS0::in, GS::out) is det :-
- goal_store_lookup(From, Id, Goal0 - InstMap),
+ goal_store_lookup(From, Id, stored_goal(Goal0, InstMap)),
rename_some_vars_in_goal(Subst, Goal0, Goal),
- goal_store_det_insert(Id, Goal - InstMap, GS0, GS)
+ goal_store_det_insert(Id, stored_goal(Goal, InstMap), GS0, GS)
), Ids, Initial, Final).
% Return all the goal_ids which belong in the base case.
@@ -1822,7 +1822,7 @@
goal_list(Ids, GS) = Goals :-
list.map(
(pred(Key::in, G::out) is det :-
- goal_store_lookup(GS, Key, G - _)
+ goal_store_lookup(GS, Key, stored_goal(G, _))
), Ids, Goals).
%-----------------------------------------------------------------------------%
Index: compiler/goal_store.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_store.m,v
retrieving revision 1.15
diff -u -r1.15 goal_store.m
--- compiler/goal_store.m 1 Dec 2006 15:03:57 -0000 1.15
+++ compiler/goal_store.m 27 Aug 2007 06:10:32 -0000
@@ -24,12 +24,13 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
-:- import_module pair.
:- import_module set.
%-----------------------------------------------------------------------------%
-:- type stored_goal == pair(hlds_goal, instmap).
+:- type stored_goal
+ ---> stored_goal(hlds_goal, instmap).
+
:- type goal_store(T).
:- pred goal_store_init(goal_store(T)::out) is det.
@@ -115,8 +116,10 @@
direct_ancestor(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict,
EarlierId) :-
- goal_store_lookup(GoalStore, StartId, LaterGoal - LaterInstMap),
- goal_store_member(GoalStore, EarlierId, EarlierGoal - EarlierInstMap),
+ goal_store_lookup(GoalStore, StartId,
+ stored_goal(LaterGoal, LaterInstMap)),
+ goal_store_member(GoalStore, EarlierId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
compare((<), EarlierId, StartId),
not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal).
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.58
diff -u -r1.58 instmap.m
--- compiler/instmap.m 1 Jun 2007 04:25:08 -0000 1.58
+++ compiler/instmap.m 27 Aug 2007 06:10:32 -0000
@@ -666,7 +666,7 @@
mode_info_set_module_info(ModuleInfo, !ModeInfo),
(
ErrorList = [FirstError | _],
- FirstError = Var - _,
+ FirstError = merge_error(Var, _),
set.singleton_set(WaitingVars, Var),
mode_info_error(WaitingVars,
mode_error_disj(MergeContext, ErrorList), !ModeInfo)
@@ -726,7 +726,7 @@
merge_var(InstList, Var, VarType, !ModuleInfo, MaybeInst),
(
MaybeInst = no,
- !:ErrorList = [Var - InstList | !.ErrorList],
+ !:ErrorList = [merge_error(Var, InstList) | !.ErrorList],
svmap.set(Var, not_reached, !InstMapping)
;
MaybeInst = yes(Inst),
@@ -920,7 +920,7 @@
% of possible errors in the mode_info.
(
ErrorList = [FirstError | _],
- FirstError = Var - _,
+ FirstError = merge_error(Var, _),
set.singleton_set(WaitingVars, Var),
mode_info_error(WaitingVars,
mode_error_par_conj(ErrorList), !ModeInfo)
@@ -956,7 +956,7 @@
!ModuleInfo, no, Error),
(
Error = yes,
- ErrorList = [Var - Insts | ErrorListTail]
+ ErrorList = [ merge_error(Var, Insts) | ErrorListTail]
;
Error = no,
ErrorList = ErrorListTail
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.318
diff -u -r1.318 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 20 Aug 2007 03:35:58 -0000 1.318
+++ compiler/mercury_to_mercury.m 27 Aug 2007 06:10:32 -0000
@@ -4576,7 +4576,8 @@
:- pred write_arg_size_term(arg_size_term::in, io::di, io::uo) is det.
-write_arg_size_term(VarId - Coefficient, !IO) :-
+write_arg_size_term(ArgSizeTerm, !IO) :-
+ ArgSizeTerm = arg_size_term(VarId, Coefficient),
io.write_string("term(", !IO),
io.write_int(VarId, !IO),
io.write_string(", ", !IO),
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.119
diff -u -r1.119 mode_errors.m
--- compiler/mode_errors.m 14 Aug 2007 01:52:27 -0000 1.119
+++ compiler/mode_errors.m 27 Aug 2007 06:10:32 -0000
@@ -30,7 +30,6 @@
:- import_module bool.
:- import_module io.
:- import_module list.
-:- import_module pair.
:- import_module set.
%-----------------------------------------------------------------------------%
@@ -39,7 +38,9 @@
---> disj
; if_then_else.
-:- type merge_error == pair(prog_var, list(mer_inst)).
+:- type merge_error
+ ---> merge_error(prog_var, list(mer_inst)).
+
:- type merge_errors == list(merge_error).
:- type delayed_goal
@@ -245,6 +246,7 @@
:- import_module int.
:- import_module map.
:- import_module maybe.
+:- import_module pair.
:- import_module string.
:- import_module term.
:- import_module varset.
@@ -526,7 +528,8 @@
:- func merge_error_to_pieces(mode_info, merge_error) = list(format_component).
-merge_error_to_pieces(ModeInfo, Var - Insts) = Pieces :-
+merge_error_to_pieces(ModeInfo, MergeError) = Pieces :-
+ MergeError = merge_error(Var, Insts),
mode_info_get_varset(ModeInfo, VarSet),
Pieces = [words(add_quotes(mercury_var_to_string(VarSet, no, Var))),
fixed("::"),
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.118
diff -u -r1.118 modecheck_unify.m
--- compiler/modecheck_unify.m 14 Aug 2007 01:52:28 -0000 1.118
+++ compiler/modecheck_unify.m 27 Aug 2007 06:10:32 -0000
@@ -1126,7 +1126,8 @@
->
mode_info_get_context(!.ModeInfo, Context),
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
- unify_proc.request_unify(TypeCtor - UniMode, InstVarSet,
+ UnifyProcId = unify_proc_id(TypeCtor, UniMode),
+ unify_proc.request_unify(UnifyProcId, InstVarSet,
Det, Context, ModuleInfo3, ModuleInfo),
mode_info_set_module_info(ModuleInfo, !ModeInfo)
;
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.192
diff -u -r1.192 prog_data.m
--- compiler/prog_data.m 25 Jul 2007 06:12:25 -0000 1.192
+++ compiler/prog_data.m 27 Aug 2007 06:10:32 -0000
@@ -318,7 +318,11 @@
---> le(list(arg_size_term), rat)
; eq(list(arg_size_term), rat).
-:- type arg_size_term == pair(int, rat).
+:- type arg_size_term
+ ---> arg_size_term(
+ as_term_var :: int,
+ as_term_coeff :: rat
+ ).
:- type pragma_constr_arg_size_info == list(arg_size_constr).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.127
diff -u -r1.127 prog_io_pragma.m
--- compiler/prog_io_pragma.m 20 Aug 2007 03:36:04 -0000 1.127
+++ compiler/prog_io_pragma.m 27 Aug 2007 06:10:32 -0000
@@ -2640,13 +2640,13 @@
Constr = eq(LPTerms, Constant)
).
-:- pred parse_lp_term(term::in, pair(int, rat)::out) is semidet.
+:- pred parse_lp_term(term::in, arg_size_term::out) is semidet.
parse_lp_term(Term, LpTerm) :-
Term = term.functor(term.atom("term"), [VarIdTerm, CoeffTerm], _),
VarIdTerm = term.functor(term.integer(VarId), [], _),
parse_rational(CoeffTerm, Coeff),
- LpTerm = VarId - Coeff.
+ LpTerm = arg_size_term(VarId, Coeff).
:- pred parse_rational(term::in, rat::out) is semidet.
Index: compiler/term_constr_initial.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_initial.m,v
retrieving revision 1.21
diff -u -r1.21 term_constr_initial.m
--- compiler/term_constr_initial.m 3 Jul 2007 04:27:58 -0000 1.21
+++ compiler/term_constr_initial.m 27 Aug 2007 06:10:32 -0000
@@ -241,10 +241,11 @@
list.map(create_lp_term(SubstMap), Terms0, Terms),
Constraint = constraint(Terms, (=), Constant).
-:- pred create_lp_term(map(int, var)::in, pair(int, rat)::in, lp_term::out)
+:- pred create_lp_term(map(int, var)::in, arg_size_term::in, lp_term::out)
is det.
-create_lp_term(SubstMap, VarId - Coefficient, Var - Coefficient) :-
+create_lp_term(SubstMap, ArgSizeTerm, Var - Coefficient) :-
+ ArgSizeTerm = arg_size_term(VarId, Coefficient),
Var = SubstMap ^ det_elem(VarId).
%----------------------------------------------------------------------------%
Index: compiler/term_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_errors.m,v
retrieving revision 1.41
diff -u -r1.41 term_errors.m
--- compiler/term_errors.m 1 Dec 2006 15:04:24 -0000 1.41
+++ compiler/term_errors.m 27 Aug 2007 06:10:32 -0000
@@ -23,9 +23,9 @@
:- import_module assoc_list.
:- import_module bag.
+:- import_module bool.
:- import_module io.
:- import_module list.
-:- import_module pair.
%-----------------------------------------------------------------------------%
@@ -139,7 +139,8 @@
% code is assumed to be non-terminating.
:- type termination_error_contexts == list(termination_error_context).
-:- type termination_error_context == pair(prog_context, termination_error).
+:- type termination_error_context
+ ---> termination_error_context(termination_error, prog_context).
:- pred report_term_errors(list(pred_proc_id)::in,
list(termination_error_context)::in, module_info::in, io::di, io::uo)
@@ -152,7 +153,11 @@
% and in the second case, the piece of code that the programmer *can* do
% something about is not this piece.
%
-:- pred indirect_error(termination_error::in) is semidet.
+:- func is_indirect_error(termination_error) = bool.
+
+ % A fatal error is one that prevents pass 2 from proving termination.
+ %
+:- func is_fatal_error(termination_error) = bool.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -168,19 +173,55 @@
:- import_module bool.
:- import_module int.
:- import_module maybe.
+:- import_module pair.
:- import_module string.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
-indirect_error(horder_call).
-indirect_error(method_call).
-indirect_error(pragma_foreign_code).
-indirect_error(imported_pred).
-indirect_error(can_loop_proc_called(_, _)).
-indirect_error(horder_args(_, _)).
-indirect_error(does_not_term_pragma(_)).
+% XXX Some of the following (and in is_fatal_error/1 as well) look wrong.
+% Some of them should probably be calling unexpected/2 - juliensf.
+
+is_indirect_error(horder_call) = yes.
+is_indirect_error(method_call) = yes.
+is_indirect_error(pragma_foreign_code) = yes.
+is_indirect_error(imported_pred) = yes.
+is_indirect_error(can_loop_proc_called(_, _)) = yes.
+is_indirect_error(horder_args(_, _)) = yes.
+is_indirect_error(does_not_term_pragma(_)) = yes.
+is_indirect_error(cycle(_, _)) = no.
+is_indirect_error(does_not_term_foreign(_)) = no.
+is_indirect_error(ho_inf_termination_const(_, _)) = no.
+is_indirect_error(inf_call(_, _)) = no.
+is_indirect_error(inf_termination_const(_, _)) = no.
+is_indirect_error(is_builtin(_)) = no.
+is_indirect_error(no_eqns) = no.
+is_indirect_error(not_subset(_, _, _)) = no.
+is_indirect_error(solver_failed) = no.
+is_indirect_error(too_many_paths) = no.
+is_indirect_error(inconsistent_annotations) = no.
+
+is_fatal_error(horder_call) = yes.
+is_fatal_error(horder_args(_, _)) = yes.
+is_fatal_error(imported_pred) = yes.
+is_fatal_error(method_call) = yes.
+is_fatal_error(pragma_foreign_code) = no.
+is_fatal_error(can_loop_proc_called(_, _)) = no.
+is_fatal_error(does_not_term_pragma(_)) = no.
+is_fatal_error(cycle(_, _)) = no.
+is_fatal_error(does_not_term_foreign(_)) = no.
+is_fatal_error(ho_inf_termination_const(_, _)) = no.
+is_fatal_error(inf_call(_, _)) = no.
+is_fatal_error(inf_termination_const(_, _)) = no.
+is_fatal_error(is_builtin(_)) = no.
+is_fatal_error(no_eqns) = no.
+is_fatal_error(not_subset(_, _, _)) = no.
+is_fatal_error(solver_failed) = no.
+is_fatal_error(too_many_paths) = no.
+is_fatal_error(inconsistent_annotations) = no.
+
+%-----------------------------------------------------------------------------%
report_term_errors(SCC, Errors, Module, !IO) :-
get_context_from_scc(SCC, Module, Context),
@@ -262,17 +303,21 @@
maybe(pred_proc_id)::in, maybe(int)::in, int::in, module_info::in,
io::di, io::uo) is det.
-output_term_error(Context - Error, Single, ErrorNum, Indent, Module, !IO) :-
+output_term_error(TermErrorContext, Single, ErrorNum, Indent, Module, !IO) :-
+ TermErrorContext = termination_error_context(Error, Context),
description(Error, Single, Module, Pieces0, Reason),
- ( ErrorNum = yes(N) ->
+ (
+ ErrorNum = yes(N),
string.int_to_string(N, Nstr),
string.append_list(["Reason ", Nstr, ":"], Preamble),
Pieces = [fixed(Preamble) | Pieces0]
;
+ ErrorNum = no,
Pieces = Pieces0
),
write_error_pieces(Context, Indent, Pieces, !IO),
- ( Reason = yes(InfArgSizePPId) ->
+ (
+ Reason = yes(InfArgSizePPId),
lookup_proc_arg_size_info(Module, InfArgSizePPId, ArgSize),
( ArgSize = yes(infinite(ArgSizeErrors)) ->
% XXX the next line is cheating
@@ -283,7 +328,7 @@
"inf arg size procedure does not have inf arg size")
)
;
- true
+ Reason = no
).
:- pred description(termination_error::in,
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.36
diff -u -r1.36 term_pass1.m
--- compiler/term_pass1.m 7 Aug 2007 07:10:07 -0000 1.36
+++ compiler/term_pass1.m 27 Aug 2007 06:10:32 -0000
@@ -99,16 +99,17 @@
(
Result = ok(Paths, OutputSupplierMap, SubsetErrors),
(
- SubsetErrors = [_|_],
+ SubsetErrors = [_ | _],
ArgSize = error(SubsetErrors)
;
SubsetErrors = [],
(
Paths = [],
get_context_from_scc(SCC, !.ModuleInfo, Context),
- ArgSize = error([Context - no_eqns])
+ ArgSizeError = termination_error_context(no_eqns, Context),
+ ArgSize = error([ArgSizeError])
;
- Paths = [_|_],
+ Paths = [_ | _],
solve_equations(Paths, SCC, MaybeSolution, !IO),
(
MaybeSolution = yes(Solution),
@@ -116,7 +117,9 @@
;
MaybeSolution = no,
get_context_from_scc(SCC, !.ModuleInfo, Context),
- ArgSize = error([Context - solver_failed])
+ ArgSizeError = termination_error_context(solver_failed,
+ Context),
+ ArgSize = error([ArgSizeError])
)
)
)
@@ -243,8 +246,7 @@
Info = ok(Paths, TermErrors),
set.to_sorted_list(Paths, PathList),
upper_bound_active_vars(PathList, AllActiveVars),
- map.lookup(OutputSupplierMap0, PPId,
- OutputSuppliers0),
+ map.lookup(OutputSupplierMap0, PPId, OutputSuppliers0),
update_output_suppliers(Args, AllActiveVars,
OutputSuppliers0, OutputSuppliers),
map.det_update(OutputSupplierMap0, PPId,
@@ -252,7 +254,10 @@
( bag.is_subbag(AllActiveVars, InVars) ->
SubsetErrors = []
;
- SubsetErrors = [Context - not_subset(PPId, AllActiveVars, InVars)]
+ SubsetError = not_subset(PPId, AllActiveVars, InVars),
+ SubsetErrorContext = termination_error_context(SubsetError,
+ Context),
+ SubsetErrors = [SubsetErrorContext]
),
Result = ok(PathList, OutputSupplierMap, SubsetErrors)
;
@@ -261,7 +266,7 @@
).
:- pred update_output_suppliers(list(prog_var)::in, bag(prog_var)::in,
- list(bool)::in, list(bool)::out) is det.
+ list(bool)::in, list(bool)::out) is det.
update_output_suppliers([], _ActiveVars, [], []).
update_output_suppliers([_ | _], _ActiveVars, [], []) :-
@@ -337,16 +342,19 @@
Context = goal_info_get_context(GoalInfo),
(
TerminationInfo = yes(can_loop(_)),
- TermError = Context - can_loop_proc_called(PPId, CallPPId),
- list.cons(TermError, !Errors)
+ CanLoopError = can_loop_proc_called(PPId, CallPPId),
+ CanLoopErrorContext = termination_error_context(CanLoopError, Context),
+ list.cons(CanLoopErrorContext, !Errors)
;
( TerminationInfo = yes(cannot_loop(_))
; TerminationInfo = no
)
),
( horder_vars(Args, VarTypes) ->
- HigherOrderError = Context - horder_args(PPId, CallPPId),
- list.cons(HigherOrderError, !Errors)
+ HigherOrderError = horder_args(PPId, CallPPId),
+ HigherOrderErrorContext = termination_error_context(HigherOrderError,
+ Context),
+ list.cons(HigherOrderErrorContext, !Errors)
;
true
).
@@ -355,7 +363,8 @@
% XXX Use closure analysis results here.
Goal = generic_call(_, _, _, _),
Context = goal_info_get_context(GoalInfo),
- list.cons(Context - horder_call, !Errors).
+ Error = termination_error_context(horder_call, Context),
+ list.cons(Error, !Errors).
check_goal_expr_non_term_calls(PPId, VarTypes, Goal, _, !Errors, !ModuleInfo,
!IO) :-
Goal = switch(_, _, Cases),
@@ -392,8 +401,7 @@
check_cases_non_term_calls(PPId, VarTypes, case(_, Goal), !Errors,
!ModuleInfo, !IO) :-
- check_goal_non_term_calls(PPId, VarTypes, Goal, !Errors,
- !ModuleInfo, !IO).
+ check_goal_non_term_calls(PPId, VarTypes, Goal, !Errors, !ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
%
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass2.m,v
retrieving revision 1.30
diff -u -r1.30 term_pass2.m
--- compiler/term_pass2.m 17 May 2007 03:52:53 -0000 1.30
+++ compiler/term_pass2.m 27 Aug 2007 06:10:32 -0000
@@ -65,7 +65,7 @@
; down.
:- type call_weight_info
- == pair(termination_error_contexts, call_weight_graph).
+ ---> call_weight_info(termination_error_contexts, call_weight_graph).
% The maximum non-infinite weight from proc to proc and which context
% it occurs at.
@@ -102,7 +102,7 @@
% the failure of the main analysis.
\+ (
list.member(Error, Errors),
- Error = _ - imported_pred
+ Error = termination_error_context(imported_pred, _)
)
->
prove_termination_in_scc_single_arg(SCC, PassInfo,
@@ -310,7 +310,7 @@
InitRecSuppliers, Result, !ModuleInfo, !IO),
(
Result = ok(CallInfo, _),
- CallInfo = InfCalls - CallWeights,
+ CallInfo = call_weight_info(InfCalls, CallWeights),
(
InfCalls \= []
->
@@ -342,7 +342,7 @@
RecSupplierMap0, Result, !ModuleInfo, !IO) :-
map.init(NewRecSupplierMap0),
map.init(CallWeightGraph0),
- CallInfo0 = [] - CallWeightGraph0,
+ CallInfo0 = call_weight_info([], CallWeightGraph0),
prove_termination_in_scc_pass(SCC, FixDir, PassInfo,
RecSupplierMap0, NewRecSupplierMap0, CallInfo0, Result1, !ModuleInfo,
!IO),
@@ -478,21 +478,23 @@
add_call_arcs([], _RecInputSuppliers, !CallInfo).
add_call_arcs([Path | Paths], RecInputSuppliers, !CallInfo) :-
Path = path_info(PPId, CallSite, GammaConst, GammaVars, ActiveVars),
- ( CallSite = yes(CallPPIdPrime - ContextPrime) ->
+ (
+ CallSite = yes(CallPPIdPrime - ContextPrime),
CallPPId = CallPPIdPrime,
Context = ContextPrime
;
+ CallSite = no,
unexpected(this_file,
"add_call_arcs/4: no call site in path in stage 2.")
),
(
GammaVars = []
;
- GammaVars = [_|_],
+ GammaVars = [_ | _],
unexpected(this_file,
"add_call_arc/4: gamma variables in path in stage 2.")
),
- !.CallInfo = InfCalls0 - CallWeights0,
+ !.CallInfo = call_weight_info(InfCalls0, CallWeights0),
( bag.is_subbag(ActiveVars, RecInputSuppliers) ->
( map.search(CallWeights0, PPId, NeighbourMap0) ->
( map.search(NeighbourMap0, CallPPId, OldEdgeInfo) ->
@@ -517,10 +519,11 @@
map.det_insert(CallWeights0, PPId, NeighbourMap,
CallWeights1)
),
- !:CallInfo = InfCalls0 - CallWeights1
+ !:CallInfo = call_weight_info(InfCalls0, CallWeights1)
;
- InfCalls1 = [Context - inf_call(PPId, CallPPId) | InfCalls0],
- !:CallInfo = InfCalls1 - CallWeights0
+ InfCall = termination_error_context(inf_call(PPId, CallPPId), Context),
+ InfCalls1 = [InfCall | InfCalls0],
+ !:CallInfo = call_weight_info(InfCalls1, CallWeights0)
),
add_call_arcs(Paths, RecInputSuppliers, !CallInfo).
@@ -597,7 +600,10 @@
( WeightSoFar1 >= 0 ->
FinalVisitedCalls = [CurPPId - Context | VisitedCalls],
list.reverse(FinalVisitedCalls, RevFinalVisitedCalls),
- Cycles = [ProcContext - cycle(LookforPPId, RevFinalVisitedCalls)]
+ CycleError = cycle(LookforPPId, RevFinalVisitedCalls),
+ CycleErrorContext = termination_error_context(CycleError,
+ ProcContext),
+ Cycles = [CycleErrorContext]
;
Cycles = []
)
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.55
diff -u -r1.55 term_traversal.m
--- compiler/term_traversal.m 7 Aug 2007 07:10:07 -0000 1.55
+++ compiler/term_traversal.m 27 Aug 2007 06:10:32 -0000
@@ -408,23 +408,23 @@
add_error(Context, Error, Params, error(Errors0, CanLoop),
error(Errors, CanLoop)) :-
- Errors1 = [Context - Error | Errors0],
+ Errors1 = [termination_error_context(Error, Context) | Errors0],
params_get_max_errors(Params, MaxErrors),
list.take_upto(MaxErrors, Errors1, Errors).
add_error(Context, Error, _, ok(_, CanLoop),
- error([Context - Error], CanLoop)).
+ error([termination_error_context(Error, Context)], CanLoop)).
:- pred called_can_loop(prog_context::in, termination_error::in,
traversal_params::in, traversal_info::in, traversal_info::out) is det.
called_can_loop(Context, Error, Params, error(Errors, CanLoop0),
error(Errors, CanLoop)) :-
- CanLoop1 = [Context - Error | CanLoop0],
+ CanLoop1 = [termination_error_context(Error, Context) | CanLoop0],
params_get_max_errors(Params, MaxErrors),
list.take_upto(MaxErrors, CanLoop1, CanLoop).
called_can_loop(Context, Error, Params, ok(Paths, CanLoop0),
ok(Paths, CanLoop)) :-
- CanLoop1 = [Context - Error | CanLoop0],
+ CanLoop1 = [termination_error_context(Error, Context) | CanLoop0],
params_get_max_errors(Params, MaxErrors),
list.take_upto(MaxErrors, CanLoop1, CanLoop).
@@ -464,7 +464,8 @@
Info = ok(Paths, CanLoop)
;
params_get_context(Params, Context),
- Info = error([Context - too_many_paths], CanLoop)
+ Info = error([termination_error_context(too_many_paths, Context)],
+ CanLoop)
).
%-----------------------------------------------------------------------------%
@@ -577,7 +578,7 @@
set.to_sorted_list(Paths, PathList),
some_active_vars_in_bag(PathList, OutVars)
->
- Info = error([Context - ErrorMsg], CanLoop)
+ Info = error([termination_error_context(ErrorMsg, Context)], CanLoop)
;
Info = ok(Paths, CanLoop)
).
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.56
diff -u -r1.56 term_util.m
--- compiler/term_util.m 23 May 2007 10:09:22 -0000 1.56
+++ compiler/term_util.m 27 Aug 2007 06:10:32 -0000
@@ -364,12 +364,12 @@
add_context_to_termination_info(yes(cannot_loop(_)), _,
yes(cannot_loop(unit))).
add_context_to_termination_info(yes(can_loop(_)), Context,
- yes(can_loop([Context - imported_pred]))).
+ yes(can_loop([termination_error_context(imported_pred, Context)]))).
add_context_to_arg_size_info(no, _, no).
add_context_to_arg_size_info(yes(finite(A, B)), _, yes(finite(A, B))).
add_context_to_arg_size_info(yes(infinite(_)), Context,
- yes(infinite([Context - imported_pred]))).
+ yes(infinite([termination_error_context(imported_pred, Context)]))).
%-----------------------------------------------------------------------------%
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.76
diff -u -r1.76 termination.m
--- compiler/termination.m 31 May 2007 08:12:53 -0000 1.76
+++ compiler/termination.m 27 Aug 2007 06:10:32 -0000
@@ -172,7 +172,8 @@
TermStatus = yes(cannot_loop(unit)),
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo)
;
- TermErr = Context - does_not_term_foreign(PPId),
+ TermErr = termination_error_context(
+ does_not_term_foreign(PPId), Context),
TermStatus = yes(can_loop([TermErr])),
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo)
)
@@ -182,7 +183,8 @@
% contradict this.
MaybeTermination = yes(cannot_loop(_)),
( get_terminates(Attributes) = proc_does_not_terminate ->
- TermErr = Context - inconsistent_annotations,
+ TermErr = termination_error_context(
+ inconsistent_annotations, Context),
TermStatus = yes(can_loop([TermErr])),
% XXX intermod
proc_info_set_maybe_termination_info(TermStatus, !ProcInfo),
@@ -206,7 +208,8 @@
% does not contradict this.
MaybeTermination = yes(can_loop(TermErrs0)),
( get_terminates(Attributes) = proc_terminates ->
- TermErr = Context - inconsistent_annotations,
+ TermErr = termination_error_context(
+ inconsistent_annotations, Context),
TermErrs = [TermErr | TermErrs0 ],
TermStatus = yes(can_loop(TermErrs)),
% XXX intermod
@@ -296,7 +299,8 @@
%
get_context_from_scc(SCCTerminationKnown, !.ModuleInfo,
Context),
- NewTermStatus = can_loop([Context - inconsistent_annotations]),
+ NewTermStatus = can_loop([termination_error_context(
+ inconsistent_annotations, Context)]),
set_termination_infos(SCC, NewTermStatus, !ModuleInfo),
PredIds = list.map((func(proc(PredId, _)) = PredId),
@@ -384,18 +388,15 @@
% report errors here as well.
SCCTerminationUnknown = []
;
- SCCTerminationUnknown = [_|_],
- IsFatal = (pred(ContextError::in) is semidet :-
- ContextError = _Context - Error,
- ( Error = horder_call
- ; Error = horder_args(_, _)
- ; Error = imported_pred
- )
+ SCCTerminationUnknown = [_ | _],
+ IsFatal = (pred(ErrorAndContext::in) is semidet :-
+ ErrorAndContext = termination_error_context(Error, _),
+ is_fatal_error(Error) = yes
),
list.filter(IsFatal, ArgSizeErrors, FatalErrors),
BothErrors = TermErrors ++ FatalErrors,
(
- BothErrors = [_|_],
+ BothErrors = [_ | _],
% These errors prevent pass 2 from proving termination
% in any case, so we may as well not prove it quickly.
PassInfo = pass_info(_, MaxErrors, _),
@@ -534,8 +535,8 @@
PrintErrors = Errors
; NormalErrors = yes ->
IsNonSimple = (pred(ContextError::in) is semidet :-
- ContextError = _Context - Error,
- \+ indirect_error(Error)
+ ContextError = termination_error_context(Error, _Context),
+ is_indirect_error(Error) = no
),
list.filter(IsNonSimple, Errors, PrintErrors0),
% If there were no direct errors then use the indirect errors.
@@ -586,7 +587,8 @@
check_preds([], !ModuleInfo, !IO).
check_preds([PredId | PredIds], !ModuleInfo, !IO) :-
- write_pred_progress_message("% Checking termination of ", PredId, !.ModuleInfo, !IO),
+ write_pred_progress_message("% Checking termination of ", PredId,
+ !.ModuleInfo, !IO),
globals.io_lookup_bool_option(make_optimization_interface, MakeOptInt, !IO),
module_info_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
@@ -635,18 +637,20 @@
change_procs_termination_info(ProcIds, yes, cannot_loop(unit),
ProcTable0, ProcTable1)
;
- TerminationError = Context - imported_pred,
+ TerminationError = termination_error_context(imported_pred,
+ Context),
TerminationInfo = can_loop([TerminationError]),
change_procs_termination_info(ProcIds, no, TerminationInfo,
ProcTable0, ProcTable1)
),
- ArgSizeError = imported_pred,
- ArgSizeInfo = infinite([Context - ArgSizeError]),
+ ArgSizeError = termination_error_context(imported_pred, Context),
+ ArgSizeInfo = infinite([ArgSizeError]),
change_procs_arg_size_info(ProcIds, no, ArgSizeInfo,
ProcTable1, ProcTable2)
),
( check_marker(Markers, marker_does_not_terminate) ->
- RequestError = Context - does_not_term_pragma(PredId),
+ RequestError = termination_error_context(
+ does_not_term_pragma(PredId), Context),
RequestTerminationInfo = can_loop([RequestError]),
change_procs_termination_info(ProcIds, yes,
RequestTerminationInfo, ProcTable2, ProcTable)
@@ -768,7 +772,8 @@
;
pred_info_get_context(PredInfo, Context),
Error = is_builtin(PredId),
- ArgSizeInfo = yes(infinite([Context - Error]))
+ ArgSizeError = termination_error_context(Error, Context),
+ ArgSizeInfo = yes(infinite([ArgSizeError]))
),
% XXX intermod
proc_info_set_maybe_arg_size_info(ArgSizeInfo, ProcInfo0, ProcInfo1),
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.190
diff -u -r1.190 unify_proc.m
--- compiler/unify_proc.m 20 Aug 2007 03:36:07 -0000 1.190
+++ compiler/unify_proc.m 27 Aug 2007 06:10:32 -0000
@@ -64,13 +64,13 @@
:- import_module io.
:- import_module list.
:- import_module maybe.
-:- import_module pair.
%-----------------------------------------------------------------------------%
:- type proc_requests.
-:- type unify_proc_id == pair(type_ctor, uni_mode).
+:- type unify_proc_id
+ ---> unify_proc_id(type_ctor, uni_mode).
% Initialize the proc_requests table.
%
@@ -170,6 +170,7 @@
:- import_module int.
:- import_module map.
+:- import_module pair.
:- import_module queue.
:- import_module set.
:- import_module string.
@@ -261,13 +262,13 @@
;
module_info_get_proc_requests(ModuleInfo, Requests),
get_unify_req_map(Requests, UnifyReqMap),
- map.search(UnifyReqMap, TypeCtor - UniMode, ProcId)
+ map.search(UnifyReqMap, unify_proc_id(TypeCtor, UniMode), ProcId)
).
%-----------------------------------------------------------------------------%
request_unify(UnifyId, InstVarSet, Determinism, Context, !ModuleInfo) :-
- UnifyId = TypeCtor - UnifyMode,
+ UnifyId = unify_proc_id(TypeCtor, UnifyMode),
% Generating a unification procedure for a type uses its body.
module_info_get_maybe_recompilation_info(!.ModuleInfo, MaybeRecompInfo0),
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list