[m-rev.] diff: fix bug #248
Julien Fischer
juliensf at csse.unimelb.edu.au
Wed Jan 18 02:40:36 AEDT 2012
Parts of this change, the bug fix for set_unordlist.singelton_set/2
and the addition of singleton_set/2, will need to go on to the 11.07
branch. The rest won't.
-----------------------------
Branches: main, 11.07 (partial)
Fix bug #248: make the argument order of the singleton_set/2 predicates in the
various set modules in the standard library consistent. (This breaks backwards
compatibility but in a fairly minor way.)
Add the predicate is_singleton/2 to those set modules that do not already
provide it.
Fix a bug in the implementation of set_unordlist.singleton_set/2.
library/set.m:
library/set_bbbtree.m:
library/set_ctree234.m:
library/set_ordlist.m:
library/set_unordlist.m:
Swap the argument order of singleton_set/2.
Add is_singleton/2 where it wasn't already present.
library/set_unordlist.m:
Fix a bug: singleton_set/2 failed to take account of
the fact that the representation could contain duplicates
in the singleton_setT::out, set_unordlist(T)::in) mode.
The fix is to sort and remove the duplicates before checking
whether the set is singleton.
NEWS:
Announce the above changes.
library/eqvclass.m:
library/tree234.m:
compiler/accumulator.m:
compiler/code_info.m:
compiler/graph_colour.m:
compiler/higher_order.m:
compiler/lp_rational.m:
compiler/ml_tag_switch.m:
compiler/pd_info.m:
compiler/pd_util.m:
compiler/proc_gen.m:
compiler/prog_mode.m:
compiler/term_pass1.m:
compiler/type_constraints.m:
compiler/unneeded_code.m:
compiler/var_locn.m:
deep_profiler/autopar_costs.m:
deep_profiler/var_use_analysis.m:
tests/general/set_test.m:
Conform to the above changes.
tests/hard_coded/Mmakefile:
tests/hard_coded/singleton_dups.{m,exp}:
Add a regression test for the problem with set_unordlist.singleton_set/2.
Julien.
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.599
diff -u -r1.599 NEWS
--- NEWS 15 Jan 2012 14:49:35 -0000 1.599
+++ NEWS 17 Jan 2012 15:21:08 -0000
@@ -1,16 +1,24 @@
NEWS since Mercury 11.07
------------------------
-* There is no news yet.
+Changes to the Mercury standard library:
+
+* We have swapped the argument order of the predicates set.singleton_set/2,
+ set_bbbtree.singleton_set/2, set_ordlist.singleton_set/2 and
+ set_unordlist.singleton_set/2 so that it conforms with the order in the
+ other set modules.
NEWS for Mercury 11.07.1-beta
-----------------------------
-Changes to the Mercury standrad library:
+Changes to the Mercury standard library:
* We have added the predicate map.keys_and_values/3.
+* We have added the predicates set.is_singleton/2, set_bbbtree.is_singleton/2,
+ set_ctree234.is_singleton/2 and set_unordlist.is_singleton/2.
+
NEWS for Mercury 11.07
----------------------
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.86
diff -u -r1.86 accumulator.m
--- compiler/accumulator.m 16 Aug 2011 03:26:29 -0000 1.86
+++ compiler/accumulator.m 17 Jan 2012 13:53:56 -0000
@@ -896,7 +896,7 @@
goal_store_all_ancestors(GoalStore, GoalId, VarTypes, ModuleInfo,
FullyStrict, Ancestors),
- set.singleton_set(Assoc `intersect` Ancestors, AssocId),
+ set.is_singleton(Assoc `intersect` Ancestors, AssocId),
goal_store_lookup(GoalStore, AssocId,
stored_goal(AssocGoal, _AssocInstMap)),
AssocGoal = hlds_goal(plain_call(PredId, _, _, _, _, _), _),
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.396
diff -u -r1.396 code_info.m
--- compiler/code_info.m 17 Oct 2011 04:31:28 -0000 1.396
+++ compiler/code_info.m 17 Jan 2012 13:47:24 -0000
@@ -2168,7 +2168,7 @@
make_fake_resume_map([], !ResumeMap).
make_fake_resume_map([Var | Vars], !ResumeMap) :-
% A visibly fake location.
- set.singleton_set(Locns, reg(reg_r, -1)),
+ Locns = set.make_singleton_set(reg(reg_r, -1)),
map.det_insert(Var, Locns, !ResumeMap),
make_fake_resume_map(Vars, !ResumeMap).
@@ -2921,7 +2921,7 @@
produce_vars([Var | Vars], Map, Code, !CI) :-
produce_vars(Vars, Map0, CodeVars, !CI),
produce_variable_in_reg_or_stack(Var, CodeVar, Lval, !CI),
- set.singleton_set(Lvals, Lval),
+ Lvals = set.make_singleton_set(Lval),
map.set(Var, Lvals, Map0, Map),
Code = CodeVars ++ CodeVar.
@@ -3090,7 +3090,7 @@
make_singleton_sets([], []).
make_singleton_sets([Var - Lval | Tail], [Var - Lvals | SetTail]) :-
- set.singleton_set(Lvals, Lval),
+ Lvals = set.make_singleton_set(Lval),
make_singleton_sets(Tail, SetTail).
%---------------------------------------------------------------------------%
Index: compiler/graph_colour.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/graph_colour.m,v
retrieving revision 1.23
diff -u -r1.23 graph_colour.m
--- compiler/graph_colour.m 21 Jul 2011 06:58:25 -0000 1.23
+++ compiler/graph_colour.m 17 Jan 2012 13:42:44 -0000
@@ -106,7 +106,7 @@
( set.empty(RestVars) ->
% There were no variables left that could share a colour,
% so create a singleton set containing this variable.
- set.singleton_set(SameColour, Var),
+ SameColour = set.make_singleton_set(Var),
ResidueSets = NotContaining
;
% If there is at least one variable that can share a colour
@@ -124,7 +124,7 @@
% by assigning any variable a colour the same as the current
% variable, so create a signleton set with the current var,
% and assign the residue to the empty set.
- set.singleton_set(SameColour, Var),
+ SameColour = set.make_singleton_set(Var),
ResidueSets = []
),
% The remaining constraints are the residue sets that could not be
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.199
diff -u -r1.199 higher_order.m
--- compiler/higher_order.m 14 Dec 2011 06:40:53 -0000 1.199
+++ compiler/higher_order.m 17 Jan 2012 13:55:30 -0000
@@ -2729,7 +2729,7 @@
set.insert(NewPred, SpecVersions0, SpecVersions),
map.det_update(CalledPredProcId, SpecVersions, NewPreds0, NewPreds)
;
- set.singleton_set(SpecVersions, NewPred),
+ SpecVersions = set.make_singleton_set(NewPred),
map.det_insert(CalledPredProcId, SpecVersions, NewPreds0, NewPreds)
),
!Info ^ hogi_new_preds := NewPreds.
Index: compiler/lp_rational.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lp_rational.m,v
retrieving revision 1.19
diff -u -r1.19 lp_rational.m
--- compiler/lp_rational.m 23 May 2011 05:08:05 -0000 1.19
+++ compiler/lp_rational.m 17 Jan 2012 13:44:52 -0000
@@ -1509,7 +1509,7 @@
:- pred make_label(set(int)::out, int::in, int::out) is det.
make_label(Label, Labels, Labels + 1) :-
- set.singleton_set(Label, Labels).
+ Label = set.make_singleton_set(Labels).
:- func matrix_to_constraints(matrix) = constraints.
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.37
diff -u -r1.37 ml_tag_switch.m
--- compiler/ml_tag_switch.m 16 Jun 2011 06:42:14 -0000 1.37
+++ compiler/ml_tag_switch.m 17 Jan 2012 13:51:33 -0000
@@ -133,7 +133,7 @@
is det.
find_any_split_cases_2(_CaseNum, Ptags, !IsAnyCaseSplit) :-
- ( set.singleton_set(Ptags, _OnlyPtag) ->
+ ( set.is_singleton(Ptags, _OnlyPtag) ->
true
;
!:IsAnyCaseSplit = some_case_is_split_between_ptags
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.46
diff -u -r1.46 pd_info.m
--- compiler/pd_info.m 16 Aug 2011 03:26:32 -0000 1.46
+++ compiler/pd_info.m 17 Jan 2012 13:56:24 -0000
@@ -149,7 +149,7 @@
proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap),
CostDelta = 0,
pd_term.local_term_info_init(LocalTermInfo),
- set.singleton_set(Parents, PredProcId),
+ Parents = set.make_singleton_set(PredProcId),
UnfoldInfo = unfold_info(ProcInfo, InstMap, CostDelta, LocalTermInfo,
PredInfo, Parents, PredProcId, no, 0, no),
pd_info_set_unfold_info(UnfoldInfo, !PDInfo).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.85
diff -u -r1.85 pd_util.m
--- compiler/pd_util.m 16 Aug 2011 03:26:32 -0000 1.85
+++ compiler/pd_util.m 17 Jan 2012 13:58:58 -0000
@@ -631,7 +631,7 @@
( map.search(Vars0, ChangedVar, Set0) ->
set.insert(BranchNo, Set0, Set)
;
- set.singleton_set(Set, BranchNo)
+ Set = set.make_singleton_set(BranchNo)
),
map.set(ChangedVar, Set, Vars0, Vars)
;
@@ -648,7 +648,7 @@
( map.search(!.ExtraVars, SwitchVar, SwitchVarSet0) ->
set.insert(BranchNo, SwitchVarSet0, SwitchVarSet)
;
- set.singleton_set(SwitchVarSet, BranchNo)
+ SwitchVarSet = set.make_singleton_set(BranchNo)
),
map.set(SwitchVar, SwitchVarSet, !ExtraVars)
;
@@ -783,7 +783,7 @@
set.insert(BranchNo, Branches0, Branches),
map.det_update(ExtraVar, Branches, !Vars)
;
- set.singleton_set(Branches, BranchNo),
+ Branches = set.make_singleton_set(BranchNo),
map.det_insert(ExtraVar, Branches, !Vars)
),
combine_vars(BranchNo, ExtraVars, !Vars).
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.52
diff -u -r1.52 proc_gen.m
--- compiler/proc_gen.m 17 Oct 2011 04:31:30 -0000 1.52
+++ compiler/proc_gen.m 17 Jan 2012 13:49:14 -0000
@@ -698,7 +698,7 @@
generate_category_code(model_semi, ProcContext, Goal, ResumePoint,
TraceSlotInfo, Code, MaybeTraceCallLabel, FrameInfo, !CI) :-
- set.singleton_set(FailureLiveRegs, reg(reg_r, 1)),
+ FailureLiveRegs = set.make_singleton_set(reg(reg_r, 1)),
FailCode = from_list([
llds_instr(assign(reg(reg_r, 1), const(llconst_false)), "Fail"),
llds_instr(livevals(FailureLiveRegs), ""),
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.25
diff -u -r1.25 prog_mode.m
--- compiler/prog_mode.m 23 May 2011 05:08:10 -0000 1.25
+++ compiler/prog_mode.m 17 Jan 2012 13:52:53 -0000
@@ -296,7 +296,7 @@
Result = inst_var(Var)
).
inst_apply_substitution(Subst, constrained_inst_vars(Vars, Inst0), Result) :-
- ( set.singleton_set(Vars, Var0) ->
+ ( set.is_singleton(Vars, Var0) ->
Var = Var0
;
unexpected($module, $pred, "multiple inst_vars found")
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.47
diff -u -r1.47 term_pass1.m
--- compiler/term_pass1.m 31 Aug 2011 07:59:35 -0000 1.47
+++ compiler/term_pass1.m 17 Jan 2012 14:01:00 -0000
@@ -236,7 +236,7 @@
partition_call_args(!.ModuleInfo, ArgModes, Args, InVars, OutVars),
Path0 = term_path_info(PPId, no, 0, [], OutVars),
- set.singleton_set(PathSet0, Path0),
+ PathSet0 = set.make_singleton_set(Path0),
Info0 = term_traversal_ok(PathSet0, []),
term_traverse_goal(Goal, Params, Info0, Info, !ModuleInfo, !IO),
Index: compiler/type_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_constraints.m,v
retrieving revision 1.20
diff -u -r1.20 type_constraints.m
--- compiler/type_constraints.m 22 Aug 2011 04:23:14 -0000 1.20
+++ compiler/type_constraints.m 17 Jan 2012 13:35:27 -0000
@@ -511,7 +511,7 @@
Error = no
;
Domain = tdomain(Types),
- ( set.singleton_set(Types, Type0) ->
+ ( set.is_singleton(Types, Type0) ->
Type = Type0,
Error = no
; set.empty(Types) ->
@@ -1059,7 +1059,7 @@
DomainB = tdomain(TypesB),
% Symmetrical case below.
set.filter_map(unify_types(TypeA), TypesB, UnifiedTypes),
- ( set.singleton_set(UnifiedTypes, SingletonType) ->
+ ( set.is_singleton(UnifiedTypes, SingletonType) ->
Domain = tdomain_singleton(SingletonType)
;
Domain = tdomain(UnifiedTypes)
@@ -1073,7 +1073,7 @@
DomainB = tdomain_singleton(TypeB),
% Symmetrical case above.
set.filter_map(unify_types(TypeB), TypesA, UnifiedTypes),
- ( set.singleton_set(UnifiedTypes, SingletonType) ->
+ ( set.is_singleton(UnifiedTypes, SingletonType) ->
Domain = tdomain_singleton(SingletonType)
;
Domain = tdomain(UnifiedTypes)
@@ -1301,13 +1301,13 @@
has_singleton_domain(DomainMap, TVar) :-
map.search(DomainMap, TVar, tdomain(Domain)),
- set.singleton_set(Domain, _).
+ set.is_singleton(Domain, _).
:- pred is_singleton_domain(type_domain::in, mer_type::out) is semidet.
is_singleton_domain(tdomain_singleton(Type), Type).
is_singleton_domain(tdomain(Domain), Type) :-
- set.singleton_set(Domain, Type).
+ set.is_singleton(Domain, Type).
:- pred update_singleton_domain(tvar::in, type_domain_map::in,
type_domain_map::out) is det.
@@ -1315,7 +1315,7 @@
update_singleton_domain(TVar, !DomainMap) :-
(
map.search(!.DomainMap, TVar, tdomain(Domain)),
- set.singleton_set(Domain, Type)
+ set.is_singleton(Domain, Type)
->
map.set(TVar, tdomain_singleton(Type), !DomainMap)
;
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.64
diff -u -r1.64 unneeded_code.m
--- compiler/unneeded_code.m 26 Sep 2011 07:08:56 -0000 1.64
+++ compiler/unneeded_code.m 17 Jan 2012 14:02:18 -0000
@@ -940,7 +940,7 @@
BranchPoint, BranchNum, CurrentId, !WhereNeededMap) :-
(
BranchWhere0 = everywhere,
- set.singleton_set(BranchNumSet, BranchNum),
+ BranchNumSet = set.make_singleton_set(BranchNum),
BranchMap = map.singleton(BranchPoint, BranchNumSet),
BranchWhere = branches(BranchMap)
;
@@ -1164,7 +1164,7 @@
map.delete(BranchPoint, Branches0, Branches1),
ParentBranchPoint = branch_point(ParentBranchGoalId,
ParentBranchAlt),
- set.singleton_set(ParentAlts, ParentBranchNum),
+ ParentAlts = set.make_singleton_set(ParentBranchNum),
where_needed_branches_upper_bound_2(ContainingGoalMap,
CurrentId, [ParentBranchPoint - ParentAlts | Rest],
Branches1, WhereNeeded)
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.81
diff -u -r1.81 var_locn.m
--- compiler/var_locn.m 17 Oct 2011 04:31:31 -0000 1.81
+++ compiler/var_locn.m 17 Jan 2012 13:50:19 -0000
@@ -2528,7 +2528,7 @@
lval::in, loc_var_map::in, loc_var_map::out) is det.
make_var_depend_on_lval_roots(Var, Lval, !LocVarMap) :-
- set.singleton_set(Lvals, Lval),
+ Lvals = set.make_singleton_set(Lval),
make_var_depend_on_lvals_roots(Var, Lvals, !LocVarMap).
:- pred make_var_depend_on_root_lval(prog_var::in, lval::in,
Index: deep_profiler/autopar_costs.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/autopar_costs.m,v
retrieving revision 1.3
diff -u -r1.3 autopar_costs.m
--- deep_profiler/autopar_costs.m 26 Sep 2011 07:08:57 -0000 1.3
+++ deep_profiler/autopar_costs.m 17 Jan 2012 14:04:28 -0000
@@ -236,7 +236,7 @@
pessimistic_var_use_info(VarUseType, CostPercall, Use)
;
HigherOrder = first_order_call,
- ( singleton_set(CostAndCallee ^ cac_callees, CalleePrime) ->
+ ( is_singleton(CostAndCallee ^ cac_callees, CalleePrime) ->
Callee = CalleePrime
;
unexpected($module, $pred,
Index: deep_profiler/var_use_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/var_use_analysis.m,v
retrieving revision 1.17
diff -u -r1.17 var_use_analysis.m
--- deep_profiler/var_use_analysis.m 26 Sep 2011 07:08:57 -0000 1.17
+++ deep_profiler/var_use_analysis.m 17 Jan 2012 14:03:31 -0000
@@ -888,7 +888,7 @@
( empty(Callees) ->
% There are no callees, this code is never called.
pessimistic_var_use_time(VarUseType, Cost, Time)
- ; singleton_set(Callees, SingletonCallee) ->
+ ; is_singleton(Callees, SingletonCallee) ->
CSDPtr = SingletonCallee ^ c_csd,
call_site_dynamic_var_use_info(CliquePtr, CSDPtr,
ArgNum, RecursionType, yes(CurDepth), Cost, CallStack,
Index: library/eqvclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/eqvclass.m,v
retrieving revision 1.28
diff -u -r1.28 eqvclass.m
--- library/eqvclass.m 6 May 2011 05:03:28 -0000 1.28
+++ library/eqvclass.m 17 Jan 2012 13:02:49 -0000
@@ -220,7 +220,7 @@
!.EqvClass = eqvclass(Counter0, PartitionMap0, ElementMap0),
counter.allocate(Id, Counter0, Counter),
map.det_insert(Element, Id, ElementMap0, ElementMap),
- set.singleton_set(Partition, Element),
+ Partition = set.make_singleton_set(Element),
map.det_insert(Id, Partition, PartitionMap0, PartitionMap),
!:EqvClass = eqvclass(Counter, PartitionMap, ElementMap).
Index: library/set.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set.m,v
retrieving revision 1.95
diff -u -r1.95 set.m
--- library/set.m 21 Jul 2011 07:29:51 -0000 1.95
+++ library/set.m 17 Jan 2012 12:57:47 -0000
@@ -64,12 +64,14 @@
% `set.singleton_set(Set, Elem)' is true iff `Set' is the set
% containing just the single element `Elem'.
%
-:- pred set.singleton_set(set(T), T).
-:- mode set.singleton_set(in, out) is semidet.
-:- mode set.singleton_set(out, in) is det.
+:- pred set.singleton_set(T, set(T)).
+:- mode set.singleton_set(in, out) is det.
+:- mode set.singleton_set(out, in) is semidet.
:- func set.make_singleton_set(T) = set(T).
+:- pred set.is_singleton(set(T)::in, T::out) is semidet.
+
% `set.equal(SetA, SetB)' is true iff
% `SetA' and `SetB' contain the same elements.
%
@@ -428,10 +430,13 @@
set_ordlist.init(Set).
set.make_singleton_set(T) = S :-
- set.singleton_set(S, T).
+ set.singleton_set(T, S).
+
+set.singleton_set(X, Set) :-
+ set_ordlist.singleton_set(X, Set).
-set.singleton_set(Set, X) :-
- set_ordlist.singleton_set(Set, X).
+set.is_singleton(Set, X) :-
+ set_ordlist.is_singleton(Set, X).
set.list_to_set(Xs) = S :-
set.list_to_set(Xs, S).
Index: library/set_bbbtree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_bbbtree.m,v
retrieving revision 1.39
diff -u -r1.39 set_bbbtree.m
--- library/set_bbbtree.m 26 May 2011 06:20:09 -0000 1.39
+++ library/set_bbbtree.m 17 Jan 2012 13:28:04 -0000
@@ -77,17 +77,18 @@
:- mode set_bbbtree.largest(in, out) is semidet.
:- mode set_bbbtree.largest(in, in) is semidet.
- % `set_bbbtree.singleton_set(Set, X)' is true iff `Set' is the set
+ % `set_bbbtree.singleton_set(X, Set)' is true iff `Set' is the set
% containing just the single element `X'.
%
-:- pred set_bbbtree.singleton_set(set_bbbtree(T), T).
-:- mode set_bbbtree.singleton_set(uo, di) is det.
-:- mode set_bbbtree.singleton_set(in, out) is semidet.
+:- pred set_bbbtree.singleton_set(T, set_bbbtree(T)).
+:- mode set_bbbtree.singleton_set(in, out) is det.
:- mode set_bbbtree.singleton_set(in, in) is semidet.
-:- mode set_bbbtree.singleton_set(out, in) is det.
+:- mode set_bbbtree.singleton_set(out, in) is semidet.
:- func set_bbbtree.make_singleton_set(T) = set_bbbtree(T).
+:- pred set_bbbtree.is_singleton(set_bbbtree(T)::in, T::out) is semidet.
+
% `set_bbbtree.equal(SetA, SetB)' is true iff `SetA' and `SetB'
% contain the same elements.
%
@@ -535,9 +536,11 @@
%------------------------------------------------------------------------------%
set_bbbtree.make_singleton_set(T) = S :-
- set_bbbtree.singleton_set(S, T).
+ set_bbbtree.singleton_set(T, S).
+
+set_bbbtree.singleton_set(V, tree(V, 1, empty, empty)).
-set_bbbtree.singleton_set(tree(V, 1, empty, empty), V).
+set_bbbtree.is_singleton(tree(V, 1, empty, empty), V).
%------------------------------------------------------------------------------%
Index: library/set_ctree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_ctree234.m,v
retrieving revision 1.16
diff -u -r1.16 set_ctree234.m
--- library/set_ctree234.m 26 May 2011 06:20:09 -0000 1.16
+++ library/set_ctree234.m 17 Jan 2012 13:10:33 -0000
@@ -47,6 +47,8 @@
:- func set_ctree234.make_singleton_set(T) = set_ctree234(T).
+:- pred set_ctree234.is_singleton(set_ctree234(T)::in, T::out) is semidet.
+
% `set_ctree234.empty(Set)' is true iff `Set' is an empty set.
%
:- pred set_ctree234.empty(set_ctree234(_T)::in) is semidet.
@@ -433,6 +435,8 @@
set_ctree234.make_singleton_set(X) = ct(1, two(X, empty, empty)).
+set_ctree234.is_singleton(ct(1, two(X, empty, empty)), X).
+
set_ctree234.empty(ct(0, _)).
set_ctree234.is_empty(ct(0, _)).
Index: library/set_ordlist.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_ordlist.m,v
retrieving revision 1.41
diff -u -r1.41 set_ordlist.m
--- library/set_ordlist.m 21 Jul 2011 07:29:51 -0000 1.41
+++ library/set_ordlist.m 17 Jan 2012 12:58:34 -0000
@@ -61,9 +61,9 @@
% `set_ordlist.singleton_set(Set, Elem)' is true iff `Set' is the set
% containing just the single element `Elem'.
%
-:- pred set_ordlist.singleton_set(set_ordlist(T), T).
-:- mode set_ordlist.singleton_set(in, out) is semidet.
-:- mode set_ordlist.singleton_set(out, in) is det.
+:- pred set_ordlist.singleton_set(T, set_ordlist(T)).
+:- mode set_ordlist.singleton_set(in, out) is det.
+:- mode set_ordlist.singleton_set(out, in) is semidet.
:- func set_ordlist.make_singleton_set(T) = set_ordlist(T).
:- pred set_ordlist.is_singleton(set_ordlist(T)::in, T::out) is semidet.
@@ -418,9 +418,9 @@
set_ordlist.init(sol([])).
set_ordlist.make_singleton_set(T) = S :-
- set_ordlist.singleton_set(S, T).
+ set_ordlist.singleton_set(T, S).
-set_ordlist.singleton_set(sol([X]), X).
+set_ordlist.singleton_set(X, sol([X])).
set_ordlist.is_singleton(sol([X]), X).
Index: library/set_unordlist.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_unordlist.m,v
retrieving revision 1.36
diff -u -r1.36 set_unordlist.m
--- library/set_unordlist.m 26 May 2011 06:20:09 -0000 1.36
+++ library/set_unordlist.m 17 Jan 2012 14:18:38 -0000
@@ -62,12 +62,14 @@
% `set_unordlist.singleton_set(Set, Elem)' is true iff `Set' is the set
% containing just the single element `Elem'.
%
-:- pred set_unordlist.singleton_set(set_unordlist(T), T).
-:- mode set_unordlist.singleton_set(in, out) is semidet.
-:- mode set_unordlist.singleton_set(out, in) is det.
+:- pred set_unordlist.singleton_set(T, set_unordlist(T)).
+:- mode set_unordlist.singleton_set(in, out) is det.
+:- mode set_unordlist.singleton_set(out, in) is semidet.
:- func set_unordlist.make_singleton_set(T) = set_unordlist(T).
+:- pred set_unordlist.is_singleton(set_unordlist(T)::in, T::out) is semidet.
+
% `set_unordlist.equal(SetA, SetB)' is true iff
% `SetA' and `SetB' contain the same elements.
%
@@ -395,7 +397,17 @@
set_unordlist.init(sul([])).
-set_unordlist.singleton_set(sul([X]), X).
+:- pragma promise_equivalent_clauses(set_unordlist.singleton_set/2).
+
+set_unordlist.singleton_set(X::in, Set::out) :-
+ Set = sul([X]).
+
+set_unordlist.singleton_set(X::out, Set::in) :-
+ Set = sul(Xs),
+ list.sort_and_remove_dups(Xs, [X]).
+
+set_unordlist.is_singleton(sul(Xs), X) :-
+ list.sort_and_remove_dups(Xs, [X]).
set_unordlist.equal(SetA, SetB) :-
set_unordlist.subset(SetA, SetB),
@@ -560,7 +572,7 @@
set_unordlist.init(S).
set_unordlist.make_singleton_set(T) = S :-
- set_unordlist.singleton_set(S, T).
+ set_unordlist.singleton_set(T, S).
set_unordlist.insert(!.S, T) = !:S :-
set_unordlist.insert(T, !S).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.74
diff -u -r1.74 tree234.m
--- library/tree234.m 15 Jan 2012 14:49:36 -0000 1.74
+++ library/tree234.m 17 Jan 2012 12:56:16 -0000
@@ -3488,7 +3488,7 @@
well_formed(Tree, WellFormed) :-
depth_levels(Tree, 0, set.init, Depths),
- ( set.singleton_set(Depths, Depth) ->
+ ( set.is_singleton(Depths, Depth) ->
WellFormed = yes(Depth)
;
WellFormed = no
Index: tests/general/set_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/general/set_test.m,v
retrieving revision 1.5
diff -u -r1.5 set_test.m
--- tests/general/set_test.m 19 May 2011 07:33:23 -0000 1.5
+++ tests/general/set_test.m 17 Jan 2012 15:06:14 -0000
@@ -36,7 +36,7 @@
(
{ set_bbbtree__is_member(5, Set10, yes) },
{ set_bbbtree__is_member(6, Set10, no) },
- { set_bbbtree__singleton_set(Set10, 5) },
+ { set_bbbtree__singleton_set(5, Set10) },
{ set_bbbtree__least(Set10, 5) },
{ set_bbbtree__largest(Set10, 5) }
->
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.422
diff -u -r1.422 Mmakefile
--- tests/hard_coded/Mmakefile 15 Jan 2012 14:49:36 -0000 1.422
+++ tests/hard_coded/Mmakefile 17 Jan 2012 14:33:37 -0000
@@ -245,6 +245,7 @@
setjmp_test \
shift_test \
simplify_multi_arm_switch \
+ singleton_dups \
solve_quadratic \
space \
special_char \
Index: tests/hard_coded/singleton_dups.exp
===================================================================
RCS file: tests/hard_coded/singleton_dups.exp
diff -N tests/hard_coded/singleton_dups.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/singleton_dups.exp 17 Jan 2012 14:33:12 -0000
@@ -0,0 +1 @@
+Singleton with element 1
Index: tests/hard_coded/singleton_dups.m
===================================================================
RCS file: tests/hard_coded/singleton_dups.m
diff -N tests/hard_coded/singleton_dups.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/singleton_dups.m 17 Jan 2012 14:33:12 -0000
@@ -0,0 +1,27 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+% Regression test for a problem in Mercury 11.07 where checking whether
+% a set represented by an unordered list was singleton didn't account for
+% the representation containing duplicate elements.
+%
+:- module singleton_dups.
+:- interface.
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+:- implementation.
+:- import_module set_unordlist.
+main(!IO) :-
+ some [!Set] (
+ set_unordlist.init(!:Set),
+ set_unordlist.insert(1, !Set),
+ set_unordlist.insert(1, !Set),
+ set_unordlist.insert(1, !Set),
+ ( if set_unordlist.singleton_set(X, !.Set) then
+ io.write_string("Singleton with element ", !IO),
+ io.write_int(X, !IO),
+ io.nl(!IO)
+ else
+ io.write_string("Not a singleton set\n", !IO)
+ )
+ ).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list