[m-rev.] for review: break up std_util (part 1)
Julien Fischer
juliensf at cs.mu.OZ.AU
Thu Mar 23 14:42:22 AEDT 2006
For review by anyone.
Estimated hours taken: 4
Branches: main
Move the all-solutions predicates from library module std_util into their own
module, solutions.
Move semidet_fail, semidet_succeed, cc_multi_equal and dynamic cast from
std_util.m into builtin.m.
Add some more utility functions for performing determinism or purity casts.
(The later are primarily intended for use by solver implementors.)
library/std_util.m:
Move the all-solutions predicates into their own module, solutions.m.
For now there are (obsolete) forwarding predicates from this module to
the new one. The forwarding predicates will be included in the
upcoming 0.13 release and then removed in later versions.
Move semidet_succeed, semidet_fail, cc_multi_equal and dynamic_cast
to builtin.m
library/solutions.m:
New file. This is the new home for the all-solutions predicates.
This is pretty much cut and pasted from std_util (with module
qualifiers updated accordingly). I've rearranged the code in a more
top-down fashion as per our current coding standard.
library/builtin.m:
Move semidet_fail/0, semidet_succeed/0, cc_multi_equal/2 and
dynamic_cast/2 to this module.
Add semidet_true/0 and semidet_false/0 as synonyms for semidet_fail/0
and semidet_succeed/0.
Add impure_true/0 and semipure_true/0. These are useful for performing
purity casts, e.g. in solver implementations.
library/library.m:
Add the new module.
NEWS:
Announce the changes.
library/*.m:
Update to conform to the above.
compiler/const_prop.m:
Update evaluate_semidet_call/5 with the new module name for
dynamic_cast.
compiler/*.m:
Module qualify calls to solutions to either disambiguate them from the
versions in std_util (where they weren't module qualified) or change
the module qualifier where they were (to avoid warnings about calls to
the now deprecated versions).
tests/debugger/declarative/solutions.*:
Rename this module as the name conflicts with the new library module.
tests/debugger/declarative/solns.*:
Renamed version of above (with updated expected output).
tests/debugger/declarative/Mmakefile:
Handle the renamed version of the solutions test.
tests/debugger/all_solutions.m:
tests/debugger/declarative/args.m:
tests/debugger/declarative/library_forwarding.m:
tests/hard_coded/constant_prop_2.m:
tests/invalid/multisoln_func.m:
tests/invalid/one_member.m:
tests/invalid/promise_equivalent_claueses.m:
tests/valid/simplify_bug2.m:
tests/valid/solv.m:
Update to conform to the above changes.
Julien.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.407
diff -u -r1.407 NEWS
--- NEWS 22 Mar 2006 03:06:24 -0000 1.407
+++ NEWS 23 Mar 2006 03:11:16 -0000
@@ -32,6 +32,11 @@
standard library, in forms that have been mostly unchanged since the
0.11 release. In most cases, the differences are quite minor, but provide
more expressive power.
+* We have moved the all-solutions predicates from std_util.m into a new
+ library module, solutions.m. These predicates are still available in
+ std_util.m but these versions are now deprecated.
+* We have made the predicates semidet_succeed/0, semidet_fail/0 and
+ cc_multi_equal/2 into builtins. Formerly these were exported by std_util.m.
* We have added an `injection' module, for reversible maps that are injective.
Changes to the Mercury compiler:
@@ -276,6 +281,11 @@
* We have added set.fold4/10.
+* We have added semidet_true/0 and semidet_false/0 as synonyms for
+ semidet_succeed/0 and semidet_fail/0.
+
+* We have added impure_true/0 and semipure_true/0.
+
Changes to the Mercury compiler:
* The compiler now generates error messages for known mismatches between format
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.52
diff -u -r1.52 accumulator.m
--- compiler/accumulator.m 17 Mar 2006 01:40:10 -0000 1.52
+++ compiler/accumulator.m 22 Mar 2006 09:02:27 -0000
@@ -186,6 +186,7 @@
:- import_module map.
:- import_module multi_map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -578,7 +579,7 @@
Key = rec - _,
Goal = call(PredId, ProcId, _, _, _, _) - _
),
- solutions(P, Ids).
+ solutions.solutions(P, Ids).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1345,7 +1346,7 @@
set(goal_id)::out) is det.
related(GS, VarTypes, ModuleInfo, Var, Related) :-
- solutions(
+ solutions.solutions(
(pred(Key::out) is nondet :-
goal_store_member(GS, Key, Goal - InstMap0),
Key = base - _,
@@ -1791,7 +1792,7 @@
:- func base_case_ids(goal_store) = list(goal_id).
base_case_ids(GS) = Base :-
- solutions(
+ solutions.solutions(
(pred(Key::out) is nondet :-
goal_store_member(GS, Key, _Goal),
Key = base - _
Index: compiler/add_class.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.12
diff -u -r1.12 add_class.m
--- compiler/add_class.m 17 Mar 2006 01:40:10 -0000 1.12
+++ compiler/add_class.m 22 Mar 2006 09:07:59 -0000
@@ -68,6 +68,7 @@
:- import_module map.
:- import_module multi_map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module varset.
@@ -521,8 +522,8 @@
NewOtherTypes),
type_list_subsumes(Types, NewOtherTypes, _)
),
- aggregate(IsOverlapping, report_overlapping_instance_declaration(ClassId),
- !IO).
+ solutions.aggregate(IsOverlapping,
+ report_overlapping_instance_declaration(ClassId), !IO).
:- pred report_overlapping_instance_declaration(class_id::in,
pair(prog_context)::in, io::di, io::uo) is det.
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.45
diff -u -r1.45 assertion.m
--- compiler/assertion.m 24 Feb 2006 05:49:24 -0000 1.45
+++ compiler/assertion.m 22 Mar 2006 08:34:35 -0000
@@ -144,6 +144,7 @@
:- import_module list.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
@@ -339,8 +340,8 @@
Q = conj(plain_conj, QCalls) - _QGoalInfo
),
- solutions(update(PCalls, QCalls, UniversiallyQuantifiedVars, CallVars),
- [StateA - StateB | _]).
+ solutions.solutions(update(PCalls, QCalls,
+ UniversiallyQuantifiedVars, CallVars), [StateA - StateB | _]).
% compose(S0, A, SA), compose(SB, A, S),
% compose(SA, B, S) <=> compose(S0, B, SB)
@@ -624,7 +625,7 @@
% Explicit lambda expression needed since
% goal_calls_pred_id has multiple modes.
P = (pred(PredId::out) is nondet :- goal_calls_pred_id(Goal, PredId)),
- solutions(P, PredIds),
+ solutions.solutions(P, PredIds),
list.foldl(update_pred_info(AssertId), PredIds, !Module).
%-----------------------------------------------------------------------------%
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.88
diff -u -r1.88 check_typeclass.m
--- compiler/check_typeclass.m 17 Mar 2006 01:40:12 -0000 1.88
+++ compiler/check_typeclass.m 22 Mar 2006 06:43:20 -0000
@@ -110,6 +110,7 @@
:- import_module map.
:- import_module multi_map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
@@ -211,7 +212,7 @@
[TermContext - ErrorPieces | Messages0],
InstanceDefns = InstanceDefns0
;
- solutions(
+ solutions.solutions(
( pred(PredId::out) is nondet :-
list.member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, _)
@@ -429,7 +430,7 @@
!InstanceCheckInfo, !IO) :-
!.InstanceCheckInfo = instance_check_info(InstanceDefn0,
OrderedMethods0, Errors0, ModuleInfo0, QualInfo0),
- solutions((pred(ProcId::out) is nondet :-
+ solutions.solutions((pred(ProcId::out) is nondet :-
list.member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, ProcId)
), ProcIds),
@@ -1242,7 +1243,7 @@
prog_type.vars_list(DomainTypes, DomainVars),
RangeTypes = restrict_list_elements(Range, Types),
prog_type.vars_list(RangeTypes, RangeVars),
- solutions((pred(V::out) is nondet :-
+ solutions.solutions((pred(V::out) is nondet :-
list.member(V, RangeVars),
\+ list.member(V, DomainVars)
), UnboundVars),
@@ -1489,8 +1490,9 @@
module_info_get_class_table(ModuleInfo, ClassTable),
InducedFunDeps = induced_fundeps(ClassTable, Constraints),
FunDepsClosure = fundeps_closure(InducedFunDeps, list_to_set(TVars)),
- solutions(constrained_var_not_in_closure(Constraints, FunDepsClosure),
- UnboundTVars).
+ solutions.solutions(
+ constrained_var_not_in_closure(Constraints, FunDepsClosure),
+ UnboundTVars).
:- pred constrained_var_not_in_closure(prog_constraints::in, set(tvar)::in,
tvar::out) is nondet.
@@ -1709,7 +1711,7 @@
pred_info_get_class_context(PredInfo, Constraints),
Constraints = constraints(UnivCs, ExistCs),
prog_type.constraint_list_get_tvars(UnivCs, UnivTVars),
- solutions((pred(V::out) is nondet :-
+ solutions.solutions((pred(V::out) is nondet :-
list.member(V, UnivTVars),
list.member(V, ExistQVars)
), BadUnivTVars),
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.152
diff -u -r1.152 code_gen.m
--- compiler/code_gen.m 17 Mar 2006 01:40:13 -0000 1.152
+++ compiler/code_gen.m 22 Mar 2006 08:48:23 -0000
@@ -115,6 +115,7 @@
:- import_module int.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -998,7 +999,7 @@
Locn = indirect(Lval, _)
)
),
- solutions(FindBaseLvals, TypeInfoLvals),
+ solutions.solutions(FindBaseLvals, TypeInfoLvals),
set.insert_list(OutLvals, TypeInfoLvals, LiveLvals)
;
MaybeTraceInfo = no,
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.35
diff -u -r1.35 const_prop.m
--- compiler/const_prop.m 17 Mar 2006 01:40:14 -0000 1.35
+++ compiler/const_prop.m 22 Mar 2006 13:58:23 -0000
@@ -470,7 +470,7 @@
list(arg_hlds_info)::in, maybe(pair(arg_hlds_info, arg_val))::out)
is semidet.
-evaluate_semidet_call("std_util", "dynamic_cast", 0, Args, Result) :-
+evaluate_semidet_call("builtin", "dynamic_cast", 0, Args, Result) :-
evaluate_semidet_call("private_builtin", "typed_unify", 1, Args, Result).
evaluate_semidet_call("private_builtin", "typed_unify", Mode, Args, Result) :-
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.69
diff -u -r1.69 continuation_info.m
--- compiler/continuation_info.m 17 Mar 2006 01:40:14 -0000 1.69
+++ compiler/continuation_info.m 22 Mar 2006 08:49:32 -0000
@@ -371,6 +371,7 @@
:- import_module parse_tree.prog_type.
:- import_module int.
+:- import_module solutions.
:- import_module string.
:- import_module svmap.
:- import_module svset.
@@ -783,7 +784,7 @@
Locn = direct(Lval)
)
),
- solutions_set(ConvertLval, Locns)
+ solutions.solutions_set(ConvertLval, Locns)
;
varset.lookup_name(VarSet, TypeInfoVar, VarString),
string.format("%s: %s %s",
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.113
diff -u -r1.113 det_report.m
--- compiler/det_report.m 21 Mar 2006 22:25:25 -0000 1.113
+++ compiler/det_report.m 22 Mar 2006 06:45:35 -0000
@@ -198,6 +198,7 @@
:- import_module getopt_io.
:- import_module int.
:- import_module map.
+:- import_module solutions.
:- import_module string.
:- import_module term.
:- import_module varset.
@@ -309,7 +310,7 @@
globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
VerboseErrors = yes,
- solutions(get_valid_dets(EvalMethod), Detisms),
+ solutions.solutions(get_valid_dets(EvalMethod), Detisms),
DetismStrs = list.map(determinism_to_string, Detisms),
DetismPieces = list_to_pieces(DetismStrs),
write_error_pieces_not_first_line(Context, 0,
Index: compiler/goal_store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_store.m,v
retrieving revision 1.10
diff -u -r1.10 goal_store.m
--- compiler/goal_store.m 17 Mar 2006 01:40:19 -0000 1.10
+++ compiler/goal_store.m 22 Mar 2006 09:03:59 -0000
@@ -56,6 +56,7 @@
:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module solutions.
%-----------------------------------------------------------------------------%
@@ -106,8 +107,9 @@
direct_ancestors(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict)
= Ancestors :-
- solutions(direct_ancestor(GoalStore, StartId, VarTypes, ModuleInfo,
- FullyStrict), Ancestors).
+ solutions.solutions(
+ direct_ancestor(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict),
+ Ancestors).
:- pred direct_ancestor(goal_store(T)::in, T::in, vartypes::in,
module_info::in, bool::in, T::out) is nondet.
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.127
diff -u -r1.127 goal_util.m
--- compiler/goal_util.m 17 Mar 2006 01:40:19 -0000 1.127
+++ compiler/goal_util.m 22 Mar 2006 08:35:30 -0000
@@ -366,6 +366,7 @@
:- import_module parse_tree.prog_util.
:- import_module int.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
@@ -973,7 +974,7 @@
% include all typeclass_infos that constrain a type variable
% that is non-local in the above sense.
%
- solutions_set(
+ solutions.solutions_set(
(pred(Var::out) is nondet :-
% Search through all arguments of all constraints
% that the goal could have used.
@@ -1639,11 +1640,11 @@
% Explicit lambda expression needed since
% goal_calls_pred_id has multiple modes.
P = (pred(PredId::out) is nondet :- goal_calls_pred_id(Goal, PredId)),
- solutions(P, PredIds).
+ solutions.solutions(P, PredIds).
pred_proc_ids_from_goal(Goal, PredProcIds) :-
P = (pred(PredProcId::out) is nondet :- goal_calls(Goal, PredProcId)),
- solutions(P, PredProcIds).
+ solutions.solutions(P, PredProcIds).
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.260
diff -u -r1.260 handle_options.m
--- compiler/handle_options.m 17 Mar 2006 01:40:20 -0000 1.260
+++ compiler/handle_options.m 22 Mar 2006 08:38:20 -0000
@@ -91,6 +91,7 @@
:- import_module library.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
@@ -1998,7 +1999,7 @@
list(pair(grade_component, string))::out) is det.
compute_grade_components(Options, GradeComponents) :-
- solutions((pred(CompData::out) is nondet :-
+ solutions.solutions((pred(CompData::out) is nondet :-
grade_component_table(Name, Comp, CompOpts, MaybeTargets,
IncludeInGradeString),
% For possible component of the grade string
@@ -2245,7 +2246,7 @@
:- pred reset_grade_options(option_table::in, option_table::out) is det.
reset_grade_options(Options0, Options) :-
- aggregate(grade_start_values,
+ solutions.aggregate(grade_start_values,
(pred(Pair::in, Opts0::in, Opts::out) is det :-
Pair = Option - Value,
map.set(Opts0, Option, Value, Opts)
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.17
diff -u -r1.17 hhf.m
--- compiler/hhf.m 17 Mar 2006 01:40:20 -0000 1.17
+++ compiler/hhf.m 22 Mar 2006 08:36:06 -0000
@@ -53,6 +53,7 @@
:- import_module list.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module term.
:- import_module varset.
@@ -92,7 +93,7 @@
clauses_info_headvars(ClausesInfo, HeadVars),
clauses_info_varset(ClausesInfo, VarSet),
!:IG = !.IG ^ interface_inst_graph := ImplementationInstGraph,
- solutions(
+ solutions.solutions(
(pred(V::out) is nondet :-
list.member(V0, HeadVars),
inst_graph.reachable(ImplementationInstGraph,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.193
diff -u -r1.193 hlds_pred.m
--- compiler/hlds_pred.m 9 Mar 2006 04:56:34 -0000 1.193
+++ compiler/hlds_pred.m 22 Mar 2006 08:37:26 -0000
@@ -56,6 +56,7 @@
% Standard library modules.
:- import_module int.
+:- import_module solutions.
:- import_module string.
:- import_module svmap.
:- import_module term.
@@ -552,7 +553,7 @@
map.keys(VarMaps ^ ti_varmap, TVars).
rtti_varmaps_types(VarMaps, Types) :-
- solutions(rtti_varmaps_is_known_type(VarMaps), Types).
+ solutions.solutions(rtti_varmaps_is_known_type(VarMaps), Types).
:- pred rtti_varmaps_is_known_type(rtti_varmaps::in, mer_type::out) is nondet.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.194
diff -u -r1.194 intermod.m
--- compiler/intermod.m 17 Mar 2006 01:40:22 -0000 1.194
+++ compiler/intermod.m 22 Mar 2006 09:04:59 -0000
@@ -126,6 +126,7 @@
:- import_module map.
:- import_module multi_map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -1392,7 +1393,7 @@
:- func unmake_hlds_class_fundep_2(list(tvar), set(hlds_class_argpos)) =
list(tvar).
-unmake_hlds_class_fundep_2(TVars, Set) = solutions(P) :-
+unmake_hlds_class_fundep_2(TVars, Set) = solutions.solutions(P) :-
P = (pred(TVar::out) is nondet :-
set.member(N, Set),
TVar = list.index1_det(TVars, N)
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.62
diff -u -r1.62 lookup_switch.m
--- compiler/lookup_switch.m 17 Mar 2006 01:40:24 -0000 1.62
+++ compiler/lookup_switch.m 22 Mar 2006 08:50:41 -0000
@@ -97,6 +97,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
+:- import_module solutions.
%-----------------------------------------------------------------------------%
@@ -202,7 +203,7 @@
instmap.lookup_var(InstMapAfter, Var, Final),
mode_is_output(ModuleInfo, (Initial -> Final))
),
- solutions(Lambda, OutVars)
+ solutions.solutions(Lambda, OutVars)
).
%---------------------------------------------------------------------------%
Index: compiler/lp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lp.m,v
retrieving revision 1.13
diff -u -r1.13 lp.m
--- compiler/lp.m 17 Nov 2005 15:57:21 -0000 1.13
+++ compiler/lp.m 22 Mar 2006 08:41:08 -0000
@@ -87,6 +87,7 @@
:- import_module bool.
:- import_module int.
:- import_module set.
+:- import_module solutions.
:- import_module string.
:- import_module svmap.
:- import_module svset.
@@ -394,7 +395,7 @@
Pair = Var - _
)
),
- solutions(GetVar, VarList),
+ solutions.solutions(GetVar, VarList),
set.list_to_set(VarList, Vars).
:- pred number_vars(list(var)::in, int::in,
@@ -473,7 +474,7 @@
rhs_col(Tab, RHS),
index(Tab, Row, RHS, Val0)
),
- solutions(GetCell, Solns),
+ solutions.solutions(GetCell, Solns),
( Solns = [Val1] ->
Val = Val1
;
@@ -503,7 +504,7 @@
)
)
),
- aggregate(AllColumns, MinAgg, no, MinResult),
+ solutions.aggregate(AllColumns, MinAgg, no, MinResult),
(
MinResult = no,
A = A0,
@@ -539,7 +540,7 @@
)
)
),
- aggregate(AllRows, MaxAgg, no, MaxResult),
+ solutions.aggregate(AllRows, MaxAgg, no, MaxResult),
(
MaxResult = no,
A = A0,
@@ -569,7 +570,7 @@
ValF0 \= 0.0,
P = R - ValF0
),
- solutions(FindOne, Ones),
+ solutions.solutions(FindOne, Ones),
(
Ones = [Row - Fac0|_],
Fac = -Val/Fac0,
@@ -595,7 +596,7 @@
Ones = [Val - R|Ones0]
)
),
- aggregate(all_rows(!.Tableau), BasisAgg, [], Res),
+ solutions.aggregate(all_rows(!.Tableau), BasisAgg, [], Res),
(
Res = [1.0 - Row]
->
@@ -605,7 +606,7 @@
index(!.Tableau, Row, Col1, Zz),
Zz \= 0.0
),
- solutions(PivGoal, PivSolns),
+ solutions.solutions(PivGoal, PivSolns),
(
PivSolns = [],
remove_col(Col, !Tableau),
@@ -644,7 +645,7 @@
NewAjk = Ajk - Apk * Ajq / Apq,
set_index(J, K, NewAjk, !T)
),
- aggregate(MostCells, ScaleCell, !Tableau),
+ solutions.aggregate(MostCells, ScaleCell, !Tableau),
QColumn = (pred(Cell::out) is nondet :-
all_rows0(!.Tableau, J),
Cell = cell(J, Q)
@@ -653,14 +654,14 @@
Cell = cell(J, K),
set_index(J, K, 0.0, T0, T)
),
- aggregate(QColumn, Zero, !Tableau),
+ solutions.aggregate(QColumn, Zero, !Tableau),
PRow = all_cols0(!.Tableau),
ScaleRow = (pred(K::in, T0::in, T::out) is det :-
index(T0, P, K, Apk),
NewApk = Apk / Apq,
set_index(P, K, NewApk, T0, T)
),
- aggregate(PRow, ScaleRow, !Tableau),
+ solutions.aggregate(PRow, ScaleRow, !Tableau),
set_index(P, Q, 1.0, !Tableau).
:- pred row_op(float::in, int::in, int::in,
@@ -674,7 +675,7 @@
Z = Y + (Scale * X),
set_index(To, Col, Z, !Tableau)
),
- aggregate(AllCols, AddRow, !Tableau).
+ solutions.aggregate(AllCols, AddRow, !Tableau).
%-----------------------------------------------------------------------------%
@@ -800,16 +801,16 @@
Z \= 0.0,
P = R - Z
),
- solutions(NonZeroGoal, Solns),
+ solutions.solutions(NonZeroGoal, Solns),
Solns = [_ - 1.0]
),
- solutions(BasisCol, Cols),
+ solutions.solutions(BasisCol, Cols),
BasisVars = (pred(V::out) is nondet :-
list.member(Col, Cols),
Tab = tableau(_, _, VarCols, _, _, _, _),
map.member(VarCols, V, Col)
),
- solutions(BasisVars, Vars).
+ solutions.solutions(BasisVars, Vars).
%-----------------------------------------------------------------------------%
@@ -918,12 +919,12 @@
show_tableau(Tableau, !IO) :-
Tableau = tableau(N, M, _, _, _, _, _),
io.format("Tableau (%d, %d):\n", [i(N), i(M)], !IO),
- aggregate(all_rows0(Tableau), show_row(Tableau), !IO).
+ solutions.aggregate(all_rows0(Tableau), show_row(Tableau), !IO).
:- pred show_row(tableau::in, int::in, io::di, io::uo) is det.
show_row(Tableau, Row, !IO) :-
- aggregate(all_cols0(Tableau), show_cell(Tableau, Row), !IO),
+ solutions.aggregate(all_cols0(Tableau), show_cell(Tableau, Row), !IO),
io.nl(!IO).
:- pred show_cell(tableau::in, int::in, int::in, io::di, io::uo) is det.
Index: compiler/lp_rational.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lp_rational.m,v
retrieving revision 1.4
diff -u -r1.4 lp_rational.m
--- compiler/lp_rational.m 17 Nov 2005 15:57:21 -0000 1.4
+++ compiler/lp_rational.m 22 Mar 2006 08:47:23 -0000
@@ -328,6 +328,7 @@
:- import_module bool.
:- import_module exception.
:- import_module int.
+:- import_module solutions.
:- import_module string.
:- import_module svmap.
:- import_module svset.
@@ -930,7 +931,7 @@
),
Var = fst(Pair)
),
- std_util.solutions(GetVar, VarList),
+ solutions.solutions(GetVar, VarList),
Vars = set.list_to_set(VarList).
:- type var_num_map == map(lp_var, int).
@@ -1004,7 +1005,7 @@
one = Tableau ^ elem(Row, Col),
Val0 = Tableau ^ elem(Row, Tableau ^ cols)
),
- std_util.solutions(GetCell, Solns),
+ solutions.solutions(GetCell, Solns),
( if Solns = [Val1] then Val = Val1 else Val = zero ).
:- pred simplex(bool::out, tableau::in, tableau::out) is det.
@@ -1022,7 +1023,7 @@
( if CellVal < MinVal0 then !:Min = yes(Col - CellVal) else true )
)
),
- std_util.aggregate(AllColumns, MinAgg, no, MinResult),
+ solutions.aggregate(AllColumns, MinAgg, no, MinResult),
(
MinResult = no,
Result = yes
@@ -1068,7 +1069,7 @@
)
)
),
- aggregate(AllRows, MaxAgg, no, MaxResult),
+ solutions.aggregate(AllRows, MaxAgg, no, MaxResult),
(
MaxResult = no,
Result = no
@@ -1096,7 +1097,7 @@
ValF0 \= zero,
P = R - ValF0
),
- std_util.solutions(FindOne, Ones),
+ solutions.solutions(FindOne, Ones),
(
Ones = [Row - Fac0 | _],
( if Fac0 = zero
@@ -1123,7 +1124,7 @@
Val = !.Tableau ^ elem(R, Col),
Ones = ( Val = zero -> Ones0 ; [Val - R | Ones0] )
),
- aggregate(all_rows(!.Tableau), BasisAgg, [], Res),
+ solutions.aggregate(all_rows(!.Tableau), BasisAgg, [], Res),
(
Res = [one - Row]
->
@@ -1133,7 +1134,7 @@
Zz = !.Tableau ^ elem(Row, Col1),
Zz \= zero
),
- solutions(PivGoal, PivSolns),
+ solutions.solutions(PivGoal, PivSolns),
(
PivSolns = [],
remove_col(Col, !Tableau),
@@ -1175,7 +1176,7 @@
),
T = T0 ^ elem(J, K) := Ajk - Apk * Ajq / Apq
),
- std_util.aggregate(MostCells, ScaleCell, !Tableau),
+ solutions.aggregate(MostCells, ScaleCell, !Tableau),
QColumn = (pred(Cell::out) is nondet :-
all_rows0(!.Tableau, J),
Cell = cell(J, Q)
@@ -1184,7 +1185,7 @@
Cell = cell(J, K),
T = T0 ^ elem(J, K) := zero
),
- std_util.aggregate(QColumn, Zero, !Tableau),
+ solutions.aggregate(QColumn, Zero, !Tableau),
PRow = all_cols0(!.Tableau),
ScaleRow = (pred(K::in, T0::in, T::out) is det :-
Apk = T0 ^ elem(P, K),
@@ -1194,7 +1195,7 @@
),
T = T0 ^ elem(P, K) := Apk / Apq
),
- std_util.aggregate(PRow, ScaleRow, !Tableau),
+ solutions.aggregate(PRow, ScaleRow, !Tableau),
set_cell(P, Q, one, !Tableau).
:- pred row_op(rat::in, int::in, int::in, tableau::in,
@@ -1208,7 +1209,7 @@
Z = Y + (Scale * X),
T = T0 ^ elem(To, Col) := Z
),
- aggregate(AllCols, AddRow, !Tableau).
+ solutions.aggregate(AllCols, AddRow, !Tableau).
%-----------------------------------------------------------------------------%
@@ -1328,15 +1329,15 @@
Z \= zero,
P = R - Z
),
- std_util.solutions(NonZeroGoal, Solns),
+ solutions.solutions(NonZeroGoal, Solns),
Solns = [_ - one]
),
- std_util.solutions(BasisCol, Cols),
+ solutions.solutions(BasisCol, Cols),
BasisVars = (pred(V::out) is nondet :-
list.member(Col, Cols),
map.member(Tableau ^ var_nums, V, Col)
),
- std_util.solutions(BasisVars, Vars).
+ solutions.solutions(BasisVars, Vars).
%-----------------------------------------------------------------------------%
@@ -2091,7 +2092,7 @@
else Coeffs = map.det_insert(Coeffs0, Var, NumA)
)
),
- aggregate(IsMapKey, AddVal, TermsB, Terms).
+ solutions.aggregate(IsMapKey, AddVal, TermsB, Terms).
%-----------------------------------------------------------------------------%
%
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.27
diff -u -r1.27 make.dependencies.m
--- compiler/make.dependencies.m 17 Mar 2006 01:40:25 -0000 1.27
+++ compiler/make.dependencies.m 22 Mar 2006 08:52:05 -0000
@@ -119,6 +119,8 @@
:- import_module transform_hlds.
:- import_module transform_hlds.mmc_analysis.
+:- import_module solutions.
+
%-----------------------------------------------------------------------------%
:- type deps_result(T) == pair(bool, set(T)).
@@ -963,7 +965,7 @@
BuildDepsSucceeded, DepFiles, WriteDepFile, DepTimestamps, !IO) :-
assoc_list.from_corresponding_lists(DepFiles, DepTimestamps,
DepTimestampAL),
- solutions(
+ solutions.solutions(
(pred(DepFile::out) is nondet :-
list.member(DepFile - error(_), DepTimestampAL)
), ErrorDeps),
@@ -1054,7 +1056,7 @@
io.write_string(": newer dependencies: ", !IO),
assoc_list.from_corresponding_lists(DepFiles, DepTimestamps,
DepTimestampAL),
- solutions(
+ solutions.solutions(
(pred(DepFile::out) is nondet :-
list.member(DepFile - MaybeDepTimestamp, DepTimestampAL),
(
Index: compiler/make.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.m,v
retrieving revision 1.36
diff -u -r1.36 make.m
--- compiler/make.m 17 Mar 2006 01:40:25 -0000 1.36
+++ compiler/make.m 22 Mar 2006 06:37:34 -0000
@@ -89,6 +89,7 @@
:- import_module map.
:- import_module parser.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -337,7 +338,7 @@
string.length(FileName, NameLength),
search_backwards_for_dot(FileName, NameLength - 1, DotLocn),
string.split(FileName, DotLocn, ModuleNameStr0, Suffix),
- solutions(classify_target_2(Globals, ModuleNameStr0, Suffix),
+ solutions.solutions(classify_target_2(Globals, ModuleNameStr0, Suffix),
TargetFiles),
TargetFiles = [TargetFile]
->
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.35
diff -u -r1.35 make_hlds_passes.m
--- compiler/make_hlds_passes.m 21 Mar 2006 22:25:26 -0000 1.35
+++ compiler/make_hlds_passes.m 22 Mar 2006 09:09:07 -0000
@@ -120,6 +120,7 @@
:- import_module int.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module varset.
@@ -700,7 +701,8 @@
get_global_name_from_foreign_names(ReportErrors, Context, ModuleName,
MercuryMutableName, ForeignNames, TargetMutableName, !IO) :-
- solutions(get_matching_foreign_name(ForeignNames, c), TargetMutableNames),
+ solutions.solutions(get_matching_foreign_name(ForeignNames, c),
+ TargetMutableNames),
(
TargetMutableNames = [],
TargetMutableName = mutable_c_var_name(ModuleName,
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.9
diff -u -r1.9 make_hlds_warn.m
--- compiler/make_hlds_warn.m 21 Mar 2006 22:25:26 -0000 1.9
+++ compiler/make_hlds_warn.m 22 Mar 2006 09:12:51 -0000
@@ -65,6 +65,7 @@
:- import_module bool.
:- import_module char.
:- import_module set.
+:- import_module solutions.
:- import_module string.
:- import_module varset.
@@ -331,7 +332,7 @@
\+ string.prefix(Name, "_"),
\+ list.member(Name, C_CodeList)
),
- solutions(Filter, UnmentionedVars),
+ solutions.solutions(Filter, UnmentionedVars),
(
UnmentionedVars = []
;
@@ -354,7 +355,7 @@
\+ string.prefix(Name, "_"),
\+ list.member(Name, FirstCodeList)
),
- solutions(InputFilter, UnmentionedInputVars),
+ solutions.solutions(InputFilter, UnmentionedInputVars),
(
UnmentionedInputVars = []
;
@@ -372,7 +373,7 @@
\+ list.member(Name, FirstCodeList),
\+ list.member(Name, SharedCodeList)
),
- solutions(FirstOutputFilter, UnmentionedFirstOutputVars),
+ solutions.solutions(FirstOutputFilter, UnmentionedFirstOutputVars),
(
UnmentionedFirstOutputVars = []
;
@@ -391,7 +392,7 @@
\+ list.member(Name, LaterCodeList),
\+ list.member(Name, SharedCodeList)
),
- solutions(LaterOutputFilter, UnmentionedLaterOutputVars),
+ solutions.solutions(LaterOutputFilter, UnmentionedLaterOutputVars),
(
UnmentionedLaterOutputVars = []
;
@@ -511,7 +512,8 @@
% or "DCG_", and don't have the same name as any variable in QuantVars
% (i.e. weren't explicitly quantified).
- solutions(generate_singleton_vars(GoalVars, NonLocals, QuantVars, VarSet),
+ solutions.solutions(
+ generate_singleton_vars(GoalVars, NonLocals, QuantVars, VarSet),
SingletonVars),
% if there were any such variables, issue a warning
@@ -543,7 +545,8 @@
% (i.e. are not singleton) and have a variable name that starts
% with "_". If there were any such variables, issue a warning.
- solutions(generate_multi_vars(GoalVars, NonLocals, VarSet), MultiVars),
+ solutions.solutions(generate_multi_vars(GoalVars, NonLocals, VarSet),
+ MultiVars),
(
MultiVars = []
;
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.172
diff -u -r1.172 ml_code_gen.m
--- compiler/ml_code_gen.m 17 Mar 2006 01:40:28 -0000 1.172
+++ compiler/ml_code_gen.m 22 Mar 2006 08:53:10 -0000
@@ -792,6 +792,7 @@
:- import_module list.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -1502,7 +1503,7 @@
union_of_direct_subgoal_locals(Goal - _GoalInfo) = UnionOfSubGoalLocals :-
promise_equivalent_solutions [UnionOfSubGoalLocals] (
set.init(EmptySet),
- unsorted_aggregate(direct_subgoal(Goal),
+ solutions.unsorted_aggregate(direct_subgoal(Goal),
union_subgoal_locals, EmptySet, UnionOfSubGoalLocals)
).
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.77
diff -u -r1.77 ml_elim_nested.m
--- compiler/ml_elim_nested.m 17 Mar 2006 01:40:29 -0000 1.77
+++ compiler/ml_elim_nested.m 22 Mar 2006 08:53:56 -0000
@@ -458,6 +458,7 @@
:- import_module counter.
:- import_module int.
:- import_module list.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
@@ -1884,7 +1885,7 @@
mlds_data(VarType, _, _)),
\+ ml_decl_is_static_const(Var)
),
- solutions(IsLocalVar, [FieldType])
+ solutions.solutions(IsLocalVar, [FieldType])
->
EnvPtr = lval(var(qual(ModuleName, QualKind,
mlds_var_name(env_name_base(Action) ++ "_ptr", no)),
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.32
diff -u -r1.32 ml_tailcall.m
--- compiler/ml_tailcall.m 17 Mar 2006 01:40:29 -0000 1.32
+++ compiler/ml_tailcall.m 22 Mar 2006 08:54:38 -0000
@@ -86,6 +86,7 @@
:- import_module int.
:- import_module list.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
@@ -510,7 +511,7 @@
%-----------------------------------------------------------------------------%
ml_warn_tailcalls(MLDS, !IO) :-
- solutions(nontailcall_in_mlds(MLDS), Warnings),
+ solutions.solutions(nontailcall_in_mlds(MLDS), Warnings),
list.foldl(report_nontailcall_warning, Warnings, !IO).
:- type tailcall_warning
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.41
diff -u -r1.41 ml_util.m
--- compiler/ml_util.m 17 Mar 2006 01:40:30 -0000 1.41
+++ compiler/ml_util.m 22 Mar 2006 08:55:19 -0000
@@ -173,6 +173,7 @@
:- import_module bool.
:- import_module list.
+:- import_module solutions.
:- import_module std_util.
%-----------------------------------------------------------------------------%
@@ -458,7 +459,7 @@
SubStatement = statement(atomic(
outline_foreign_proc(Lang, _, _, _)), _)
),
- solutions(GetTargetCode, Langs).
+ solutions.solutions(GetTargetCode, Langs).
%-----------------------------------------------------------------------------%
%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.183
diff -u -r1.183 mlds_to_c.m
--- compiler/mlds_to_c.m 17 Mar 2006 01:40:30 -0000 1.183
+++ compiler/mlds_to_c.m 22 Mar 2006 08:56:02 -0000
@@ -98,6 +98,7 @@
:- import_module library.
:- import_module list.
:- import_module map.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -1117,7 +1118,7 @@
% Output forward declarations for all struct types
% that are contained in the parameter types.
- aggregate(mlds_type_list_contains_type(ParamTypes),
+ solutions.aggregate(mlds_type_list_contains_type(ParamTypes),
mlds_output_type_forward_decl(Indent), !IO).
% mlds_type_list_contains_type(Types, SubType):
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.115
diff -u -r1.115 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 17 Mar 2006 01:40:30 -0000 1.115
+++ compiler/mlds_to_gcc.m 22 Mar 2006 09:18:43 -0000
@@ -182,6 +182,7 @@
:- import_module library.
:- import_module list.
:- import_module map.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -1514,7 +1515,7 @@
:- pred build_label_table(statement::in, label_table::out,
io__state::di, io__state::uo) is det.
build_label_table(Statement, LabelTable) -->
- { solutions(statement_contains_label(Statement), Labels) },
+ { solutions.solutions(statement_contains_label(Statement), Labels) },
list__map_foldl(gcc__build_label, Labels, GCC_LabelDecls),
{ map__from_corresponding_lists(Labels, GCC_LabelDecls,
LabelTable) }.
Index: compiler/mode_constraint_robdd.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_constraint_robdd.m,v
retrieving revision 1.8
diff -u -r1.8 mode_constraint_robdd.m
--- compiler/mode_constraint_robdd.m 9 Mar 2006 04:56:34 -0000 1.8
+++ compiler/mode_constraint_robdd.m 22 Mar 2006 06:46:13 -0000
@@ -151,6 +151,7 @@
:- import_module map.
:- import_module require.
:- import_module robdd.
+:- import_module solutions.
:- import_module sparse_bitset.
:- import_module stack.
:- import_module std_util.
@@ -290,7 +291,7 @@
PredId = Info0 ^ pred_id,
bimap.ordinates(VarMap, Keys),
Constraint1 = ensure_normalised(Constraint0),
- solutions((pred(ProgVar::out) is nondet :-
+ solutions.solutions((pred(ProgVar::out) is nondet :-
list.member(Key, Keys),
Key = key(in(ProgVar), PredId, LambdaPath),
bimap.lookup(VarMap, Key, RobddVar),
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.24
diff -u -r1.24 mode_constraints.m
--- compiler/mode_constraints.m 17 Mar 2006 01:40:31 -0000 1.24
+++ compiler/mode_constraints.m 22 Mar 2006 06:57:34 -0000
@@ -79,6 +79,7 @@
:- import_module multi_map.
:- import_module robdd.
:- import_module set.
+:- import_module solutions.
:- import_module sparse_bitset.
:- import_module std_util.
:- import_module string.
@@ -450,7 +451,8 @@
number_robdd_variables_at_goal_path(InstGraph, GoalPath, ParentNonLocals,
Vars0, Occurring, !NRInfo) :-
- solutions_set(inst_graph.reachable_from_list(InstGraph, Vars0), Occurring),
+ solutions.solutions_set(inst_graph.reachable_from_list(InstGraph, Vars0),
+ Occurring),
Vars = set.to_sorted_list(ParentNonLocals `set.union`
set.list_to_set(Vars0)),
% XXX We may be able to make this more efficient.
@@ -585,7 +587,7 @@
% DMO document this better
% XXX Needed for analysing calls. May want to store the constraint
% as an ROBDD instead.
- solutions(arg_modes_map(HeadVars, InstGraph, ModeConstraint,
+ solutions.solutions(arg_modes_map(HeadVars, InstGraph, ModeConstraint,
ModeConstraintInfo0), Modes),
PredInfo = PredInfo0 ^ modes := Modes,
% PredInfo = PredInfo0,
@@ -1055,7 +1057,7 @@
goal_info_get_nonlocals(GoalInfo0, NonLocals),
InstGraph = !.GCInfo ^ inst_graph,
- NonLocalReachable = solutions_set(inst_graph.reachable_from_list(
+ NonLocalReachable = solutions.solutions_set(inst_graph.reachable_from_list(
InstGraph, to_sorted_list(NonLocals))),
LocalVars = Vars `difference` NonLocalReachable,
@@ -1214,7 +1216,7 @@
PredInstGraph = PredInfo ^ inst_graph_info ^ interface_inst_graph,
pred_info_clauses_info(PredInfo, PredClausesInfo),
clauses_info_headvars(PredClausesInfo, PredHeadVars),
- solutions((pred((V - W)::out) is nondet :-
+ solutions.solutions((pred((V - W)::out) is nondet :-
inst_graph.corresponding_nodes_from_lists(
PredInstGraph, InstGraph, PredHeadVars, Args, V, W)
), CorrespondingNodes),
@@ -1314,7 +1316,7 @@
CanSucceed = (CanSucceedC `and` CanSucceedT) `or` CanSucceedE,
InstGraph = !.GCInfo ^ inst_graph,
- NonLocalReachable = solutions(inst_graph.reachable_from_list(
+ NonLocalReachable = solutions.solutions(inst_graph.reachable_from_list(
InstGraph, to_sorted_list(NonLocals))),
% Make sure variables have the same bindings in both the then and else
@@ -1485,7 +1487,7 @@
get_var(W `at` GoalPath, Wgp, S3, S),
C = C0 ^ eq_vars(Vout, Wout) ^ not_both(Vgp, Wgp)
),
- aggregate2(Generator, Accumulator, !Constraint, !GCInfo),
+ solutions.aggregate2(Generator, Accumulator, !Constraint, !GCInfo),
get_var(out(A), Aout, !GCInfo),
!:Constraint = !.Constraint ^ var(Aout),
@@ -1623,7 +1625,7 @@
get_var(out(W), Wout, S3, S),
C = C0 ^ eq_vars(V_, Wgp) ^ imp_vars(Vin, Wout)
),
- aggregate2(Generator, Accumulator, !Constraint, !GCInfo).
+ solutions.aggregate2(Generator, Accumulator, !Constraint, !GCInfo).
:- pred higher_order_call_constraints(mode_constraint::in,
mode_constraint::out, goal_constraints_info::in,
@@ -1852,8 +1854,8 @@
get_var(V `at` GoalPath, VGP),
{ Vs = Vs0 `insert` VGP }
),
- aggregate2(Generator, Accumulator, empty_vars_set, NonOccurringVars,
- !GCInfo),
+ solutions.aggregate2(Generator, Accumulator, empty_vars_set,
+ NonOccurringVars, !GCInfo),
!:Constraint = !.Constraint ^ conj_not_vars(NonOccurringVars).
% aggregate2((pred(V::out) is nondet :-
@@ -1894,7 +1896,8 @@
mode_constraint_info::in, arg_modes_map::out) is nondet.
arg_modes_map(HeadVars, InstGraph, Constraint0, Info0, ArgModes) :-
- solutions(inst_graph.reachable_from_list(InstGraph, HeadVars), Vars),
+ solutions.solutions(inst_graph.reachable_from_list(InstGraph, HeadVars),
+ Vars),
list.map_foldl((pred(PV::in, (MV - in(PV))::out, in, out) is det -->
mode_constraint_var(in(PV), MV)), Vars, InVars, Info0, Info1),
list.map_foldl((pred(PV::in, (MV - out(PV))::out, in, out) is det -->
Index: compiler/mode_ordering.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_ordering.m,v
retrieving revision 1.11
diff -u -r1.11 mode_ordering.m
--- compiler/mode_ordering.m 9 Mar 2006 04:56:35 -0000 1.11
+++ compiler/mode_ordering.m 22 Mar 2006 07:00:33 -0000
@@ -60,6 +60,7 @@
:- import_module assoc_list.
:- import_module relation.
:- import_module set.
+:- import_module solutions.
:- import_module stack.
:- import_module std_util.
@@ -238,7 +239,7 @@
MakeVisibleVars = set.init,
NeedVisibleVars = list_to_set([VarA, VarB])
),
- ConsumingVars = solutions_set((pred(Var::out) is nondet :-
+ ConsumingVars = solutions.solutions_set((pred(Var::out) is nondet :-
inst_graph.corresponding_nodes(InstGraph, VarA, VarB, VarC, VarD),
( ProdVars `contains` VarC ->
Var = VarD
@@ -280,7 +281,7 @@
mode_order_goal(SubGoal0, SubGoal, !MOI),
leave_lambda_goal(!MOI),
- ConsumingVars = solutions_set(
+ ConsumingVars = solutions.solutions_set(
inst_graph.reachable_from_list(InstGraph, NonLocals)),
MakeVisibleVars = make_singleton_set(VarA),
NeedVisibleVars = list_to_set(NonLocals)
@@ -545,7 +546,7 @@
)
->
ProcId = ProcId0,
- ConsumingVars = solutions_set(pred(X::out) is nondet :-
+ ConsumingVars = solutions.solutions_set(pred(X::out) is nondet :-
some [Y] (
inst_graph.corresponding_nodes_from_lists(CallerInstGraph,
CalleeInstGraph, Args, HeadVars, X, Y),
Index: compiler/mode_robdd.equiv_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_robdd.equiv_vars.m,v
retrieving revision 1.3
diff -u -r1.3 mode_robdd.equiv_vars.m
--- compiler/mode_robdd.equiv_vars.m 28 Oct 2005 02:10:23 -0000 1.3
+++ compiler/mode_robdd.equiv_vars.m 22 Mar 2006 08:57:19 -0000
@@ -70,6 +70,7 @@
:- import_module map.
:- import_module require.
:- import_module set.
+:- import_module solutions.
:- import_module sparse_bitset.
:- import_module std_util.
@@ -275,7 +276,7 @@
( L = E0 ^ leader(V) ->
( L = V ->
M0 = map__delete(E0 ^ leader_map, V),
- Vars = solutions(map__inverse_search(M0, V)),
+ Vars = solutions.solutions(map.inverse_search(M0, V)),
( Vars = [NewLeader | _] ->
M = list__foldl(
func(V1, M1) =
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.129
diff -u -r1.129 module_qual.m
--- compiler/module_qual.m 21 Mar 2006 22:25:27 -0000 1.129
+++ compiler/module_qual.m 22 Mar 2006 08:58:01 -0000
@@ -139,6 +139,7 @@
:- import_module int.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module string.
:- import_module svmap.
:- import_module term.
@@ -1829,7 +1830,7 @@
list.member(MatchModule, AllMatchingModules),
set.member(MatchModule, DefiningModules)
),
- solutions(FindMatch, MatchingModules)
+ solutions.solutions(FindMatch, MatchingModules)
)
;
MatchingModules = []
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.381
diff -u -r1.381 modules.m
--- compiler/modules.m 20 Mar 2006 22:24:27 -0000 1.381
+++ compiler/modules.m 22 Mar 2006 08:59:51 -0000
@@ -818,6 +818,7 @@
:- import_module getopt_io.
:- import_module library.
:- import_module multi_map.
+:- import_module solutions.
:- import_module sparse_bitset.
:- import_module string.
:- import_module svmap.
@@ -1499,7 +1500,7 @@
% If there is an exported type declaration for a type with an abstract
% declaration in the implementation (usually it will originally
% have been a d.u. type), remove the declaration in the implementation.
- unsorted_aggregate(
+ solutions.unsorted_aggregate(
(pred(TypeCtor::out) is nondet :-
map.member(!.ImplTypesMap, TypeCtor, Defns),
\+ (
@@ -2824,7 +2825,7 @@
; list.member(Import, UsedModules)
)
),
- aggregate(IsImportedAncestor,
+ solutions.aggregate(IsImportedAncestor,
warn_imported_ancestor(ModuleName), !IO)
;
Warn = no
@@ -7071,7 +7072,7 @@
),
set.member(SubModuleName, Duplicates)
),
- solutions(IsDuplicateError, DuplicateErrors),
+ solutions.solutions(IsDuplicateError, DuplicateErrors),
list.foldl(report_error_duplicate_module_decl, DuplicateErrors, !IO).
:- pred report_error_duplicate_module_decl(pair(module_name, prog_context)::in,
@@ -7161,8 +7162,8 @@
set(foreign_language)::in, set(foreign_language)::out) is det.
accumulate_item_foreign_import_langs(Item - _, !LangSet) :-
- solutions(item_needs_foreign_imports(Item), Langs),
- set.insert_list(!.LangSet, Langs, !:LangSet).
+ solutions.solutions(item_needs_foreign_imports(Item), Langs),
+ svset.insert_list(Langs, !LangSet).
:- pred get_interface_and_implementation_2(bool::in, item_list::in, bool::in,
item_list::in, item_list::out,
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.29
diff -u -r1.29 recompilation.usage.m
--- compiler/recompilation.usage.m 22 Mar 2006 06:28:06 -0000 1.29
+++ compiler/recompilation.usage.m 22 Mar 2006 12:15:17 -0000
@@ -105,6 +105,7 @@
:- import_module bool.
:- import_module int.
:- import_module queue.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
@@ -540,7 +541,7 @@
% when the interface of the module changes.
map.init(ImportedItems0),
promise_equivalent_solutions [ImportedItems1] (
- std_util.unsorted_aggregate(visible_modules(ModuleInfo),
+ solutions.unsorted_aggregate(visible_modules(ModuleInfo),
insert_into_imported_items_map, ImportedItems0, ImportedItems1)
),
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.4
diff -u -r1.4 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 3 Mar 2006 06:08:24 -0000 1.4
+++ compiler/structure_sharing.domain.m 22 Mar 2006 09:14:04 -0000
@@ -244,6 +244,7 @@
:- import_module int.
:- import_module require.
+:- import_module solutions.
:- import_module std_util.
:- import_module svmap.
:- import_module svset.
@@ -1668,7 +1669,7 @@
set(pair(T1, T2))::out) is det.
set_cross_product(SetA, SetB, CrossProduct):-
- solutions_set(cross_product(SetA, SetB), CrossProduct).
+ solutions.solutions_set(cross_product(SetA, SetB), CrossProduct).
:- pred cross_product(set(T1)::in, set(T2)::in, pair(T1, T2)::out) is nondet.
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.103
diff -u -r1.103 table_gen.m
--- compiler/table_gen.m 17 Mar 2006 01:40:42 -0000 1.103
+++ compiler/table_gen.m 22 Mar 2006 09:06:45 -0000
@@ -92,6 +92,7 @@
:- import_module list.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -275,7 +276,8 @@
is det.
may_call_mercury_attributes(Goal, MayCallMercuryAttrs) :-
- solutions(subgoal_may_call_mercury_attribute(Goal), MayCallMercuryAttrs).
+ solutions.solutions(subgoal_may_call_mercury_attribute(Goal),
+ MayCallMercuryAttrs).
:- pred subgoal_may_call_mercury_attribute(hlds_goal::in,
may_call_mercury::out) is nondet.
@@ -291,7 +293,8 @@
is det.
tabled_for_io_attributes(Goal, TabledForIoAttrs) :-
- solutions(subgoal_tabled_for_io_attribute(Goal), TabledForIoAttrs).
+ solutions.solutions(subgoal_tabled_for_io_attribute(Goal),
+ TabledForIoAttrs).
:- pred subgoal_tabled_for_io_attribute(hlds_goal::in, tabled_for_io::out)
is nondet.
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.15
diff -u -r1.15 typecheck_errors.m
--- compiler/typecheck_errors.m 17 Mar 2006 01:40:45 -0000 1.15
+++ compiler/typecheck_errors.m 22 Mar 2006 07:06:42 -0000
@@ -122,6 +122,7 @@
:- import_module int.
:- import_module map.
:- import_module set.
+:- import_module solutions.
:- import_module std_util.
:- import_module string.
:- import_module term.
@@ -962,7 +963,7 @@
(
Functor = cons(Constructor, Arity),
typecheck_info_get_ctors(Info, ConsTable),
- solutions(
+ solutions.solutions(
(pred(N::out) is nondet :-
map.member(ConsTable, cons(Constructor, N), _),
N \= Arity
@@ -1506,7 +1507,7 @@
% The module qualifier matches one or more of the
% visible modules. But maybe the user forgot to
% import the parent module(s) of that module...
- solutions(get_unimported_parent(ModuleQualifier,
+ solutions.solutions(get_unimported_parent(ModuleQualifier,
ModuleInfo), UnimportedParents),
UnimportedParents \= []
->
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.117
diff -u -r1.117 builtin.m
--- library/builtin.m 23 Mar 2006 01:38:39 -0000 1.117
+++ library/builtin.m 23 Mar 2006 01:58:54 -0000
@@ -324,14 +324,62 @@
% call/N
%-----------------------------------------------------------------------------%
+
+ % `semidet_succeed' is exactly the same as `true', exception that
+ % the compiler thinks that it is semi-deterministic. You can use
+ % calls to `semidet_succeed' to suppress warnings about determinism
+ % declarations that could be stricter.
+ %
+:- pred semidet_succeed is semidet.
+
+ % `semidet_fail' is like `fail' except that its determinism is semidet
+ % rather than failure.
+ %
+:- pred semidet_fail is semidet.
+
+ % A synonym for semidet_succeed/0.
+ %
+:- pred semidet_true is semidet.
+
+ % A synonym for semidet_fail/0
+ %
+:- pred semidet_false is semidet.
+
+ % `cc_multi_equal(X, Y)' is the same as `X = Y' except that it
+ % is cc_multi rather than det.
+ %
+:- pred cc_multi_equal(T, T).
+:- mode cc_multi_equal(di, uo) is cc_multi.
+:- mode cc_multi_equal(in, out) is cc_multi.
+
+ % `impure_true' is exactly the same as `true' except that it is
+ % impure. You can use calls to `impure_true' to
+ %
+ %
+:- impure pred impure_true is det.
+
+ % `semipure_true' is like `true' except that that it is semipure.
+ %
+:- semipure pred semipure_true is det.
+
+%-----------------------------------------------------------------------------%
:- implementation.
% Everything below here is not intended to be part of the public interface,
% and will not be included in the Mercury library reference manual.
%-----------------------------------------------------------------------------%
+
:- interface.
+
+ % dynamic_cast(X, Y) succeeds with Y = X iff X has the same
+ % ground type as Y (so this may succeed if Y is of type
+ % list(int), say, but not if Y is of type list(T)).
+ %
+:- pred dynamic_cast(T1::in, T2::out) is semidet.
+%-----------------------------------------------------------------------------%
+
% `get_one_solution' and `get_one_solution_io' are impure alternatives
% to `promise_one_solution' and `promise_one_solution_io', respectively.
% They get a solution to the procedure, without requiring any promise
@@ -383,6 +431,11 @@
%-----------------------------------------------------------------------------%
+dynamic_cast(X, Y) :-
+ private_builtin.typed_unify(X, Y).
+
+%-----------------------------------------------------------------------------%
+
% XXX The calls to unsafe_promise_unique below work around
% mode checker limitations.
:- pragma promise_pure(promise_only_solution/1).
@@ -943,6 +996,114 @@
}
").
-:- end_module builtin.
+%-----------------------------------------------------------------------------%
+%
+% semidet_succeed and semidet_fail
+%
+
+% semidet_succeed and semidet_fail are implemented using the foreign language
+% interface to make sure that the compiler doesn't issue any determinism
+% warnings for them.
+
+:- pragma foreign_proc("C",
+ semidet_succeed,
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ SUCCESS_INDICATOR = MR_TRUE;
+").
+:- pragma foreign_proc("C",
+ semidet_fail,
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ SUCCESS_INDICATOR = MR_FALSE;
+").
+
+:- pragma foreign_proc("C#",
+ semidet_succeed,
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ SUCCESS_INDICATOR = true;
+").
+:- pragma foreign_proc("C#",
+ semidet_fail,
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ SUCCESS_INDICATOR = false;
+").
+
+% We can't just use "true" and "fail" here, because that provokes warnings
+% from determinism analysis, and the library is compiled with --halt-at-warn.
+% So instead we use 0+0 = (or \=) 0.
+% This is guaranteed to succeed or fail (respectively),
+% and with a bit of luck will even get optimized by constant propagation.
+% But this optimization won't happen until after determinism analysis,
+% which doesn't know anything about integer arithmetic,
+% so this code won't provide a warning from determinism analysis.
+
+semidet_succeed :-
+ 0 + 0 = 0.
+semidet_fail :-
+ 0 + 0 \= 0.
+semidet_true :- semidet_succeed.
+semidet_false :- semidet_fail.
+
+%-----------------------------------------------------------------------------%
+%
+% cc_multi_equal
+%
+
+:- pragma foreign_proc("C",
+ cc_multi_equal(X::in, Y::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+:- pragma foreign_proc("C",
+ cc_multi_equal(X::di, Y::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+
+:- pragma foreign_proc("C#",
+ cc_multi_equal(X::in, Y::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+:- pragma foreign_proc("C#",
+ cc_multi_equal(X::di, Y::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+
+:- pragma foreign_proc("Java",
+ cc_multi_equal(X::in, Y::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+:- pragma foreign_proc("Java",
+ cc_multi_equal(X::di, Y::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Y = X;
+").
+
+:- pragma promise_pure(cc_multi_equal/2).
+
+cc_multi_equal(X, X).
+
+%-----------------------------------------------------------------------------%
+
+impure_true :-
+ impure private_builtin.imp.
+
+semipure_true :-
+ semipure private_builtin.semip.
+
+%-----------------------------------------------------------------------------%
+:- end_module builtin.
%-----------------------------------------------------------------------------%
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.105
diff -u -r1.105 exception.m
--- library/exception.m 7 Mar 2006 22:23:44 -0000 1.105
+++ library/exception.m 22 Mar 2006 06:27:56 -0000
@@ -244,6 +244,8 @@
:- import_module require.
:- import_module string.
+:- use_module solutions.
+
:- pred try(determinism, pred(T), exception_result(T)).
:- mode try(in(bound(det)), pred(out) is det, out(cannot_fail))
is cc_multi.
@@ -568,7 +570,7 @@
).
incremental_try_all(Goal, AccPred, Acc0, Acc) :-
- unsorted_aggregate((pred(Result::out) is nondet :-
+ solutions.unsorted_aggregate((pred(Result::out) is nondet :-
catch_impl((pred(R::out) is nondet :-
wrap_success(Goal, R)),
wrap_exception, Result)),
Index: library/getopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/getopt.m,v
retrieving revision 1.36
diff -u -r1.36 getopt.m
--- library/getopt.m 7 Mar 2006 22:23:44 -0000 1.36
+++ library/getopt.m 22 Mar 2006 06:29:54 -0000
@@ -285,6 +285,8 @@
:- import_module string.
:- import_module svset.
+:- use_module solutions.
+
% Please keep the differences between this module and getopt_io.m to the
% minimum. Most changes should done in both modules.
@@ -325,14 +327,14 @@
)).
init_option_table(OptionDefaultsPred, OptionTable) :-
- solutions((pred(OptionDataPair::out) is nondet :-
+ solutions.solutions((pred(OptionDataPair::out) is nondet :-
OptionDataPair = Option - OptionData,
call(OptionDefaultsPred, Option, OptionData)
), OptionDefaultsList),
map.from_assoc_list(OptionDefaultsList, OptionTable).
init_option_table_multi(OptionDefaultsPred, OptionTable) :-
- solutions((pred(OptionDataPair::out) is multi :-
+ solutions.solutions((pred(OptionDataPair::out) is multi :-
OptionDataPair = Option - OptionData,
call(OptionDefaultsPred, Option, OptionData)
), OptionDefaultsList),
Index: library/getopt_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/getopt_io.m,v
retrieving revision 1.5
diff -u -r1.5 getopt_io.m
--- library/getopt_io.m 7 Mar 2006 22:23:44 -0000 1.5
+++ library/getopt_io.m 22 Mar 2006 06:30:31 -0000
@@ -290,6 +290,8 @@
:- import_module string.
:- import_module svset.
+:- use_module solutions.
+
% Please keep the differences between this module and getopt.m to the
% minimum. Most changes should done in both modules.
@@ -330,14 +332,14 @@
)).
init_option_table(OptionDefaultsPred, OptionTable) :-
- solutions((pred(OptionDataPair::out) is nondet :-
+ solutions.solutions((pred(OptionDataPair::out) is nondet :-
OptionDataPair = Option - OptionData,
call(OptionDefaultsPred, Option, OptionData)
), OptionDefaultsList),
map.from_assoc_list(OptionDefaultsList, OptionTable).
init_option_table_multi(OptionDefaultsPred, OptionTable) :-
- solutions((pred(OptionDataPair::out) is multi :-
+ solutions.solutions((pred(OptionDataPair::out) is multi :-
OptionDataPair = Option - OptionData,
call(OptionDefaultsPred, Option, OptionData)
), OptionDefaultsList),
Index: library/graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/graph.m,v
retrieving revision 1.26
diff -u -r1.26 graph.m
--- library/graph.m 7 Mar 2006 22:23:44 -0000 1.26
+++ library/graph.m 22 Mar 2006 06:30:57 -0000
@@ -176,6 +176,8 @@
:- import_module require.
:- import_module std_util.
+:- use_module solutions.
+
:- type graph(N, A)
---> graph(
node_supply :: counter,
@@ -255,7 +257,7 @@
% SolnGoal = lambda([Node::out] is nondet,
% map.member(NodeTable, Node, NodeInfo)),
% solutions(SolnGoal, NodeList),
- solutions(graph.select_node(NodeTable, NodeInfo), NodeList),
+ solutions.solutions(graph.select_node(NodeTable, NodeInfo), NodeList),
set.sorted_list_to_set(NodeList, NodeSet).
:- pred graph.select_node(map(node(N), N)::in, N::in, node(N)::out) is nondet.
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.92
diff -u -r1.92 library.m
--- library/library.m 7 Mar 2006 22:23:45 -0000 1.92
+++ library/library.m 23 Mar 2006 03:36:53 -0000
@@ -99,6 +99,7 @@
:- import_module set_ordlist.
:- import_module set_tree234.
:- import_module set_unordlist.
+:- import_module solutions.
:- import_module sparse_bitset.
:- import_module stack.
:- import_module std_util.
@@ -237,6 +238,7 @@
mercury_std_library_module("set_unordlist").
mercury_std_library_module("set_ctree234").
mercury_std_library_module("set_tree234").
+mercury_std_library_module("solutions").
mercury_std_library_module("sparse_bitset").
mercury_std_library_module("stack").
mercury_std_library_module("std_util").
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.64
diff -u -r1.64 rtti_implementation.m
--- library/rtti_implementation.m 22 Mar 2006 02:56:18 -0000 1.64
+++ library/rtti_implementation.m 22 Mar 2006 06:15:52 -0000
@@ -1513,10 +1513,10 @@
#endif
").
high_level_data :-
- ( std_util.semidet_succeed ->
+ ( semidet_succeed ->
private_builtin.sorry("high_level_data")
;
- std_util.semidet_succeed
+ semidet_succeed
).
:- pred get_arg_type_info(type_info::in, P::in, T::in,
@@ -2169,16 +2169,16 @@
:- pred semidet_unimplemented(string::in) is semidet.
semidet_unimplemented(S) :-
- ( std_util.semidet_succeed ->
+ ( semidet_succeed ->
error("rtti_implementation: unimplemented: " ++ S)
;
- std_util.semidet_succeed
+ semidet_succeed
).
:- pred det_unimplemented(string::in) is det.
det_unimplemented(S) :-
- ( std_util.semidet_succeed ->
+ ( semidet_succeed ->
error("rtti_implementation: unimplemented: " ++ S)
;
true
Index: library/solutions.m
===================================================================
RCS file: library/solutions.m
diff -N library/solutions.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/solutions.m 23 Mar 2006 03:36:41 -0000
@@ -0,0 +1,909 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1994-2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+
+% File: solutions.m.
+% Main author: fjh.
+% Stability: medium.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module solutions.
+:- interface.
+
+:- import_module bool.
+:- import_module list.
+:- import_module set.
+
+%-----------------------------------------------------------------------------%
+
+ % solutions/2 collects all the solutions to a predicate and returns
+ % them as a list in sorted order, with duplicates removed.
+ % solutions_set/2 returns them as a set. unsorted_solutions/2 returns
+ % them as an unsorted list with possible duplicates; since there are an
+ % infinite number of such lists, this must be called from a context in
+ % which only a single solution is required.
+ %
+:- pred solutions(pred(T), list(T)).
+:- mode solutions(pred(out) is multi, out(non_empty_list)) is det.
+:- mode solutions(pred(out) is nondet, out) is det.
+
+:- func solutions(pred(T)) = list(T).
+:- mode solutions(pred(out) is multi) = out(non_empty_list) is det.
+:- mode solutions(pred(out) is nondet) = out is det.
+
+:- func solutions_set(pred(T)) = set(T).
+:- mode solutions_set(pred(out) is multi) = out is det.
+:- mode solutions_set(pred(out) is nondet) = out is det.
+
+:- pred solutions_set(pred(T), set(T)).
+:- mode solutions_set(pred(out) is multi, out) is det.
+:- mode solutions_set(pred(out) is nondet, out) is det.
+
+:- pred unsorted_solutions(pred(T), list(T)).
+:- mode unsorted_solutions(pred(out) is multi, out(non_empty_list))
+ is cc_multi.
+:- mode unsorted_solutions(pred(out) is nondet, out) is cc_multi.
+
+:- func aggregate(pred(T), func(T, U) = U, U) = U.
+:- mode aggregate(pred(out) is multi, func(in, in) = out is det, in)
+ = out is det.
+:- mode aggregate(pred(out) is nondet, func(in, in) = out is det, in)
+ = out is det.
+
+ % aggregate/4 generates all the solutions to a predicate,
+ % sorts them and removes duplicates, then applies an accumulator
+ % predicate to each solution in turn:
+ %
+ % aggregate(Generator, Accumulator, Acc0, Acc) <=>
+ % solutions(Generator, Solutions),
+ % list.foldl(Accumulator, Solutions, Acc0, Acc).
+ %
+:- pred aggregate(pred(T), pred(T, U, U), U, U).
+:- mode aggregate(pred(out) is multi, pred(in, in, out) is det,
+ in, out) is det.
+:- mode aggregate(pred(out) is multi, pred(in, di, uo) is det,
+ di, uo) is det.
+:- mode aggregate(pred(out) is nondet, pred(in, di, uo) is det,
+ di, uo) is det.
+:- mode aggregate(pred(out) is nondet, pred(in, in, out) is det,
+ in, out) is det.
+
+ % aggregate2/6 generates all the solutions to a predicate,
+ % sorts them and removes duplicates, then applies an accumulator
+ % predicate to each solution in turn:
+ %
+ % aggregate2(Generator, Accumulator, AccA0, AccA, AccB0, AccB) <=>
+ % solutions(Generator, Solutions),
+ % list.foldl2(Accumulator, Solutions, AccA0, AccA, AccB0, AccB).
+ %
+:- pred aggregate2(pred(T), pred(T, U, U, V, V), U, U, V, V).
+:- mode aggregate2(pred(out) is multi, pred(in, in, out, in, out) is det,
+ in, out, in, out) is det.
+:- mode aggregate2(pred(out) is multi, pred(in, in, out, di, uo) is det,
+ in, out, di, uo) is det.
+:- mode aggregate2(pred(out) is nondet, pred(in, in, out, di, uo) is det,
+ in, out, di, uo) is det.
+:- mode aggregate2(pred(out) is nondet, pred(in, in, out, in, out) is det,
+ in, out, in, out) is det.
+
+ % unsorted_aggregate/4 generates all the solutions to a predicate
+ % and applies an accumulator predicate to each solution in turn.
+ % Declaratively, the specification is as follows:
+ %
+ % unsorted_aggregate(Generator, Accumulator, Acc0, Acc) <=>
+ % unsorted_solutions(Generator, Solutions),
+ % list.foldl(Accumulator, Solutions, Acc0, Acc).
+ %
+ % Operationally, however, unsorted_aggregate/4 will call the
+ % Accumulator for each solution as it is obtained, rather than
+ % first building a list of all the solutions.
+ %
+:- pred unsorted_aggregate(pred(T), pred(T, U, U), U, U).
+:- mode unsorted_aggregate(pred(out) is multi, pred(in, in, out) is det,
+ in, out) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is multi, pred(in, in, out) is cc_multi,
+ in, out) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is multi, pred(in, di, uo) is det,
+ di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is multi, pred(in, di, uo) is cc_multi,
+ di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(muo) is multi, pred(mdi, di, uo) is det,
+ di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is nondet, pred(in, di, uo) is det,
+ di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is nondet, pred(in, di, uo) is cc_multi,
+ di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is nondet, pred(in, in, out) is det,
+ in, out) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is nondet, pred(in, in, out) is cc_multi,
+ in, out) is cc_multi.
+:- mode unsorted_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
+ di, uo) is cc_multi.
+
+ % This is a generalization of unsorted_aggregate which allows the
+ % iteration to stop before all solutions have been found.
+ % Declaratively, the specification is as follows:
+ %
+ % do_while(Generator, Filter, !Acc) :-
+ % unsorted_solutions(Generator, Solutions),
+ % do_while_2(Solutions, Filter, !Acc).
+ %
+ % do_while_2([], _, !Acc).
+ % do_while_2([X | Xs], Filter, !Acc) :-
+ % Filter(X, More, !Acc),
+ % ( More = yes ->
+ % do_while_2(Xs, Filter, !Acc)
+ % ;
+ % true
+ % ).
+ %
+ % Operationally, however, do_while/4 will call the Filter
+ % predicate for each solution as it is obtained, rather than
+ % first building a list of all the solutions.
+ %
+:- pred do_while(pred(T), pred(T, bool, T2, T2), T2, T2).
+:- mode do_while(pred(out) is multi, pred(in, out, in, out) is det, in, out)
+ is cc_multi.
+:- mode do_while(pred(out) is multi, pred(in, out, di, uo) is det, di, uo)
+ is cc_multi.
+:- mode do_while(pred(out) is multi, pred(in, out, di, uo) is cc_multi, di, uo)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, in, out) is det, in, out)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, di, uo) is det, di, uo)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, di, uo) is cc_multi, di, uo)
+ is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+solutions(Pred, List) :-
+ builtin_solutions(Pred, UnsortedList),
+ list.sort_and_remove_dups(UnsortedList, List).
+
+solutions(P) = S :- solutions(P, S).
+
+solutions_set(P) = S :- solutions_set(P, S).
+
+solutions_set(Pred, Set) :-
+ builtin_solutions(Pred, List),
+ set.list_to_set(List, Set).
+
+unsorted_solutions(Pred, List) :-
+ builtin_solutions(Pred, UnsortedList),
+ cc_multi_equal(UnsortedList, List).
+
+aggregate(P, F, Acc0) = Acc :-
+ aggregate(P, (pred(X::in, A0::in, A::out) is det :- A = F(X, A0)),
+ Acc0, Acc).
+
+aggregate(Generator, Accumulator, !Acc) :-
+ solutions(Generator, Solutions),
+ list.foldl(Accumulator, Solutions, !Acc).
+
+aggregate2(Generator, Accumulator, !Acc1, !Acc2) :-
+ solutions(Generator, Solutions),
+ list.foldl2(Accumulator, Solutions, !Acc1, !Acc2).
+
+unsorted_aggregate(Generator, Accumulator, !Acc) :-
+ builtin_aggregate(Generator, Accumulator, !Acc),
+ cc_multi_equal(!Acc).
+
+%-----------------------------------------------------------------------------%
+
+:- pred builtin_solutions(pred(T), list(T)).
+:- mode builtin_solutions(pred(out) is multi, out)
+ is det. /* really cc_multi */
+:- mode builtin_solutions(pred(out) is nondet, out)
+ is det. /* really cc_multi */
+
+builtin_solutions(Generator, UnsortedList) :-
+ builtin_aggregate(Generator, list.cons, [], UnsortedList).
+
+%-----------------------------------------------------------------------------%
+%
+% This section defines builtin_aggregate/4 which takes a closure of type
+% pred(T) in which the remaining argument is output, and backtracks over
+% solutions for this, using the second argument to aggregate them however the
+% user wishes. This is basically a generalization of solutions/2.
+
+:- pred builtin_aggregate(pred(T), pred(T, U, U), U, U).
+:- mode builtin_aggregate(pred(out) is multi, pred(in, in, out) is det,
+ in, out) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is det,
+ di, uo) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is multi, pred(in, in, out) is cc_multi,
+ in, out) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is cc_multi,
+ di, uo) is det. % really cc_multi
+:- mode builtin_aggregate(pred(muo) is multi, pred(mdi, di, uo) is det,
+ di, uo) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is det,
+ di, uo) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is cc_multi,
+ di, uo) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is nondet, pred(in, in, out) is det,
+ in, out) is det. % really cc_multi
+:- mode builtin_aggregate(pred(out) is nondet, pred(in, in, out) is cc_multi,
+ in, out) is det. % really cc_multi
+:- mode builtin_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
+ di, uo) is det. % really cc_multi
+
+% If we're doing heap reclamation on failure, then in order to implement any
+% sort of code that requires terms to survive backtracking, we need to
+% (deeply) copy them out of the heap and into some other area before
+% backtracking. The obvious thing to do then is just call the generator
+% predicate, let it run to completion, and copy its result into another memory
+% area (call it the solutions heap) before forcing backtracking. When we get
+% the next solution, we do the same, this time passing the previous collection
+% (which is still on the solutions heap) to the collector predicate. If the
+% result of this operation contains the old collection as a part, then the
+% deep copy operation is smart enough not to copy again. So this could be
+% pretty efficient.
+%
+% But what if the collector predicate does something that copies the previous
+% collection? Then on each solution, we'll copy the previous collection to
+% the heap, and then deep copy it back to the solution heap. This means
+% copying solutions order N**2 times, where N is the number of solutions. So
+% this isn't as efficient as we hoped.
+%
+% So we use a slightly different approach. When we find a solution, we deep
+% copy it to the solution heap. Then, before calling the collector code, we
+% sneakily swap the runtime system's notion of which is the heap and which is
+% the solutions heap. This ensures that any terms are constructed on the
+% solutions heap. When this is complete, we swap them back, and force the
+% engine to backtrack to get the next solution. And so on. After we've
+% gotten the last solution, we do another deep copy to move the solution back
+% to the 'real' heap, and reset the solutions heap pointer (which of course
+% reclaims all the garbage of the collection process).
+%
+% Note that this will work with recursive calls to builtin_aggregate as
+% well. If the recursive invocation occurs in the generator pred, there can
+% be no problem because by the time the generator succeeds, the inner
+% do_ call will have completed, copied its result from the solutions heap,
+% and reset the solutions heap pointer. If the recursive invocation happens
+% in the collector pred, then it will happen when the heap and solutions heap
+% are 'swapped.' This will work out fine, because the real heap isn't needed
+% while the collector pred is executing, and by the time the nested do_ is
+% completed, the 'real' heap pointer will have been reset.
+%
+% If the collector predicate throws an exception while they are swapped,
+% then the code for builtin_throw/1 will unswap the heaps.
+% So we don't need to create our own exception handlers to here to
+% cover that case.
+%
+% If we're not doing heap reclamation on failure (as is currently the
+% case when using conservative GC), then all of the heap-swapping
+% and copying operations are no-ops, so we get a "zero-copy" solution.
+
+% Note that the code for builtin_aggregate is very similar to the code
+% for do_while (below).
+
+:- pragma promise_pure(builtin_aggregate/4).
+
+builtin_aggregate(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
+ % Save some of the Mercury virtual machine registers
+ impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
+ impure start_all_soln_neg_context,
+
+ % Initialize the accumulator
+ % /* Mutvar := Accumulator0 */
+ impure new_mutvar(Accumulator0, Mutvar),
+
+ (
+ % Get a solution.
+ GeneratorPred(Answer0),
+
+ % Check that the generator didn't leave any delayed goals outstanding.
+ impure check_for_floundering(TrailPtr),
+
+ % Update the accumulator.
+ % /* MutVar := CollectorPred(MutVar) */
+ impure swap_heap_and_solutions_heap,
+ impure partial_deep_copy(HeapPtr, Answer0, Answer),
+ impure get_mutvar(Mutvar, Acc0),
+ impure non_cc_call(CollectorPred, Answer, Acc0, Acc1),
+ impure set_mutvar(Mutvar, Acc1),
+ impure swap_heap_and_solutions_heap,
+
+ % Force backtracking, so that we get the next solution.
+ % This will automatically reset the heap and trail.
+ fail
+ ;
+ % There are no more solutions.
+ impure end_all_soln_neg_context_no_more,
+
+ % So now we just need to copy the final value of the accumulator
+ % from the solutions heap back onto the ordinary heap, and then we can
+ % reset the solutions heap pointer. We also need to discard the trail
+ % ticket created by get_registers/3.
+ % /* Accumulator := MutVar */
+ impure get_mutvar(Mutvar, Accumulator1),
+ impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
+ impure reset_solutions_heap(SolutionsHeapPtr),
+ impure discard_trail_ticket
+ ).
+
+%-----------------------------------------------------------------------------%
+
+% The code for do_while/4 is essentially the same as the code for
+% builtin_aggregate (above). See the detailed comments above.
+%
+% XXX It would be nice to avoid the code duplication here,
+% but it is a bit tricky -- we can't just use a lambda expression,
+% because we'd need to specify the mode, but we want it to work
+% for multiple modes. An alternative would be to use a typeclass,
+% but typeclasses still don't work in `jump' or `fast' grades.
+
+:- pragma promise_pure(do_while/4).
+
+do_while(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
+ impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
+ impure new_mutvar(Accumulator0, Mutvar),
+ impure start_all_soln_neg_context,
+ (
+ GeneratorPred(Answer0),
+
+ impure check_for_floundering(TrailPtr),
+
+ impure swap_heap_and_solutions_heap,
+ impure partial_deep_copy(HeapPtr, Answer0, Answer),
+ impure get_mutvar(Mutvar, Acc0),
+ impure non_cc_call(CollectorPred, Answer, More, Acc0, Acc1),
+ impure set_mutvar(Mutvar, Acc1),
+ impure swap_heap_and_solutions_heap,
+
+ % If More = yes, then backtrack for the next solution.
+ % If More = no, then we're done.
+ More = no,
+ impure end_all_soln_neg_context_more
+ ;
+ impure end_all_soln_neg_context_no_more
+ ),
+ impure get_mutvar(Mutvar, Accumulator1),
+ impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
+ impure reset_solutions_heap(SolutionsHeapPtr),
+ impure discard_trail_ticket.
+
+ % This is the same as call/4, except that it is not cc_multi
+ % even when the called predicate is cc_multi.
+:- impure pred non_cc_call(pred(T, Acc, Acc), T, Acc, Acc).
+:- mode non_cc_call(pred(in, in, out) is det, in, in, out) is det.
+:- mode non_cc_call(pred(in, in, out) is cc_multi, in, in, out) is det.
+:- mode non_cc_call(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode non_cc_call(pred(in, di, uo) is cc_multi, in, di, uo) is det.
+:- mode non_cc_call(pred(mdi, di, uo) is det, mdi, di, uo) is det.
+
+non_cc_call(P::pred(in, in, out) is det, X::in, Acc0::in, Acc::out) :-
+ P(X, Acc0, Acc).
+non_cc_call(P::pred(in, in, out) is cc_multi, X::in, Acc0::in, Acc::out) :-
+ Pred = (pred(Soln::out) is cc_multi :- P(X, Acc0, Soln)),
+ impure Acc = builtin.get_one_solution(Pred).
+non_cc_call(P::pred(in, di, uo) is cc_multi, X::in, Acc0::di, Acc::uo) :-
+ impure builtin.get_one_solution_io(
+ (pred({}::out, di, uo) is cc_multi --> P(X)),
+ _, Acc0, Acc).
+non_cc_call(P::pred(in, di, uo) is det, X::in, Acc0::di, Acc::uo) :-
+ P(X, Acc0, Acc).
+non_cc_call(P::pred(mdi, di, uo) is det, X::mdi, Acc0::di, Acc::uo) :-
+ P(X, Acc0, Acc).
+
+ % This is the same as call/5, except that it is not cc_multi
+ % even when the called predicate is cc_multi.
+:- impure pred non_cc_call(pred(T1, T2, Acc, Acc), T1, T2, Acc, Acc).
+:- mode non_cc_call(pred(in, out, in, out) is det, in, out, in, out) is det.
+:- mode non_cc_call(pred(in, out, di, uo) is det, in, out, di, uo) is det.
+:- mode non_cc_call(pred(in, out, di, uo) is cc_multi, in, out, di, uo) is det.
+
+non_cc_call(P::pred(in, out, di, uo) is det, X::in, More::out,
+ Acc0::di, Acc::uo) :-
+ P(X, More, Acc0, Acc).
+non_cc_call(P::pred(in, out, in, out) is det, X::in, More::out,
+ Acc0::in, Acc::out) :-
+ P(X, More, Acc0, Acc).
+non_cc_call(P::pred(in, out, di, uo) is cc_multi, X::in, More::out,
+ Acc0::di, Acc::uo) :-
+ impure builtin.get_one_solution_io(
+ (pred(M::out, di, uo) is cc_multi --> P(X, M)),
+ More, Acc0, Acc).
+
+:- type heap_ptr == private_builtin.heap_pointer.
+:- type trail_ptr ---> trail_ptr(c_pointer).
+
+% Save the state of the Mercury heap and trail registers,
+% for later use in partial_deep_copy/3 and reset_solutions_heap/1.
+% Note that this allocates a trail ticket;
+% you need to dispose of it properly when you're finished with it,
+% e.g. by calling discard_trail_ticket/0.
+:- impure pred get_registers(heap_ptr::out, heap_ptr::out, trail_ptr::out)
+ is det.
+
+:- pragma foreign_proc("C",
+ get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
+ [will_not_call_mercury, thread_safe],
+"
+ /* save heap states */
+#ifdef MR_RECLAIM_HP_ON_FAILURE
+ HeapPtr = (MR_Word) MR_hp;
+ SolutionsHeapPtr = (MR_Word) MR_sol_hp;
+#else
+ HeapPtr = SolutionsHeapPtr = 0;
+#endif
+
+ /* save trail state */
+#ifdef MR_USE_TRAIL
+ MR_store_ticket(TrailPtr);
+#else
+ TrailPtr = 0;
+#endif
+").
+
+:- pragma foreign_proc("C#",
+ get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
+ [will_not_call_mercury, thread_safe],
+"
+ /*
+ ** For .NET we always use the MS garbage collector,
+ ** so we don't have to worry here about heap reclamation on failure.
+ */
+ HeapPtr = null;
+ SolutionsHeapPtr = null;
+
+#if MR_USE_TRAIL
+ /* XXX trailing not yet implemented for the MLDS back-end */
+ mercury.runtime.Errors.SORRY(""foreign code for get_registers"");
+#else
+ TrailPtr = null;
+#endif
+").
+
+:- pragma foreign_proc("Java",
+ get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
+ [will_not_call_mercury, thread_safe],
+"
+ /*
+ ** Java has a builtin garbage collector,
+ ** so we don't have to worry here about heap reclamation on failure.
+ */
+ HeapPtr = null;
+ SolutionsHeapPtr = null;
+
+ /* XXX No trailing for the Java back-end. */
+ TrailPtr = null;
+").
+
+:- impure pred check_for_floundering(trail_ptr::in) is det.
+
+:- pragma foreign_proc("C",
+ check_for_floundering(TrailPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_USE_TRAIL
+ /* check for outstanding delayed goals (``floundering'') */
+ MR_reset_ticket(TrailPtr, MR_solve);
+#endif
+").
+
+:- pragma foreign_proc("C#",
+ check_for_floundering(_TrailPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+#if MR_USE_TRAIL
+ mercury.runtime.Errors.SORRY(""foreign code for check_for_floundering"");
+#endif
+").
+
+:- pragma foreign_proc("Java",
+ check_for_floundering(_TrailPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+ /* XXX No trailing for the Java back-end, so take no action. */
+").
+
+ % Discard the topmost trail ticket.
+ %
+:- impure pred discard_trail_ticket is det.
+
+:- pragma foreign_proc("C",
+ discard_trail_ticket,
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_USE_TRAIL
+ MR_discard_ticket();
+#endif
+").
+
+:- pragma foreign_proc("C#",
+ discard_trail_ticket,
+ [will_not_call_mercury, thread_safe],
+"
+#if MR_USE_TRAIL
+ mercury.runtime.Errors.SORRY(""foreign code for discard_trail_ticket"");
+#endif
+").
+
+:- pragma foreign_proc("Java",
+ discard_trail_ticket,
+ [will_not_call_mercury, thread_safe],
+"
+ /* XXX No trailing for the Java back-end, so take no action. */
+").
+
+ % Swap the heap with the solutions heap
+ %
+:- impure pred swap_heap_and_solutions_heap is det.
+
+:- pragma foreign_proc("C",
+ swap_heap_and_solutions_heap,
+ [will_not_call_mercury, thread_safe],
+"{
+#ifdef MR_RECLAIM_HP_ON_FAILURE
+ MR_MemoryZone *temp_zone;
+ MR_Word *temp_hp;
+
+ temp_zone = MR_ENGINE(MR_eng_heap_zone);
+ MR_ENGINE(MR_eng_heap_zone) = MR_ENGINE(MR_eng_solutions_heap_zone);
+ MR_ENGINE(MR_eng_solutions_heap_zone) = temp_zone;
+ temp_hp = MR_hp;
+ MR_hp_word = (MR_Word) MR_sol_hp;
+ MR_sol_hp = temp_hp;
+#endif
+}").
+
+:- pragma foreign_proc("C#",
+ swap_heap_and_solutions_heap,
+ [will_not_call_mercury, thread_safe],
+"
+ //
+ // For the .NET back-end, we use the system heap, rather
+ // than defining our own heaps. So we don't need to
+ // worry about swapping them. Hence do nothing here.
+ //
+").
+
+:- pragma foreign_proc("Java",
+ swap_heap_and_solutions_heap,
+ [will_not_call_mercury, thread_safe],
+"
+ /*
+ ** For the Java back-end, as for the .NET back-end, we don't define
+ ** our own heaps. So take no action here.
+ */
+").
+
+ % partial_deep_copy(SolutionsHeapPtr, OldVal, NewVal):
+ % Make a copy of all of the parts of OldVar that occur between
+ % SolutionsHeapPtr and the top of the current solutions heap.
+ %
+:- impure pred partial_deep_copy(heap_ptr, T, T) is det.
+:- mode partial_deep_copy(in, di, uo) is det.
+:- mode partial_deep_copy(in, mdi, muo) is det.
+:- mode partial_deep_copy(in, in, out) is det.
+
+:- pragma foreign_decl("C", "
+
+#include ""mercury_deep_copy.h""
+
+#ifndef MR_RECLAIM_HP_ON_FAILURE
+ /* for conservative GC, shallow copies suffice */
+ #define MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, \\
+ OldVar, NewVal, TypeInfo_for_T) \\
+ do { \\
+ NewVal = OldVal; \\
+ } while (0)
+#else
+ /*
+ ** Note that we need to save/restore the MR_hp register, if it
+ ** is transient, before/after calling MR_deep_copy().
+ */
+ #define MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, \\
+ OldVar, NewVal, TypeInfo_for_T) \\
+ do { \\
+ MR_save_transient_hp(); \\
+ NewVal = MR_deep_copy(OldVal, (MR_TypeInfo) TypeInfo_for_T, \\
+ (const MR_Word *) SolutionsHeapPtr, \\
+ MR_ENGINE(MR_eng_solutions_heap_zone)->MR_zone_top); \\
+ MR_restore_transient_hp(); \\
+ } while (0)
+#endif
+
+").
+
+:- pragma foreign_proc("C",
+ partial_deep_copy(SolutionsHeapPtr::in, OldVal::in, NewVal::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
+").
+:- pragma foreign_proc("C",
+ partial_deep_copy(SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
+").
+:- pragma foreign_proc("C",
+ partial_deep_copy(SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
+").
+
+:- pragma foreign_proc("C#",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ //
+ // For the IL back-end, we don't do heap reclamation on failure,
+ // so we don't need to worry about making deep copies here.
+ // Shallow copies will suffice.
+ //
+ NewVal = OldVal;
+").
+:- pragma foreign_proc("C#",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ NewVal = OldVal;
+").
+:- pragma foreign_proc("C#",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ NewVal = OldVal;
+").
+
+:- pragma foreign_proc("Java",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ /*
+ ** For the Java back-end, as for the .NET implementation,
+ ** we don't do heap reclamation on failure,
+ ** so we don't need to worry about making deep copies here.
+ ** Shallow copies will suffice.
+ */
+ NewVal = OldVal;
+").
+:- pragma foreign_proc("Java",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ NewVal = OldVal;
+").
+:- pragma foreign_proc("Java",
+ partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ NewVal = OldVal;
+").
+
+ % reset_solutions_heap(SolutionsHeapPtr):
+ %
+ % Reset the solutions heap pointer to the specified value,
+ % thus deallocating everything allocated on the solutions
+ % heap since that value was obtained via get_registers/3.
+ %
+:- impure pred reset_solutions_heap(heap_ptr::in) is det.
+
+:- pragma foreign_proc("C",
+ reset_solutions_heap(SolutionsHeapPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_RECLAIM_HP_ON_FAILURE
+ MR_sol_hp = (MR_Word *) SolutionsHeapPtr;
+#endif
+").
+
+:- pragma foreign_proc("C#",
+ reset_solutions_heap(_SolutionsHeapPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+ // For the IL back-end, we don't have a separate `solutions heap'.
+ // Hence this operation is a NOP.
+").
+
+:- pragma foreign_proc("Java",
+ reset_solutions_heap(_SolutionsHeapPtr::in),
+ [will_not_call_mercury, thread_safe],
+"
+ /* As above, we take no action. */
+").
+
+:- impure pred start_all_soln_neg_context is det.
+:- impure pred end_all_soln_neg_context_more is det.
+:- impure pred end_all_soln_neg_context_no_more is det.
+
+:- pragma foreign_proc("C",
+ start_all_soln_neg_context,
+ % In minimal model tabling grades, there are no threads.
+ % In all other grades, this predicate is a noop.
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
+ MR_pneg_enter_cond();
+#endif
+").
+
+:- pragma foreign_proc("C",
+ end_all_soln_neg_context_more,
+ % In minimal model tabling grades, there are no threads.
+ % In all other grades, this predicate is a noop.
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
+ MR_pneg_enter_then();
+#endif
+").
+
+:- pragma foreign_proc("C",
+ end_all_soln_neg_context_no_more,
+ % In minimal model tabling grades, there are no threads.
+ % In all other grades, this predicate is a noop.
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
+ MR_pneg_enter_else(""end_all_soln_neg_context"");
+#endif
+").
+
+start_all_soln_neg_context.
+end_all_soln_neg_context_more.
+end_all_soln_neg_context_no_more.
+
+%-----------------------------------------------------------------------------%
+
+%%% :- module mutvar.
+%%% :- interface.
+
+% A non-backtrackably destructively modifiable reference type
+:- type mutvar(T).
+
+% Create a new mutvar given a term for it to reference.
+:- impure pred new_mutvar(T, mutvar(T)).
+:- mode new_mutvar(in, out) is det.
+:- mode new_mutvar(di, uo) is det.
+
+% Get the value currently referred to by a reference.
+:- impure pred get_mutvar(mutvar(T), T) is det.
+:- mode get_mutvar(in, uo) is det. % XXX this is a work-around
+/*
+XXX `ui' modes don't work yet
+:- mode get_mutvar(in, uo) is det.
+:- mode get_mutvar(ui, uo) is det. % unsafe, but we use it safely
+*/
+
+% destructively modify a reference to refer to a new object.
+:- impure pred set_mutvar(mutvar(T), T) is det.
+:- mode set_mutvar(in, in) is det.
+/*
+XXX `ui' modes don't work yet
+:- pred set_mutvar(ui, di) is det.
+*/
+
+%%% :- implementation.
+
+% This type is a builtin-in type whose operations are implemented in C.
+:- type mutvar(T)
+ ---> mutvar(private_builtin.ref(T)).
+
+:- pragma inline(new_mutvar/2).
+:- pragma inline(get_mutvar/2).
+:- pragma inline(set_mutvar/2).
+
+:- pragma foreign_proc("C",
+ new_mutvar(X::in, Ref::out),
+ [will_not_call_mercury, thread_safe],
+"
+ MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
+ MR_PROC_LABEL, ""solutions.mutvar/1"");
+ MR_define_size_slot(0, Ref, 1);
+ * (MR_Word *) Ref = X;
+").
+:- pragma foreign_proc("C",
+ new_mutvar(X::di, Ref::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
+ MR_PROC_LABEL, ""solutions.mutvar/1"");
+ MR_define_size_slot(0, Ref, 1);
+ * (MR_Word *) Ref = X;
+").
+
+:- pragma foreign_proc("C",
+ get_mutvar(Ref::in, X::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ X = * (MR_Word *) Ref;
+").
+
+:- pragma foreign_proc("C",
+ set_mutvar(Ref::in, X::in),
+ [will_not_call_mercury, thread_safe],
+"
+ *(MR_Word *) Ref = X;
+").
+
+:- pragma foreign_proc("C#",
+ new_mutvar(X::in, Ref::out),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref = new object[1];
+ Ref[0] = X;
+").
+:- pragma foreign_proc("C#",
+ new_mutvar(X::di, Ref::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref = new object[1];
+ Ref[0] = X;
+").
+
+:- pragma foreign_proc("C#",
+ get_mutvar(Ref::in, X::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ X = Ref[0];
+").
+
+:- pragma foreign_proc("C#",
+ set_mutvar(Ref::in, X::in),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref[0] = X;
+").
+
+:- pragma foreign_code("Java",
+"
+ public static class Mutvar {
+ public Object object;
+
+ public Mutvar(Object init) {
+ object = init;
+ }
+ }
+").
+:- pragma foreign_type(java, mutvar(T), "mercury.solutions.Mutvar").
+
+:- pragma foreign_proc("Java",
+ new_mutvar(X::in, Ref::out),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref = new mercury.solutions.Mutvar(X);
+").
+:- pragma foreign_proc("Java",
+ new_mutvar(X::di, Ref::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref = new mercury.solutions.Mutvar(X);
+").
+
+:- pragma foreign_proc("Java",
+ get_mutvar(Ref::in, X::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ X = Ref.object;
+").
+
+:- pragma foreign_proc("Java",
+ set_mutvar(Ref::in, X::in),
+ [will_not_call_mercury, thread_safe],
+"
+ Ref.object = X;
+").
+
+%%% end_module mutvar.
+
+%-----------------------------------------------------------------------------%
+:- end_module solutions.
+%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.307
diff -u -r1.307 std_util.m
--- library/std_util.m 22 Mar 2006 02:56:19 -0000 1.307
+++ library/std_util.m 23 Mar 2006 03:36:28 -0000
@@ -17,7 +17,6 @@
%-----------------------------------------------------------------------------%
:- module std_util.
-
:- interface.
:- import_module bool.
@@ -27,7 +26,8 @@
%-----------------------------------------------------------------------------%
%
-% The universal type `univ'.
+% The universal type `univ'
+%
% An object of type `univ' can hold the type and value of an object of any
% other type.
@@ -84,7 +84,7 @@
%-----------------------------------------------------------------------------%
%
-% The "maybe" type.
+% The "maybe" type
%
:- type maybe(T) ---> no ; yes(T).
@@ -174,6 +174,10 @@
%-----------------------------------------------------------------------------%
+% NOTE: the procedures in this section are all obsolete and will be deleted
+% in a later release. New code should use the versions defined in
+% solutions.m instead.
+
% solutions/2 collects all the solutions to a predicate and returns
% them as a list in sorted order, with duplicates removed.
% solutions_set/2 returns them as a set. unsorted_solutions/2 returns
@@ -181,27 +185,33 @@
% infinite number of such lists, this must be called from a context in
% which only a single solution is required.
%
+:- pragma obsolete(solutions/2).
:- pred solutions(pred(T), list(T)).
:- mode solutions(pred(out) is multi, out(non_empty_list)) is det.
:- mode solutions(pred(out) is nondet, out) is det.
+:- pragma obsolete(solutions/1).
:- func solutions(pred(T)) = list(T).
:- mode solutions(pred(out) is multi) = out(non_empty_list) is det.
:- mode solutions(pred(out) is nondet) = out is det.
+:- pragma obsolete(solutions_set/2).
:- pred solutions_set(pred(T), set(T)).
:- mode solutions_set(pred(out) is multi, out) is det.
:- mode solutions_set(pred(out) is nondet, out) is det.
+:- pragma obsolete(solutions_set/1).
:- func solutions_set(pred(T)) = set(T).
:- mode solutions_set(pred(out) is multi) = out is det.
:- mode solutions_set(pred(out) is nondet) = out is det.
+:- pragma obsolete(unsorted_solutions/2).
:- pred unsorted_solutions(pred(T), list(T)).
:- mode unsorted_solutions(pred(out) is multi, out(non_empty_list))
is cc_multi.
:- mode unsorted_solutions(pred(out) is nondet, out) is cc_multi.
+:- pragma obsolete(aggregate/3).
:- func aggregate(pred(T), func(T, U) = U, U) = U.
:- mode aggregate(pred(out) is multi, func(in, in) = out is det, in)
= out is det.
@@ -218,6 +228,7 @@
% solutions(Generator, Solutions),
% list.foldl(Accumulator, Solutions, Acc0, Acc).
%
+:- pragma obsolete(aggregate/4).
:- pred aggregate(pred(T), pred(T, U, U), U, U).
:- mode aggregate(pred(out) is multi, pred(in, in, out) is det,
in, out) is det.
@@ -236,6 +247,7 @@
% solutions(Generator, Solutions),
% list.foldl2(Accumulator, Solutions, AccA0, AccA, AccB0, AccB).
%
+:- pragma obsolete(aggregate2/6).
:- pred aggregate2(pred(T), pred(T, U, U, V, V), U, U, V, V).
:- mode aggregate2(pred(out) is multi, pred(in, in, out, in, out) is det,
in, out, in, out) is det.
@@ -258,6 +270,7 @@
% Accumulator for each solution as it is obtained, rather than
% first building a list of all the solutions.
%
+:- pragma obsolete(unsorted_aggregate/4).
:- pred unsorted_aggregate(pred(T), pred(T, U, U), U, U).
:- mode unsorted_aggregate(pred(out) is multi, pred(in, in, out) is det,
in, out) is cc_multi.
@@ -301,6 +314,7 @@
% predicate for each solution as it is obtained, rather than
% first building a list of all the solutions.
%
+:- pragma obsolete(do_while/4).
:- pred do_while(pred(T), pred(T, bool, T2, T2), T2, T2).
:- mode do_while(pred(out) is multi, pred(in, out, in, out) is det, in, out)
is cc_multi.
@@ -365,39 +379,6 @@
:- pred isnt(pred(T)::(pred(in) is semidet), T::in) is semidet.
%-----------------------------------------------------------------------------%
-
- % `semidet_succeed' is exactly the same as `true', except that
- % the compiler thinks that it is semi-deterministic. You can
- % use calls to `semidet_succeed' to suppress warnings about
- % determinism declarations which could be stricter.
- % Similarly, `semidet_fail' is like `fail' except that its
- % determinism is semidet rather than failure, and
- % `cc_multi_equal(X, Y)' is the same as `X=Y' except that it
- % is cc_multi rather than det.
-
-:- pred semidet_succeed is semidet.
-
-:- pred semidet_fail is semidet.
-
-:- pred cc_multi_equal(T, T).
-:- mode cc_multi_equal(di, uo) is cc_multi.
-:- mode cc_multi_equal(in, out) is cc_multi.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-:- interface.
-
-% The rest of the interface is for use by implementors only.
-
- % dynamic_cast(X, Y) succeeds with Y = X iff X has the same
- % ground type as Y (so this may succeed if Y is of type
- % list(int), say, but not if Y is of type list(T)).
- %
-:- pred dynamic_cast(T1::in, T2::out) is semidet.
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -411,6 +392,7 @@
:- import_module string.
:- use_module private_builtin. % for the `heap_pointer' type.
+:- use_module solutions.
% XXX This should not be necessary, but the current compiler is broken in that
% it puts foreign_proc clauses into deconstruct.opt without also putting the
@@ -468,823 +450,31 @@
Y = no
).
-%-----------------------------------------------------------------------------%
-%
-% This section defines builtin_aggregate/4 which takes a closure of type
-% pred(T) in which the remaining argument is output, and backtracks over
-% solutions for this, using the second argument to aggregate them however the
-% user wishes. This is basically a generalization of solutions/2.
-
-:- pred builtin_aggregate(pred(T), pred(T, U, U), U, U).
-:- mode builtin_aggregate(pred(out) is multi, pred(in, in, out) is det,
- in, out) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is det,
- di, uo) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is multi, pred(in, in, out) is cc_multi,
- in, out) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is cc_multi,
- di, uo) is det. % really cc_multi
-:- mode builtin_aggregate(pred(muo) is multi, pred(mdi, di, uo) is det,
- di, uo) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is det,
- di, uo) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is cc_multi,
- di, uo) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is nondet, pred(in, in, out) is det,
- in, out) is det. % really cc_multi
-:- mode builtin_aggregate(pred(out) is nondet, pred(in, in, out) is cc_multi,
- in, out) is det. % really cc_multi
-:- mode builtin_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
- di, uo) is det. % really cc_multi
-
-% If we're doing heap reclamation on failure, then
-% in order to implement any sort of code that requires terms to survive
-% backtracking, we need to (deeply) copy them out of the heap and into some
-% other area before backtracking. The obvious thing to do then is just call
-% the generator predicate, let it run to completion, and copy its result into
-% another memory area (call it the solutions heap) before forcing
-% backtracking. When we get the next solution, we do the same, this time
-% passing the previous collection (which is still on the solutions heap) to
-% the collector predicate. If the result of this operation contains the old
-% collection as a part, then the deep copy operation is smart enough
-% not to copy again. So this could be pretty efficient.
-%
-% But what if the collector predicate does something that copies the previous
-% collection? Then on each solution, we'll copy the previous collection to
-% the heap, and then deep copy it back to the solution heap. This means
-% copying solutions order N**2 times, where N is the number of solutions. So
-% this isn't as efficient as we hoped.
-%
-% So we use a slightly different approach. When we find a solution, we deep
-% copy it to the solution heap. Then, before calling the collector code, we
-% sneakily swap the runtime system's notion of which is the heap and which is
-% the solutions heap. This ensures that any terms are constructed on the
-% solutions heap. When this is complete, we swap them back, and force the
-% engine to backtrack to get the next solution. And so on. After we've
-% gotten the last solution, we do another deep copy to move the solution back
-% to the 'real' heap, and reset the solutions heap pointer (which of course
-% reclaims all the garbage of the collection process).
-%
-% Note that this will work with recursive calls to builtin_aggregate as
-% well. If the recursive invocation occurs in the generator pred, there can
-% be no problem because by the time the generator succeeds, the inner
-% do_ call will have completed, copied its result from the solutions heap,
-% and reset the solutions heap pointer. If the recursive invocation happens
-% in the collector pred, then it will happen when the heap and solutions heap
-% are 'swapped.' This will work out fine, because the real heap isn't needed
-% while the collector pred is executing, and by the time the nested do_ is
-% completed, the 'real' heap pointer will have been reset.
-%
-% If the collector predicate throws an exception while they are swapped,
-% then the code for builtin_throw/1 will unswap the heaps.
-% So we don't need to create our own exception handlers to here to
-% cover that case.
-%
-% If we're not doing heap reclamation on failure (as is currently the
-% case when using conservative GC), then all of the heap-swapping
-% and copying operations are no-ops, so we get a "zero-copy" solution.
-
-% Note that the code for builtin_aggregate is very similar to the code
-% for do_while (below).
-
-:- pragma promise_pure(builtin_aggregate/4).
-
-builtin_aggregate(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
- % Save some of the Mercury virtual machine registers
- impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
- impure start_all_soln_neg_context,
-
- % Initialize the accumulator
- % /* Mutvar := Accumulator0 */
- impure new_mutvar(Accumulator0, Mutvar),
-
- (
- % Get a solution.
- GeneratorPred(Answer0),
-
- % Check that the generator didn't leave any delayed goals outstanding.
- impure check_for_floundering(TrailPtr),
-
- % Update the accumulator.
- % /* MutVar := CollectorPred(MutVar) */
- impure swap_heap_and_solutions_heap,
- impure partial_deep_copy(HeapPtr, Answer0, Answer),
- impure get_mutvar(Mutvar, Acc0),
- impure non_cc_call(CollectorPred, Answer, Acc0, Acc1),
- impure set_mutvar(Mutvar, Acc1),
- impure swap_heap_and_solutions_heap,
-
- % Force backtracking, so that we get the next solution.
- % This will automatically reset the heap and trail.
- fail
- ;
- % There are no more solutions.
- impure end_all_soln_neg_context_no_more,
-
- % So now we just need to copy the final value of the accumulator
- % from the solutions heap back onto the ordinary heap, and then we can
- % reset the solutions heap pointer. We also need to discard the trail
- % ticket created by get_registers/3.
- % /* Accumulator := MutVar */
- impure get_mutvar(Mutvar, Accumulator1),
- impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
- impure reset_solutions_heap(SolutionsHeapPtr),
- impure discard_trail_ticket
- ).
-
-% The code for do_while/4 is essentially the same as the code for
-% builtin_aggregate (above). See the detailed comments above.
-%
-% XXX It would be nice to avoid the code duplication here,
-% but it is a bit tricky -- we can't just use a lambda expression,
-% because we'd need to specify the mode, but we want it to work
-% for multiple modes. An alternative would be to use a typeclass,
-% but typeclasses still don't work in `jump' or `fast' grades.
-
-:- pragma promise_pure(do_while/4).
-
-do_while(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
- impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
- impure new_mutvar(Accumulator0, Mutvar),
- impure start_all_soln_neg_context,
- (
- GeneratorPred(Answer0),
-
- impure check_for_floundering(TrailPtr),
-
- impure swap_heap_and_solutions_heap,
- impure partial_deep_copy(HeapPtr, Answer0, Answer),
- impure get_mutvar(Mutvar, Acc0),
- impure non_cc_call(CollectorPred, Answer, More, Acc0, Acc1),
- impure set_mutvar(Mutvar, Acc1),
- impure swap_heap_and_solutions_heap,
-
- % If More = yes, then backtrack for the next solution.
- % If More = no, then we're done.
- More = no,
- impure end_all_soln_neg_context_more
- ;
- impure end_all_soln_neg_context_no_more
- ),
- impure get_mutvar(Mutvar, Accumulator1),
- impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
- impure reset_solutions_heap(SolutionsHeapPtr),
- impure discard_trail_ticket.
-
- % This is the same as call/4, except that it is not cc_multi
- % even when the called predicate is cc_multi.
-:- impure pred non_cc_call(pred(T, Acc, Acc), T, Acc, Acc).
-:- mode non_cc_call(pred(in, in, out) is det, in, in, out) is det.
-:- mode non_cc_call(pred(in, in, out) is cc_multi, in, in, out) is det.
-:- mode non_cc_call(pred(in, di, uo) is det, in, di, uo) is det.
-:- mode non_cc_call(pred(in, di, uo) is cc_multi, in, di, uo) is det.
-:- mode non_cc_call(pred(mdi, di, uo) is det, mdi, di, uo) is det.
-
-non_cc_call(P::pred(in, in, out) is det, X::in, Acc0::in, Acc::out) :-
- P(X, Acc0, Acc).
-non_cc_call(P::pred(in, in, out) is cc_multi, X::in, Acc0::in, Acc::out) :-
- Pred = (pred(Soln::out) is cc_multi :- P(X, Acc0, Soln)),
- impure Acc = builtin.get_one_solution(Pred).
-non_cc_call(P::pred(in, di, uo) is cc_multi, X::in, Acc0::di, Acc::uo) :-
- impure builtin.get_one_solution_io(
- (pred({}::out, di, uo) is cc_multi --> P(X)),
- _, Acc0, Acc).
-non_cc_call(P::pred(in, di, uo) is det, X::in, Acc0::di, Acc::uo) :-
- P(X, Acc0, Acc).
-non_cc_call(P::pred(mdi, di, uo) is det, X::mdi, Acc0::di, Acc::uo) :-
- P(X, Acc0, Acc).
-
- % This is the same as call/5, except that it is not cc_multi
- % even when the called predicate is cc_multi.
-:- impure pred non_cc_call(pred(T1, T2, Acc, Acc), T1, T2, Acc, Acc).
-:- mode non_cc_call(pred(in, out, in, out) is det, in, out, in, out) is det.
-:- mode non_cc_call(pred(in, out, di, uo) is det, in, out, di, uo) is det.
-:- mode non_cc_call(pred(in, out, di, uo) is cc_multi, in, out, di, uo) is det.
-
-non_cc_call(P::pred(in, out, di, uo) is det, X::in, More::out,
- Acc0::di, Acc::uo) :-
- P(X, More, Acc0, Acc).
-non_cc_call(P::pred(in, out, in, out) is det, X::in, More::out,
- Acc0::in, Acc::out) :-
- P(X, More, Acc0, Acc).
-non_cc_call(P::pred(in, out, di, uo) is cc_multi, X::in, More::out,
- Acc0::di, Acc::uo) :-
- impure builtin.get_one_solution_io(
- (pred(M::out, di, uo) is cc_multi --> P(X, M)),
- More, Acc0, Acc).
-
-:- type heap_ptr == private_builtin.heap_pointer.
-:- type trail_ptr ---> trail_ptr(c_pointer).
-
-% Save the state of the Mercury heap and trail registers,
-% for later use in partial_deep_copy/3 and reset_solutions_heap/1.
-% Note that this allocates a trail ticket;
-% you need to dispose of it properly when you're finished with it,
-% e.g. by calling discard_trail_ticket/0.
-:- impure pred get_registers(heap_ptr::out, heap_ptr::out, trail_ptr::out)
- is det.
-
-:- pragma foreign_proc("C",
- get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
- [will_not_call_mercury, thread_safe],
-"
- /* save heap states */
-#ifdef MR_RECLAIM_HP_ON_FAILURE
- HeapPtr = (MR_Word) MR_hp;
- SolutionsHeapPtr = (MR_Word) MR_sol_hp;
-#else
- HeapPtr = SolutionsHeapPtr = 0;
-#endif
-
- /* save trail state */
-#ifdef MR_USE_TRAIL
- MR_store_ticket(TrailPtr);
-#else
- TrailPtr = 0;
-#endif
-").
-
-:- pragma foreign_proc("C#",
- get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
- [will_not_call_mercury, thread_safe],
-"
- /*
- ** For .NET we always use the MS garbage collector,
- ** so we don't have to worry here about heap reclamation on failure.
- */
- HeapPtr = null;
- SolutionsHeapPtr = null;
-
-#if MR_USE_TRAIL
- /* XXX trailing not yet implemented for the MLDS back-end */
- mercury.runtime.Errors.SORRY(""foreign code for get_registers"");
-#else
- TrailPtr = null;
-#endif
-").
-
-:- pragma foreign_proc("Java",
- get_registers(HeapPtr::out, SolutionsHeapPtr::out, TrailPtr::out),
- [will_not_call_mercury, thread_safe],
-"
- /*
- ** Java has a builtin garbage collector,
- ** so we don't have to worry here about heap reclamation on failure.
- */
- HeapPtr = null;
- SolutionsHeapPtr = null;
-
- /* XXX No trailing for the Java back-end. */
- TrailPtr = null;
-").
-
-:- impure pred check_for_floundering(trail_ptr::in) is det.
-
-:- pragma foreign_proc("C",
- check_for_floundering(TrailPtr::in),
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_USE_TRAIL
- /* check for outstanding delayed goals (``floundering'') */
- MR_reset_ticket(TrailPtr, MR_solve);
-#endif
-").
-
-:- pragma foreign_proc("C#",
- check_for_floundering(_TrailPtr::in),
- [will_not_call_mercury, thread_safe],
-"
-#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for check_for_floundering"");
-#endif
-").
-
-:- pragma foreign_proc("Java",
- check_for_floundering(_TrailPtr::in),
- [will_not_call_mercury, thread_safe],
-"
- /* XXX No trailing for the Java back-end, so take no action. */
-").
+%----------------------------------------------------------------------------%
-%
-% Discard the topmost trail ticket.
-%
-:- impure pred discard_trail_ticket is det.
-
-:- pragma foreign_proc("C",
- discard_trail_ticket,
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_USE_TRAIL
- MR_discard_ticket();
-#endif
-").
-
-:- pragma foreign_proc("C#",
- discard_trail_ticket,
- [will_not_call_mercury, thread_safe],
-"
-#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for discard_trail_ticket"");
-#endif
-").
-
-:- pragma foreign_proc("Java",
- discard_trail_ticket,
- [will_not_call_mercury, thread_safe],
-"
- /* XXX No trailing for the Java back-end, so take no action. */
-").
-
-%
-% Swap the heap with the solutions heap
-%
-:- impure pred swap_heap_and_solutions_heap is det.
-
-:- pragma foreign_proc("C",
- swap_heap_and_solutions_heap,
- [will_not_call_mercury, thread_safe],
-"{
-#ifdef MR_RECLAIM_HP_ON_FAILURE
- MR_MemoryZone *temp_zone;
- MR_Word *temp_hp;
-
- temp_zone = MR_ENGINE(MR_eng_heap_zone);
- MR_ENGINE(MR_eng_heap_zone) = MR_ENGINE(MR_eng_solutions_heap_zone);
- MR_ENGINE(MR_eng_solutions_heap_zone) = temp_zone;
- temp_hp = MR_hp;
- MR_hp_word = (MR_Word) MR_sol_hp;
- MR_sol_hp = temp_hp;
-#endif
-}").
-
-:- pragma foreign_proc("C#",
- swap_heap_and_solutions_heap,
- [will_not_call_mercury, thread_safe],
-"
- //
- // For the .NET back-end, we use the system heap, rather
- // than defining our own heaps. So we don't need to
- // worry about swapping them. Hence do nothing here.
- //
-").
-
-:- pragma foreign_proc("Java",
- swap_heap_and_solutions_heap,
- [will_not_call_mercury, thread_safe],
-"
- /*
- ** For the Java back-end, as for the .NET back-end, we don't define
- ** our own heaps. So take no action here.
- */
-").
-
-%
-% partial_deep_copy(SolutionsHeapPtr, OldVal, NewVal):
-% Make a copy of all of the parts of OldVar that occur between
-% SolutionsHeapPtr and the top of the current solutions heap.
-%
-:- impure pred partial_deep_copy(heap_ptr, T, T) is det.
-:- mode partial_deep_copy(in, di, uo) is det.
-:- mode partial_deep_copy(in, mdi, muo) is det.
-:- mode partial_deep_copy(in, in, out) is det.
-
-:- pragma foreign_decl("C", "
-
-#include ""mercury_deep_copy.h""
-
-#ifndef MR_RECLAIM_HP_ON_FAILURE
- /* for conservative GC, shallow copies suffice */
- #define MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, \\
- OldVar, NewVal, TypeInfo_for_T) \\
- do { \\
- NewVal = OldVal; \\
- } while (0)
-#else
- /*
- ** Note that we need to save/restore the MR_hp register, if it
- ** is transient, before/after calling MR_deep_copy().
- */
- #define MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, \\
- OldVar, NewVal, TypeInfo_for_T) \\
- do { \\
- MR_save_transient_hp(); \\
- NewVal = MR_deep_copy(OldVal, (MR_TypeInfo) TypeInfo_for_T, \\
- (const MR_Word *) SolutionsHeapPtr, \\
- MR_ENGINE(MR_eng_solutions_heap_zone)->MR_zone_top); \\
- MR_restore_transient_hp(); \\
- } while (0)
-#endif
-
-").
-
-:- pragma foreign_proc("C",
- partial_deep_copy(SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
-").
-:- pragma foreign_proc("C",
- partial_deep_copy(SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
-").
-:- pragma foreign_proc("C",
- partial_deep_copy(SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
-").
-
-:- pragma foreign_proc("C#",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- //
- // For the IL back-end, we don't do heap reclamation on failure,
- // so we don't need to worry about making deep copies here.
- // Shallow copies will suffice.
- //
- NewVal = OldVal;
-").
-:- pragma foreign_proc("C#",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- NewVal = OldVal;
-").
-:- pragma foreign_proc("C#",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- NewVal = OldVal;
-").
-
-:- pragma foreign_proc("Java",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- /*
- ** For the Java back-end, as for the .NET implementation,
- ** we don't do heap reclamation on failure,
- ** so we don't need to worry about making deep copies here.
- ** Shallow copies will suffice.
- */
- NewVal = OldVal;
-").
-:- pragma foreign_proc("Java",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- NewVal = OldVal;
-").
-:- pragma foreign_proc("Java",
- partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- NewVal = OldVal;
-").
-
- % reset_solutions_heap(SolutionsHeapPtr):
- %
- % Reset the solutions heap pointer to the specified value,
- % thus deallocating everything allocated on the solutions
- % heap since that value was obtained via get_registers/3.
- %
-:- impure pred reset_solutions_heap(heap_ptr::in) is det.
-
-:- pragma foreign_proc("C",
- reset_solutions_heap(SolutionsHeapPtr::in),
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_RECLAIM_HP_ON_FAILURE
- MR_sol_hp = (MR_Word *) SolutionsHeapPtr;
-#endif
-").
-
-:- pragma foreign_proc("C#",
- reset_solutions_heap(_SolutionsHeapPtr::in),
- [will_not_call_mercury, thread_safe],
-"
- // For the IL back-end, we don't have a separate `solutions heap'.
- // Hence this operation is a NOP.
-").
-
-:- pragma foreign_proc("Java",
- reset_solutions_heap(_SolutionsHeapPtr::in),
- [will_not_call_mercury, thread_safe],
-"
- /* As above, we take no action. */
-").
-
-:- impure pred start_all_soln_neg_context is det.
-:- impure pred end_all_soln_neg_context_more is det.
-:- impure pred end_all_soln_neg_context_no_more is det.
-
-:- pragma foreign_proc("C",
- start_all_soln_neg_context,
- % In minimal model tabling grades, there are no threads.
- % In all other grades, this predicate is a noop.
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
- MR_pneg_enter_cond();
-#endif
-").
-
-:- pragma foreign_proc("C",
- end_all_soln_neg_context_more,
- % In minimal model tabling grades, there are no threads.
- % In all other grades, this predicate is a noop.
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
- MR_pneg_enter_then();
-#endif
-").
-
-:- pragma foreign_proc("C",
- end_all_soln_neg_context_no_more,
- % In minimal model tabling grades, there are no threads.
- % In all other grades, this predicate is a noop.
- [will_not_call_mercury, thread_safe],
-"
-#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
- MR_pneg_enter_else(""end_all_soln_neg_context"");
-#endif
-").
-
-start_all_soln_neg_context.
-end_all_soln_neg_context_more.
-end_all_soln_neg_context_no_more.
-
-%-----------------------------------------------------------------------------%
-
-%%% :- module mutvar.
-%%% :- interface.
-
-% A non-backtrackably destructively modifiable reference type
-:- type mutvar(T).
-
-% Create a new mutvar given a term for it to reference.
-:- impure pred new_mutvar(T, mutvar(T)).
-:- mode new_mutvar(in, out) is det.
-:- mode new_mutvar(di, uo) is det.
-
-% Get the value currently referred to by a reference.
-:- impure pred get_mutvar(mutvar(T), T) is det.
-:- mode get_mutvar(in, uo) is det. % XXX this is a work-around
-/*
-XXX `ui' modes don't work yet
-:- mode get_mutvar(in, uo) is det.
-:- mode get_mutvar(ui, uo) is det. % unsafe, but we use it safely
-*/
-
-% destructively modify a reference to refer to a new object.
-:- impure pred set_mutvar(mutvar(T), T) is det.
-:- mode set_mutvar(in, in) is det.
-/*
-XXX `ui' modes don't work yet
-:- pred set_mutvar(ui, di) is det.
-*/
-
-%%% :- implementation.
-
-% This type is a builtin-in type whose operations are implemented in C.
-:- type mutvar(T)
- ---> mutvar(private_builtin.ref(T)).
-
-:- pragma inline(new_mutvar/2).
-:- pragma inline(get_mutvar/2).
-:- pragma inline(set_mutvar/2).
-
-:- pragma foreign_proc("C",
- new_mutvar(X::in, Ref::out),
- [will_not_call_mercury, thread_safe],
-"
- MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
- MR_PROC_LABEL, ""std_util.mutvar/1"");
- MR_define_size_slot(0, Ref, 1);
- * (MR_Word *) Ref = X;
-").
-:- pragma foreign_proc("C",
- new_mutvar(X::di, Ref::uo),
- [will_not_call_mercury, thread_safe],
-"
- MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
- MR_PROC_LABEL, ""std_util.mutvar/1"");
- MR_define_size_slot(0, Ref, 1);
- * (MR_Word *) Ref = X;
-").
-
-:- pragma foreign_proc("C",
- get_mutvar(Ref::in, X::uo),
- [will_not_call_mercury, thread_safe],
-"
- X = * (MR_Word *) Ref;
-").
-
-:- pragma foreign_proc("C",
- set_mutvar(Ref::in, X::in),
- [will_not_call_mercury, thread_safe],
-"
- *(MR_Word *) Ref = X;
-").
-
-:- pragma foreign_proc("C#",
- new_mutvar(X::in, Ref::out),
- [will_not_call_mercury, thread_safe],
-"
- Ref = new object[1];
- Ref[0] = X;
-").
-:- pragma foreign_proc("C#",
- new_mutvar(X::di, Ref::uo),
- [will_not_call_mercury, thread_safe],
-"
- Ref = new object[1];
- Ref[0] = X;
-").
-
-:- pragma foreign_proc("C#",
- get_mutvar(Ref::in, X::uo),
- [will_not_call_mercury, thread_safe],
-"
- X = Ref[0];
-").
-
-:- pragma foreign_proc("C#",
- set_mutvar(Ref::in, X::in),
- [will_not_call_mercury, thread_safe],
-"
- Ref[0] = X;
-").
-
-:- pragma foreign_code("Java",
-"
- public static class Mutvar {
- public Object object;
-
- public Mutvar(Object init) {
- object = init;
- }
- }
-").
-:- pragma foreign_type(java, mutvar(T), "mercury.std_util.Mutvar").
-
-:- pragma foreign_proc("Java",
- new_mutvar(X::in, Ref::out),
- [will_not_call_mercury, thread_safe],
-"
- Ref = new mercury.std_util.Mutvar(X);
-").
-:- pragma foreign_proc("Java",
- new_mutvar(X::di, Ref::uo),
- [will_not_call_mercury, thread_safe],
-"
- Ref = new mercury.std_util.Mutvar(X);
-").
-
-:- pragma foreign_proc("Java",
- get_mutvar(Ref::in, X::uo),
- [will_not_call_mercury, thread_safe],
-"
- X = Ref.object;
-").
-
-:- pragma foreign_proc("Java",
- set_mutvar(Ref::in, X::in),
- [will_not_call_mercury, thread_safe],
-"
- Ref.object = X;
-").
-
-%%% end_module mutvar.
-
-%-----------------------------------------------------------------------------%
+% NOTE: the implementations for these predicates is in solutions.m.
solutions(Pred, List) :-
- builtin_solutions(Pred, UnsortedList),
- list.sort_and_remove_dups(UnsortedList, List).
+ solutions.solutions(Pred, List).
solutions_set(Pred, Set) :-
- builtin_solutions(Pred, List),
- set.list_to_set(List, Set).
+ solutions.solutions_set(Pred, Set).
unsorted_solutions(Pred, List) :-
- builtin_solutions(Pred, UnsortedList),
- cc_multi_equal(UnsortedList, List).
-
-:- pred builtin_solutions(pred(T), list(T)).
-:- mode builtin_solutions(pred(out) is multi, out)
- is det. /* really cc_multi */
-:- mode builtin_solutions(pred(out) is nondet, out)
- is det. /* really cc_multi */
-
-builtin_solutions(Generator, UnsortedList) :-
- builtin_aggregate(Generator, list.cons, [], UnsortedList).
-
-%-----------------------------------------------------------------------------%
+ solutions.unsorted_solutions(Pred, List).
aggregate(Generator, Accumulator, !Acc) :-
- solutions(Generator, Solutions),
- list.foldl(Accumulator, Solutions, !Acc).
+ solutions.aggregate(Generator, Accumulator, !Acc).
aggregate2(Generator, Accumulator, !Acc1, !Acc2) :-
- solutions(Generator, Solutions),
- list.foldl2(Accumulator, Solutions, !Acc1, !Acc2).
+ solutions.aggregate2(Generator, Accumulator, !Acc1, !Acc2).
unsorted_aggregate(Generator, Accumulator, !Acc) :-
- builtin_aggregate(Generator, Accumulator, !Acc),
- cc_multi_equal(!Acc).
-
-%-----------------------------------------------------------------------------%
-
-% semidet_succeed and semidet_fail, implemented using the C interface
-% to make sure that the compiler doesn't issue any determinism warnings
-% for them.
-
-:- pragma foreign_proc("C",
- semidet_succeed,
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- SUCCESS_INDICATOR = MR_TRUE;
-").
-:- pragma foreign_proc("C",
- semidet_fail,
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- SUCCESS_INDICATOR = MR_FALSE;
-").
-:- pragma foreign_proc("C",
- cc_multi_equal(X::in, Y::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
-:- pragma foreign_proc("C",
- cc_multi_equal(X::di, Y::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
-
-:- pragma foreign_proc("C#",
- semidet_succeed,
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- SUCCESS_INDICATOR = true;
-").
-:- pragma foreign_proc("C#",
- semidet_fail,
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- SUCCESS_INDICATOR = false;
-").
-:- pragma foreign_proc("C#",
- cc_multi_equal(X::in, Y::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
-:- pragma foreign_proc("C#",
- cc_multi_equal(X::di, Y::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
-
-:- pragma foreign_proc("Java",
- cc_multi_equal(X::in, Y::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
-:- pragma foreign_proc("Java",
- cc_multi_equal(X::di, Y::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
-"
- Y = X;
-").
+ solutions.unsorted_aggregate(Generator, Accumulator, !Acc).
-% We can't just use "true" and "fail" here, because that provokes warnings
-% from determinism analysis, and the library is compiled with --halt-at-warn.
-% So instead we use 0+0 = (or \=) 0.
-% This is guaranteed to succeed or fail (respectively),
-% and with a bit of luck will even get optimized by constant propagation.
-% But this optimization won't happen until after determinism analysis,
-% which doesn't know anything about integer arithmetic,
-% so this code won't provide a warning from determinism analysis.
-
-semidet_succeed :-
- 0 + 0 = 0.
-semidet_fail :-
- 0 + 0 \= 0.
-
-:- pragma promise_pure(cc_multi_equal/2).
-
-cc_multi_equal(X, X).
+do_while(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
+ solutions.do_while(GeneratorPred, CollectorPred,
+ Accumulator0, Accumulator).
%-----------------------------------------------------------------------------%
@@ -1339,9 +529,6 @@
unravel_univ(Univ, X) :-
univ_value(Univ) = X.
-dynamic_cast(X, Y) :-
- private_builtin.typed_unify(X, Y).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cam.sri.com> 24/04/99
@@ -1367,13 +554,11 @@
id(X) = X.
-solutions(P) = S :- solutions(P, S).
+solutions(P) = solutions.solutions(P).
-solutions_set(P) = S :- solutions_set(P, S).
+solutions_set(P) = solutions.solutions_set(P).
-aggregate(P, F, Acc0) = Acc :-
- aggregate(P, (pred(X::in, A0::in, A::out) is det :- A = F(X, A0)),
- Acc0, Acc).
+aggregate(P, F, Acc0) = solutions.aggregate(P, F, Acc0).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Index: tests/debugger/all_solutions.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/all_solutions.m,v
retrieving revision 1.1
diff -u -r1.1 all_solutions.m
--- tests/debugger/all_solutions.m 18 Dec 2000 05:16:53 -0000 1.1
+++ tests/debugger/all_solutions.m 23 Mar 2006 03:05:34 -0000
@@ -11,13 +11,13 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module std_util.
+:- import_module solutions.
main -->
{ solutions(hello, List) },
io__write_strings(List).
-:- pred hello(string::out) is multidet.
+:- pred hello(string::out) is multi.
hello("Hello, world\n").
hello("Hello again, world\n").
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.91
diff -u -r1.91 Mmakefile
--- tests/debugger/declarative/Mmakefile 21 Mar 2006 02:13:26 -0000 1.91
+++ tests/debugger/declarative/Mmakefile 23 Mar 2006 02:53:44 -0000
@@ -64,9 +64,9 @@
revise \
revise_2 \
small \
- solutions \
special_term_dep \
skip \
+ solns \
tabled_read_decl \
tabled_read_decl_goto \
throw \
@@ -490,10 +490,10 @@
# We need to pipe the output through sed to avoid hard-coding dependencies on
# particular line numbers in the standard library source code.
-solutions.out: solutions solutions.$(DECLDEBUG_INP)
- $(MDB) ./solutions < solutions.$(DECLDEBUG_INP) 2>&1 | \
- sed -e 's/std_util.m:[0-9]*/std_util.m:NNNN/g' \
- > solutions.out 2>&1 \
+solns.out: solns solns.$(DECLDEBUG_INP)
+ $(MDB) ./solns < solns.$(DECLDEBUG_INP) 2>&1 | \
+ sed -e 's/solutions.m:[0-9]*/solutions.m:NNNN/g' \
+ > solns.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
sort.out: sort sort.inp
Index: tests/debugger/declarative/args.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/args.m,v
retrieving revision 1.2
diff -u -r1.2 args.m
--- tests/debugger/declarative/args.m 30 Jan 2003 05:59:27 -0000 1.2
+++ tests/debugger/declarative/args.m 22 Mar 2006 22:54:12 -0000
@@ -22,7 +22,7 @@
:- mode p(in, out, in, out, in) is nondet.
p(A, A + (B * C), B, (A + B) * C, C) :-
- semidet_succeed.
+ library_forwarding.semidet_succeed.
p(A, A - B, B, C - B, C) :-
- semidet_succeed.
+ library_forwarding.semidet_succeed.
Index: tests/debugger/declarative/library_forwarding.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/library_forwarding.m,v
retrieving revision 1.2
diff -u -r1.2 library_forwarding.m
--- tests/debugger/declarative/library_forwarding.m 24 Aug 2005 09:07:13 -0000 1.2
+++ tests/debugger/declarative/library_forwarding.m 22 Mar 2006 22:53:51 -0000
@@ -24,7 +24,7 @@
:- implementation.
-:- import_module int, std_util.
+:- import_module int.
X + Y = 'int__+'(X, Y).
X * Y = 'int__*'(X, Y).
@@ -38,8 +38,8 @@
X > Y :- 'int__>'(X, Y).
semidet_succeed :-
- std_util__semidet_succeed.
+ builtin.semidet_succeed.
semidet_fail :-
- std_util__semidet_fail.
+ builtin.semidet_fail.
Index: tests/debugger/declarative/solns.exp
===================================================================
RCS file: tests/debugger/declarative/solns.exp
diff -N tests/debugger/declarative/solns.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.exp 23 Mar 2006 02:55:32 -0000
@@ -0,0 +1,30 @@
+ 1: 1 1 CALL pred solns.main/2-0 (det) solns.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p
+ 0: + stop interface pred solns.p/2-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred solns.p/2-0 (det) solns.m:15 (solns.m:9)
+mdb> finish
+ 15: 2 2 EXIT pred solns.p/2-0 (det) solns.m:15 (solns.m:9)
+mdb> dd -d 3 -n 7
+p(1, [1, 2, 3])
+Valid? no
+q(1, 1)
+Valid? yes
+q(1, 2)
+Valid? yes
+q(1, 3)
+Valid? yes
+Call q(1, _)
+Solutions:
+ q(1, 1)
+ q(1, 2)
+ q(1, 3)
+Complete? yes
+Found incorrect contour:
+p(1, [1, 2, 3])
+Is this a bug? yes
+ 15: 2 2 EXIT pred solns.p/2-0 (det) solns.m:15 (solns.m:9)
+mdb> quit -y
Index: tests/debugger/declarative/solns.exp2
===================================================================
RCS file: tests/debugger/declarative/solns.exp2
diff -N tests/debugger/declarative/solns.exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.exp2 23 Mar 2006 02:57:41 -0000
@@ -0,0 +1,33 @@
+ 1: 1 1 CALL pred solns.main/2-0 (det) solns.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> untrust 0
+mdb> break p
+ 0: + stop interface pred solns.p/2-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred solns.p/2-0 (det) solns.m:15 (solns.m:9)
+mdb> finish
+ 17: 2 2 EXIT pred solns.p/2-0 (det) solns.m:15 (solns.m:9)
+mdb> dd -d 3 -n 7
+p(1, [1, 2, 3])
+Valid? no
+solutions(q(1), [1, 2, 3])
+Valid? no
+q(1, 1)
+Valid? yes
+q(1, 2)
+Valid? yes
+q(1, 3)
+Valid? yes
+Call q(1, _)
+Solutions:
+ q(1, 1)
+ q(1, 2)
+ q(1, 3)
+Complete? yes
+Found incorrect contour:
+solutions(q(1), [1, 2, 3])
+Is this a bug? yes
+ 16: 3 3 EXIT pred solutions.solutions/2-1 (det) solutions.m:NNNN (solns.m:16)
+mdb> quit -y
Index: tests/debugger/declarative/solns.exp3
===================================================================
RCS file: tests/debugger/declarative/solns.exp3
diff -N tests/debugger/declarative/solns.exp3
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.exp3 23 Mar 2006 02:58:20 -0000
@@ -0,0 +1,39 @@
+ 1: 1 1 CALL pred solns.main/2-0 (det) solns.m:8
+mdb> mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+mdb> trust int
+Trusting module int
+mdb> trust list
+Trusting module list
+mdb> trust std_util
+Trusting module std_util
+mdb> break p
+ 0: + stop interface pred solns.p/2-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred solns.p/2-0 (det)
+mdb> finish
+ 233: 2 2 EXIT pred solns.p/2-0 (det)
+mdb> dd -d 3 -n 7
+p(1, [1, 2, 3])
+Valid? no
+q(1, 1)
+Valid? yes
+q(1, 2)
+Valid? yesy
+Unknown command, 'h' for help.
+dd> yes
+q(1, 3)
+Valid? yes
+Call q(1, _)
+Solutions:
+ q(1, 1)
+ q(1, 2)
+ q(1, 3)
+Complete? yes
+Found incorrect contour:
+solutions(q(1), [1, 2, 3])
+p(1, [1, 2, 3])
+Is this a bug? yes
+ 233: 2 2 EXIT pred solns.p/2-0 (det)
+mdb> quit -y
Index: tests/debugger/declarative/solns.inp
===================================================================
RCS file: tests/debugger/declarative/solns.inp
diff -N tests/debugger/declarative/solns.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.inp 20 May 2005 05:40:30 -0000
@@ -0,0 +1,13 @@
+echo on
+register --quiet
+break p
+continue
+finish
+dd -d 3 -n 7
+no
+yes
+yes
+yes
+yes
+yes
+quit -y
Index: tests/debugger/declarative/solns.inp2
===================================================================
RCS file: tests/debugger/declarative/solns.inp2
diff -N tests/debugger/declarative/solns.inp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.inp2 20 May 2005 05:40:30 -0000
@@ -0,0 +1,15 @@
+echo on
+register --quiet
+untrust 0
+break p
+continue
+finish
+dd -d 3 -n 7
+no
+no
+yes
+yes
+yes
+yes
+yes
+quit -y
Index: tests/debugger/declarative/solns.inp3
===================================================================
RCS file: tests/debugger/declarative/solns.inp3
diff -N tests/debugger/declarative/solns.inp3
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.inp3 20 May 2005 05:40:30 -0000
@@ -0,0 +1,18 @@
+register --quiet
+context none
+echo on
+trust int
+trust list
+trust std_util
+break p
+continue
+finish
+dd -d 3 -n 7
+no
+yes
+yesy
+yes
+yes
+yes
+yes
+quit -y
Index: tests/debugger/declarative/solns.m
===================================================================
RCS file: tests/debugger/declarative/solns.m
diff -N tests/debugger/declarative/solns.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/solns.m 23 Mar 2006 02:19:20 -0000
@@ -0,0 +1,26 @@
+:- module solns.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module solutions, list.
+
+main -->
+ { p(1, Ss) },
+ io__write(Ss),
+ io__nl.
+
+:- pred p(int::in, list(int)::out) is det.
+
+p(N, Ss) :-
+ solutions(q(N), Ss).
+
+:- pred q(int::in, int::out) is nondet.
+
+q(0, 0).
+q(1, 1).
+q(1, 2).
+q(1, 3).
+q(2, 2).
+q(2, 4).
+
Index: tests/debugger/declarative/solutions.exp
===================================================================
RCS file: tests/debugger/declarative/solutions.exp
diff -N tests/debugger/declarative/solutions.exp
--- tests/debugger/declarative/solutions.exp 20 May 2005 05:40:29 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,30 +0,0 @@
- 1: 1 1 CALL pred solutions.main/2-0 (det) solutions.m:8
-mdb> echo on
-Command echo enabled.
-mdb> register --quiet
-mdb> break p
- 0: + stop interface pred solutions.p/2-0 (det)
-mdb> continue
- 2: 2 2 CALL pred solutions.p/2-0 (det) solutions.m:15 (solutions.m:9)
-mdb> finish
- 15: 2 2 EXIT pred solutions.p/2-0 (det) solutions.m:15 (solutions.m:9)
-mdb> dd -d 3 -n 7
-p(1, [1, 2, 3])
-Valid? no
-q(1, 1)
-Valid? yes
-q(1, 2)
-Valid? yes
-q(1, 3)
-Valid? yes
-Call q(1, _)
-Solutions:
- q(1, 1)
- q(1, 2)
- q(1, 3)
-Complete? yes
-Found incorrect contour:
-p(1, [1, 2, 3])
-Is this a bug? yes
- 15: 2 2 EXIT pred solutions.p/2-0 (det) solutions.m:15 (solutions.m:9)
-mdb> quit -y
Index: tests/debugger/declarative/solutions.exp2
===================================================================
RCS file: tests/debugger/declarative/solutions.exp2
diff -N tests/debugger/declarative/solutions.exp2
--- tests/debugger/declarative/solutions.exp2 20 May 2005 05:40:29 -0000 1.7
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,33 +0,0 @@
- 1: 1 1 CALL pred solutions.main/2-0 (det) solutions.m:8
-mdb> echo on
-Command echo enabled.
-mdb> register --quiet
-mdb> untrust 0
-mdb> break p
- 0: + stop interface pred solutions.p/2-0 (det)
-mdb> continue
- 2: 2 2 CALL pred solutions.p/2-0 (det) solutions.m:15 (solutions.m:9)
-mdb> finish
- 17: 2 2 EXIT pred solutions.p/2-0 (det) solutions.m:15 (solutions.m:9)
-mdb> dd -d 3 -n 7
-p(1, [1, 2, 3])
-Valid? no
-solutions(q(1), [1, 2, 3])
-Valid? no
-q(1, 1)
-Valid? yes
-q(1, 2)
-Valid? yes
-q(1, 3)
-Valid? yes
-Call q(1, _)
-Solutions:
- q(1, 1)
- q(1, 2)
- q(1, 3)
-Complete? yes
-Found incorrect contour:
-solutions(q(1), [1, 2, 3])
-Is this a bug? yes
- 16: 3 3 EXIT pred std_util.solutions/2-1 (det) std_util.m:NNNN (solutions.m:16)
-mdb> quit -y
Index: tests/debugger/declarative/solutions.exp3
===================================================================
RCS file: tests/debugger/declarative/solutions.exp3
diff -N tests/debugger/declarative/solutions.exp3
--- tests/debugger/declarative/solutions.exp3 20 May 2005 05:40:29 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,39 +0,0 @@
- 1: 1 1 CALL pred solutions.main/2-0 (det) solutions.m:8
-mdb> mdb> Contexts will not be printed.
-mdb> echo on
-Command echo enabled.
-mdb> trust int
-Trusting module int
-mdb> trust list
-Trusting module list
-mdb> trust std_util
-Trusting module std_util
-mdb> break p
- 0: + stop interface pred solutions.p/2-0 (det)
-mdb> continue
- 2: 2 2 CALL pred solutions.p/2-0 (det)
-mdb> finish
- 233: 2 2 EXIT pred solutions.p/2-0 (det)
-mdb> dd -d 3 -n 7
-p(1, [1, 2, 3])
-Valid? no
-q(1, 1)
-Valid? yes
-q(1, 2)
-Valid? yesy
-Unknown command, 'h' for help.
-dd> yes
-q(1, 3)
-Valid? yes
-Call q(1, _)
-Solutions:
- q(1, 1)
- q(1, 2)
- q(1, 3)
-Complete? yes
-Found incorrect contour:
-solutions(q(1), [1, 2, 3])
-p(1, [1, 2, 3])
-Is this a bug? yes
- 233: 2 2 EXIT pred solutions.p/2-0 (det)
-mdb> quit -y
Index: tests/debugger/declarative/solutions.inp
===================================================================
RCS file: tests/debugger/declarative/solutions.inp
diff -N tests/debugger/declarative/solutions.inp
--- tests/debugger/declarative/solutions.inp 20 May 2005 05:40:30 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,13 +0,0 @@
-echo on
-register --quiet
-break p
-continue
-finish
-dd -d 3 -n 7
-no
-yes
-yes
-yes
-yes
-yes
-quit -y
Index: tests/debugger/declarative/solutions.inp2
===================================================================
RCS file: tests/debugger/declarative/solutions.inp2
diff -N tests/debugger/declarative/solutions.inp2
--- tests/debugger/declarative/solutions.inp2 20 May 2005 05:40:30 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,15 +0,0 @@
-echo on
-register --quiet
-untrust 0
-break p
-continue
-finish
-dd -d 3 -n 7
-no
-no
-yes
-yes
-yes
-yes
-yes
-quit -y
Index: tests/debugger/declarative/solutions.inp3
===================================================================
RCS file: tests/debugger/declarative/solutions.inp3
diff -N tests/debugger/declarative/solutions.inp3
--- tests/debugger/declarative/solutions.inp3 20 May 2005 05:40:30 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,18 +0,0 @@
-register --quiet
-context none
-echo on
-trust int
-trust list
-trust std_util
-break p
-continue
-finish
-dd -d 3 -n 7
-no
-yes
-yesy
-yes
-yes
-yes
-yes
-quit -y
Index: tests/debugger/declarative/solutions.m
===================================================================
RCS file: tests/debugger/declarative/solutions.m
diff -N tests/debugger/declarative/solutions.m
--- tests/debugger/declarative/solutions.m 21 Jan 2000 02:44:35 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,26 +0,0 @@
-:- module solutions.
-:- interface.
-:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
-:- implementation.
-:- import_module std_util, list.
-
-main -->
- { p(1, Ss) },
- io__write(Ss),
- io__nl.
-
-:- pred p(int::in, list(int)::out) is det.
-
-p(N, Ss) :-
- solutions(q(N), Ss).
-
-:- pred q(int::in, int::out) is nondet.
-
-q(0, 0).
-q(1, 1).
-q(1, 2).
-q(1, 3).
-q(2, 2).
-q(2, 4).
-
Index: tests/hard_coded/constant_prop_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/constant_prop_2.m,v
retrieving revision 1.2
diff -u -r1.2 constant_prop_2.m
--- tests/hard_coded/constant_prop_2.m 19 Feb 2004 07:17:31 -0000 1.2
+++ tests/hard_coded/constant_prop_2.m 22 Mar 2006 13:57:51 -0000
@@ -43,12 +43,12 @@
;
io.write_string("no"), io.nl
),
- ( { std_util.dynamic_cast(45, X2) } ->
+ ( { dynamic_cast(45, X2) } ->
io.write_int(X2), io.nl
;
link_error
),
- ( { std_util.dynamic_cast(46, _ `with_type` string) } ->
+ ( { dynamic_cast(46, _ `with_type` string) } ->
link_error
;
io.write_string("no"), io.nl
Index: tests/invalid/multisoln_func.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/multisoln_func.m,v
retrieving revision 1.1
diff -u -r1.1 multisoln_func.m
--- tests/invalid/multisoln_func.m 3 Jul 1997 14:40:14 -0000 1.1
+++ tests/invalid/multisoln_func.m 22 Mar 2006 12:10:43 -0000
@@ -5,7 +5,7 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module int, list, std_util.
+:- import_module int, list, solutions.
main --> [].
Index: tests/invalid/one_member.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/one_member.m,v
retrieving revision 1.1
diff -u -r1.1 one_member.m
--- tests/invalid/one_member.m 21 Mar 2006 22:25:39 -0000 1.1
+++ tests/invalid/one_member.m 22 Mar 2006 10:34:45 -0000
@@ -11,7 +11,7 @@
:- implementation.
:- import_module list.
-:- import_module std_util.
+:- import_module solutions.
:- type set_ctree234(T)
---> ct(int, set_tree234(T))
Index: tests/invalid/promise_equivalent_clauses.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/promise_equivalent_clauses.m,v
retrieving revision 1.1
diff -u -r1.1 promise_equivalent_clauses.m
--- tests/invalid/promise_equivalent_clauses.m 8 Mar 2006 02:25:43 -0000 1.1
+++ tests/invalid/promise_equivalent_clauses.m 22 Mar 2006 10:34:23 -0000
@@ -9,7 +9,7 @@
:- implementation.
:- import_module list.
-:- import_module std_util.
+:- import_module solutions.
main(!IO) :-
SortedList = [1, 2, 3],
Index: tests/valid/simplify_bug2.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/simplify_bug2.m,v
retrieving revision 1.1
diff -u -r1.1 simplify_bug2.m
--- tests/valid/simplify_bug2.m 14 May 2002 14:34:44 -0000 1.1
+++ tests/valid/simplify_bug2.m 22 Mar 2006 10:33:46 -0000
@@ -11,7 +11,6 @@
:- implementation.
:- import_module require.
-:- use_module std_util.
get_type_and_extra_args(TypeInfoParams, PseudoTypeInfo, ArgTypeInfo) :-
(
@@ -37,5 +36,5 @@
:- pragma no_inline(typeinfo_is_variable/2).
typeinfo_is_variable(_, 42) :-
- std_util__semidet_succeed.
+ semidet_succeed.
Index: tests/valid/solv.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/solv.m,v
retrieving revision 1.3
diff -u -r1.3 solv.m
--- tests/valid/solv.m 8 Nov 2005 06:42:03 -0000 1.3
+++ tests/valid/solv.m 22 Mar 2006 10:33:11 -0000
@@ -49,7 +49,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util.
+:- import_module solutions.
:- solver type fd_var
where representation is c_pointer,
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list