[m-rev.] diff: cleanup type constraints code
Zoltan Somogyi
zs at csse.unimelb.edu.au
Thu Jun 4 15:14:56 AEST 2009
compiler/type_constraints.m:
Minor cleanups.
Zoltan.
cvs diff: Diffing .
Index: type_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_constraints.m,v
retrieving revision 1.3
diff -u -b -r1.3 type_constraints.m
--- type_constraints.m 10 Mar 2009 05:00:31 -0000 1.3
+++ type_constraints.m 4 Jun 2009 05:06:33 -0000
@@ -75,47 +75,51 @@
:- type type_constraint
---> tconstr_conj(
+ % A conjunction of constraints, all of which must hold.
conj_type_constraint
- % A conjunction of constraints, all of which must hold
)
; tconstr_disj(
- list(conj_type_constraint),
% A disjunction of conjunctions of constraints, caused
- % by ambiguity in unifications or calls
- maybe(conj_type_constraint)
+ % by ambiguity in unifications or calls.
+ list(conj_type_constraint),
+
% "Yes" if the disjunction has been reduced to a single
- % possible conjunction by constraint propagation
+ % possible conjunction by constraint propagation.
+ maybe(conj_type_constraint)
).
:- type conj_type_constraint
---> ctconstr(
- tconstr_simples :: list(simple_type_constraint),
% The simple constraints which make up the conjunction.
- tconstr_activity :: tconstr_activity,
+ tconstr_simples :: list(simple_type_constraint),
+
% Whether the constraint is still active, or has been
% found to be unsatisfiable.
- tconstr_context :: prog_context,
+ tconstr_activity :: tconstr_activity,
+
% The context of the goal that creates the conjunction.
- tconstr_goal_path :: maybe(goal_path),
+ tconstr_context :: prog_context,
+
% The goal path of the goal which created the constraint,
% if it is relevant.
- tconstr_pred_id :: maybe(pred_id)
- % The predicate ID of the predicate call, if this is a
+ tconstr_goal_path :: maybe(goal_path),
+
+ % The predicate id of the predicate call, if this is a
% predicate call constraint.
+ tconstr_pred_id :: maybe(pred_id)
).
:- type tconstr_activity
---> tconstr_active
% The constraint is still relevant.
+
; tconstr_unsatisfiable.
% The constraint is only relevant for error diagnosis.
:- type simple_type_constraint
---> stconstr(
- tvar,
- % The variable whose type is being constrained.
- mer_type
- % The type to which the variable is being assigned.
+ tvar, % The variable whose type is being constrained.
+ mer_type % The type to which the variable is being assigned.
).
:- type type_constraint_set == set(type_constraint_id).
@@ -144,29 +148,36 @@
:- type type_domain
---> tdomain(set(mer_type))
- % A type-domain consisting of multiple possible types
+ % A type-domain consisting of multiple possible types.
+
; tdomain_singleton(mer_type)
% A domain that has been fixed to one definite type. This
% is used to avoid propagating on the same variable twice.
+
; tdomain_any.
% This represents an unbound type.
:- type type_constraint_info
---> tconstr_info(
- tconstr_var_map :: prog_var_map,
% A map from program variables to their corresponding
% type variables.
+ tconstr_var_map :: prog_var_map,
+
+ % A counter for constraint ids.
tconstr_constraint_counter :: type_constraint_counter,
- % A counter for constraint IDs.
+
+ % A map from constraint ids to constraints.
tconstr_constraint_map :: type_constraint_map,
- % A map from constraint IDs to constraints.
- tconstr_var_constraints :: var_constraint_map,
+
% A map from type variables to the constraints
% which involve them.
- tconstr_tvarset :: tvarset,
+ tconstr_var_constraints :: var_constraint_map,
+
% The set of type variables used in the constraints.
- tconstr_error_spec :: error_specs
+ tconstr_tvarset :: tvarset,
+
% All errors encountered during typechecking.
+ tconstr_error_specs :: error_specs
).
:- type type_constraint_solution
@@ -176,8 +187,8 @@
tconstr_sol_success :: bool
).
- % Maps from IDs of program elements to their definitions,
- % extracted from the HLDS
+ % Maps from ids of program elements to their definitions,
+ % extracted from the HLDS.
%
:- type tconstr_environment
---> tconstr_environment(
@@ -205,24 +216,25 @@
% This is the predicate called by the compiler to perform the typecheck
% pass.
%
-typecheck_constraints(!HLDS, ErrorSpec) :-
+typecheck_constraints(!HLDS, Specs) :-
% hlds_module.module_info_get_type_table(!.HLDS, TypeEnv),
hlds_module.module_info_get_event_set(!.HLDS, event_set(_, EventEnv)),
hlds_module.module_info_get_class_table(!.HLDS, ClassEnv),
hlds_module.module_info_get_cons_table(!.HLDS, FuncEnv),
hlds_module.module_info_get_predicate_table(!.HLDS, PredEnv),
- hlds_module.module_info_predids(PredIDs, !HLDS),
+ Environment0 = tconstr_environment(EventEnv, ClassEnv, FuncEnv, PredEnv),
- list.foldl3(typecheck_one_predicate_if_needed, PredIDs,
- tconstr_environment(EventEnv, ClassEnv, FuncEnv, PredEnv), _, !HLDS,
- [], ErrorSpec).
+ hlds_module.module_info_predids(PredIds, !HLDS),
+ list.foldl3(typecheck_one_predicate_if_needed, PredIds,
+ Environment0, _, !HLDS, [], Specs).
:- pred typecheck_one_predicate_if_needed(pred_id::in, tconstr_environment::in,
tconstr_environment::out, module_info::in, module_info::out,
error_specs::in, error_specs::out) is det.
-typecheck_one_predicate_if_needed(PredID, !Environment, !HLDS, !Errors) :-
- predicate_table_get_preds(!.Environment^pred_env, Preds),
- map.lookup(Preds, PredID, PredInfo),
+
+typecheck_one_predicate_if_needed(PredId, !Environment, !HLDS, !Specs) :-
+ predicate_table_get_preds(!.Environment ^ pred_env, Preds),
+ map.lookup(Preds, PredId, PredInfo),
(
% Compiler-generated predicates are created already type-correct,
% so there's no need to typecheck them. The same is true for builtins.
@@ -243,30 +255,31 @@
(
IsEmpty = yes,
pred_info_mark_as_external(PredInfo, PredInfo1),
- map.det_update(Preds, PredID, PredInfo1, Preds1),
- predicate_table_set_preds(Preds1, !.Environment^pred_env,
- PredEnv1),
- module_info_set_predicate_table(PredEnv1, !HLDS),
- !:Environment = !.Environment^pred_env := PredEnv1
+ map.det_update(Preds, PredId, PredInfo1, Preds1),
+ PredEnv0 = !.Environment ^ pred_env,
+ predicate_table_set_preds(Preds1, PredEnv0, PredEnv),
+ module_info_set_predicate_table(PredEnv, !HLDS),
+ !Environment ^ pred_env := PredEnv
;
IsEmpty = no
)
;
- typecheck_one_predicate(PredID, !Environment, !HLDS, !Errors)
+ typecheck_one_predicate(PredId, !Environment, !HLDS, !Specs)
).
-
-:- pred typecheck_one_predicate(pred_id::in, tconstr_environment::in,
- tconstr_environment::out, module_info::in, module_info::out,
+:- pred typecheck_one_predicate(pred_id::in,
+ tconstr_environment::in, tconstr_environment::out,
+ module_info::in, module_info::out,
error_specs::in, error_specs::out) is det.
-typecheck_one_predicate(PredID, !Environment, !HLDS, !Errors) :-
+typecheck_one_predicate(PredId, !Environment, !HLDS, !Specs) :-
some [!Preds, !PredInfo, !ClausesInfo, !Clauses, !Goals, !PredEnv,
- !TCInfo, !Vartypes] (
+ !TCInfo, !Vartypes]
+ (
% Find the clause list in the predicate definition.
- !:PredEnv = !.Environment^pred_env,
+ !:PredEnv = !.Environment ^ pred_env,
predicate_table_get_preds(!.PredEnv, !:Preds),
- map.lookup(!.Preds, PredID, !:PredInfo),
+ map.lookup(!.Preds, PredId, !:PredInfo),
pred_info_get_typevarset(!.PredInfo, TVarSet),
pred_info_get_context(!.PredInfo, Context),
pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
@@ -276,7 +289,7 @@
trace [compile_time(flag("type_error_diagnosis")), io(!IO)] (
LineNumber = string.int_to_string(term.context_line(Context)),
FileName = term.context_file(Context),
- PredNumber = int_to_string(pred_id_to_int(PredID)),
+ PredNumber = int_to_string(pred_id_to_int(PredId)),
io.write_string("=== Predicate " ++ PredNumber ++ " [" ++
FileName ++ ": " ++ LineNumber ++ "] ===\n", !IO)
),
@@ -290,12 +303,10 @@
HeadVars, HeadTypes, tconstr_info(bimap.init, counter.init(0),
map.init, map.init, TVarSet, []), !:TCInfo)
;
- unexpected(this_file, "Predicate " ++ int_to_string(pred_id_to_int(
- PredID)) ++ ": Number of head variable types is not equal" ++
- "to number of head variables")
+ unexpected(this_file, "head variable types vs vars mismatch")
),
- % Generate constraints for each clause of the predicate
+ % Generate constraints for each clause of the predicate.
list.map(get_clause_body, !.Clauses, !:Goals),
list.map(fill_goal_path_slots_in_goal_2(map.init, !.HLDS), !Goals),
list.foldl(goal_to_constraint(!.Environment), !.Goals, !TCInfo),
@@ -303,22 +314,22 @@
print_pred_constraint(!.TCInfo, ProgVarSet, !IO)
),
- % Solve all the constraints
+ % Solve all the constraints.
find_type_constraint_solutions(Context, ProgVarSet, DomainMap0,
!TCInfo),
list.foldl2_corresponding(unify_equal_tvars(!.TCInfo, set.init),
- HeadTVars, HeadTVars, map.init, ReplacementMap, DomainMap0,
- DomainMap),
+ HeadTVars, HeadTVars,
+ map.init, ReplacementMap, DomainMap0, DomainMap),
trace [compile_time(flag("type_error_diagnosis")), io(!IO)] (
print_constraint_solution(!.TCInfo, ProgVarSet, DomainMap, !IO)
),
% Update the HLDS with the results of the solving and report any
% ambiguity errors found in this process.
- list.map2(update_goal(!.PredEnv, !.TCInfo^tconstr_constraint_map),
+ list.map2(update_goal(!.PredEnv, !.TCInfo ^ tconstr_constraint_map),
!Goals, PredErrors),
- create_vartypes_map(Context, ProgVarSet, !.TCInfo^tconstr_tvarset,
- !.TCInfo^tconstr_var_map, DomainMap, ReplacementMap, !:Vartypes,
+ create_vartypes_map(Context, ProgVarSet, !.TCInfo ^ tconstr_tvarset,
+ !.TCInfo ^ tconstr_var_map, DomainMap, ReplacementMap, !:Vartypes,
VarTypeErrors),
list.map_corresponding(set_clause_body, !.Goals, !Clauses),
list.condense([VarTypeErrors | PredErrors], NewErrors),
@@ -327,15 +338,16 @@
list.foldl(add_unused_prog_var(!.TCInfo), HeadVars, !Vartypes),
clauses_info_set_vartypes(!.Vartypes, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo),
- pred_info_set_typevarset(!.TCInfo^tconstr_tvarset, !PredInfo),
- svmap.det_update(PredID, !.PredInfo, !Preds),
+ pred_info_set_typevarset(!.TCInfo ^ tconstr_tvarset, !PredInfo),
+ svmap.det_update(PredId, !.PredInfo, !Preds),
predicate_table_set_preds(!.Preds, !PredEnv),
module_info_set_predicate_table(!.PredEnv, !HLDS),
- !:Environment = !.Environment^pred_env := !.PredEnv,
- list.append(!.TCInfo^tconstr_error_spec, !Errors)
+ !Environment ^ pred_env := !.PredEnv,
+ !:Specs = !.TCInfo ^ tconstr_error_specs ++ !.Specs
).
%-----------------------------------------------------------------------------%
+%
% General typechecking utility predicates
% A compiler-generated predicate only needs type checking if
@@ -350,8 +362,8 @@
is semidet.
special_pred_needs_typecheck(PredInfo, ModuleInfo) :-
- % Check if the predicate is a compiler-generated special
- % predicate, and if so, for which type.
+ % Check if the predicate is a compiler-generated special predicate,
+ % and if so, for which type.
pred_info_get_origin(PredInfo, Origin),
Origin = origin_special_pred(SpecialPredId - TypeCtor),
@@ -367,9 +379,8 @@
special_pred_for_type_needs_typecheck(ModuleInfo, SpecialPredId, Body).
% Updates the goal with the pred_ids of all predicates called in the goal.
- % If there is an ambiguous predicate call, chooses one predicate to
- % be the "correct" one and returns an error message describing the
- % problem.
+ % If there is an ambiguous predicate call, chooses one predicate to be
+ % the "correct" one and returns an error message describing the problem.
%
:- pred update_goal(pred_env::in, type_constraint_map::in, hlds_goal::in,
hlds_goal::out, list(error_msg)::out) is det.
@@ -388,17 +399,16 @@
PredData = DefinitePredData ++ AmbigPredData,
list.foldl(apply_pred_data_to_goal, PredData, !Goal).
-
:- pred apply_pred_data_to_goal(pair(goal_path, pred_id)::in,
hlds_goal::in, hlds_goal::out) is det.
-apply_pred_data_to_goal((GoalPath0 - PredID), !Goal) :-
+apply_pred_data_to_goal((GoalPath0 - PredId), !Goal) :-
program_representation.goal_path_consable(GoalPath0, GoalPath),
(
- goal_util.maybe_transform_goal_at_goal_path(set_goal_pred_id(PredID),
- GoalPath, !.Goal, yes(Goal1))
+ goal_util.maybe_transform_goal_at_goal_path(set_goal_pred_id(PredId),
+ GoalPath, !.Goal, yes(GoalPrime))
->
- !:Goal = Goal1
+ !:Goal = GoalPrime
;
true
).
@@ -406,25 +416,24 @@
:- pred set_goal_pred_id(pred_id::in, hlds_goal::in, maybe(hlds_goal)::out)
is det.
-set_goal_pred_id(PredID, hlds_goal(Expression0, Info), MaybeGoal) :-
+set_goal_pred_id(PredId, hlds_goal(Expression0, Info), MaybeGoal) :-
( Expression0 = plain_call(_, _, _, _, _, _) ->
trace [compile_time(flag("type_error_diagnosis")), io(!IO)] (
Context = goal_info_get_context(Info),
LineNumber = string.int_to_string(term.context_line(Context)),
FileName = term.context_file(Context),
- PredName = sym_name_to_string(Expression0^call_sym_name),
+ PredName = sym_name_to_string(Expression0 ^ call_sym_name),
io.print(" Predicate " ++ PredName ++ " (" ++ FileName ++ ": " ++
- LineNumber ++ ") has ID " ++
- int_to_string(pred_id_to_int(PredID)) ++ "\n", !IO)
+ LineNumber ++ ") has id " ++
+ int_to_string(pred_id_to_int(PredId)) ++ "\n", !IO)
),
- NewCall = Expression0^call_pred_id := PredID,
+ NewCall = Expression0 ^ call_pred_id := PredId,
MaybeGoal = yes(hlds_goal(NewCall, Info))
;
MaybeGoal = no
).
- % The following predicates extract the disjuncts from
- % type constraints.
+ % The following predicates extract the disjuncts from type constraints.
%
:- pred has_one_disjunct(type_constraint::in, conj_type_constraint::out)
is semidet.
@@ -438,7 +447,7 @@
is semidet.
get_first_disjunct(tconstr_disj(Cs, no), C) :-
- list.filter(still_active, Cs, [C|_]).
+ list.filter(still_active, Cs, [C | _]).
get_first_disjunct(tconstr_disj(_, yes(C)), C).
get_first_disjunct(tconstr_conj(C), C).
@@ -449,8 +458,8 @@
list.filter(still_active, Cs0, Cs),
Cs = [_, _ | _].
- % Creates the vartypes map, which is inserted into the relevant
- % pred_info and used by the rest of the compiler.
+ % Creates the vartypes map, which is inserted into the relevant pred_info
+ % and used by the rest of the compiler.
%
:- pred create_vartypes_map(prog_context::in, prog_varset::in, tvarset::in,
prog_var_map::in, type_domain_map::in, simple_prog_var_map::in,
@@ -461,7 +470,7 @@
bimap.ordinates(VarMap, ProgVars),
list.map2(find_variable_type(Context, ProgVarSet, TVarSet, VarMap,
DomainMap, ReplacementMap), ProgVars, Types, MaybeErrors),
- list.filter_map(type_constraints.remove_maybe, MaybeErrors, Errors),
+ list.filter_map(remove_maybe, MaybeErrors, Errors),
map.det_insert_from_corresponding_lists(map.init, ProgVars, Types,
Vartypes).
@@ -522,11 +531,12 @@
fill_goal_path_slots_in_goal(!.G, V, M, !:G).
:- pred get_clause_body(clause::in, hlds_goal::out) is det.
-get_clause_body(Clause, Clause^clause_body).
+
+get_clause_body(Clause, Clause ^ clause_body).
:- pred set_clause_body(hlds_goal::in, clause::in, clause::out) is det.
-set_clause_body(Goal, Clause, Clause^clause_body := Goal).
+set_clause_body(Goal, Clause, Clause ^ clause_body := Goal).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -540,60 +550,62 @@
% the problem.
%
:- pred find_type_constraint_solutions(prog_context::in, prog_varset::in,
- type_domain_map::out, type_constraint_info::in,
- type_constraint_info::out) is det.
+ type_domain_map::out,
+ type_constraint_info::in, type_constraint_info::out) is det.
-find_type_constraint_solutions(Context, ProgVarSet, DomainMap,
- !.TCInfo @ tconstr_info(_, _, !.ConstraintMap, VarConstraints,
- TVarSet, _), !:TCInfo) :-
- solve_constraint_labeling(TVarSet, VarConstraints, !.ConstraintMap,
- map.init, map.init, LabledSolution),
- LabledSolution = tconstr_solution(Solutions, !:ConstraintMap, Success),
+find_type_constraint_solutions(Context, ProgVarSet, DomainMap, !TCInfo) :-
+ !.TCInfo = tconstr_info(_, _, ConstraintMap0, VarConstraints, TVarSet, _),
+ solve_constraint_labeling(TVarSet, VarConstraints, ConstraintMap0,
+ map.init, map.init, LabeledSolution),
+ LabeledSolution = tconstr_solution(Solutions, ConstraintMap, Success),
(
- Solutions = []
- ->
+ Solutions = [],
% This shouldn't happen.
+ % XXX zs: The reason *why* it should not happen should be documented.
unexpected(this_file,
"Cannot find any possible solutions for the type constraints")
;
+ Solutions = [FirstSolution | LaterSolutions],
+ (
+ Success = no,
% Unsatisfiability error (no solutions). If labeling was required
% and no labeling assignment produced a solution, pick an arbitrary
% labeling to report (this should be rare in real programs).
- Success = no,
- Solutions = [Solution | _]
- ->
trace [compile_time(flag("type_error_reporting")), io(!IO)] (
io.write_string("\nUnsatisfiability error\n", !IO)
),
- map.to_assoc_list(Solution, SolutionAssocList),
+ map.to_assoc_list(FirstSolution, SolutionAssocList),
list.filter_map(has_empty_domain, SolutionAssocList, ErrorTVars),
list.map(diagnose_unsatisfiability_error(!.TCInfo, Context,
ProgVarSet), ErrorTVars, ErrorMessages),
list.foldl(add_message_to_spec, ErrorMessages, !TCInfo),
- list.foldl(map.union(type_domain_union), Solutions, map.init,
- DomainMap)
+ list.foldl(map.union(type_domain_union), Solutions,
+ map.init, DomainMap)
;
+ Success = yes,
+ (
+ LaterSolutions = [],
% Type correct (one solution).
- Solutions = [SingleSolution]
- ->
- DomainMap = SingleSolution
+ DomainMap = FirstSolution
;
+ LaterSolutions = [_ | _],
% Ambiguity error (many solutions).
list.foldl(map.union(type_domain_union), Solutions, map.init,
DomainMap),
trace [compile_time(flag("type_error_reporting")), io(!IO)] (
io.write_string("\nAmbiguity error\n", !IO)
)
+ )
+ )
),
- !TCInfo ^ tconstr_constraint_map := !.ConstraintMap.
+ !TCInfo ^ tconstr_constraint_map := ConstraintMap.
:- pred solve_constraint_labeling(tvarset::in, var_constraint_map::in,
type_constraint_map::in, type_domain_map::in, type_domain_map::in,
type_constraint_solution::out) is det.
-solve_constraint_labeling(TVarSet, VarConstraints, ConstraintMap0,
- DomainMap0, Guesses,
- tconstr_solution(DomainMaps, ConstraintMap, Success)) :-
+solve_constraint_labeling(TVarSet, VarConstraints, ConstraintMap0, DomainMap0,
+ Guesses, Solution) :-
trace [compile_time(flag("type_constraint_prop")), io(!IO)] (
map.to_assoc_list(Guesses, GuessesAssocList),
list.foldl(print_guess(TVarSet), GuessesAssocList, !IO)
@@ -613,20 +625,20 @@
list.map(map.set(Guesses, Var), Domains, NewGuesses),
list.map(solve_constraint_labeling(TVarSet, VarConstraints,
ConstraintMap1, DomainMap1), NewGuesses, Solutions),
- list.filter(solution_is_invalid, Solutions, FailSolutions,
- SuccessSolutions),
+ list.filter(solution_is_invalid, Solutions,
+ FailSolutions, SuccessSolutions),
(
SuccessSolutions = [],
- list.map(type_constraint_solution_get_domains, FailSolutions,
- DomainMaps0),
+ list.map(type_constraint_solution_get_domains,
+ FailSolutions, DomainMaps0),
list.condense(DomainMaps0, DomainMaps),
list.map(type_constraint_solution_get_constraint_map,
FailSolutions, RelevantConstraintMaps),
Success = no
;
- SuccessSolutions = [_|_],
- list.map(type_constraint_solution_get_domains, SuccessSolutions,
- DomainMaps0),
+ SuccessSolutions = [_ | _],
+ list.map(type_constraint_solution_get_domains,
+ SuccessSolutions, DomainMaps0),
list.condense(DomainMaps0, DomainMaps),
list.map(type_constraint_solution_get_constraint_map,
SuccessSolutions, RelevantConstraintMaps),
@@ -644,7 +656,8 @@
DomainMaps = [DomainMap1],
ConstraintMap = ConstraintMap1,
Success = yes
- ).
+ ),
+ Solution = tconstr_solution(DomainMaps, ConstraintMap, Success).
:- pred solution_is_invalid(type_constraint_solution::in) is semidet.
@@ -653,12 +666,12 @@
:- pred type_constraint_solution_get_domains(type_constraint_solution::in,
list(type_domain_map)::out) is det.
-type_constraint_solution_get_domains(T, T^tconstr_sol_domain_maps).
+type_constraint_solution_get_domains(T, T ^ tconstr_sol_domain_maps).
:- pred type_constraint_solution_get_constraint_map(
type_constraint_solution::in, type_constraint_map::out) is det.
-type_constraint_solution_get_constraint_map(T, T^tconstr_sol_constraint_map).
+type_constraint_solution_get_constraint_map(T, T ^ tconstr_sol_constraint_map).
% Restricts the domain of each variable in the constraint based on all
% information in the constraint. If the domain map is unchanged in one pass
@@ -670,12 +683,11 @@
type_constraint_map::in, type_constraint_map::out,
type_domain_map::in, type_domain_map::out) is det.
-solve_constraint(TVarSet, VarConstraints, !ConstraintMap,
- !DomainMap) :-
+solve_constraint(TVarSet, VarConstraints, !ConstraintMap, !DomainMap) :-
ConstraintMap0 = !.ConstraintMap,
DomainMap0 = !.DomainMap,
- ConstraintIDs = map.keys(!.ConstraintMap),
- list.foldl2(propagate(TVarSet, VarConstraints), ConstraintIDs,
+ ConstraintIds = map.keys(!.ConstraintMap),
+ list.foldl2(propagate(TVarSet, VarConstraints), ConstraintIds,
!ConstraintMap, !DomainMap),
(
% Failure.
@@ -690,8 +702,7 @@
true
;
% Need to iterate again.
- solve_constraint(TVarSet, VarConstraints, !ConstraintMap,
- !DomainMap)
+ solve_constraint(TVarSet, VarConstraints, !ConstraintMap, !DomainMap)
).
% Given the information from a single constraint, updates the domains of
@@ -700,31 +711,31 @@
% involving that variable.
%
:- pred propagate(tvarset::in, var_constraint_map::in, type_constraint_id::in,
- type_constraint_map::in, type_constraint_map::out, type_domain_map::in,
- type_domain_map::out) is det.
+ type_constraint_map::in, type_constraint_map::out,
+ type_domain_map::in, type_domain_map::out) is det.
-propagate(TVarSet, VarConstraints, ConstraintID, !ConstraintMap, !DomainMap) :-
+propagate(TVarSet, VarConstraints, ConstraintId, !ConstraintMap, !DomainMap) :-
% Update the domain of each variable in the constraint.
- map.lookup(!.ConstraintMap, ConstraintID, Constraint0),
+ map.lookup(!.ConstraintMap, ConstraintId, Constraint0),
find_domain(Constraint0, Constraint, !.DomainMap, NewDomainMap),
% Print the changes to the domain map.
trace [compile_time(flag("type_constraint_prop")), io(!IO)] (
- io.format("Constraint %d:\n", [i(ConstraintID)], !IO),
+ io.format("Constraint %d:\n", [i(ConstraintId)], !IO),
map.to_sorted_assoc_list(NewDomainMap, NewDomainAssocList),
list.foldl(print_domain_map_change(TVarSet, !.DomainMap),
NewDomainAssocList, !IO),
print_constraint_change(TVarSet, Constraint0, Constraint, !IO)
),
!:DomainMap = NewDomainMap,
- svmap.det_update(ConstraintID, Constraint, !ConstraintMap),
+ svmap.det_update(ConstraintId, Constraint, !ConstraintMap),
% If any variable domains have been reduced to singleton domains
% by this constraint, update the status of those variables and
% propagate to other constriants involving them.
tvars_in_constraint(Constraint, TVars),
list.filter(has_singleton_domain(!.DomainMap), TVars, SingletonVars),
list.foldl(update_singleton_domain, SingletonVars, !DomainMap),
- list.filter_map(map.search(VarConstraints), SingletonVars,
- PropConstraints0),
+ list.filter_map(map.search(VarConstraints),
+ SingletonVars, PropConstraints0),
PropConstraints = list.remove_dups(list.condense(PropConstraints0)),
list.foldl2(propagate(TVarSet, VarConstraints), PropConstraints,
!ConstraintMap, !DomainMap).
@@ -740,50 +751,61 @@
conj_find_domain(!Constraint, !DomainMap).
% Finds the domain of a type variable, given its existing domain and a
- % set of constraints on its type. Will mark as unsatisfiable any constraints
- % that are unsatisfiable.
+ % set of constraints on its type. Will mark as unsatisfiable any
+ % constraints that are unsatisfiable.
%
:- pred find_domain(type_constraint::in, type_constraint::out,
type_domain_map::in, type_domain_map::out) is det.
% A conjunction of constraints requires each constraint to be met.
%
-find_domain(tconstr_conj(Constraints), tconstr_conj(NewConstraints),
- !DomainMap) :-
- conj_find_domain(Constraints, NewConstraints, !DomainMap).
-
-find_domain(tconstr_disj(C, yes(Constraints)),
- tconstr_disj(C, yes(NewConstraints)), !DomainMap) :-
- conj_find_domain(Constraints, NewConstraints, !DomainMap).
-
+find_domain(Constraint0, Constraint, !DomainMap) :-
+ (
+ Constraint0 = tconstr_conj(ConjConstraints0),
+ conj_find_domain(ConjConstraints0, ConjConstraints, !DomainMap),
+ Constraint = tconstr_conj(ConjConstraints)
+ ;
+ Constraint0 = tconstr_disj(DisjConstraints0, yes(SingleConstraints0)),
+ conj_find_domain(SingleConstraints0, SingleConstraints, !DomainMap),
+ Constraint = tconstr_disj(DisjConstraints0, yes(SingleConstraints))
+ ;
+ Constraint0 = tconstr_disj(DisjConstraints0, no),
% A disjunction of constraints means the domain is restricted to
% the union of all type assignments in the each active disjunct.
- %
-find_domain(tconstr_disj(!.Constraints, no),
- tconstr_disj(!:Constraints, SingleConstraint), !DomainMap) :-
- % Generates a distinct domain map for each disjunct unifies each
- % domain in the domain map to get an overall domain for the disjunct,
- % then takes the intersect of this with the existing domain map.
- list.filter(still_active, !Constraints, InactiveConstraints),
- list.map2(create_domain(!.DomainMap), !Constraints, Domains),
+ some [!DisjConstraints] (
+ !:DisjConstraints = DisjConstraints0,
+
+ % Generates a distinct domain map for each disjunct, unifies each
+ % domain in the domain map to get an overall domain for the
+ % disjunct, then takes the intersection of this with the existing
+ % domain map.
+ list.filter(still_active, !.DisjConstraints,
+ !:DisjConstraints, InactiveConstraints),
+ list.map2(create_domain(!.DomainMap), !.DisjConstraints,
+ !:DisjConstraints, Domains),
(
Domains = [],
DisjDomain = map.init
;
Domains = [HeadDomain | TailDomains],
- list.foldl(map.intersect(type_domain_union), TailDomains, HeadDomain,
- DisjDomain)
+ list.foldl(map.intersect(type_domain_union), TailDomains,
+ HeadDomain, DisjDomain)
),
map.union(type_domain_intersect, DisjDomain, !DomainMap),
- % If there is only one active disjunct remaining, turn the constraint
+ % If there is only one active disjunct remaining, then mark
+ % the disjunction as such, which effectively turns the constraint
% into a conjunction constraint.
- list.filter(still_active, !.Constraints, Active),
+ list.filter(still_active, !.DisjConstraints, Active),
( Active = [SingleConstraint0] ->
SingleConstraint = yes(SingleConstraint0)
;
SingleConstraint = no
),
- list.append(InactiveConstraints, !Constraints).
+ list.append(InactiveConstraints, !DisjConstraints),
+ DisjConstraints = !.DisjConstraints
+ ),
+ Constraint = tconstr_disj(DisjConstraints, SingleConstraint)
+ ).
% Finds the domain of a conjunction of constraints. If the conjunction is
% unsatisfiable, marks it as unsatisfiable. If the domain of any type
@@ -793,76 +815,83 @@
:- pred conj_find_domain(conj_type_constraint::in, conj_type_constraint::out,
type_domain_map::in, type_domain_map::out) is det.
-conj_find_domain(Conj @ ctconstr(_, tconstr_unsatisfiable, _, _, _),
- Conj, !DomainMap).
-
-conj_find_domain(!.Conj @ ctconstr(Constraints, tconstr_active, Context,
- GoalPath, PredID), !:Conj, DomainMap0, DomainMap) :-
+conj_find_domain(!ConjTypeConstraint, DomainMap0, DomainMap) :-
+ (
+ !.ConjTypeConstraint = ctconstr(_, tconstr_unsatisfiable, _, _, _),
+ DomainMap = DomainMap0
+ ;
+ !.ConjTypeConstraint = ctconstr(Constraints, tconstr_active, Context,
+ GoalPath, PredId),
list.foldl(simple_find_domain, Constraints, DomainMap0, DomainMap1),
( constraint_is_satisfiable(DomainMap1, Constraints) ->
map.to_assoc_list(DomainMap1, AssocDomain1),
( list.all_true(domain_map_unchanged(DomainMap0), AssocDomain1) ->
DomainMap = DomainMap1
;
- conj_find_domain(!Conj, DomainMap1, DomainMap)
+ conj_find_domain(!ConjTypeConstraint, DomainMap1, DomainMap)
)
;
- DomainMap = DomainMap1,
- !:Conj = ctconstr(Constraints, tconstr_unsatisfiable, Context,
- GoalPath, PredID)
+ !:ConjTypeConstraint = ctconstr(Constraints, tconstr_unsatisfiable,
+ Context, GoalPath, PredId),
+ DomainMap = DomainMap1
+ )
).
% Finds the domain of a type variable based on the information provided by
% a simple type constraint, and the existing domain of the variable.
%
-:- pred simple_find_domain(simple_type_constraint::in, type_domain_map::in,
- type_domain_map::out) is det.
+:- pred simple_find_domain(simple_type_constraint::in,
+ type_domain_map::in, type_domain_map::out) is det.
+
+simple_find_domain(stconstr(TVarA, TypeA), !DomainMap) :-
+ % If the type is a compound type (e.g., maybe(T)), we try to further
+ % restrict its type based on what (if anything) we know about
+ % the types of its arguments.
-simple_find_domain(stconstr(TVar, Type), !DomainMap) :-
(
% If two type variables are unified, the domain of each is restricted
% to the insersection of the domains.
- Type = type_variable(TVar2, _),
- ( map.search(!.DomainMap, TVar2, Domain20) ->
- Domain2 = Domain20
- ;
- Domain2 = tdomain_any,
- svmap.det_insert(TVar2, Domain2, !DomainMap)
- ),
- ( map.search(!.DomainMap, TVar, Domain) ->
- type_domain_intersect(Domain, Domain2, NewDomain),
- svmap.det_update(TVar, NewDomain, !DomainMap),
- svmap.det_update(TVar2, NewDomain, !DomainMap)
- ;
- svmap.det_insert(TVar, Domain2, !DomainMap)
- )
- ;
- % If the type is a compound type (e.g., maybe(T)), try to determine
- % the types of its arguments.
- Type = defined_type(Name, Args, Kind),
- list.map(find_type_of_tvar(!.DomainMap), Args, ArgTypes),
- restrict_domain(TVar, defined_type(Name, ArgTypes, Kind), !DomainMap)
- ;
- Type = builtin_type(_),
- restrict_domain(TVar, Type, !DomainMap)
- ;
- Type = tuple_type(Args, Kind),
- list.map(find_type_of_tvar(!.DomainMap), Args, ArgTypes),
- restrict_domain(TVar, tuple_type(ArgTypes, Kind), !DomainMap)
- ;
- Type = higher_order_type(Args, Return, Purity, Lambda),
- list.map(find_type_of_tvar(!.DomainMap), Args, ArgTypes),
- map_maybe(find_type_of_tvar(!.DomainMap), Return, ReturnType),
- restrict_domain(TVar, higher_order_type(ArgTypes, ReturnType,
- Purity, Lambda), !DomainMap)
- ;
- Type = apply_n_type(Return, Args, Kind),
- list.map(find_type_of_tvar(!.DomainMap), Args, ArgTypes),
- restrict_domain(TVar, apply_n_type(Return, ArgTypes, Kind),
- !DomainMap)
+ TypeA = type_variable(TVarB, _),
+ ( map.search(!.DomainMap, TVarB, DomainBPrime) ->
+ DomainB = DomainBPrime
+ ;
+ DomainB = tdomain_any,
+ svmap.det_insert(TVarB, DomainB, !DomainMap)
+ ),
+ ( map.search(!.DomainMap, TVarA, DomainA) ->
+ type_domain_intersect(DomainA, DomainB, NewDomain),
+ svmap.det_update(TVarA, NewDomain, !DomainMap),
+ svmap.det_update(TVarB, NewDomain, !DomainMap)
+ ;
+ svmap.det_insert(TVarA, DomainB, !DomainMap)
+ )
+ ;
+ TypeA = defined_type(Name, ArgTypes0, Kind),
+ list.map(find_type_of_tvar(!.DomainMap), ArgTypes0, ArgTypes),
+ NewTypeA = defined_type(Name, ArgTypes, Kind),
+ restrict_domain(TVarA, NewTypeA, !DomainMap)
+ ;
+ TypeA = builtin_type(_),
+ restrict_domain(TVarA, TypeA, !DomainMap)
+ ;
+ TypeA = tuple_type(ArgTypes0, Kind),
+ list.map(find_type_of_tvar(!.DomainMap), ArgTypes0, ArgTypes),
+ NewTypeA = tuple_type(ArgTypes, Kind),
+ restrict_domain(TVarA, NewTypeA, !DomainMap)
+ ;
+ TypeA = higher_order_type(ArgTypes0, ReturnType0, Purity, Lambda),
+ list.map(find_type_of_tvar(!.DomainMap), ArgTypes0, ArgTypes),
+ map_maybe(find_type_of_tvar(!.DomainMap), ReturnType0, ReturnType),
+ NewTypeA = higher_order_type(ArgTypes, ReturnType, Purity, Lambda),
+ restrict_domain(TVarA, NewTypeA, !DomainMap)
+ ;
+ TypeA = apply_n_type(Return, ArgTypes0, Kind),
+ list.map(find_type_of_tvar(!.DomainMap), ArgTypes0, ArgTypes),
+ NewTypeA = apply_n_type(Return, ArgTypes, Kind),
+ restrict_domain(TVarA, NewTypeA, !DomainMap)
;
- Type = kinded_type(Type0, _),
- simple_find_domain(stconstr(TVar, Type0), !DomainMap)
+ TypeA = kinded_type(KindedTypeA, _),
+ simple_find_domain(stconstr(TVarA, KindedTypeA), !DomainMap)
).
% Finds each variable which is unified to the target variable. Replaces
@@ -875,16 +904,16 @@
tvar::in, tvar::in, simple_prog_var_map::in, simple_prog_var_map::out,
type_domain_map::in, type_domain_map::out) is det.
-unify_equal_tvars(TCInfo @ tconstr_info(VarMap, _, ConstraintMap,
- VarConstraints, _, _), Replaced, Replacement, Target,
+unify_equal_tvars(TCInfo, Replaced, Replacement, Target,
!ReplacementMap, !DomainMap) :-
+ TCInfo = tconstr_info(VarMap, _, ConstraintMap, VarConstraints, _, _),
map.det_insert(map.init, Target, Replacement, Renaming),
(
map.search(!.DomainMap, Target, tdomain_any),
- map.search(VarConstraints, Target, ConstraintIDs)
+ map.search(VarConstraints, Target, ConstraintIds)
->
% Find all variables unified with the target variable.
- map.apply_to_list(ConstraintIDs, ConstraintMap, Constraints),
+ map.apply_to_list(ConstraintIds, ConstraintMap, Constraints),
list.filter_map(to_simple_constraints, Constraints,
SimpleConstraints0),
list.condense(SimpleConstraints0, SimpleConstraints),
@@ -916,13 +945,14 @@
).
%-----------------------------------------------------------------------------%
-% Constraint solving utility predicates
+%
+% Constraint solving utility predicates.
% Returns the type variable that is unified with Target in the constraint.
% Fails if no such variable exists.
%
-:- pred find_unified_var(tvar::in, simple_type_constraint::in,
- tvar::out) is semidet.
+:- pred find_unified_var(tvar::in, simple_type_constraint::in, tvar::out)
+ is semidet.
find_unified_var(Target, stconstr(LHS, type_variable(RHS, _)), Unified) :-
(
@@ -942,8 +972,8 @@
:- pred to_simple_constraints(type_constraint::in,
list(simple_type_constraint)::out) is semidet.
-to_simple_constraints(tconstr_conj(Conj), Conj^tconstr_simples).
-to_simple_constraints(tconstr_disj(_, yes(Conj)), Conj^tconstr_simples).
+to_simple_constraints(tconstr_conj(Conj), Conj ^ tconstr_simples).
+to_simple_constraints(tconstr_disj(_, yes(Conj)), Conj ^ tconstr_simples).
:- pred update_replacement_map(prog_var_map::in, tvar::in, tvar::in,
simple_prog_var_map::in, simple_prog_var_map::out) is det.
@@ -1001,38 +1031,56 @@
:- pred type_domain_intersect(type_domain::in, type_domain::in,
type_domain::out) is det.
-type_domain_intersect(tdomain_any, D, D).
-
-type_domain_intersect(SD @ tdomain_singleton(_), tdomain_any, SD).
-
-type_domain_intersect(tdomain_singleton(Type1), tdomain_singleton(Type2),
- Intersect) :-
- ( unify_types(Type1, Type2, Type) ->
- Intersect = tdomain_singleton(Type)
+type_domain_intersect(DomainA, DomainB, Domain) :-
+ (
+ DomainA = tdomain_any,
+ Domain = DomainB
;
- Intersect = tdomain(set.init)
- ).
-
-type_domain_intersect(tdomain_singleton(Type), tdomain(Types),
- Intersect) :-
- set.filter_map(unify_types(Type), Types, UnifiedTypes),
+ DomainA = tdomain_singleton(_),
+ DomainB = tdomain_any,
+ Domain = DomainA
+ ;
+ DomainA = tdomain_singleton(TypeA),
+ DomainB = tdomain_singleton(TypeB),
+ ( unify_types(TypeA, TypeB, Type) ->
+ Domain = tdomain_singleton(Type)
+ ;
+ Domain = tdomain(set.init)
+ )
+ ;
+ DomainA = tdomain_singleton(TypeA),
+ DomainB = tdomain(TypesB),
+ % Symmetrical case below.
+ set.filter_map(unify_types(TypeA), TypesB, UnifiedTypes),
( set.singleton_set(UnifiedTypes, SingletonType) ->
- Intersect = tdomain_singleton(SingletonType)
+ Domain = tdomain_singleton(SingletonType)
+ ;
+ Domain = tdomain(UnifiedTypes)
+ )
+ ;
+ DomainA = tdomain(_),
+ DomainB = tdomain_any,
+ Domain = DomainA
;
- Intersect = tdomain(UnifiedTypes)
+ DomainA = tdomain(TypesA),
+ DomainB = tdomain_singleton(TypeB),
+ % Symmetrical case above.
+ set.filter_map(unify_types(TypeB), TypesA, UnifiedTypes),
+ ( set.singleton_set(UnifiedTypes, SingletonType) ->
+ Domain = tdomain_singleton(SingletonType)
+ ;
+ Domain = tdomain(UnifiedTypes)
+ )
+ ;
+ DomainA = tdomain(TypesA),
+ DomainB = tdomain(TypesB),
+ set.to_sorted_list(TypesA, TypeListA),
+ set.to_sorted_list(TypesB, TypeListB),
+ td_list_intersect(TypeListB, TypeListA, TypeList),
+ set.sorted_list_to_set(TypeList, Types),
+ Domain = tdomain(Types)
).
-type_domain_intersect(D @ tdomain(_), tdomain_any, D).
-
-type_domain_intersect(D @ tdomain(_), SD @ tdomain_singleton(_), Intersect) :-
- type_domain_intersect(SD, D, Intersect).
-
-type_domain_intersect(tdomain(Set1), tdomain(Set2), tdomain(Intersect)) :-
- set.to_sorted_list(Set1, List1),
- set.to_sorted_list(Set2, List2),
- td_list_intersect(List2, List1, List_Intersect),
- set.sorted_list_to_set(List_Intersect, Intersect).
-
% Very similar to set.intersect, but will unify equal functors with
% different type variable parameters - e.g.,
% yes(type_variable(V_1)) = yes(type_variable(V_2)).
@@ -1041,23 +1089,23 @@
list(mer_type)::out) is det.
td_list_intersect([], _, []).
-td_list_intersect([_|_], [], []).
-td_list_intersect([A|As], [B|Bs], Cs) :-
- ( unify_types(A, B, Type) ->
+td_list_intersect([_ | _], [], []).
+td_list_intersect([A | As], [B | Bs], Cs) :-
+ ( unify_types(A, B, AB) ->
td_list_intersect(As, Bs, Cs0),
- Cs = [Type|Cs0]
+ Cs = [AB | Cs0]
;
compare(R, A, B),
(
R = (<),
- td_list_intersect(As, [B|Bs], Cs)
+ td_list_intersect(As, [B | Bs], Cs)
;
R = (=),
td_list_intersect(As, Bs, Cs0),
- Cs = [A|Cs0]
+ Cs = [A | Cs0]
;
R = (>),
- td_list_intersect([A|As], Bs, Cs)
+ td_list_intersect([A | As], Bs, Cs)
)
).
@@ -1068,8 +1116,8 @@
:- pred unify_types(mer_type::in, mer_type::in, mer_type::out) is semidet.
unify_types(A, B, Type) :-
- % If two compound types are unified, unify each of their
- % arguments: e.g., yes(type_variable(V_1)) = yes(type_variable(V_2)),
+ % If two compound types are unified, unify each of their arguments:
+ % e.g., yes(type_variable(V_1)) = yes(type_variable(V_2)),
% and unify any type variable with anything.
% Fail if types cannot be unified.
( B = type_variable(_, _) ->
@@ -1134,37 +1182,56 @@
)
).
- % Like set.union, but treads tdomain_any as the universal domain.
+ % Like set.union, but treats tdomain_any as the universal domain.
%
:- pred type_domain_union(type_domain::in, type_domain::in,
type_domain::out) is det.
-type_domain_union(tdomain_any, _, tdomain_any).
-
-type_domain_union(tdomain_singleton(_), tdomain_any, tdomain_any).
-
-type_domain_union(tdomain_singleton(Type1), tdomain_singleton(Type2), Union) :-
- ( Type1 = Type2 ->
- Union = tdomain_singleton(Type1)
+type_domain_union(DomainA, DomainB, Domain) :-
+ (
+ DomainA = tdomain_any,
+ Domain = tdomain_any
;
- Union = tdomain(set.from_list([Type1, Type2]))
- ).
-
-type_domain_union(SD @ tdomain_singleton(Type), tdomain(Types), Union) :-
- ( set.empty(Types) ->
- Union = SD
+ DomainA = tdomain_singleton(_),
+ DomainB = tdomain_any,
+ Domain = tdomain_any
+ ;
+ DomainA = tdomain_singleton(TypeA),
+ DomainB = tdomain_singleton(TypeB),
+ ( TypeA = TypeB ->
+ Domain = tdomain_singleton(TypeA)
+ ;
+ Domain = tdomain(set.from_list([TypeA, TypeB]))
+ )
+ ;
+ DomainA = tdomain_singleton(TypeA),
+ DomainB = tdomain(TypesB),
+ % Symmetrical case below.
+ ( set.empty(TypesB) ->
+ Domain = DomainA
+ ;
+ Domain = tdomain(set.insert(TypesB, TypeA))
+ )
+ ;
+ DomainA = tdomain(_),
+ DomainB = tdomain_any,
+ Domain = tdomain_any
;
- Union = tdomain(set.insert(Types, Type))
+ DomainA = tdomain(TypesA),
+ DomainB = tdomain_singleton(TypeB),
+ % Symmetrical case above.
+ ( set.empty(TypesA) ->
+ Domain = DomainB
+ ;
+ Domain = tdomain(set.insert(TypesA, TypeB))
+ )
+ ;
+ DomainA = tdomain(TypesA),
+ DomainB = tdomain(TypesB),
+ set.union(TypesA, TypesB, Types),
+ Domain = tdomain(Types)
).
-type_domain_union(tdomain(_), tdomain_any, tdomain_any).
-
-type_domain_union(D @ tdomain(_), SD @ tdomain_singleton(_), Union) :-
- type_domain_union(SD, D, Union).
-
-type_domain_union(tdomain(Set1), tdomain(Set2), tdomain(Union)) :-
- set.union(Set2, Set1, Union).
-
:- pred still_active(conj_type_constraint::in) is semidet.
still_active(ctconstr(_, tconstr_active, _, _, _)).
@@ -1209,15 +1276,15 @@
set.count(A, C),
set.count(B, C)
->
- list.map_corresponding(unify_types, set.to_sorted_list(A),
- set.to_sorted_list(B), _)
+ list.map_corresponding(unify_types,
+ set.to_sorted_list(A), set.to_sorted_list(B), _)
;
fail
).
:- pred has_empty_domain(pair(tvar, type_domain)::in, tvar::out) is semidet.
-has_empty_domain((TVar - tdomain(Domain)), TVar) :-
+has_empty_domain(TVar - tdomain(Domain), TVar) :-
set.empty(Domain).
% Checks if a variable which was not previously known to have a singleton
@@ -1264,7 +1331,7 @@
:- pred tvars_in_simple_constraint(simple_type_constraint::in,
list(tvar)::out) is det.
-tvars_in_simple_constraint(stconstr(TVar, Type), [TVar|TVars]) :-
+tvars_in_simple_constraint(stconstr(TVar, Type), [TVar | TVars]) :-
prog_type.type_vars(Type, TVars).
:- pred constraint_has_no_solutions(type_domain_map::in) is semidet.
@@ -1283,7 +1350,7 @@
constraint_has_multiple_solutions(DomainMap, Var, Domains) :-
map.to_assoc_list(DomainMap, DomainMap1),
list.filter(has_ambiguous_domain, DomainMap1, AmbigDomains0),
- list.sort(domain_size_compare, AmbigDomains0, [(Var - Domain0)|_]),
+ list.sort(domain_size_compare, AmbigDomains0, [(Var - Domain0) | _]),
Domain0 = tdomain(Domain1),
Domains = set.to_sorted_list(set.map(to_singleton_type_domain, Domain1)).
@@ -1326,14 +1393,14 @@
( map.contains(!.Vartypes, Var) ->
true
;
- bimap.lookup(TCInfo^tconstr_var_map, Var, TVar),
+ bimap.lookup(TCInfo ^ tconstr_var_map, Var, TVar),
svmap.det_insert(Var, tvar_to_type(TVar), !Vartypes)
).
:- pred get_constraints_from_conj(conj_type_constraint::in,
list(simple_type_constraint)::out) is det.
-get_constraints_from_conj(Conj, Conj^tconstr_simples).
+get_constraints_from_conj(Conj, Conj ^ tconstr_simples).
% Merges two type constraints, which should be equal except possibly
% for the activity of their disjuncts, into one type constraint. The
@@ -1370,17 +1437,18 @@
merge_type_constraints2(A, B, Result) :-
(
- A^tconstr_activity = tconstr_unsatisfiable,
- B^tconstr_activity = tconstr_unsatisfiable
+ A ^ tconstr_activity = tconstr_unsatisfiable,
+ B ^ tconstr_activity = tconstr_unsatisfiable
->
Result = A
;
- Result = A^tconstr_activity := tconstr_active
+ Result = A ^ tconstr_activity := tconstr_active
).
%-----------------------------------------------------------------------------%
-% Error diagnosis
%
+% Error diagnosis
+
% If the list of type constraints contains more than one predicate call
% constraint, return an error message describing the ambiguity and one
% of the predicate call constraints (chosen arbitrarily). Otherwise, fail.
@@ -1388,35 +1456,37 @@
:- pred diagnose_ambig_pred_error(pred_env::in, list(conj_type_constraint)::in,
error_msg::out) is semidet.
-diagnose_ambig_pred_error(PredEnv, Conjunctions, Error) :-
+diagnose_ambig_pred_error(PredEnv, Conjunctions, Msg) :-
conj_constraint_get_context(head(Conjunctions), Context),
list.filter_map(pred_constraint_info, Conjunctions, AmbigPredData),
\+ list.all_same(assoc_list.values(AmbigPredData)),
- list.map(ambig_pred_error_message(PredEnv), AmbigPredData, Errors),
- Error = simple_msg(Context, [always([words("Ambiguous predicate"),
- words("call. Possible predicates include:"),
- nl_indent_delta(2)]) | Errors]).
+ list.map(ambig_pred_error_message(PredEnv), AmbigPredData, Components),
+ Pieces = [always([words("Ambiguous predicate call."),
+ words("Possible predicates include:"), nl_indent_delta(2)])
+ | Components],
+ Msg = simple_msg(Context, Pieces).
:- pred ambig_pred_error_message(pred_env::in, pair(goal_path, pred_id)::in,
error_msg_component::out) is det.
-ambig_pred_error_message(PredEnv, (_ - ID), Error) :-
+ambig_pred_error_message(PredEnv, (_ - PredId), Component) :-
+ % XXX Should use describe_one_pred_name.
predicate_table_get_preds(PredEnv, Preds),
- map.lookup(Preds, ID, PredInfo),
+ map.lookup(Preds, PredId, PredInfo),
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
pred_info_get_context(PredInfo, Context),
LineNumber = term.context_line(Context),
FileName = term.context_file(Context),
- Error = always([fixed(Name), suffix("/"), suffix(int_to_string(Arity)),
+ Component = always([fixed(Name), suffix("/"), suffix(int_to_string(Arity)),
prefix("("), words(FileName), suffix(": "), int_fixed(LineNumber),
suffix(")")]).
:- pred pred_constraint_info(conj_type_constraint::in,
pair(goal_path, pred_id)::out) is semidet.
-pred_constraint_info(ctconstr(_, tconstr_active, _, yes(Path), yes(ID)),
- (Path - ID)).
+pred_constraint_info(Constraint, Path - PredId) :-
+ Constraint = ctconstr(_, tconstr_active, _, yes(Path), yes(PredId)).
% Creates an error message describing why a variable is unsatisfiable.
% This is done by finding all minimal unsatisfiable subsets of the
@@ -1427,13 +1497,14 @@
prog_context::in, prog_varset::in, tvar::in,
error_msg::out) is det.
-diagnose_unsatisfiability_error(TCInfo @ tconstr_info(VarMap, _, ConstraintMap,
- VarConstraints, TVarSet, _), Context, ProgVarSet, TypeVar, Error) :-
- map.lookup(VarConstraints, TypeVar, ConstraintIDs),
- svset.insert_list(ConstraintIDs, set.init, ConstraintSet),
+diagnose_unsatisfiability_error(TCInfo, Context, ProgVarSet, TypeVar, Msg) :-
+ TCInfo = tconstr_info(VarMap, _, ConstraintMap, VarConstraints,
+ TVarSet, _),
+ map.lookup(VarConstraints, TypeVar, ConstraintIds),
+ svset.insert_list(ConstraintIds, set.init, ConstraintSet),
min_unsat_constraints(TCInfo, set.init, ConstraintSet, [], MinUnsats),
list.map(error_from_one_min_set(ConstraintMap), MinUnsats, MinUnsatPieces),
- type_constraints.zip_single([suffix(") or"), nl, prefix("(")],
+ zip_single([suffix(") or"), nl, prefix("(")],
MinUnsatPieces, ErrorLocations0),
list.condense(ErrorLocations0, ErrorLocations),
( bimap.reverse_search(VarMap, ProgVar, TypeVar) ->
@@ -1443,7 +1514,7 @@
VarName = mercury_var_to_string(TVarSet, yes, TypeVar),
VarKind = "type"
),
- Error = simple_msg(Context,
+ Msg = simple_msg(Context,
[always([words("Conflicting type assignments for the"),
fixed(VarKind), words("variable"), words(VarName), nl,
words("The problem is most likely due to one of the following"),
@@ -1453,13 +1524,13 @@
:- pred error_from_one_min_set(type_constraint_map::in,
set(type_constraint_id)::in, list(format_component)::out) is det.
-error_from_one_min_set(ConstraintMap, MinUnsatSet, ErrorLocations) :-
+error_from_one_min_set(ConstraintMap, MinUnsatSet, Components) :-
set.to_sorted_list(MinUnsatSet, MinUnsatList),
map.apply_to_list(MinUnsatList, ConstraintMap, Constraints),
list.filter_map(get_first_disjunct, Constraints, ConjConstraints),
list.map(conj_constraint_get_context, ConjConstraints, Contexts),
list.map(context_to_string, Contexts, ContextStrings),
- ErrorLocations = list_to_pieces(ContextStrings).
+ Components = list_to_pieces(ContextStrings).
% Uses the min_unsat1 algorithm
% (www.cs.mu.oz.au/~pjs/papers/ppdp2003b.ps.gz)
@@ -1470,12 +1541,14 @@
type_constraint_set::in, type_constraint_set::in,
list(type_constraint_set)::in, list(type_constraint_set)::out) is det.
-min_unsat_constraints(tconstr_info(VarMap, _, ConstraintMap,
- VarConstraints0, TVarSet, _), D, P, !MinUnsats) :-
+min_unsat_constraints(TCInfo, D, P, !MinUnsats) :-
+ % XXX What are D and P?
+ TCInfo = tconstr_info(VarMap, _, ConstraintMap, VarConstraints0,
+ TVarSet, _),
set.union(P, D, Union),
trace [compile_time(flag("type_error_diagnosis")), io(!IO)] (
- list.map(string.int_to_string, set.to_sorted_list(Union), IDs),
- io.print("\n Constraints " ++ string.join_list(", ", IDs) ++ "\n",
+ list.map(string.int_to_string, set.to_sorted_list(Union), Ids),
+ io.print("\n Constraints " ++ string.join_list(", ", Ids) ++ "\n",
!IO)
),
% Remove all constraints which are not part of the subset currently
@@ -1490,10 +1563,9 @@
map.init, map.init, tconstr_solution(_, _, Success)),
(
Success = no,
- set.fold3(next_min_unsat(Constraint), P, D, NewD, P, _,
- !MinUnsats),
+ set.fold3(next_min_unsat(Constraint), P, D, NewD, P, _, !MinUnsats),
( list.all_false(set.superset(NewD), !.MinUnsats) ->
- !:MinUnsats = [NewD|!.MinUnsats]
+ !:MinUnsats = [NewD | !.MinUnsats]
;
true
)
@@ -1516,8 +1588,7 @@
add_message_to_spec(ErrMsg, !TCInfo) :-
Spec = error_spec(severity_error, phase_type_check, [ErrMsg]),
- !:TCInfo = !.TCInfo^tconstr_error_spec :=
- [Spec | !.TCInfo^tconstr_error_spec ].
+ !TCInfo ^ tconstr_error_specs := [Spec | !.TCInfo ^ tconstr_error_specs].
:- pred context_to_string(prog_context::in, string::out) is det.
@@ -1529,25 +1600,29 @@
:- pred conj_constraint_get_context(conj_type_constraint::in,
prog_context::out) is det.
-conj_constraint_get_context(Constraint, Constraint^tconstr_context).
+conj_constraint_get_context(Constraint, Constraint ^ tconstr_context).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+%
% Constraint generation
- % Turns a goal expression to a constraint on the types of variable
- % appearing within that goal, then updates all relevant maps with the
+ % Turn a goal expression to a constraint on the types of variable
+ % appearing within that goal, then update all relevant maps with the
% information in the new constraint.
%
:- pred goal_to_constraint(tconstr_environment::in, hlds_goal::in,
type_constraint_info::in, type_constraint_info::out) is det.
- % Transforms a unification constraint into an assignment of types to the
- % variables being unified.
- %
-goal_to_constraint(Environment @ tconstr_environment(_, _, FuncEnv, PredEnv),
- hlds_goal(unify(L, RHS, _, _, _), Info), !TCInfo) :-
- Context = goal_info_get_context(Info),
+goal_to_constraint(Environment, Goal, !TCInfo) :-
+ Environment = tconstr_environment(_, _, FuncEnv, PredEnv),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = unify(L, RHS, _, _, _),
+ % Transform a unification constraint into an assignment of types
+ % to the variables being unified.
+
+ Context = goal_info_get_context(GoalInfo),
get_var_type(L, LTVar, !TCInfo),
(
RHS = rhs_var(R),
@@ -1556,25 +1631,25 @@
tconstr_active, Context, no, no)],
RelevantTVars = [LTVar, RTVar]
;
- RHS = rhs_functor(Cons_ID, _, Args),
+ RHS = rhs_functor(ConsId, _, Args),
(
- builtin_atomic_type(Cons_ID, Builtin)
+ builtin_atomic_type(ConsId, Builtin)
->
- Constraints = [ctconstr([stconstr(LTVar, builtin_type(Builtin))],
- tconstr_active, Context, no, no)],
+ SimpleConstraint = stconstr(LTVar, builtin_type(Builtin)),
+ Constraints = [ctconstr([SimpleConstraint], tconstr_active,
+ Context, no, no)],
RelevantTVars = [LTVar]
;
- Cons_ID = cons(Name, Arity),
+ ConsId = cons(Name, Arity),
Arity = list.length(Args)
->
list.map_foldl(get_var_type, Args, ArgTypeVars, !TCInfo),
% If it is a type constructor, create a disjunction
% constraint with each possible type of the constructor.
- (
- map.search(FuncEnv, Cons_ID, Cons_Defns)
- ->
- list.map_foldl(functor_unif_constraint(LTVar, ArgTypeVars,
- Info), Cons_Defns, TypeConstraints, !TCInfo)
+ ( map.search(FuncEnv, ConsId, Cons_Defns) ->
+ list.map_foldl(
+ functor_unif_constraint(LTVar, ArgTypeVars, GoalInfo),
+ Cons_Defns, TypeConstraints, !TCInfo)
;
TypeConstraints = []
),
@@ -1582,115 +1657,90 @@
% constraint for each predicate it could refer to.
(
predicate_table_search_sym(PredEnv,
- may_be_partially_qualified, Name, PredIDs)
+ may_be_partially_qualified, Name, PredIds)
->
predicate_table_get_preds(PredEnv, Preds),
- list.filter_map_foldl(ho_pred_unif_constraint(Preds, Info,
- LTVar, ArgTypeVars), PredIDs, PredConstraints, !TCInfo)
+ list.filter_map_foldl(
+ ho_pred_unif_constraint(Preds, GoalInfo, LTVar,
+ ArgTypeVars),
+ PredIds, PredConstraints, !TCInfo)
;
PredConstraints = []
),
Constraints = TypeConstraints ++ PredConstraints,
- ( Constraints = [] ->
+ (
+ Constraints = [],
ErrMsg = simple_msg(Context, [always([
- words("The constructor ID"),
+ words("The constructor"),
sym_name_and_arity(Name / Arity),
words("has not been defined")])]),
add_message_to_spec(ErrMsg, !TCInfo)
;
- true
+ Constraints = [_ | _]
),
- RelevantTVars = [LTVar|ArgTypeVars]
+ RelevantTVars = [LTVar | ArgTypeVars]
;
- ErrMsg = simple_msg(Context, [always([words("The given type"),
- words("is not supported by constraint-based type"),
- words("checking.")])]),
+ Pieces = [words("The given type is not supported"),
+ words("by constraint-based type checking.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo),
RelevantTVars = [],
Constraints = []
)
;
- RHS = rhs_lambda_goal(Purity, _, PredOrFunc, EvalMethod, _, Args, _,
- _, Goal),
+ RHS = rhs_lambda_goal(Purity, _, PredOrFunc, EvalMethod, _, Args,
+ _, _, LambdaGoal),
list.map_foldl(get_var_type, Args, ArgTVars, !TCInfo),
ArgTypes = list.map(tvar_to_type, ArgTVars),
- construct_higher_order_type(Purity, PredOrFunc, EvalMethod, ArgTypes,
- LambdaType),
+ construct_higher_order_type(Purity, PredOrFunc, EvalMethod,
+ ArgTypes, LambdaType),
Constraints = [ctconstr([stconstr(LTVar, LambdaType)],
tconstr_active, Context, no, no)],
- RelevantTVars = [LTVar|ArgTVars],
- goal_to_constraint(Environment, Goal, !TCInfo)
+ RelevantTVars = [LTVar | ArgTVars],
+ goal_to_constraint(Environment, LambdaGoal, !TCInfo)
),
- add_type_constraint(Constraints, RelevantTVars, !TCInfo).
-
- % Transforms a predicate call to variable assignments of the variables used
- % in the predicate call.
- %
-goal_to_constraint(tconstr_environment(_, _, _, PredEnv),
- hlds_goal(plain_call(_, _, Args, _, _, Name), Info), !TCInfo) :-
- % "may_be_partially_qualified" might be replaced by "is_fully_qualified"
- % XXX (I don't know what either of them mean).
- ( predicate_table_search_pred_sym(PredEnv, may_be_partially_qualified,
- Name, PredIDs0) ->
- PredIDs1 = PredIDs0
+ add_type_constraint(Constraints, RelevantTVars, !TCInfo)
+ ;
+ GoalExpr = plain_call(_, _, Args, _, _, Name),
+ % Transform a call to variable assignments of the variables
+ % used in the call.
+ (
+ predicate_table_search_pred_sym(PredEnv,
+ may_be_partially_qualified, Name, PredIds0)
+ ->
+ PredIds1 = PredIds0
;
- PredIDs1 = []
+ PredIds1 = []
),
predicate_table_get_preds(PredEnv, Preds),
- list.filter(pred_has_arity(Preds, list.length(Args)), PredIDs1,
- PredIDs),
+ list.filter(pred_has_arity(Preds, list.length(Args)),
+ PredIds1, PredIds),
list.map_foldl(get_var_type, Args, ArgTVars, !TCInfo),
- list.map2_foldl(pred_call_constraint(Preds, Info, ArgTVars), PredIDs,
- Constraints, PredTVars, !TCInfo),
+ list.map2_foldl(pred_call_constraint(Preds, GoalInfo, ArgTVars),
+ PredIds, Constraints, PredTVars, !TCInfo),
list.condense([ArgTVars | PredTVars], TVars),
- add_type_constraint(Constraints, TVars, !TCInfo).
-
- % call_foreign_proc goals are implemented in a similar manner to predicate
- % calls. The rest are implemented by calling expression_to_constraint on
- % each goal within the goal.
-goal_to_constraint(Environment, hlds_goal(conj(_, Goals), _), !TCInfo) :-
- list.foldl(goal_to_constraint(Environment), Goals, !TCInfo).
-
-goal_to_constraint(Environment, hlds_goal(disj(Goals), _), !TCInfo) :-
- list.foldl(goal_to_constraint(Environment), Goals, !TCInfo).
-
-goal_to_constraint(Environment, hlds_goal(negation(Goal), _), !TCInfo) :-
- goal_to_constraint(Environment, Goal, !TCInfo).
-
-goal_to_constraint(Environment, hlds_goal(
- call_foreign_proc(_,PredID,_,ForeignArgs,_,_,_), Info), !TCInfo) :-
- Context = goal_info_get_context(Info),
+ add_type_constraint(Constraints, TVars, !TCInfo)
+ ;
+ GoalExpr = call_foreign_proc(_, PredId, _, ForeignArgs, _, _, _),
+ Context = goal_info_get_context(GoalInfo),
ArgVars = list.map(foreign_arg_var, ForeignArgs),
ArgTypes0 = list.map(foreign_arg_type, ForeignArgs),
- predicate_table_get_preds(Environment^pred_env, Preds),
- ( map.search(Preds, PredID, PredInfo) ->
+ predicate_table_get_preds(Environment ^ pred_env, Preds),
+ ( map.search(Preds, PredId, PredInfo) ->
pred_info_get_typevarset(PredInfo, PredTVarSet),
- prog_data.tvarset_merge_renaming(!.TCInfo^tconstr_tvarset,
+ prog_data.tvarset_merge_renaming(!.TCInfo ^ tconstr_tvarset,
PredTVarSet, NewTVarSet, TVarRenaming),
- !:TCInfo = !.TCInfo^tconstr_tvarset := NewTVarSet,
+ !TCInfo ^ tconstr_tvarset := NewTVarSet,
prog_type_subst.apply_variable_renaming_to_type_list(TVarRenaming,
ArgTypes0, ArgTypes),
list.foldl_corresponding(variable_assignment_constraint(Context),
ArgVars, ArgTypes, !TCInfo)
;
- ErrMsg = simple_msg(Context, [always([words("Cannot find the"),
- words("predicate with ID"), int_fixed(pred_id_to_int(PredID)),
- words("referenced by the call_foreign_proc")])]),
- add_message_to_spec(ErrMsg, !TCInfo)
- ).
-
-goal_to_constraint(Environment, hlds_goal(scope(_,Goal), _), !TCInfo) :-
- goal_to_constraint(Environment, Goal, !TCInfo).
-
-goal_to_constraint(Environment, hlds_goal(if_then_else(_,Cond,Then,Else), _),
- !TCInfo) :-
- goal_to_constraint(Environment, Cond, !TCInfo),
- goal_to_constraint(Environment, Then, !TCInfo),
- goal_to_constraint(Environment, Else, !TCInfo).
-
-goal_to_constraint(Environment,
- hlds_goal(generic_call(Details, Vars, _, _), Info), !TCInfo) :-
- Context = goal_info_get_context(Info),
+ unexpected(this_file, "cannot find pred_info for foreign_proc")
+ )
+ ;
+ GoalExpr = generic_call(Details, Vars, _, _),
+ Context = goal_info_get_context(GoalInfo),
list.map_foldl(get_var_type, Vars, ArgTVars, !TCInfo),
ArgTypes = list.map(tvar_to_type, ArgTVars),
(
@@ -1700,77 +1750,102 @@
HOType = higher_order_type(ArgTypes, no, Purity, lambda_normal)
;
Kind = pf_function,
- svvarset.new_var(FunctionTVar, !.TCInfo^tconstr_tvarset,
+ svvarset.new_var(FunctionTVar, !.TCInfo ^ tconstr_tvarset,
NewTVarSet),
- !:TCInfo = !.TCInfo^tconstr_tvarset := NewTVarSet,
+ !TCInfo ^ tconstr_tvarset := NewTVarSet,
HOType = apply_n_type(FunctionTVar, ArgTypes, kind_star)
),
variable_assignment_constraint(Context, CallVar, HOType, !TCInfo)
;
% Class methods are handled by looking up the method number in the
% class' method list.
- Details = class_method(_, MethodNum, ClassID, _),
- ClassID = class_id(Name, Arity),
- ( map.search(Environment^class_env, ClassID, ClassDefn) ->
- ( list.index0(ClassDefn^class_hlds_interface, MethodNum, Method) ->
- Method = hlds_class_proc(PredID, _),
- predicate_table_get_preds(Environment^pred_env, Preds),
- ( pred_has_arity(Preds, list.length(Vars), PredID) ->
- pred_call_constraint(Preds, Info, ArgTVars, PredID,
+ Details = class_method(_, MethodNum, ClassId, _),
+ ClassId = class_id(Name, Arity),
+ ( map.search(Environment ^ class_env, ClassId, ClassDefn) ->
+ (
+ list.index0(ClassDefn ^ class_hlds_interface, MethodNum,
+ Method)
+ ->
+ Method = hlds_class_proc(PredId, _),
+ predicate_table_get_preds(Environment ^ pred_env, Preds),
+ ( pred_has_arity(Preds, list.length(Vars), PredId) ->
+ pred_call_constraint(Preds, GoalInfo, ArgTVars, PredId,
Constraint, PredTVars, !TCInfo),
list.append(ArgTVars, PredTVars, TVars),
add_type_constraint([Constraint], TVars, !TCInfo)
;
- ErrMsg = simple_msg(Context, [always([words("Incorrect"),
- words("number of arguments provided to method"),
- int_fixed(MethodNum), words("of typeclass"),
- sym_name_and_arity(Name / Arity)])]),
+ Pieces = [words("Incorrect number of arguments"),
+ words("provided to method"), int_fixed(MethodNum),
+ words("of typeclass"),
+ sym_name_and_arity(Name / Arity)],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo)
)
;
- ErrMsg = simple_msg(Context, [always([words("The typeclass"),
+ Pieces = [words("The typeclass"),
sym_name_and_arity(Name / Arity),
- words("does not have the given method.")])]),
+ words("does not have the given method.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo)
)
;
- ErrMsg = simple_msg(Context, [always([words("The typeclass"),
- sym_name_and_arity(Name / Arity), words("is undefined.")])]),
+ Pieces = [words("The typeclass"),
+ sym_name_and_arity(Name / Arity),
+ words("is undefined.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo)
)
;
Details = event_call(Name),
- ( event_arg_types(Environment^event_env, Name, _ArgTypes0) ->
- ErrMsg = simple_msg(Context, [always([words("Event calls are"),
- words("not supported by constraint-based typechecking.")])]),
+ ( event_arg_types(Environment ^ event_env, Name, _ArgTypes0) ->
+ Pieces = [words("Event calls are not yet supported"),
+ words("by constraint-based typechecking.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo)
;
- ErrMsg = simple_msg(Context, [always([words("There is not event"),
- words("named"), words(Name)])]),
+ Pieces = [words("There is not event named"), words(Name)],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo)
)
;
% Casts do not contain any type information.
Details = cast(_)
- ).
-
-goal_to_constraint(Environment, hlds_goal(switch(_,_,Cases), _), !TCInfo) :-
+ )
+ ;
+ GoalExpr = conj(_, Goals),
+ list.foldl(goal_to_constraint(Environment), Goals, !TCInfo)
+ ;
+ GoalExpr = disj(Goals),
+ list.foldl(goal_to_constraint(Environment), Goals, !TCInfo)
+ ;
+ GoalExpr = negation(SubGoal),
+ goal_to_constraint(Environment, SubGoal, !TCInfo)
+ ;
+ GoalExpr = scope(_, SubGoal),
+ goal_to_constraint(Environment, SubGoal, !TCInfo)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ goal_to_constraint(Environment, Cond, !TCInfo),
+ goal_to_constraint(Environment, Then, !TCInfo),
+ goal_to_constraint(Environment, Else, !TCInfo)
+ ;
+ GoalExpr = switch(_, _, Cases),
list.map(get_case_goal, Cases, Goals),
- list.foldl(goal_to_constraint(Environment), Goals, !TCInfo).
-
-goal_to_constraint(Env, hlds_goal(shorthand(bi_implication(GoalA, GoalB)), _),
- !TCInfo) :-
- goal_to_constraint(Env, GoalA, !TCInfo),
- goal_to_constraint(Env, GoalB, !TCInfo).
-
+ list.foldl(goal_to_constraint(Environment), Goals, !TCInfo)
+ ;
+ GoalExpr = shorthand(bi_implication(GoalA, GoalB)),
+ goal_to_constraint(Environment, GoalA, !TCInfo),
+ goal_to_constraint(Environment, GoalB, !TCInfo)
+ ;
+ GoalExpr = shorthand(atomic_goal(GoalType, Outer, Inner,
+ _, Main, Alternatives, _)),
% Atomic goals are handled by forcing their inner arguments
% to be of type stm_atomic_type, their outer arguments to be
% of type stm_atomic_type or io_state_type, depending on the type
% of atomic goal. The transaction goals are handled by recursive
% calls to goal_to_constraint.
-goal_to_constraint(Environment, hlds_goal(shorthand(atomic_goal(GoalType, Outer,
- Inner, _, Main, Alternatives, _)), Info), !TCInfo) :-
- Context = goal_info_get_context(Info),
+
+ Context = goal_info_get_context(GoalInfo),
% Inner variable handling (simple assignment).
Inner = atomic_interface_vars(InnerInitVar, InnerFinalVar),
variable_assignment_constraint(Context, InnerInitVar, stm_atomic_type,
@@ -1789,7 +1864,7 @@
tconstr_active, Context, no, no),
FinalIOConstraint = ctconstr([stconstr(OuterFinal, io_state_type)],
tconstr_active, Context, no, no),
- % Determine which constraints should be applied to outer variables.
+ % Determine which constraints should be applied to outer variables..
(
GoalType = unknown_atomic_goal_type,
add_type_constraint([InitStmConstraint, InitIOConstraint],
@@ -1806,11 +1881,11 @@
add_type_constraint([FinalStmConstraint], [OuterFinal], !TCInfo)
),
% Recursively evaluate transaction goals.
- list.foldl(goal_to_constraint(Environment), [Main|Alternatives], !TCInfo).
-
-goal_to_constraint(Environment, hlds_goal(shorthand(try_goal(MaybeIO, _ResultVar,
- SubGoal)), Info), !TCInfo) :-
- Context = goal_info_get_context(Info),
+ list.foldl(goal_to_constraint(Environment), [Main | Alternatives],
+ !TCInfo)
+ ;
+ GoalExpr = shorthand(try_goal(MaybeIO, _ResultVar, SubGoal)),
+ Context = goal_info_get_context(GoalInfo),
(
MaybeIO = yes(try_io_state_vars(IOVarA, IOVarB)),
get_var_type(IOVarA, InitA, !TCInfo),
@@ -1824,7 +1899,8 @@
;
MaybeIO = no
),
- goal_to_constraint(Environment, SubGoal, !TCInfo).
+ goal_to_constraint(Environment, SubGoal, !TCInfo)
+ ).
% Creates a constraint from the information stored in a predicate
% definition. This may only be called if the number of arguments given
@@ -1834,26 +1910,28 @@
list(tvar)::in, pred_id::in, conj_type_constraint::out, list(tvar)::out,
type_constraint_info::in, type_constraint_info::out) is det.
-pred_call_constraint(PredTable, Info, ArgTVars, PredID, ctconstr(Constraints,
- tconstr_active, Context, yes(GoalPath), yes(PredID)), TVars,
+pred_call_constraint(PredTable, Info, ArgTVars, PredId, Constraint, TVars,
!TCInfo) :-
+ Constraint = ctconstr(Constraints, tconstr_active, Context,
+ yes(GoalPath), yes(PredId)),
Context = goal_info_get_context(Info),
GoalPath = goal_info_get_goal_path(Info),
- ( map.search(PredTable, PredID, PredInfo) ->
+ ( map.search(PredTable, PredId, PredInfo) ->
pred_info_get_arg_types(PredInfo, PredArgTypes0),
pred_info_get_typevarset(PredInfo, PredTVarSet),
- prog_data.tvarset_merge_renaming(!.TCInfo^tconstr_tvarset,
+ prog_data.tvarset_merge_renaming(!.TCInfo ^ tconstr_tvarset,
PredTVarSet, NewTVarSet, TVarRenaming),
- !:TCInfo = !.TCInfo^tconstr_tvarset := NewTVarSet,
+ !TCInfo ^ tconstr_tvarset := NewTVarSet,
prog_type_subst.apply_variable_renaming_to_type_list(TVarRenaming,
PredArgTypes0, PredArgTypes),
Constraints = list.map_corresponding(create_stconstr, ArgTVars,
PredArgTypes),
prog_type.type_vars_list(PredArgTypes, TVars)
;
- ErrMsg = simple_msg(Context, [always([words("The predicate with ID"),
- int_fixed(pred_id_to_int(PredID)),
- words("has not been defined.")])]),
+ Pieces = [words("The predicate with id"),
+ int_fixed(pred_id_to_int(PredId)),
+ words("has not been defined.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo),
TVars = [],
Constraints = []
@@ -1864,23 +1942,25 @@
% X :: pred(int, int), Y :: int.
% Fails if the number of arguments supplied to the predicate is greater
% than its arity.
+ %
:- pred ho_pred_unif_constraint(pred_table::in, hlds_goal_info::in, tvar::in,
list(tvar)::in, pred_id::in, conj_type_constraint::out,
type_constraint_info::in, type_constraint_info::out) is semidet.
-ho_pred_unif_constraint(PredTable, Info, LHSTVar, ArgTVars, PredID,
- ctconstr(Constraints, tconstr_active, Context, yes(GoalPath),
- yes(PredID)), !TCInfo) :-
+ho_pred_unif_constraint(PredTable, Info, LHSTVar, ArgTVars, PredId, Constraint,
+ !TCInfo) :-
+ Constraint = ctconstr(Constraints, tconstr_active, Context,
+ yes(GoalPath), yes(PredId)),
Context = goal_info_get_context(Info),
GoalPath = goal_info_get_goal_path(Info),
- ( map.search(PredTable, PredID, PredInfo) ->
+ ( map.search(PredTable, PredId, PredInfo) ->
pred_info_get_arg_types(PredInfo, PredArgTypes0),
pred_info_get_typevarset(PredInfo, PredTVarSet),
pred_info_get_purity(PredInfo, Purity),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- prog_data.tvarset_merge_renaming(!.TCInfo^tconstr_tvarset, PredTVarSet,
- NewTVarSet, TVarRenaming),
- !:TCInfo = !.TCInfo^tconstr_tvarset := NewTVarSet,
+ prog_data.tvarset_merge_renaming(!.TCInfo ^ tconstr_tvarset,
+ PredTVarSet, NewTVarSet, TVarRenaming),
+ !TCInfo ^ tconstr_tvarset := NewTVarSet,
prog_type_subst.apply_variable_renaming_to_type_list(TVarRenaming,
PredArgTypes0, PredArgTypes),
(
@@ -1901,19 +1981,20 @@
LambdaTypes1 = [],
LHSConstraint = stconstr(LHSTVar, ReturnType)
;
- LambdaTypes1 = [_|_],
+ LambdaTypes1 = [_ | _],
LHSConstraint = stconstr(LHSTVar, higher_order_type(
LambdaTypes1, yes(ReturnType), Purity, lambda_normal))
)
),
- Constraints = [LHSConstraint|ArgConstraints]
+ Constraints = [LHSConstraint | ArgConstraints]
;
fail
)
;
- ErrMsg = simple_msg(Context, [always([words("The predicate with ID"),
- int_fixed(pred_id_to_int(PredID)),
- words("has not been defined.")])]),
+ Pieces = [words("The predicate with id"),
+ int_fixed(pred_id_to_int(PredId)),
+ words("has not been defined.")],
+ ErrMsg = simple_msg(Context, [always(Pieces)]),
add_message_to_spec(ErrMsg, !TCInfo),
Constraints = []
).
@@ -1928,7 +2009,7 @@
get_var_type(Var, TVar, !TCInfo),
Constraint = ctconstr([stconstr(TVar, Type)], tconstr_active, Context,
no, no),
- add_type_constraint([Constraint], [TVar|TypeVariables], !TCInfo).
+ add_type_constraint([Constraint], [TVar | TypeVariables], !TCInfo).
% Create a conjunction of type constraints from a functor unification goal.
% The LHS variable is constrained to be of the result type, and each RHS
@@ -1940,17 +2021,18 @@
hlds_cons_defn::in, conj_type_constraint::out, type_constraint_info::in,
type_constraint_info::out) is det.
-functor_unif_constraint(LTVar, ArgTVars, Info, hlds_cons_defn(TypeCtor,
- FunctorTVarSet, TypeParams0, _, _, _, FuncArgs, _), Constraints,
+functor_unif_constraint(LTVar, ArgTVars, Info, ConsDefn, Constraints,
!TCInfo) :-
+ ConsDefn = hlds_cons_defn(TypeCtor, FunctorTVarSet, TypeParams0, _, _, _,
+ FuncArgs, _),
Context = goal_info_get_context(Info),
GoalPath = goal_info_get_goal_path(Info),
% Find the types of each argument and the result type, given a renaming
% of type variables.
list.map(get_ctor_arg_type, FuncArgs, FuncArgTypes0),
- prog_data.tvarset_merge_renaming(!.TCInfo^tconstr_tvarset, FunctorTVarSet,
- NewTVarSet, TVarRenaming),
- !:TCInfo = !.TCInfo^tconstr_tvarset := NewTVarSet,
+ prog_data.tvarset_merge_renaming(!.TCInfo ^ tconstr_tvarset,
+ FunctorTVarSet, NewTVarSet, TVarRenaming),
+ !TCInfo ^ tconstr_tvarset := NewTVarSet,
prog_type_subst.apply_variable_renaming_to_tvar_list(TVarRenaming,
TypeParams0, TypeParams),
prog_type_subst.apply_variable_renaming_to_type_list(TVarRenaming,
@@ -1960,16 +2042,17 @@
LHS_Constraint = stconstr(LTVar, ResultType),
RHS_Constraints = list.map_corresponding(create_stconstr,
ArgTVars, FuncArgTypes),
- Constraints = ctconstr([LHS_Constraint|RHS_Constraints],
+ Constraints = ctconstr([LHS_Constraint | RHS_Constraints],
tconstr_active, Context, yes(GoalPath), no).
%-----------------------------------------------------------------------------%
+%
% Constraint generation utility predicates.
:- pred pred_has_arity(pred_table::in, int::in, pred_id::in) is semidet.
-pred_has_arity(Preds, Arity, PredID) :-
- map.lookup(Preds, PredID, Pred),
+pred_has_arity(Preds, Arity, PredId) :-
+ map.lookup(Preds, PredId, Pred),
pred_info_get_arg_types(Pred, PredArgTypes),
list.length(PredArgTypes) = Arity.
@@ -1995,7 +2078,7 @@
Type = builtin_type_int
).
- % Creates a new ID for a type constraint, then maps each of the given type
+ % Creates a new id for a type constraint, then maps each of the given type
% variables to that constraint.
%
:- pred add_type_constraint(list(conj_type_constraint)::in, list(tvar)::in,
@@ -2012,12 +2095,12 @@
Constraints = [SingleConstraint],
Constraint = tconstr_conj(SingleConstraint)
;
- Constraints = [_,_|_],
+ Constraints = [_, _ | _],
Constraint = tconstr_disj(Constraints, no)
),
- counter.allocate(ID, !ConstraintCounter),
- svmap.det_insert(ID, Constraint, !ConstraintMap),
- list.foldl(map_var_to_constraint(ID), TVars, !VarConstraints)
+ counter.allocate(Id, !ConstraintCounter),
+ svmap.det_insert(Id, Constraint, !ConstraintMap),
+ list.foldl(map_var_to_constraint(Id), TVars, !VarConstraints)
),
!:TConstrInfo = tconstr_info(VarMap, !.ConstraintCounter,
!.ConstraintMap, !.VarConstraints, TVarSet, Errors)
@@ -2026,15 +2109,15 @@
:- pred map_var_to_constraint(type_constraint_id::in, tvar::in,
var_constraint_map::in, var_constraint_map::out) is det.
-map_var_to_constraint(ID, TVar, !VarConstraints) :-
- ( map.search(!.VarConstraints, TVar, OldIDs) ->
- ( list.contains(OldIDs, ID) ->
+map_var_to_constraint(Id, TVar, !VarConstraints) :-
+ ( map.search(!.VarConstraints, TVar, OldIds) ->
+ ( list.contains(OldIds, Id) ->
true
;
- svmap.det_update(TVar, [ID|OldIDs], !VarConstraints)
+ svmap.det_update(TVar, [Id | OldIds], !VarConstraints)
)
;
- svmap.det_insert(TVar, [ID], !VarConstraints)
+ svmap.det_insert(TVar, [Id], !VarConstraints)
).
% If a program variable corresponds to a particular type variable, return
@@ -2044,7 +2127,8 @@
:- pred get_var_type(prog_var::in, tvar::out,
type_constraint_info::in, type_constraint_info::out) is det.
-get_var_type(Var, TVar, tconstr_info(!.VarMap, CC, CM, VC, !.TVarSet, Errs),
+get_var_type(Var, TVar,
+ tconstr_info(!.VarMap, CC, CM, VC, !.TVarSet, Errs),
tconstr_info(!:VarMap, CC, CM, VC, !:TVarSet, Errs)) :-
( bimap.search(!.VarMap, Var, TVar0) ->
TVar = TVar0
@@ -2059,7 +2143,7 @@
:- pred get_case_goal(case::in, hlds_goal::out) is det.
-get_case_goal(Case, Case^case_goal).
+get_case_goal(Case, Case ^ case_goal).
:- pred get_ctor_arg_type(constructor_arg::in, mer_type::out) is det.
@@ -2071,9 +2155,9 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+%
% Constraint printing.
-
:- pred print_guess(tvarset::in, pair(tvar, type_domain)::in, io::di, io::uo)
is det.
@@ -2119,13 +2203,15 @@
:- pred print_conj_constraint_change(tvarset::in, conj_type_constraint::in,
conj_type_constraint::in, io::di, io::uo) is det.
-print_conj_constraint_change(TVarSet, CCS @ ctconstr(_, ActivityA, _, _, _),
- ctconstr(_, ActivityB, _, _, _), !IO) :-
+print_conj_constraint_change(TVarSet, ConjConstraintA, ConjConstraintB, !IO) :-
+ ConjConstraintA = ctconstr(_, ActivityA, _, _, _),
+ ConjConstraintB = ctconstr(_, ActivityB, _, _, _),
(
ActivityA = tconstr_active,
ActivityB = tconstr_unsatisfiable
->
- conj_constraint_to_string(4, TVarSet, CCS, ConstraintString),
+ conj_constraint_to_string(4, TVarSet, ConjConstraintA,
+ ConstraintString),
io.write_string(" Conjunction marked unsatisfiable:\n", !IO),
io.write_string(ConstraintString ++ "\n", !IO)
;
@@ -2135,7 +2221,7 @@
:- pred print_domain_map_change(tvarset::in, type_domain_map::in,
pair(tvar, type_domain)::in, io::di, io::uo) is det.
-print_domain_map_change(TVarSet, OldDomainMap, (TVar - NewDomain), !IO) :-
+print_domain_map_change(TVarSet, OldDomainMap, TVar - NewDomain, !IO) :-
( map.search(OldDomainMap, TVar, OldDomain) ->
( equal_domain(OldDomain, NewDomain) ->
true
@@ -2154,16 +2240,15 @@
prog_varset::in, type_domain_map::in, io::di, io::uo) is det.
print_constraint_solution(TCInfo, ProgVarSet, DomainMap, !IO) :-
- bimap.to_assoc_list(TCInfo^tconstr_var_map, VarMapAL),
+ bimap.to_assoc_list(TCInfo ^ tconstr_var_map, VarMapAL),
list.map(pair.fst, VarMapAL, ProgVars),
list.map(pair.snd, VarMapAL, RelevantTVars),
list.map(find_type_domain(DomainMap), RelevantTVars, RelevantDomains),
io.print("\n", !IO),
- list.foldl_corresponding(print_prog_var_domain(TCInfo^tconstr_tvarset,
+ list.foldl_corresponding(print_prog_var_domain(TCInfo ^ tconstr_tvarset,
ProgVarSet), ProgVars, RelevantDomains, !IO).
-
:- pred print_prog_var_domain(tvarset::in, prog_varset::in, prog_var::in,
type_domain::in, io::di, io::uo) is det.
@@ -2175,7 +2260,7 @@
:- pred print_type_domain(tvarset::in, pair(tvar, type_domain)::in,
io::di, io::uo) is det.
-print_type_domain(TVarSet, (TVar - Domain), !IO) :-
+print_type_domain(TVarSet, TVar - Domain, !IO) :-
type_domain_to_string(TVarSet, Domain, DomainName),
TVarName = mercury_var_to_string(TVarSet, yes, TVar),
io.print(" " ++ TVarName ++ " -> {" ++ DomainName ++ "}\n", !IO).
@@ -2200,8 +2285,9 @@
:- pred print_pred_constraint(type_constraint_info::in, prog_varset::in,
io::di, io::uo) is det.
-print_pred_constraint(tconstr_info(VarMap, _, ConstraintMap,
- VarConstraints, TVarSet, _), ProgVarSet, !IO) :-
+print_pred_constraint(TCInfo, ProgVarSet, !IO) :-
+ TCInfo = tconstr_info(VarMap, _, ConstraintMap, VarConstraints, TVarSet,
+ _),
bimap.to_assoc_list(VarMap, VarMapAssocList),
list.foldl(print_var_constraints(ConstraintMap, VarConstraints,
TVarSet, ProgVarSet), VarMapAssocList, !IO).
@@ -2211,80 +2297,82 @@
is det.
print_var_constraints(ConstraintMap, VarConstraints, TVarSet, ProgVarSet,
- (Var - TVar), !IO) :-
+ Var - TVar, !IO) :-
VarName = mercury_var_to_string(ProgVarSet, yes, Var),
TVarName = mercury_var_to_string(TVarSet, yes, TVar),
io.print(VarName ++ " -> " ++ TVarName ++ "\n", !IO),
- ( map.search(VarConstraints, TVar, ConstraintIDs0) ->
- ConstraintIDs = ConstraintIDs0
+ ( map.search(VarConstraints, TVar, ConstraintIds0) ->
+ ConstraintIds = ConstraintIds0
;
- ConstraintIDs = []
+ ConstraintIds = []
),
- list.map(constraint_to_string(2, TVarSet, ConstraintMap), ConstraintIDs,
+ list.map(constraint_to_string(2, TVarSet, ConstraintMap), ConstraintIds,
StringReps),
String = string.join_list(",\n", StringReps),
io.print(String ++ "\n", !IO).
-
:- pred constraint_to_string(int::in, tvarset::in, type_constraint_map::in,
type_constraint_id::in, string::out) is det.
-constraint_to_string(Indent, TVarSet, ConstraintMap, ConstraintID, String) :-
- IDString = string.int_to_string(ConstraintID),
- map.lookup(ConstraintMap, ConstraintID, Constraint),
+constraint_to_string(Indent, TVarSet, ConstraintMap, ConstraintId, String) :-
+ IdString = string.int_to_string(ConstraintId),
+ map.lookup(ConstraintMap, ConstraintId, Constraint),
IndentString = duplicate_char(' ', Indent),
(
Constraint = tconstr_conj(ConjConstraints),
- conj_constraint_to_string(Indent, TVarSet, ConjConstraints,
- ConjString)
+ conj_constraint_to_string(Indent, TVarSet, ConjConstraints, ConjString)
;
Constraint = tconstr_disj(Constraints, _),
list.map(conj_constraint_to_string(Indent+2, TVarSet),
Constraints, ConjStrings),
- ConjString = IndentString ++ "(\n" ++ string.join_list(" OR\n",
- ConjStrings) ++ "\n" ++ IndentString ++ ")"
+ ConjString = IndentString ++ "(\n"
+ ++ string.join_list(" OR\n", ConjStrings) ++ "\n"
+ ++ IndentString ++ ")"
),
- String = IndentString ++ "Constraint " ++ IDString ++ ":\n" ++
- ConjString.
+ String = IndentString ++ "Constraint " ++ IdString ++ ":\n" ++ ConjString.
:- pred conj_constraint_to_string(int::in, tvarset::in,
conj_type_constraint::in, string::out) is det.
-conj_constraint_to_string(Indent, TVarSet,
- ctconstr(SimpleConstraints, _, Context, _, PredID), String) :-
+conj_constraint_to_string(Indent, TVarSet, Constraint, String) :-
+ Constraint = ctconstr(SimpleConstraints, _, Context, _, PredId),
IndentString = duplicate_char(' ', Indent),
LineNumber = string.int_to_string(term.context_line(Context)),
FileName = term.context_file(Context),
(
- PredID = yes(ID),
+ PredId = yes(Id),
PredString = " (calling predicate " ++
- int_to_string(pred_id_to_int(ID)) ++ ")"
+ int_to_string(pred_id_to_int(Id)) ++ ")"
;
- PredID = no,
+ PredId = no,
PredString = ""
),
ContextString = IndentString ++ "[" ++ FileName ++ ": " ++ LineNumber
++ PredString ++ "]\n",
- ( SimpleConstraints = [SimpleConstraint] ->
- simple_constraint_to_string(Indent, TVarSet, SimpleConstraint,
- String0)
+ (
+ SimpleConstraints = [],
+ String0 = "empty conj"
+ ;
+ SimpleConstraints = [SimpleConstraint],
+ simple_constraint_to_string(Indent, TVarSet, SimpleConstraint, String0)
;
+ SimpleConstraints = [_, _ | _],
list.map(simple_constraint_to_string(Indent + 2, TVarSet),
SimpleConstraints, SimpleStrings),
- String0 = IndentString ++ "(\n" ++ string.join_list(" AND\n",
- SimpleStrings) ++ "\n" ++ IndentString ++ ")"
+ String0 = IndentString ++ "(\n"
+ ++ string.join_list(" AND\n", SimpleStrings) ++ "\n"
+ ++ IndentString ++ ")"
),
String = ContextString ++ String0.
:- pred simple_constraint_to_string(int::in, tvarset::in,
simple_type_constraint::in, string::out) is det.
-simple_constraint_to_string(Indent, TVarSet, stconstr(TVar, Type),
- String) :-
+simple_constraint_to_string(Indent, TVarSet, stconstr(TVar, Type), String) :-
VarName = mercury_var_to_string(TVarSet, yes, TVar),
type_to_string(TVarSet, Type, TypeName),
- String = duplicate_char(' ', Indent) ++ "( " ++ VarName ++ " :: "
- ++ TypeName ++ ")".
+ String = duplicate_char(' ', Indent) ++
+ "( " ++ VarName ++ " :: " ++ TypeName ++ ")".
:- pred type_to_string(tvarset::in, mer_type::in, string::out) is det.
@@ -2333,22 +2421,24 @@
).
%-----------------------------------------------------------------------------%
-% General purpose utility.
+%
+% General purpose utilities.
-:- pred type_constraints.remove_maybe(maybe(T)::in, T::out) is semidet.
+:- pred remove_maybe(maybe(T)::in, T::out) is semidet.
-type_constraints.remove_maybe(yes(X), X).
+remove_maybe(yes(X), X).
% zip_single(Elem, List, NewList):
%
- % NewList is the result of adding Elem between each element
- % in List. Like string.join_list.
-:- pred type_constraints.zip_single(T::in, list(T)::in, list(T)::out) is det.
-
-type_constraints.zip_single(_, [], []).
-type_constraints.zip_single(_, [A], [A]).
-type_constraints.zip_single(E, [A,A0|As], [A,E|Bs]) :-
- type_constraints.zip_single(E, [A0|As], Bs).
+ % NewList is the result of adding Elem between each element in List.
+ % Like string.join_list.
+ %
+:- pred zip_single(T::in, list(T)::in, list(T)::out) is det.
+
+zip_single(_, [], []).
+zip_single(_, [A], [A]).
+zip_single(E, [A, A0 | As], [A,E | Bs]) :-
+ zip_single(E, [A0 | As], Bs).
%-----------------------------------------------------------------------------%
cvs diff: Diffing notes
--------------------------------------------------------------------------
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