[m-rev.] for post-commit review: speed up divide_by_set
Zoltan Somogyi
zs at unimelb.edu.au
Thu Mar 29 15:02:21 AEDT 2012
Fix a performance problem in liveness. Liveness makes many calls to
divide_by_set, but the existing implementation of that predicate in
tree_bitset.m did not exploit the structure of its operands.
After this diff, it now does so, though not yet to the fullest extent
possible. However, even this is enough to reduce the time needed
to compile a variant of the zm_rcpsp_cpx.m stress test from 66 seconds
to 15, with liveness analysis no longer being the bottleneck.
On tools/speedtest, we get about a 0.4% speedup, which is just
above the noise threshold.
library/tree_bitset.m:
Specialize the implementation of divide_by_set for many of
the possible cases. Leave XXXs where further specialization
is possible.
Put some predicate definitions in a more logical order.
compiler/test_bitset.m:
This module has long been used (initially by Simon Taylor, later
by me) to test the correctness of the implementation of first
sparse_bitset.m and later tree_bitset.m. However, since it
slows down all set operations a lot (by doing them twice, once using
a bitset module and once using set_ordlist, and then comparing
the results), it is never enabled in production compilers,
and since it is usually not imported by any ordinary compiler
modules, it is rarely even compiled. It has thus tended to
get bitrot; changes in the set modules it uses need corresponding
changes in this module, but it has not been getting them.
To fix this, move this module from the compiler directory to the
library directory. By including the moved version in the library,
it will always be compiled, and anyone who breaks it will have
to fix the breakage before checking in their change.
The cost is about 16 kilobytes in the Mercury library's .so file,
which is well worth it.
library/test_bitset.m:
The moved module. It had to be updated to compile and work
with the current versions of tree_bitset.m and set_ordlist.m.
library/library.m:
Include the moved module in the library.
doc/Mmakefile:
Since the moved module is only for the implementors of the bitset
modules, do not include it in the documentation.
Sort the names of the modules that are not included in the
documentation.
tests/hard_coded/test_tree_bitset.{m,exp}:
Make this module, which tests the operation of tree_bitset.m,
both more thorough and more controllable.
Make it more thorough by testing it not just with some toy sets
and some small random sets as inputs, but also with some inputs
specifically designed to be stress tests. These are taken from
the old tree_bitset_difference test case.
Make it more thorough in another way by also testing the divide_by_set
operation.
Make it more controllable by making it easy to test just one operation
(for me now, that was of course divide_by_set), without the distraction
of outputs from tests of other operations.
tests/hard_coded/tree_bitset_tester.m:
This module used to do the job of test_bitset.m for test_tree_bitset.m.
This was needed while test_bitset.m was in the compiler directory,
but it is not needed now, and keeping it presents a double maintenance
problem. This diff therefore deletes it, and makes test_tree_bitset.m
use test_bitset.m from the library.
tests/hard_coded/tree_bitset_difference.{m,exp}:
Delete this test case. The stress test inputs it used to test the
difference operation with are now in test_tree_bitset.m, which
uses them to test not just the difference operation, but other
operations as well.
tests/hard_coded/test_bitset.{m,exp}:
Delete this test case, since it seems to be a duplicate of an early
version of tree_bitset_tester.m. Despite its name, it was NOT a copy
of the identically named module that used to be in the compiler
directory.
tests/hard_coded/Mmakefile:
Remove the now unneeded tree_bitset_difference and test_bitset
test cases from the list of test cases.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/test_bitset.m
===================================================================
RCS file: compiler/test_bitset.m
diff -N compiler/test_bitset.m
--- compiler/test_bitset.m 3 Sep 2011 01:44:15 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,575 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2011 The University of Melbourne.
-% This file may only be copied under the terms of the GNU General
-% Public License - see the file COPYING in the Mercury distribution.
-%-----------------------------------------------------------------------------%
-%
-% Test operations on bitsets by comparing the output with the output
-% from an ordinary set.
-%
-%-----------------------------------------------------------------------------%
-
-:- module test_bitset.
-
-:- interface.
-
-:- import_module enum.
-:- import_module list.
-:- import_module set.
-
-:- type test_bitset(T).
-
-:- type bitset_error(T)
- ---> zero_argument(string,
- test_bitset(T))
- ; one_argument(string,
- test_bitset(T), test_bitset(T))
- ; two_arguments(string,
- test_bitset(T), test_bitset(T), test_bitset(T)).
-
-:- func init = test_bitset(T).
-:- func singleton_set(T) = test_bitset(T) <= enum(T).
-:- func make_singleton_set(T) = test_bitset(T) <= enum(T).
-
-:- pred init(test_bitset(T)::out) is det.
-:- pred singleton_set(test_bitset(T)::out, T::in) is det <= enum(T).
-:- pred make_singleton_set(test_bitset(T)::out, T::in) is det <= enum(T).
-
-:- func count(test_bitset(T)) = int <= enum(T).
-
-%---------------
-% Tests.
-
-:- pred is_empty(test_bitset(T)::in) is semidet.
-:- pred is_non_empty(test_bitset(T)::in) is semidet.
-:- pred is_singleton(test_bitset(T)::in, T::out) is semidet <= enum(T).
-
-:- pred contains(test_bitset(T)::in, T::in) is semidet <= enum(T).
-:- pred member(T, test_bitset(T)) <= enum(T).
-:- mode member(in, in) is semidet.
-:- mode member(out, in) is nondet.
-
-:- pred equal(test_bitset(T)::in, test_bitset(T)::in) is semidet <= enum(T).
-
-:- pred subset(test_bitset(T)::in, test_bitset(T)::in) is semidet.
-:- pred superset(test_bitset(T)::in, test_bitset(T)::in) is semidet.
-
-%---------------
-% Conversions.
-
-:- func list_to_set(list(T)) = test_bitset(T) <= enum(T).
-:- func sorted_list_to_set(list(T)) = test_bitset(T) <= enum(T).
-:- func to_sorted_list(test_bitset(T)) = list(T) <= enum(T).
-
-:- pred list_to_set(list(T)::in, test_bitset(T)::out) is det <= enum(T).
-:- pred sorted_list_to_set(list(T)::in, test_bitset(T)::out) is det <= enum(T).
-:- pred to_sorted_list(test_bitset(T)::in, list(T)::out) is det <= enum(T).
-
-:- func set_to_bitset(set(T)) = test_bitset(T) <= enum(T).
-:- func bitset_to_set(test_bitset(T)) = set(T) <= enum(T).
-:- func from_set(set(T)) = test_bitset(T) <= enum(T).
-:- func to_set(test_bitset(T)) = set(T) <= enum(T).
-
-%---------------
-% Updates.
-
-:- pred insert(T::in, test_bitset(T)::in, test_bitset(T)::out)
- is det <= enum(T).
-:- pred insert_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
- is det <= enum(T).
-:- pred delete(T::in, test_bitset(T)::in, test_bitset(T)::out)
- is det <= enum(T).
-:- pred delete_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
- is det <= enum(T).
-:- pred remove(T::in, test_bitset(T)::in, test_bitset(T)::out)
- is semidet <= enum(T).
-:- pred remove_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
- is semidet <= enum(T).
-:- pred remove_least(T::out, test_bitset(T)::in, test_bitset(T)::out)
- is semidet <= enum(T).
-
-%---------------
-% Set operations.
-
-:- func union(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
-:- func union_list(list(test_bitset(T))) = test_bitset(T) <= enum(T).
-:- func intersect(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
-:- func intersect_list(list(test_bitset(T))) = test_bitset(T) <= enum(T).
-:- func difference(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
-
-:- pred union(test_bitset(T)::in,
- test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
-:- pred union_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
- <= enum(T).
-:- pred intersect(test_bitset(T)::in,
- test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
-:- pred intersect_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
- <= enum(T).
-:- pred difference(test_bitset(T)::in,
- test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
-
-:- pred divide(pred(T)::in(pred(in) is semidet), test_bitset(T)::in,
- test_bitset(T)::out, test_bitset(T)::out) is det <= enum(T).
-
-:- pred divide_by_set(test_bitset(T)::in, test_bitset(T)::in,
- test_bitset(T)::out, test_bitset(T)::out) is det <= enum(T).
-
-%---------------
-% Traversals.
-
-:- pred foldl(pred(T, Acc, Acc), test_bitset(T), Acc, Acc) <= enum(T).
-:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
-:- mode foldl(pred(in, in, out) is semidet, in, in, out) is semidet.
-
-:- func foldl(func(T, Acc) = Acc, test_bitset(T), Acc) = Acc <= enum(T).
-:- mode foldl(func(in, in) = out is det, in, in) = out is det.
-
-:- func filter(pred(T)::in(pred(in) is semidet), test_bitset(T)::in)
- = (test_bitset(T)::out) is det <= enum(T).
-:- pred filter(pred(T)::in(pred(in) is semidet),
- test_bitset(T)::in, test_bitset(T)::out, test_bitset(T)::out)
- is det <= enum(T).
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module bool.
-:- import_module exception.
-:- import_module int.
-:- import_module list.
-:- import_module maybe.
-:- import_module pair.
-:- import_module require.
-:- import_module set_ordlist.
-:- import_module solutions.
-:- import_module string.
-:- import_module tree_bitset.
-
-:- type test_bitset(T) == pair(tree_bitset(T), set_ordlist(T)).
-
-%-----------------------------------------------------------------------------%
-
-init = tree_bitset.init - set_ordlist.init.
-
-singleton_set(A) =
- tree_bitset.make_singleton_set(A) - set_ordlist.make_singleton_set(A).
-
-make_singleton_set(A) =
- tree_bitset.make_singleton_set(A) - set_ordlist.make_singleton_set(A).
-
-init(init).
-singleton_set(test_bitset.singleton_set(A), A).
-make_singleton_set(test_bitset.make_singleton_set(A), A).
-
-count(SetA - SetB) = Count :-
- CountA = tree_bitset.count(SetA),
- CountB = set_ordlist.count(SetB),
- ( CountA = CountB ->
- Count = CountA
- ;
- error("test_bitset: count failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-is_empty(A - B) :-
- ( tree_bitset.is_empty(A) -> EmptyA = yes; EmptyA = no),
- ( set_ordlist.is_empty(B) -> EmptyB = yes; EmptyB = no),
- ( EmptyA = EmptyB ->
- EmptyA = yes
- ;
- error("test_bitset: is_empty failed")
- ).
-
-is_non_empty(A - B) :-
- ( tree_bitset.is_non_empty(A) -> NonEmptyA = yes; NonEmptyA = no),
- ( set_ordlist.non_empty(B) -> NonEmptyB = yes; NonEmptyB = no),
- ( NonEmptyA = NonEmptyB ->
- NonEmptyA = yes
- ;
- error("test_bitset: is_non_empty failed")
- ).
-
-is_singleton(A - B, E) :-
- ( tree_bitset.is_singleton(A, AE) -> NonEmptyA = yes(AE); NonEmptyA = no),
- ( set_ordlist.singleton_set(B, BE) -> NonEmptyB = yes(BE); NonEmptyB = no),
- ( NonEmptyA = NonEmptyB ->
- NonEmptyA = yes(E)
- ;
- error("test_bitset: is_singleton failed")
- ).
-
-contains(SetA - SetB, E) :-
- ( tree_bitset.contains(SetA, E) -> InSetA = yes ; InSetA = no),
- ( set_ordlist.contains(SetB, E) -> InSetB = yes ; InSetB = no),
- ( InSetA = InSetB ->
- InSetA = yes
- ;
- error("test_bitset: contains failed")
- ).
-
-:- pragma promise_equivalent_clauses(member/2).
-
-member(E::in, (SetA - SetB)::in) :-
- ( tree_bitset.member(E, SetA) -> InSetA = yes ; InSetA = no),
- ( set_ordlist.member(E, SetB) -> InSetB = yes ; InSetB = no),
- ( InSetA = InSetB ->
- InSetA = yes
- ;
- error("test_bitset: member failed")
- ).
-
-member(E::out, (SetA - SetB)::in) :-
- PredA = (pred(EA::out) is nondet :- tree_bitset.member(EA, SetA)),
- PredB = (pred(EB::out) is nondet :- set_ordlist.member(EB, SetB)),
- solutions(PredA, SolnsA),
- solutions(PredB, SolnsB),
- ( SolnsA = SolnsB ->
- tree_bitset.member(E, SetA)
- ;
- error("test_bitset: member failed")
- ).
-
-equal(SetA1 - SetB1, SetA2 - SetB2) :-
- ( tree_bitset.equal(SetA1, SetA2) -> EqualA = yes ; EqualA = no),
- ( set_ordlist.equal(SetB1, SetB2) -> EqualB = yes ; EqualB = no),
- ( EqualA = EqualB ->
- EqualA = yes
- ;
- error("test_bitset: equal failed")
- ).
-
-subset(SetA1 - SetB1, SetA2 - SetB2) :-
- ( tree_bitset.subset(SetA1, SetA2) ->
- ( set_ordlist.subset(SetB1, SetB2) ->
- true
- ;
- error("test_bitset: subset succeeded unexpectedly")
- )
- ; set_ordlist.subset(SetB1, SetB2) ->
- error("test_bitset: subset failed unexpectedly")
- ;
- fail
- ).
-
-superset(SetA1 - SetB1, SetA2 - SetB2) :-
- ( tree_bitset.superset(SetA1, SetA2) ->
- ( set_ordlist.superset(SetB1, SetB2) ->
- true
- ;
- error("test_bitset: superset succeeded unexpectedly")
- )
- ; set_ordlist.superset(SetB1, SetB2) ->
- error("test_bitset: superset failed unexpectedly")
- ;
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-list_to_set(List) = Result :-
- check0("list_to_set",
- tree_bitset.list_to_set(List) - set_ordlist.list_to_set(List),
- Result).
-
-sorted_list_to_set(List) = Result :-
- check0("sorted_list_to_set",
- tree_bitset.sorted_list_to_set(List) -
- set_ordlist.sorted_list_to_set(List),
- Result).
-
-to_sorted_list(A - B) = List :-
- ListA = tree_bitset.to_sorted_list(A),
- ListB = set_ordlist.to_sorted_list(B),
- ( ListA = ListB ->
- List = ListB
- ;
- error("test_bitset: to_sorted_list failed")
- ).
-
-list_to_set(A, test_bitset.list_to_set(A)).
-sorted_list_to_set(A, test_bitset.sorted_list_to_set(A)).
-to_sorted_list(A, test_bitset.to_sorted_list(A)).
-
-set_to_bitset(Set) = A - B :-
- set.to_sorted_list(Set, SortedList),
- A - B = test_bitset.sorted_list_to_set(SortedList).
-
-bitset_to_set(A - B) = Set :-
- SortedList = test_bitset.to_sorted_list(A - B),
- set.sorted_list_to_set(SortedList, Set).
-
-from_set(Set) = set_to_bitset(Set).
-to_set(Set) = bitset_to_set(Set).
-
-%-----------------------------------------------------------------------------%
-
-insert(E, SetA0 - SetB0, Result) :-
- tree_bitset.insert(E, SetA0, SetA),
- set_ordlist.insert(E, SetB0, SetB),
- check1("insert", SetA0 - SetB0, SetA - SetB, Result).
-
-insert_list(Es, SetA0 - SetB0, Result) :-
- tree_bitset.insert_list(Es, SetA0, SetA),
- set_ordlist.insert_list(Es, SetB0, SetB),
- check1("insert_list", SetA0 - SetB0, SetA - SetB, Result).
-
-delete(E, SetA0 - SetB0, Result) :-
- tree_bitset.delete(E, SetA0, SetA),
- set_ordlist.delete(E, SetB0, SetB),
- check1("delete", SetA0 - SetB0, SetA - SetB, Result).
-
-delete_list(Es, SetA0 - SetB0, Result) :-
- tree_bitset.delete_list(Es, SetA0, SetA),
- set_ordlist.delete_list(Es, SetB0, SetB),
- check1("delete_list", SetA0 - SetB0, SetA - SetB, Result).
-
-remove(E, SetA0 - SetB0, Result) :-
- ( tree_bitset.remove(E, SetA0, SetA1) ->
- ( set_ordlist.remove(E, SetB0, SetB1) ->
- SetA = SetA1,
- SetB = SetB1
- ;
- error("test_bitset: remove succeeded unexpectedly")
- )
- ; set_ordlist.remove(E, SetB0, _) ->
- error("test_bitset: remove failed unexpectedly")
- ;
- fail
- ),
- check1("remove", SetA0 - SetB0, SetA - SetB, Result).
-
-remove_list(Es, SetA0 - SetB0, Result) :-
- ( tree_bitset.remove_list(Es, SetA0, SetA1) ->
- ( set_ordlist.remove_list(Es, SetB0, SetB1) ->
- SetA = SetA1,
- SetB = SetB1
- ;
- error("test_bitset: remove succeeded unexpectedly")
- )
- ; set_ordlist.remove_list(Es, SetB0, _) ->
- error("test_bitset: remove failed unexpectedly")
- ;
- fail
- ),
- check1("remove_list", SetA0 - SetB0, SetA - SetB, Result).
-
-remove_least(Least, SetA0 - SetB0, Result) :-
- ( tree_bitset.remove_least(LeastA, SetA0, SetA1) ->
- ( set_ordlist.remove_least(LeastB, SetB0, SetB1) ->
- ( LeastA = LeastB ->
- Least = LeastA,
- check1("remove_least", SetA0 - SetB0, SetA1 - SetB1, Result)
- ;
- error("test_bitset: remove_least: wrong least element")
- )
- ;
- error("test_bitset: remove_least: should be no least value")
- )
- ; set_ordlist.remove_least(_, SetB0, _) ->
- error("test_bitset: remove_least: failed")
- ;
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-union(SetA1 - SetB1, SetA2 - SetB2) = Result :-
- tree_bitset.union(SetA1, SetA2, SetA),
- set_ordlist.union(SetB1, SetB2, SetB),
- check2("union", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
-
-union_list(SetsAB) = Result :-
- get_sets("union_list", SetsAB, SetsA, SetsB),
- SetA = tree_bitset.union_list(SetsA),
- SetB = set_ordlist.union_list(SetsB),
- check0("union_list", SetA - SetB, Result).
-
-intersect(SetA1 - SetB1, SetA2 - SetB2) = Result :-
- tree_bitset.intersect(SetA1, SetA2, SetA),
- set_ordlist.intersect(SetB1, SetB2, SetB),
- check2("intersect", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
-
-intersect_list(SetsAB) = Result :-
- get_sets("intersect_list", SetsAB, SetsA, SetsB),
- SetA = tree_bitset.intersect_list(SetsA),
- SetB = set_ordlist.intersect_list(SetsB),
- check0("intersect_list", SetA - SetB, Result).
-
-difference(SetA1 - SetB1, SetA2 - SetB2) = Result :-
- tree_bitset.difference(SetA1, SetA2, SetA),
- set_ordlist.difference(SetB1, SetB2, SetB),
- check2("difference", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
-
-union(A, B, test_bitset.union(A, B)).
-union_list(Sets, test_bitset.union_list(Sets)).
-intersect(A, B, test_bitset.intersect(A, B)).
-intersect_list(Sets, test_bitset.intersect_list(Sets)).
-difference(A, B, test_bitset.difference(A, B)).
-
-:- pred get_sets(string::in, list(pair(tree_bitset(T), set_ordlist(T)))::in,
- list(tree_bitset(T))::out, list(set_ordlist(T))::out) is det <= enum(T).
-
-get_sets(_, [], [], []).
-get_sets(Op, [SetA - SetB | SetsAB], [SetA | SetsA], [SetB | SetsB]) :-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- ( SetListA = SetListB ->
- get_sets(Op, SetsAB, SetsA, SetsB)
- ;
- error("test_bitset: get_sets: unequal sets in " ++ Op ++ " arg list")
- ).
-
-divide(Pred, SetA - SetB, ResultIn, ResultOut) :-
- tree_bitset.divide(Pred, SetA, InSetA, OutSetA),
- set_ordlist.divide(Pred, SetB, InSetB, OutSetB),
-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- tree_bitset.to_sorted_list(InSetA, InSetListA),
- set_ordlist.to_sorted_list(InSetB, InSetListB),
- tree_bitset.to_sorted_list(OutSetA, OutSetListA),
- set_ordlist.to_sorted_list(OutSetB, OutSetListB),
- (
- SetListA = SetListB,
- InSetListA = InSetListB,
- OutSetListA = OutSetListB
- ->
- ResultIn = InSetA - InSetB,
- ResultOut = OutSetA - OutSetB
- ;
- error("test_bitset: divide: unequal sets")
- ).
-
-divide_by_set(DivideBySetA - DivideBySetB, SetA - SetB, ResultIn, ResultOut) :-
- tree_bitset.divide_by_set(DivideBySetA, SetA, InSetA, OutSetA),
- set_ordlist.divide_by_set(DivideBySetB, SetB, InSetB, OutSetB),
-
- tree_bitset.to_sorted_list(DivideBySetA, DivideBySetListA),
- set_ordlist.to_sorted_list(DivideBySetB, DivideBySetListB),
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- tree_bitset.to_sorted_list(InSetA, InSetListA),
- set_ordlist.to_sorted_list(InSetB, InSetListB),
- tree_bitset.to_sorted_list(OutSetA, OutSetListA),
- set_ordlist.to_sorted_list(OutSetB, OutSetListB),
- (
- DivideBySetListA = DivideBySetListB,
- SetListA = SetListB,
- InSetListA = InSetListB,
- OutSetListA = OutSetListB
- ->
- ResultIn = InSetA - InSetB,
- ResultOut = OutSetA - OutSetB
- ;
- error("test_bitset: divide_by_set: unequal sets")
- ).
-
-%-----------------------------------------------------------------------------%
-
-foldl(Pred, SetA - SetB, Acc0, Acc) :-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- tree_bitset.foldl(Pred, SetA, Acc0, AccA),
- set_ordlist.fold(Pred, SetB, Acc0, AccB),
- ( SetListA = SetListB, AccA = AccB ->
- Acc = AccA
- ;
- error("test_bitset: foldl failed")
- ).
-
-foldl(Pred, SetA - SetB, Acc0) = Acc :-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- tree_bitset.foldl(Pred, SetA, Acc0) = AccA,
- set_ordlist.fold(Pred, SetB, Acc0) = AccB,
- ( SetListA = SetListB, AccA = AccB ->
- Acc = AccA
- ;
- error("test_bitset: foldl failed")
- ).
-
-filter(Pred, SetA - SetB) = Result :-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- InSetA = tree_bitset.filter(Pred, SetA),
- InSetB = set_ordlist.filter(Pred, SetB),
- tree_bitset.to_sorted_list(InSetA, InSetListA),
- set_ordlist.to_sorted_list(InSetB, InSetListB),
- ( SetListA = SetListB, InSetListA = InSetListB ->
- Result = InSetA - InSetB
- ;
- error("test_bitset: filter/2 failed")
- ).
-
-filter(Pred, SetA - SetB, ResultIn, ResultOut) :-
- tree_bitset.to_sorted_list(SetA, SetListA),
- set_ordlist.to_sorted_list(SetB, SetListB),
- tree_bitset.filter(Pred, SetA, InSetA, OutSetA),
- set_ordlist.filter(Pred, SetB, InSetB, OutSetB),
- tree_bitset.to_sorted_list(InSetA, InSetListA),
- set_ordlist.to_sorted_list(InSetB, InSetListB),
- tree_bitset.to_sorted_list(OutSetA, OutSetListA),
- set_ordlist.to_sorted_list(OutSetB, OutSetListB),
- ( SetListA = SetListB, InSetListA = InSetListB, OutSetListA = OutSetListB ->
- ResultIn = InSetA - InSetB,
- ResultOut = OutSetA - OutSetB
- ;
- error("test_bitset: filter/4 failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- pred check0(string::in, test_bitset(T)::in, test_bitset(T)::out) is det
- <= enum(T).
-
-check0(Op, Tester, Result) :-
- Tester = BitSet - Set,
- tree_bitset.to_sorted_list(BitSet, BitSetList),
- set_ordlist.to_sorted_list(Set, SetList),
- ( BitSetList = SetList ->
- Result = Tester
- ;
- throw(zero_argument(Op, Tester))
- ).
-
-:- pred check1(string::in, test_bitset(T)::in, test_bitset(T)::in,
- test_bitset(T)::out) is det <= enum(T).
-
-check1(Op, TesterA, Tester, Result) :-
- TesterA = BitSetA - SetA,
- tree_bitset.to_sorted_list(BitSetA, BitSetListA),
- set_ordlist.to_sorted_list(SetA, SetListA),
- Tester = BitSet - Set,
- tree_bitset.to_sorted_list(BitSet, BitSetList),
- set_ordlist.to_sorted_list(Set, SetList),
- ( BitSetListA = SetListA, BitSetList = SetList ->
- Result = Tester
- ;
- throw(one_argument(Op, TesterA, Tester))
- ).
-
-:- pred check2(string::in, test_bitset(T)::in, test_bitset(T)::in,
- test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
-
-check2(Op, TesterA, TesterB, Tester, Result) :-
- TesterA = BitSetA - SetA,
- tree_bitset.to_sorted_list(BitSetA, BitSetListA),
- set_ordlist.to_sorted_list(SetA, SetListA),
- TesterB = BitSetB - SetB,
- tree_bitset.to_sorted_list(BitSetB, BitSetListB),
- set_ordlist.to_sorted_list(SetB, SetListB),
- Tester = BitSet - Set,
- tree_bitset.to_sorted_list(BitSet, BitSetList),
- set_ordlist.to_sorted_list(Set, SetList),
-
- ( BitSetListA = SetListA, BitSetListB = SetListB, BitSetList = SetList ->
- Result = Tester
- ;
- throw(two_arguments(Op, TesterA, TesterB, Tester))
- ).
-
-%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/Mmakefile,v
retrieving revision 1.56
diff -u -b -r1.56 Mmakefile
--- doc/Mmakefile 18 Aug 2011 17:19:25 -0000 1.56
+++ doc/Mmakefile 27 Mar 2012 23:35:18 -0000
@@ -244,37 +244,39 @@
echo ""; \
for filename in $(LIBRARY_DIR)/*.m; do \
case $$filename in \
- $(LIBRARY_DIR)/mer_std.m) \
- ;; \
- $(LIBRARY_DIR)/private_builtin.m) \
+ $(LIBRARY_DIR)/backjump.m) \
;; \
- $(LIBRARY_DIR)/profiling_builtin.m) \
+ $(LIBRARY_DIR)/bintree.m) \
;; \
- $(LIBRARY_DIR)/par_builtin.m) \
+ $(LIBRARY_DIR)/bintree_set.m) \
;; \
- $(LIBRARY_DIR)/rtti_implementation.m) \
+ $(LIBRARY_DIR)/erlang_conf.m) \
;; \
$(LIBRARY_DIR)/erlang_rtti_implementation.m) \
;; \
- $(LIBRARY_DIR)/erlang_conf.m) \
+ $(LIBRARY_DIR)/mer_std.m) \
;; \
- $(LIBRARY_DIR)/table_builtin.m) \
+ $(LIBRARY_DIR)/mutvar.m) \
+ ;; \
+ $(LIBRARY_DIR)/par_builtin.m) \
+ ;; \
+ $(LIBRARY_DIR)/private_builtin.m) \
+ ;; \
+ $(LIBRARY_DIR)/profiling_builtin.m) \
;; \
$(LIBRARY_DIR)/region_builtin.m) \
;; \
$(LIBRARY_DIR)/robdd.m) \
;; \
- $(LIBRARY_DIR)/stm_builtin.m) \
- ;; \
- $(LIBRARY_DIR)/term_size_prof_builtin.m) \
+ $(LIBRARY_DIR)/rtti_implementation.m) \
;; \
- $(LIBRARY_DIR)/mutvar.m) \
+ $(LIBRARY_DIR)/stm_builtin.m) \
;; \
- $(LIBRARY_DIR)/backjump.m) \
+ $(LIBRARY_DIR)/table_builtin.m) \
;; \
- $(LIBRARY_DIR)/bintree.m) \
+ $(LIBRARY_DIR)/term_size_prof_builtin.m) \
;; \
- $(LIBRARY_DIR)/bintree_set.m) \
+ $(LIBRARY_DIR)/test_bitset.m) \
;; \
*) \
echo "* `basename $$filename .m`::"; \
@@ -286,37 +288,39 @@
library-chapters.texi_pp: $(LIBRARY_DIR)/[a-z]*.m
for filename in $(LIBRARY_DIR)/[a-z]*.m; do \
case $$filename in \
- $(LIBRARY_DIR)/mer_std.m) \
- ;; \
- $(LIBRARY_DIR)/private_builtin.m) \
+ $(LIBRARY_DIR)/backjump.m) \
;; \
- $(LIBRARY_DIR)/profiling_builtin.m) \
+ $(LIBRARY_DIR)/bintree.m) \
;; \
- $(LIBRARY_DIR)/par_builtin.m) \
+ $(LIBRARY_DIR)/bintree_set.m) \
;; \
- $(LIBRARY_DIR)/rtti_implementation.m) \
+ $(LIBRARY_DIR)/erlang_conf.m) \
;; \
$(LIBRARY_DIR)/erlang_rtti_implementation.m) \
;; \
- $(LIBRARY_DIR)/erlang_conf.m) \
+ $(LIBRARY_DIR)/mer_std.m) \
;; \
- $(LIBRARY_DIR)/table_builtin.m) \
+ $(LIBRARY_DIR)/mutvar.m) \
+ ;; \
+ $(LIBRARY_DIR)/par_builtin.m) \
+ ;; \
+ $(LIBRARY_DIR)/private_builtin.m) \
+ ;; \
+ $(LIBRARY_DIR)/profiling_builtin.m) \
;; \
$(LIBRARY_DIR)/region_builtin.m) \
;; \
$(LIBRARY_DIR)/robdd.m) \
;; \
- $(LIBRARY_DIR)/stm_builtin.m) \
- ;; \
- $(LIBRARY_DIR)/term_size_prof_builtin.m) \
+ $(LIBRARY_DIR)/rtti_implementation.m) \
;; \
- $(LIBRARY_DIR)/mutvar.m) \
+ $(LIBRARY_DIR)/stm_builtin.m) \
;; \
- $(LIBRARY_DIR)/backjump.m) \
+ $(LIBRARY_DIR)/table_builtin.m) \
;; \
- $(LIBRARY_DIR)/bintree.m) \
+ $(LIBRARY_DIR)/term_size_prof_builtin.m) \
;; \
- $(LIBRARY_DIR)/bintree_set.m) \
+ $(LIBRARY_DIR)/test_bitset.m) \
;; \
*) \
file="`basename $$filename .m`"; \
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.134
diff -u -b -r1.134 library.m
--- library/library.m 3 Jan 2012 11:04:48 -0000 1.134
+++ library/library.m 28 Mar 2012 13:35:46 -0000
@@ -150,6 +150,7 @@
:- import_module stm_builtin.
:- import_module table_builtin.
:- import_module term_size_prof_builtin.
+:- import_module test_bitset.
:- pragma foreign_decl("Erlang", local, "
-include(""erlang_conf.hrl"").
@@ -295,6 +296,7 @@
mercury_std_library_module("term_io").
mercury_std_library_module("term_size_prof_builtin").
mercury_std_library_module("term_to_xml").
+mercury_std_library_module("test_bitset").
mercury_std_library_module("time").
mercury_std_library_module("thread").
mercury_std_library_module("thread.channel").
Index: library/test_bitset.m
===================================================================
RCS file: library/test_bitset.m
diff -N library/test_bitset.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/test_bitset.m 28 Mar 2012 01:21:00 -0000
@@ -0,0 +1,579 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2011 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Test operations on bitsets by comparing the output with the output
+% from an ordinary set.
+%
+%-----------------------------------------------------------------------------%
+
+:- module test_bitset.
+
+:- interface.
+
+:- import_module enum.
+:- import_module list.
+:- import_module set.
+
+:- type test_bitset(T).
+
+:- type bitset_error(T)
+ ---> zero_argument(string,
+ test_bitset(T))
+ ; one_argument(string,
+ test_bitset(T), test_bitset(T))
+ ; two_arguments(string,
+ test_bitset(T), test_bitset(T), test_bitset(T)).
+
+:- func init = test_bitset(T).
+:- func singleton_set(T) = test_bitset(T) <= enum(T).
+:- func make_singleton_set(T) = test_bitset(T) <= enum(T).
+
+:- pred init(test_bitset(T)::out) is det.
+:- pred singleton_set(test_bitset(T)::out, T::in) is det <= enum(T).
+:- pred make_singleton_set(test_bitset(T)::out, T::in) is det <= enum(T).
+
+:- func count(test_bitset(T)) = int <= enum(T).
+
+%---------------
+% Tests.
+
+:- pred is_empty(test_bitset(T)::in) is semidet.
+:- pred is_non_empty(test_bitset(T)::in) is semidet.
+:- pred is_singleton(test_bitset(T)::in, T::out) is semidet <= enum(T).
+
+:- pred contains(test_bitset(T)::in, T::in) is semidet <= enum(T).
+:- pred member(T, test_bitset(T)) <= enum(T).
+:- mode member(in, in) is semidet.
+:- mode member(out, in) is nondet.
+
+:- pred equal(test_bitset(T)::in, test_bitset(T)::in) is semidet <= enum(T).
+
+:- pred subset(test_bitset(T)::in, test_bitset(T)::in) is semidet.
+:- pred superset(test_bitset(T)::in, test_bitset(T)::in) is semidet.
+
+%---------------
+% Conversions.
+
+:- func list_to_set(list(T)) = test_bitset(T) <= enum(T).
+:- func sorted_list_to_set(list(T)) = test_bitset(T) <= enum(T).
+:- func to_sorted_list(test_bitset(T)) = list(T) <= enum(T).
+
+:- pred list_to_set(list(T)::in, test_bitset(T)::out) is det <= enum(T).
+:- pred sorted_list_to_set(list(T)::in, test_bitset(T)::out) is det <= enum(T).
+:- pred to_sorted_list(test_bitset(T)::in, list(T)::out) is det <= enum(T).
+
+:- func set_to_bitset(set(T)) = test_bitset(T) <= enum(T).
+:- func bitset_to_set(test_bitset(T)) = set(T) <= enum(T).
+:- func from_set(set(T)) = test_bitset(T) <= enum(T).
+:- func to_set(test_bitset(T)) = set(T) <= enum(T).
+
+%---------------
+% Updates.
+
+:- pred insert(T::in, test_bitset(T)::in, test_bitset(T)::out)
+ is det <= enum(T).
+:- pred insert_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
+ is det <= enum(T).
+:- pred delete(T::in, test_bitset(T)::in, test_bitset(T)::out)
+ is det <= enum(T).
+:- pred delete_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
+ is det <= enum(T).
+:- pred remove(T::in, test_bitset(T)::in, test_bitset(T)::out)
+ is semidet <= enum(T).
+:- pred remove_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
+ is semidet <= enum(T).
+:- pred remove_least(T::out, test_bitset(T)::in, test_bitset(T)::out)
+ is semidet <= enum(T).
+
+%---------------
+% Set operations.
+
+:- func union(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
+:- func union_list(list(test_bitset(T))) = test_bitset(T) <= enum(T).
+:- func intersect(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
+:- func intersect_list(list(test_bitset(T))) = test_bitset(T) <= enum(T).
+:- func difference(test_bitset(T), test_bitset(T)) = test_bitset(T) <= enum(T).
+
+:- pred union(test_bitset(T)::in,
+ test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
+:- pred union_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
+ <= enum(T).
+:- pred intersect(test_bitset(T)::in,
+ test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
+:- pred intersect_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
+ <= enum(T).
+:- pred difference(test_bitset(T)::in,
+ test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
+
+:- pred divide(pred(T)::in(pred(in) is semidet), test_bitset(T)::in,
+ test_bitset(T)::out, test_bitset(T)::out) is det <= enum(T).
+
+:- pred divide_by_set(test_bitset(T)::in, test_bitset(T)::in,
+ test_bitset(T)::out, test_bitset(T)::out) is det <= enum(T).
+
+%---------------
+% Traversals.
+
+:- pred foldl(pred(T, Acc, Acc), test_bitset(T), Acc, Acc) <= enum(T).
+:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
+:- mode foldl(pred(in, in, out) is semidet, in, in, out) is semidet.
+
+:- func foldl(func(T, Acc) = Acc, test_bitset(T), Acc) = Acc <= enum(T).
+:- mode foldl(func(in, in) = out is det, in, in) = out is det.
+
+:- func filter(pred(T)::in(pred(in) is semidet), test_bitset(T)::in)
+ = (test_bitset(T)::out) is det <= enum(T).
+:- pred filter(pred(T)::in(pred(in) is semidet),
+ test_bitset(T)::in, test_bitset(T)::out, test_bitset(T)::out)
+ is det <= enum(T).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+:- import_module pair.
+:- import_module require.
+:- import_module set_ordlist.
+:- import_module solutions.
+:- import_module string.
+:- import_module tree_bitset.
+
+:- type test_bitset(T) == pair(tree_bitset(T), set_ordlist(T)).
+
+%-----------------------------------------------------------------------------%
+
+init = tree_bitset.init - set_ordlist.init.
+
+singleton_set(A) =
+ tree_bitset.make_singleton_set(A) - set_ordlist.make_singleton_set(A).
+
+make_singleton_set(A) =
+ tree_bitset.make_singleton_set(A) - set_ordlist.make_singleton_set(A).
+
+init(init).
+singleton_set(test_bitset.singleton_set(A), A).
+make_singleton_set(test_bitset.make_singleton_set(A), A).
+
+count(SetA - SetB) = Count :-
+ CountA = tree_bitset.count(SetA),
+ CountB = set_ordlist.count(SetB),
+ ( CountA = CountB ->
+ Count = CountA
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+is_empty(A - B) :-
+ ( tree_bitset.is_empty(A) -> EmptyA = yes; EmptyA = no),
+ ( set_ordlist.is_empty(B) -> EmptyB = yes; EmptyB = no),
+ ( EmptyA = EmptyB ->
+ EmptyA = yes
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+is_non_empty(A - B) :-
+ ( tree_bitset.is_non_empty(A) -> NonEmptyA = yes; NonEmptyA = no),
+ ( set_ordlist.is_non_empty(B) -> NonEmptyB = yes; NonEmptyB = no),
+ ( NonEmptyA = NonEmptyB ->
+ NonEmptyA = yes
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+is_singleton(A - B, E) :-
+ ( tree_bitset.is_singleton(A, AE) -> NonEmptyA = yes(AE); NonEmptyA = no),
+ ( set_ordlist.is_singleton(B, BE) -> NonEmptyB = yes(BE); NonEmptyB = no),
+ ( NonEmptyA = NonEmptyB ->
+ NonEmptyA = yes(E)
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+contains(SetA - SetB, E) :-
+ ( tree_bitset.contains(SetA, E) -> InSetA = yes ; InSetA = no),
+ ( set_ordlist.contains(SetB, E) -> InSetB = yes ; InSetB = no),
+ ( InSetA = InSetB ->
+ InSetA = yes
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+:- pragma promise_equivalent_clauses(member/2).
+
+member(E::in, (SetA - SetB)::in) :-
+ ( tree_bitset.member(E, SetA) -> InSetA = yes ; InSetA = no),
+ ( set_ordlist.member(E, SetB) -> InSetB = yes ; InSetB = no),
+ ( InSetA = InSetB ->
+ InSetA = yes
+ ;
+ unexpected($module, $pred, "failed (in, in)")
+ ).
+
+member(E::out, (SetA - SetB)::in) :-
+ PredA = (pred(EA::out) is nondet :- tree_bitset.member(EA, SetA)),
+ PredB = (pred(EB::out) is nondet :- set_ordlist.member(EB, SetB)),
+ solutions(PredA, SolnsA),
+ solutions(PredB, SolnsB),
+ ( SolnsA = SolnsB ->
+ tree_bitset.member(E, SetA)
+ ;
+ unexpected($module, $pred, "failed (out, in)")
+ ).
+
+equal(SetA1 - SetB1, SetA2 - SetB2) :-
+ ( tree_bitset.equal(SetA1, SetA2) -> EqualA = yes ; EqualA = no),
+ ( set_ordlist.equal(SetB1, SetB2) -> EqualB = yes ; EqualB = no),
+ ( EqualA = EqualB ->
+ EqualA = yes
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+subset(SetA1 - SetB1, SetA2 - SetB2) :-
+ ( tree_bitset.subset(SetA1, SetA2) ->
+ ( set_ordlist.subset(SetB1, SetB2) ->
+ true
+ ;
+ unexpected($module, $pred, "unexpected success")
+ )
+ ; set_ordlist.subset(SetB1, SetB2) ->
+ unexpected($module, $pred, "unexpected failure")
+ ;
+ fail
+ ).
+
+superset(SetA1 - SetB1, SetA2 - SetB2) :-
+ ( tree_bitset.superset(SetA1, SetA2) ->
+ ( set_ordlist.superset(SetB1, SetB2) ->
+ true
+ ;
+ unexpected($module, $pred, "unexpected success")
+ )
+ ; set_ordlist.superset(SetB1, SetB2) ->
+ unexpected($module, $pred, "unexpected failure")
+ ;
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+list_to_set(List) = Result :-
+ check0("list_to_set",
+ tree_bitset.list_to_set(List) - set_ordlist.list_to_set(List),
+ Result).
+
+sorted_list_to_set(List) = Result :-
+ check0("sorted_list_to_set",
+ tree_bitset.sorted_list_to_set(List) -
+ set_ordlist.sorted_list_to_set(List),
+ Result).
+
+to_sorted_list(A - B) = List :-
+ ListA = tree_bitset.to_sorted_list(A),
+ ListB = set_ordlist.to_sorted_list(B),
+ ( ListA = ListB ->
+ List = ListB
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+list_to_set(A, test_bitset.list_to_set(A)).
+sorted_list_to_set(A, test_bitset.sorted_list_to_set(A)).
+to_sorted_list(A, test_bitset.to_sorted_list(A)).
+
+set_to_bitset(Set) = A - B :-
+ set.to_sorted_list(Set, SortedList),
+ A - B = test_bitset.sorted_list_to_set(SortedList).
+
+bitset_to_set(A - B) = Set :-
+ SortedList = test_bitset.to_sorted_list(A - B),
+ set.sorted_list_to_set(SortedList, Set).
+
+from_set(Set) = set_to_bitset(Set).
+to_set(Set) = bitset_to_set(Set).
+
+%-----------------------------------------------------------------------------%
+
+insert(E, SetA0 - SetB0, Result) :-
+ tree_bitset.insert(E, SetA0, SetA),
+ set_ordlist.insert(E, SetB0, SetB),
+ check1("insert", SetA0 - SetB0, SetA - SetB, Result).
+
+insert_list(Es, SetA0 - SetB0, Result) :-
+ tree_bitset.insert_list(Es, SetA0, SetA),
+ set_ordlist.insert_list(Es, SetB0, SetB),
+ check1("insert_list", SetA0 - SetB0, SetA - SetB, Result).
+
+delete(E, SetA0 - SetB0, Result) :-
+ tree_bitset.delete(E, SetA0, SetA),
+ set_ordlist.delete(E, SetB0, SetB),
+ check1("delete", SetA0 - SetB0, SetA - SetB, Result).
+
+delete_list(Es, SetA0 - SetB0, Result) :-
+ tree_bitset.delete_list(Es, SetA0, SetA),
+ set_ordlist.delete_list(Es, SetB0, SetB),
+ check1("delete_list", SetA0 - SetB0, SetA - SetB, Result).
+
+remove(E, SetA0 - SetB0, Result) :-
+ ( tree_bitset.remove(E, SetA0, SetA1) ->
+ ( set_ordlist.remove(E, SetB0, SetB1) ->
+ SetA = SetA1,
+ SetB = SetB1,
+ check1("remove", SetA0 - SetB0, SetA - SetB, Result)
+ ;
+ unexpected($module, $pred, "unexpected success")
+ )
+ ; set_ordlist.remove(E, SetB0, _) ->
+ unexpected($module, $pred, "unexpected failure")
+ ;
+ fail
+ ).
+
+remove_list(Es, SetA0 - SetB0, Result) :-
+ ( tree_bitset.remove_list(Es, SetA0, SetA1) ->
+ ( set_ordlist.remove_list(Es, SetB0, SetB1) ->
+ SetA = SetA1,
+ SetB = SetB1,
+ check1("remove_list", SetA0 - SetB0, SetA - SetB, Result)
+ ;
+ unexpected($module, $pred, "unexpected success")
+ )
+ ; set_ordlist.remove_list(Es, SetB0, _) ->
+ unexpected($module, $pred, "unexpected failure")
+ ;
+ fail
+ ).
+
+remove_least(Least, SetA0 - SetB0, Result) :-
+ ( tree_bitset.remove_least(LeastA, SetA0, SetA1) ->
+ ( set_ordlist.remove_least(LeastB, SetB0, SetB1) ->
+ ( LeastA = LeastB ->
+ Least = LeastA,
+ check1("remove_least", SetA0 - SetB0, SetA1 - SetB1, Result)
+ ;
+ unexpected($module, $pred, "wrong least element")
+ )
+ ;
+ unexpected($module, $pred, "should be no least value")
+ )
+ ; set_ordlist.remove_least(_, SetB0, _) ->
+ unexpected($module, $pred, "failed")
+ ;
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+union(SetA1 - SetB1, SetA2 - SetB2) = Result :-
+ tree_bitset.union(SetA1, SetA2, SetA),
+ set_ordlist.union(SetB1, SetB2, SetB),
+ check2("union", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
+
+union_list(SetsAB) = Result :-
+ get_sets("union_list", SetsAB, SetsA, SetsB),
+ SetA = tree_bitset.union_list(SetsA),
+ SetB = set_ordlist.union_list(SetsB),
+ check0("union_list", SetA - SetB, Result).
+
+intersect(SetA1 - SetB1, SetA2 - SetB2) = Result :-
+ tree_bitset.intersect(SetA1, SetA2, SetA),
+ set_ordlist.intersect(SetB1, SetB2, SetB),
+ check2("intersect", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
+
+intersect_list(SetsAB) = Result :-
+ get_sets("intersect_list", SetsAB, SetsA, SetsB),
+ SetA = tree_bitset.intersect_list(SetsA),
+ SetB = set_ordlist.intersect_list(SetsB),
+ check0("intersect_list", SetA - SetB, Result).
+
+difference(SetA1 - SetB1, SetA2 - SetB2) = Result :-
+ tree_bitset.difference(SetA1, SetA2, SetA),
+ set_ordlist.difference(SetB1, SetB2, SetB),
+ check2("difference", SetA1 - SetB1, SetA2 - SetB2, SetA - SetB, Result).
+
+union(A, B, test_bitset.union(A, B)).
+union_list(Sets, test_bitset.union_list(Sets)).
+intersect(A, B, test_bitset.intersect(A, B)).
+intersect_list(Sets, test_bitset.intersect_list(Sets)).
+difference(A, B, test_bitset.difference(A, B)).
+
+:- pred get_sets(string::in, list(pair(tree_bitset(T), set_ordlist(T)))::in,
+ list(tree_bitset(T))::out, list(set_ordlist(T))::out) is det <= enum(T).
+
+get_sets(_, [], [], []).
+get_sets(Op, [SetA - SetB | SetsAB], [SetA | SetsA], [SetB | SetsB]) :-
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ ( SetListA = SetListB ->
+ get_sets(Op, SetsAB, SetsA, SetsB)
+ ;
+ unexpected($module, $pred, "unequal sets in " ++ Op ++ " arg list")
+ ).
+
+divide(Pred, SetA - SetB, ResultIn, ResultOut) :-
+ tree_bitset.divide(Pred, SetA, InSetA, OutSetA),
+ set_ordlist.divide(Pred, SetB, InSetB, OutSetB),
+
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ tree_bitset.to_sorted_list(InSetA, InSetListA),
+ set_ordlist.to_sorted_list(InSetB, InSetListB),
+ tree_bitset.to_sorted_list(OutSetA, OutSetListA),
+ set_ordlist.to_sorted_list(OutSetB, OutSetListB),
+ (
+ SetListA = SetListB,
+ InSetListA = InSetListB,
+ OutSetListA = OutSetListB
+ ->
+ ResultIn = InSetA - InSetB,
+ ResultOut = OutSetA - OutSetB
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+divide_by_set(DivideBySetA - DivideBySetB, SetA - SetB, ResultIn, ResultOut) :-
+ tree_bitset.divide_by_set(DivideBySetA, SetA, InSetA, OutSetA),
+ set_ordlist.divide_by_set(DivideBySetB, SetB, InSetB, OutSetB),
+
+ tree_bitset.to_sorted_list(DivideBySetA, DivideBySetListA),
+ set_ordlist.to_sorted_list(DivideBySetB, DivideBySetListB),
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ tree_bitset.to_sorted_list(InSetA, InSetListA),
+ set_ordlist.to_sorted_list(InSetB, InSetListB),
+ tree_bitset.to_sorted_list(OutSetA, OutSetListA),
+ set_ordlist.to_sorted_list(OutSetB, OutSetListB),
+ (
+ DivideBySetListA = DivideBySetListB,
+ SetListA = SetListB,
+ InSetListA = InSetListB,
+ OutSetListA = OutSetListB
+ ->
+ ResultIn = InSetA - InSetB,
+ ResultOut = OutSetA - OutSetB
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+foldl(Pred, SetA - SetB, Acc0, Acc) :-
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ tree_bitset.foldl(Pred, SetA, Acc0, AccA),
+ set_ordlist.fold(Pred, SetB, Acc0, AccB),
+ ( SetListA = SetListB, AccA = AccB ->
+ Acc = AccA
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+foldl(Pred, SetA - SetB, Acc0) = Acc :-
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ tree_bitset.foldl(Pred, SetA, Acc0) = AccA,
+ set_ordlist.fold(Pred, SetB, Acc0) = AccB,
+ ( SetListA = SetListB, AccA = AccB ->
+ Acc = AccA
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+filter(Pred, SetA - SetB) = Result :-
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ InSetA = tree_bitset.filter(Pred, SetA),
+ InSetB = set_ordlist.filter(Pred, SetB),
+ tree_bitset.to_sorted_list(InSetA, InSetListA),
+ set_ordlist.to_sorted_list(InSetB, InSetListB),
+ ( SetListA = SetListB, InSetListA = InSetListB ->
+ Result = InSetA - InSetB
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+filter(Pred, SetA - SetB, ResultIn, ResultOut) :-
+ tree_bitset.to_sorted_list(SetA, SetListA),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ tree_bitset.filter(Pred, SetA, InSetA, OutSetA),
+ set_ordlist.filter(Pred, SetB, InSetB, OutSetB),
+ tree_bitset.to_sorted_list(InSetA, InSetListA),
+ set_ordlist.to_sorted_list(InSetB, InSetListB),
+ tree_bitset.to_sorted_list(OutSetA, OutSetListA),
+ set_ordlist.to_sorted_list(OutSetB, OutSetListB),
+ (
+ SetListA = SetListB,
+ InSetListA = InSetListB,
+ OutSetListA = OutSetListB
+ ->
+ ResultIn = InSetA - InSetB,
+ ResultOut = OutSetA - OutSetB
+ ;
+ unexpected($module, $pred, "failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred check0(string::in, test_bitset(T)::in, test_bitset(T)::out) is det
+ <= enum(T).
+
+check0(Op, Tester, Result) :-
+ Tester = BitSet - Set,
+ tree_bitset.to_sorted_list(BitSet, BitSetList),
+ set_ordlist.to_sorted_list(Set, SetList),
+ ( BitSetList = SetList ->
+ Result = Tester
+ ;
+ throw(zero_argument(Op, Tester))
+ ).
+
+:- pred check1(string::in, test_bitset(T)::in, test_bitset(T)::in,
+ test_bitset(T)::out) is det <= enum(T).
+
+check1(Op, TesterA, Tester, Result) :-
+ TesterA = BitSetA - SetA,
+ tree_bitset.to_sorted_list(BitSetA, BitSetListA),
+ set_ordlist.to_sorted_list(SetA, SetListA),
+ Tester = BitSet - Set,
+ tree_bitset.to_sorted_list(BitSet, BitSetList),
+ set_ordlist.to_sorted_list(Set, SetList),
+ ( BitSetListA = SetListA, BitSetList = SetList ->
+ Result = Tester
+ ;
+ throw(one_argument(Op, TesterA, Tester))
+ ).
+
+:- pred check2(string::in, test_bitset(T)::in, test_bitset(T)::in,
+ test_bitset(T)::in, test_bitset(T)::out) is det <= enum(T).
+
+check2(Op, TesterA, TesterB, Tester, Result) :-
+ TesterA = BitSetA - SetA,
+ tree_bitset.to_sorted_list(BitSetA, BitSetListA),
+ set_ordlist.to_sorted_list(SetA, SetListA),
+ TesterB = BitSetB - SetB,
+ tree_bitset.to_sorted_list(BitSetB, BitSetListB),
+ set_ordlist.to_sorted_list(SetB, SetListB),
+ Tester = BitSet - Set,
+ tree_bitset.to_sorted_list(BitSet, BitSetList),
+ set_ordlist.to_sorted_list(Set, SetList),
+
+ ( BitSetListA = SetListA, BitSetListB = SetListB, BitSetList = SetList ->
+ Result = Tester
+ ;
+ throw(two_arguments(Op, TesterA, TesterB, Tester))
+ ).
+
+%-----------------------------------------------------------------------------%
Index: library/tree_bitset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree_bitset.m,v
retrieving revision 1.16
diff -u -b -r1.16 tree_bitset.m
--- library/tree_bitset.m 3 Sep 2011 01:43:38 -0000 1.16
+++ library/tree_bitset.m 29 Mar 2012 04:01:07 -0000
@@ -420,7 +420,6 @@
:- import_module int.
:- import_module list.
:- import_module require.
-:- import_module string. % for ++ on strings in exceptions
% These are needed only for integrity checking.
:- import_module bool.
@@ -435,7 +434,7 @@
% bits_per_int bits.
%
% - Level k > 0 nodes are interior nodes. An interior node of level k + 1
- % has up to 2 ^ bits_per_level children of level k.
+ % has up to 2 ^ bits_per_level children, all of level k.
%
% - If a node at level k is isomorphic to a bitmap of b bits, then a node
% at level k + 1 is isomorphic to the bitmap of b * 2 ^ bits_per_level
@@ -457,9 +456,9 @@
% `Offset' .. `Offset + bits_per_int - 1' are in the set.
%
% Interior nodes contain bitmaps only indirectly; they contain a list
- % of nodes one level down. (For level 1 interior nodes, this means
+ % of nodes one level down. For level 1 interior nodes, this means
% a list of leaf nodes; for interior nodes of level k+1, this means
- % a list of interior nodes of level k.)
+ % a list of interior nodes of level k.
%
% Invariants:
%
@@ -555,13 +554,15 @@
%-----------------------------------------------------------------------------%
-% This function is the only place in the module that adds the tree_bitset/1
-% wrapper around node lists, and therefore the only place that constructs
-% terms that are semantically tree_bitsets. Invoking our integrity test from
-% here thus guarantees that we never return any malformed tree_bitsets.
+% This function should be the only place in the module that adds the
+% tree_bitset/1 wrapper around node lists, and therefore the only place
+% that constructs terms that are semantically tree_bitsets. Invoking our
+% integrity test from here should thus guarantee that we never return
+% any malformed tree_bitsets.
%
% If you want to use the integrity checking version of wrap_tree_bitset,
-% then you will need to compile this module with the following flag:
+% then you will need to compile this module with the flag
+%
% --trace-flag="tree-bitset-integrity"
:- func wrap_tree_bitset(node_list) = tree_bitset(T).
@@ -1393,8 +1394,7 @@
sorted_list_to_set(Elems) = Set :-
items_to_index(Elems, Indexes),
- % XXX
- % Should we sort Indexes? The fact that Elems is sorted
+ % XXX We SHOULD sort Indexes. The fact that Elems is sorted
% does not *necessarily* imply that Indexes is sorted.
LeafNodes = sorted_list_to_leaf_nodes(Indexes),
(
@@ -1429,6 +1429,28 @@
IndexHead = enum_to_index(ElemHead),
items_to_index(ElemTail, IndexTail).
+:- func sorted_list_to_leaf_nodes(list(int)) = list(leaf_node).
+
+sorted_list_to_leaf_nodes([]) = [].
+sorted_list_to_leaf_nodes([Head | Tail]) = LeafNodes :-
+ bits_for_index(Head, Offset, HeadBits),
+ gather_bits_for_leaf(Tail, Offset, HeadBits, Bits, Remaining),
+ sorted_list_to_leaf_nodes(Remaining) = LeafNodesTail,
+ LeafNodes = [make_leaf_node(Offset, Bits) | LeafNodesTail].
+
+:- pred gather_bits_for_leaf(list(int)::in, int::in, int::in, int::out,
+ list(int)::out) is det.
+
+gather_bits_for_leaf([], _Offset, !Bits, []).
+gather_bits_for_leaf(List @ [Head | Tail], Offset, !Bits, Remaining) :-
+ bits_for_index(Head, HeadOffset, HeadBits),
+ ( HeadOffset = Offset ->
+ !:Bits = !.Bits \/ HeadBits,
+ gather_bits_for_leaf(Tail, Offset, !Bits, Remaining)
+ ;
+ Remaining = List
+ ).
+
:- pred group_leaf_nodes(leaf_node::in, list(leaf_node)::in,
list(interior_node)::out) is det.
@@ -1536,28 +1558,6 @@
Remaining = [Head | Tail]
).
-:- func sorted_list_to_leaf_nodes(list(int)) = list(leaf_node).
-
-sorted_list_to_leaf_nodes([]) = [].
-sorted_list_to_leaf_nodes([Head | Tail]) = LeafNodes :-
- bits_for_index(Head, Offset, HeadBits),
- gather_bits_for_leaf(Tail, Offset, HeadBits, Bits, Remaining),
- sorted_list_to_leaf_nodes(Remaining) = LeafNodesTail,
- LeafNodes = [make_leaf_node(Offset, Bits) | LeafNodesTail].
-
-:- pred gather_bits_for_leaf(list(int)::in, int::in, int::in, int::out,
- list(int)::out) is det.
-
-gather_bits_for_leaf([], _Offset, !Bits, []).
-gather_bits_for_leaf(List @ [Head | Tail], Offset, !Bits, Remaining) :-
- bits_for_index(Head, HeadOffset, HeadBits),
- ( HeadOffset = Offset ->
- !:Bits = !.Bits \/ HeadBits,
- gather_bits_for_leaf(Tail, Offset, !Bits, Remaining)
- ;
- Remaining = List
- ).
-
%-----------------------------------------------------------------------------%
subset(Subset, Set) :-
@@ -2827,16 +2827,334 @@
%-----------------------------------------------------------------------------%
divide_by_set(DivideBySet, Set, InSet, OutSet) :-
- Pred = (pred(Element::in) is semidet :-
- contains(DivideBySet, Element)
+ DivideBySet = tree_bitset(DivideByList),
+ Set = tree_bitset(List),
+ (
+ DivideByList = leaf_list(DBLeafNodes),
+ List = leaf_list(LeafNodes),
+ leaflist_divide_by_set(DBLeafNodes, LeafNodes,
+ InNodes, OutNodes),
+ InList = leaf_list(InNodes),
+ OutList = leaf_list(OutNodes),
+ InSet = wrap_tree_bitset(InList),
+ OutSet = wrap_tree_bitset(OutList)
+ ;
+ DivideByList = interior_list(DBLevel, DBNodes),
+ List = leaf_list(LeafNodes),
+ (
+ LeafNodes = [],
+ % The set we are dividing is empty, so both InSet and OutSet
+ % must be empty too.
+ InSet = Set,
+ OutSet = Set
+ ;
+ LeafNodes = [leaf_node(FirstOffset, _) | _],
+ range_of_parent_node(FirstOffset, 0, InitOffset, LimitOffset),
+ head_and_tail(DBNodes, DBNodesHead, _),
+ DBNodesHead = interior_node(DBFirstInitOffset, _, _),
+ range_of_parent_node(DBFirstInitOffset, DBLevel,
+ DBInitOffset, DBLimitOffset),
+ (
+ DBInitOffset =< InitOffset,
+ InitOffset < DBLimitOffset
+ ->
+ (
+ DBInitOffset < LimitOffset,
+ LimitOffset =< DBLimitOffset
+ ->
+ true
+ ;
+ unexpected($module, $pred, "strange offsets")
),
- divide(Pred, Set, InSet, OutSet).
+ divide_by_set_descend_divide_by(DBLevel, DBNodes,
+ 0, InitOffset, LimitOffset, List, InList0, OutList0),
+ prune_top_levels(InList0, InList),
+ prune_top_levels(OutList0, OutList),
+ InSet = wrap_tree_bitset(InList),
+ OutSet = wrap_tree_bitset(OutList)
+ ;
+ % The ranges of the two sets do not overlap.
+ InSet = wrap_tree_bitset(leaf_list([])),
+ OutSet = Set
+ )
+ )
+ ;
+ DivideByList = leaf_list(_),
+ List = interior_list(_, _),
+ % XXX Should have specialized code here that traverses Set
+ % just once. This will require something analogous to
+ % divide_by_set_descend_divide_by, but descending List
+ % instead of DivideByList.
+ intersect(DivideBySet, Set, InSet),
+ difference(Set, InSet, OutSet)
+ ;
+ DivideByList = interior_list(DBLevel, DBNodes),
+ List = interior_list(Level, Nodes),
+ ( DBLevel = Level ->
+ interiorlist_divide_by_set(Level, DBNodes, Nodes,
+ InNodes, OutNodes),
+ (
+ InNodes = [],
+ InList = leaf_list([])
+ ;
+ InNodes = [_ | _],
+ InList0 = interior_list(Level, InNodes),
+ prune_top_levels(InList0, InList)
+ ),
+ (
+ OutNodes = [],
+ OutList = leaf_list([])
+ ;
+ OutNodes = [_ | _],
+ OutList0 = interior_list(Level, OutNodes),
+ prune_top_levels(OutList0, OutList)
+ ),
+ InSet = wrap_tree_bitset(InList),
+ OutSet = wrap_tree_bitset(OutList)
+ ; DBLevel > Level ->
+ head_and_tail(Nodes, NodesHead, _),
+ NodesHead = interior_node(FirstInitOffset, _, _),
+ range_of_parent_node(FirstInitOffset, Level,
+ InitOffset, LimitOffset),
+ divide_by_set_descend_divide_by(DBLevel, DBNodes,
+ Level, InitOffset, LimitOffset, List, InList0, OutList0),
+ prune_top_levels(InList0, InList),
+ prune_top_levels(OutList0, OutList),
+ InSet = wrap_tree_bitset(InList),
+ OutSet = wrap_tree_bitset(OutList)
+ ;
+ % XXX Should have specialized code here that traverses Set
+ % just once. This will require something analogous to
+ % divide_by_set_descend_divide_by, but descending List
+ % instead of DivideByList.
+ intersect(DivideBySet, Set, InSet),
+ difference(Set, InSet, OutSet)
+ )
+ ).
+
+:- pred divide_by_set_descend_divide_by(int::in,
+ list(interior_node)::in, int::in, int::in, int::in, node_list::in,
+ node_list::out, node_list::out) is det.
+
+divide_by_set_descend_divide_by(DBLevel, DBNodes,
+ Level, InitOffset, LimitOffset, List, InList, OutList) :-
+ expect((DBLevel > Level), $module, $pred, "not DBLevel > Level"),
+ (
+ DBNodes = [],
+ % Every node in the original DivideByList is before List.
+ InList = leaf_list([]),
+ OutList = List
+ ;
+ DBNodes = [DBNodesHead | DBNodesTail],
+ DBNodesHead = interior_node(DBHeadInitOffset, DBHeadLimitOffset,
+ DBHeadComponents),
+ ( DBHeadLimitOffset =< InitOffset ->
+ % DBNodesHead is before List.
+ divide_by_set_descend_divide_by(DBLevel, DBNodesTail,
+ Level, InitOffset, LimitOffset, List, InList, OutList)
+ ; LimitOffset =< DBHeadInitOffset ->
+ % DBNodesHead is after List, and every other
+ % node in the original DivideByList is before List.
+ InList = leaf_list([]),
+ OutList = List
+ ;
+ % The range of DBNodesHead contains the range of List.
+ % Dividing List by DBNodesHead is thus the same as
+ % dividing List by the original DivideBySet.
+ (
+ DBHeadComponents = leaf_list(DBHeadLeafNodes),
+ expect(unify(DBLevel, 1), $pred, $module, "DBLevel != 1"),
+ expect(unify(Level, 0), $pred, $module, "Level != 0"),
+ % The other nodes in the original DivideByList are all
+ % outside the range of List.
+ (
+ List = leaf_list(Nodes),
+ leaflist_divide_by_set(DBHeadLeafNodes, Nodes,
+ InNodes, OutNodes),
+ InList = leaf_list(InNodes),
+ OutList = leaf_list(OutNodes)
+ ;
+ List = interior_list(_, _),
+ % divide_by_set_descend_divide_by should have stopped
+ % recursing when it got to Level.
+ unexpected($module, $pred, "List is not leaf_list")
+ )
+ ;
+ DBHeadComponents = interior_list(DBSubLevel, DBSubNodes),
+ expect(unify(DBLevel, DBSubLevel + 1), $pred, $module,
+ "DBLevel != SubLevel + 1"),
+ ( DBSubLevel > Level ->
+ divide_by_set_descend_divide_by(DBSubLevel, DBSubNodes,
+ Level, InitOffset, LimitOffset, List, InList, OutList)
+ ; DBSubLevel = Level ->
+ (
+ List = leaf_list(_),
+ % Since DBHeadComponents is an interior list,
+ % and List is at the same level, it should be
+ % an interior list too.
+ unexpected($module, $pred, "List is leaf_list")
+ ;
+ List = interior_list(_, Nodes),
+ interiorlist_divide_by_set(Level,
+ DBSubNodes, Nodes, InNodes, OutNodes),
+ (
+ InNodes = [],
+ InList = leaf_list([])
+ ;
+ InNodes = [_ | _],
+ InList = interior_list(Level, InNodes)
+ ),
+ (
+ OutNodes = [],
+ OutList = leaf_list([])
+ ;
+ OutNodes = [_ | _],
+ OutList = interior_list(Level, OutNodes)
+ )
+ )
+ ;
+ unexpected($module, $pred, "DBSubLevel > Level")
+ )
+ )
+ )
+ ).
+
+:- pred interiorlist_divide_by_set(int::in,
+ list(interior_node)::in, list(interior_node)::in,
+ list(interior_node)::out, list(interior_node)::out) is det.
+
+interiorlist_divide_by_set(_Level, _DBSubNodes, [], [], []).
+interiorlist_divide_by_set(_Level, [], Nodes @ [_ | _], [], Nodes).
+interiorlist_divide_by_set(Level, DBNodes @ [DBNodesHead | DBNodesTail],
+ Nodes @ [NodesHead | NodesTail], InNodes, OutNodes) :-
+ DBNodesHead = interior_node(DBInitOffset, DBLimitOffset, DBComponents),
+ NodesHead = interior_node(InitOffset, LimitOffset, Components),
+ % Since DBNodesHead and NodesHead are at the same level,
+ % they cover the same region only if their initial and limit offsets
+ % both match.
+ ( DBInitOffset = InitOffset ->
+ expect(unify(DBLimitOffset, LimitOffset), $module, $pred,
+ "DBLimitOffset != LimitOffset"),
+ interiorlist_divide_by_set(Level, DBNodesTail, NodesTail,
+ InNodesTail, OutNodesTail),
+ (
+ DBComponents = leaf_list(DBLeafNodes),
+ Components = leaf_list(LeafNodes),
+ leaflist_divide_by_set(DBLeafNodes, LeafNodes,
+ InLeafNodes, OutLeafNodes),
+ (
+ InLeafNodes = [],
+ InNodes = InNodesTail
+ ;
+ InLeafNodes = [_ | _],
+ InNodesHead = interior_node(InitOffset, LimitOffset,
+ leaf_list(InLeafNodes)),
+ InNodes = [InNodesHead | InNodesTail]
+ ),
+ (
+ OutLeafNodes = [],
+ OutNodes = OutNodesTail
+ ;
+ OutLeafNodes = [_ | _],
+ OutNodesHead = interior_node(InitOffset, LimitOffset,
+ leaf_list(OutLeafNodes)),
+ OutNodes = [OutNodesHead | OutNodesTail]
+ )
+ ;
+ DBComponents = interior_list(_, _),
+ Components = leaf_list(_),
+ unexpected($module, $pred, "DB interior vs leaf")
+ ;
+ DBComponents = leaf_list(_),
+ Components = interior_list(_, _),
+ unexpected($module, $pred, "DB leaf vs interior")
+ ;
+ DBComponents = interior_list(DBSubLevel, DBSubNodes),
+ Components = interior_list(SubLevel, SubNodes),
+ expect(unify(DBSubLevel, SubLevel), $module, $pred,
+ "DBSubLevel != SubLevel"),
+ expect(unify(SubLevel, Level - 1), $module, $pred,
+ "DBSubLevel != SubLevel"),
+ interiorlist_divide_by_set(SubLevel, DBSubNodes, SubNodes,
+ SubInNodes, SubOutNodes),
+ (
+ SubInNodes = [],
+ InNodes = InNodesTail
+ ;
+ SubInNodes = [_ | _],
+ InNodesHead = interior_node(InitOffset, LimitOffset,
+ interior_list(SubLevel, SubInNodes)),
+ InNodes = [InNodesHead | InNodesTail]
+ ),
+ (
+ SubOutNodes = [],
+ OutNodes = OutNodesTail
+ ;
+ SubOutNodes = [_ | _],
+ OutNodesHead = interior_node(InitOffset, LimitOffset,
+ interior_list(SubLevel, SubOutNodes)),
+ OutNodes = [OutNodesHead | OutNodesTail]
+ )
+ )
+ ; DBInitOffset < InitOffset ->
+ % DBNodesHead covers a region that is entirely before the region
+ % covered by Nodes.
+ interiorlist_divide_by_set(Level, DBNodesTail, Nodes,
+ InNodes, OutNodes)
+ ;
+ % NodesHead covers a region that is entirely before the region
+ % covered by DBNodesHead. Therefore all the items in NodesHead
+ % are outside DivideBySet.
+ interiorlist_divide_by_set(Level, DBNodes, NodesTail,
+ InNodes, OutNodesTail),
+ OutNodes = [NodesHead | OutNodesTail]
+ ).
+
+:- pred leaflist_divide_by_set(list(leaf_node)::in, list(leaf_node)::in,
+ list(leaf_node)::out, list(leaf_node)::out) is det.
+
+leaflist_divide_by_set(_, [], [], []).
+leaflist_divide_by_set([], List @ [_ | _], [], List).
+leaflist_divide_by_set(DivideByList @ [DivideByHead | DivideByTail],
+ List @ [ListHead | ListTail], InList, OutList) :-
+ DivideByOffset = DivideByHead ^ leaf_offset,
+ ListOffset = ListHead ^ leaf_offset,
+ ( DivideByOffset = ListOffset ->
+ ListHeadBits = ListHead ^ leaf_bits,
+ DivideByHeadBits = DivideByHead ^ leaf_bits,
+ InBits = ListHeadBits /\ DivideByHeadBits,
+ OutBits = ListHeadBits /\ \ DivideByHeadBits,
+ ( InBits = 0 ->
+ ( OutBits = 0 ->
+ leaflist_divide_by_set(DivideByTail, ListTail, InList, OutList)
+ ;
+ NewOutNode = make_leaf_node(ListOffset, OutBits),
+ leaflist_divide_by_set(DivideByTail, ListTail,
+ InList, OutTail),
+ OutList = [NewOutNode | OutTail]
+ )
+ ;
+ NewInNode = make_leaf_node(ListOffset, InBits),
+ ( OutBits = 0 ->
+ leaflist_divide_by_set(DivideByTail, ListTail,
+ InTail, OutList),
+ InList = [NewInNode | InTail]
+ ;
+ NewOutNode = make_leaf_node(ListOffset, OutBits),
+ leaflist_divide_by_set(DivideByTail, ListTail,
+ InTail, OutTail),
+ InList = [NewInNode | InTail],
+ OutList = [NewOutNode | OutTail]
+ )
+ )
+ ; DivideByOffset < ListOffset ->
+ leaflist_divide_by_set(DivideByTail, List, InList, OutList)
+ ;
+ leaflist_divide_by_set(DivideByList, ListTail, InList, OutTail),
+ OutList = [ListHead | OutTail]
+ ).
-% This is the beginning of a more efficient version of divide_by_set.
-% divide_by_set(DivideBySet, Set, InSet, OutSet) :-
-% DivideBySet = tree_bitset(DivideByList),
-% Set = tree_bitset(List),
% % Our basic approach of raising both operands to the same level simplifies
% % the code (by allowing the reuse of the basic pattern and the helper
% % predicates of the union predicate), but searching the larger set for the
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.425
diff -u -b -r1.425 Mmakefile
--- tests/hard_coded/Mmakefile 13 Feb 2012 00:11:56 -0000 1.425
+++ tests/hard_coded/Mmakefile 28 Mar 2012 17:52:47 -0000
@@ -289,7 +289,6 @@
term_io_test \
term_to_univ_test \
test234_sorted_insert \
- test_bitset \
test_cord \
test_imported_no_tag \
test_keys_and_values \
@@ -306,7 +305,6 @@
trace_goal_4 \
transform_value \
transitive_inst_type \
- tree_bitset_difference \
trigraphs \
tuple_test \
type_ctor_desc \
Index: tests/hard_coded/test_bitset.exp
===================================================================
RCS file: tests/hard_coded/test_bitset.exp
diff -N tests/hard_coded/test_bitset.exp
--- tests/hard_coded/test_bitset.exp 26 Sep 2002 06:11:39 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,90 +0,0 @@
-List1: -59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 39, 40, 42, 44, 47, 58, 59
-
-List2: -64, -61, -58, -56, -51, -49, -48, -46, -44, -40, -38, -37, -31, -30, -23, -18, -13, -4, -2, 4, 9, 11, 12, 14, 17, 21, 23, 37, 39, 42, 43, 50, 52, 53, 54, 55, 56, 57, 61, 63
-
-testing count
-count: 22 40
-testing foldl
-Sum of List1 = 471
-Sum of List2 = 60
-testing union
-[-64, -61, -59, -58, -56, -51, -49, -48, -46, -44, -40, -38, -37, -34, -31, -30, -23, -19, -18, -15, -13, -4, -2, 2, 4, 7, 9, 11, 12, 14, 17, 19, 21, 22, 23, 25, 28, 29, 31, 32, 36, 37, 38, 39, 40, 42, 43, 44, 47, 50, 52, 53, 54, 55, 56, 57, 58, 59, 61, 63]
-testing intersection
-[39, 42]
-testing difference
-[-59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 40, 44, 47, 58, 59]
-testing remove_least_element
--59
-[-34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 39, 40, 42, 44, 47, 58, 59]
-testing delete_list
-[-59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 40, 44, 47, 58, 59]
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
-testing count
-testing foldl
-testing union
-testing intersection
-testing difference
-testing remove_least_element
-testing delete_list
Index: tests/hard_coded/test_bitset.m
===================================================================
RCS file: tests/hard_coded/test_bitset.m
diff -N tests/hard_coded/test_bitset.m
--- tests/hard_coded/test_bitset.m 26 Sep 2002 06:11:39 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,159 +0,0 @@
-:- module test_bitset.
-
-:- interface.
-
-:- import_module io.
-
-:- pred main(io__state::di, io__state::uo) is det.
-
-:- implementation.
-
-:- import_module bool, enum, int, list, bitset_tester, random, require.
-
-:- func list1 = list(int).
-
-list1 = [29, 28, 31, 22, -15, 32, 19, 58, -59, 36, 7, 39, 42,
- -34, 25, 40, 59, 2, -19, 44, 47, 38].
-
-:- func list2 = list(int).
-
-list2 = [21, 52, 23, -18, -23, 56, 11, -46, 61, -4, 63, 54, 17, -64,
- -13, -38, 37, 4, 39, -2, 57, -56, -37, -30, -51, 12, -49,
- -58, -31, -48, -61, 42, 53, -44, 55, 14, 9, -40, 43, 50].
-
-main -->
- % Run one lot of tests with known input lists,
- % to generate some visible output.
- { Write = yes },
- run_test(Write, list1, list2),
-
- % Run some more tests with random input, checking
- % the output against that of set_ordlist.
- { Iterations = 10 },
- { random__init(1, Supply) },
- run_tests(Iterations, Supply).
-
-:- pred run_tests(int::in, random__supply::mdi,
- io__state::di, io__state::uo) is det.
-
-run_tests(Iterations, Supply0) -->
- ( { Iterations = 0 } ->
- []
- ;
- { Num1 = 20 },
- { get_random_numbers(Num1, [], List1, Supply0, Supply1) },
- { Num2 = 40 },
- { get_random_numbers(Num2, [], List2, Supply1, Supply) },
-
- { Write = no },
- run_test(Write, List1, List2),
-
-
- run_tests(Iterations - 1, Supply)
- ).
-
-:- pred get_random_numbers(int::in, list(int)::in, list(int)::out,
- random__supply::mdi, random__supply::muo) is det.
-
-get_random_numbers(Num, List0, List, Supply0, Supply) :-
- ( Num = 0 ->
- List = List0,
- Supply = Supply0
- ;
- % Test negative as well as positive numbers.
- random__random(-64, 128, RN, Supply0, Supply1),
- get_random_numbers(Num - 1, [RN | List0], List,
- Supply1, Supply)
- ).
-
-:- pred run_test(bool::in, list(int)::in, list(int)::in,
- io__state::di, io__state::uo) is det.
-
-run_test(Write, List1, List2) -->
- ( { Write = yes } ->
- io__write_string("List1: "),
- io__write_list(list__sort(List1), ", ", io__write_int),
- io__nl, io__nl,
- io__write_string("List2: "),
- io__write_list(list__sort(List2), ", ", io__write_int),
- io__nl, io__nl
- ;
- []
- ),
- { Set1 = bitset_tester__list_to_set(List1) },
- { Set2 = bitset_tester__list_to_set(List2) },
-
- io__write_string("testing count\n"),
- { Count1 = count(Set1) },
- { Count2 = count(Set2) },
- ( { Write = yes } ->
- io__write_string("count: "),
- io__write_int(Count1),
- io__write_string(" "),
- io__write_int(Count2),
- io__nl
- ;
- []
- ),
-
- io__write_string("testing foldl\n"),
- { Sum = (func(Elem, Acc) = Elem + Acc) },
- { Result1 = foldl(Sum, Set1, 0) },
- { Result2 = foldl(Sum, Set2, 0) },
- ( { Write = yes } ->
- io__write_string("Sum of List1 = "),
- io__write_int(Result1),
- io__nl,
- io__write_string("Sum of List2 = "),
- io__write_int(Result2),
- io__nl
- ;
- []
- ),
-
- io__write_string("testing union\n"),
- { Union = union(Set1, Set2) },
- write_bitset_result(Write, Union),
-
- io__write_string("testing intersection\n"),
- { Intersection = intersect(Set1, Set2) },
- write_bitset_result(Write, Intersection),
-
- io__write_string("testing difference\n"),
- { Difference = difference(Set1, Set2) },
- write_bitset_result(Write, Difference),
-
- io__write_string("testing remove_least_element\n"),
- ( { remove_least(Set1, Least, RemovedLeast) } ->
- ( { Write = yes } ->
- io__write_int(Least),
- io__nl
- ;
- []
- ),
- write_bitset_result(Write, RemovedLeast)
- ;
- { error("remove_least failed") }
- ),
-
- io__write_string("testing delete_list\n"),
- { Delete = delete_list(Set1, List2) },
- write_bitset_result(Write, Delete),
-
- { require(unify(delete_list(Set1, List1),
- init `with_type` bitset_tester(int)),
- "delete_list_failed") }.
-
-:- pred write_bitset_result(bool::in, bitset_tester(int)::in,
- io__state::di, io__state::uo) is det.
-:- pragma no_inline(write_bitset_result/4).
-
-write_bitset_result(Write, Set) -->
- ( { Write = yes } ->
- { List `with_type` list(int) = to_sorted_list(Set) },
- io__write(List),
- io__nl
- ;
- []
- ).
-
Index: tests/hard_coded/test_tree_bitset.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/test_tree_bitset.exp,v
retrieving revision 1.2
diff -u -b -r1.2 test_tree_bitset.exp
--- tests/hard_coded/test_tree_bitset.exp 10 Aug 2011 05:11:57 -0000 1.2
+++ tests/hard_coded/test_tree_bitset.exp 28 Mar 2012 19:29:06 -0000
@@ -1,5 +1,5 @@
-List1: 2, 7, 15, 19, 19, 22, 25, 28, 29, 31, 32, 34, 36, 38, 39, 40, 42, 44, 47, 58, 59, 59
+List1: 2, 7, 15, 19, 19, 22, 25, 28, 29, 31, 32, 34, 36, 38, 39, 40, 42, 44, 47, 58, 59, 59
List2: 2, 4, 4, 9, 11, 12, 13, 14, 17, 18, 21, 23, 23, 30, 31, 37, 37, 38, 39, 40, 42, 43, 44, 46, 48, 49, 50, 51, 52, 53, 54, 55, 56, 56, 57, 58, 61, 61, 63, 64
testing count
@@ -13,78 +13,501 @@
[2, 31, 38, 39, 40, 42, 44, 58]
testing difference
[7, 15, 19, 22, 25, 28, 29, 32, 34, 36, 47, 59]
-testing remove_least_element
+testing remove_least
2
[7, 15, 19, 22, 25, 28, 29, 31, 32, 34, 36, 38, 39, 40, 42, 44, 47, 58, 59]
testing delete_list
[7, 15, 19, 22, 25, 28, 29, 32, 34, 36, 47, 59]
+testing divide_by_set
+[2, 31, 38, 39, 40, 42, 44, 58]
+[4, 9, 11, 12, 13, 14, 17, 18, 21, 23, 30, 37, 43, 46, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 61, 63, 64]
+
+List1: 532, 32431
+List2: 32794
+
+testing count
+count: 2 1
+testing foldl
+Sum of List1 = 32963
+Sum of List2 = 32794
+testing union
+[532, 32431, 32794]
+testing intersection
+[]
+testing difference
+[532, 32431]
+testing remove_least
+532
+[32431]
+testing delete_list
+[532, 32431]
+testing divide_by_set
+[]
+[32794]
+
+List1: 1064, 64862
+List2: 65588
+
+testing count
+count: 2 1
+testing foldl
+Sum of List1 = 65926
+Sum of List2 = 65588
+testing union
+[1064, 64862, 65588]
+testing intersection
+[]
+testing difference
+[1064, 64862]
+testing remove_least
+1064
+[64862]
+testing delete_list
+[1064, 64862]
+testing divide_by_set
+[]
+[65588]
+
+List1: 1, 29424
+List2: 1, 2, 3, 35701
+
+testing count
+count: 2 4
+testing foldl
+Sum of List1 = 29425
+Sum of List2 = 35707
+testing union
+[1, 2, 3, 29424, 35701]
+testing intersection
+[1]
+testing difference
+[29424]
+testing remove_least
+1
+[29424]
+testing delete_list
+[29424]
+testing divide_by_set
+[1]
+[2, 3, 35701]
+
+List1: 2, 58848
+List2: 2, 4, 6, 71402
+
+testing count
+count: 2 4
+testing foldl
+Sum of List1 = 58850
+Sum of List2 = 71414
+testing union
+[2, 4, 6, 58848, 71402]
+testing intersection
+[2]
+testing difference
+[58848]
+testing remove_least
+2
+[58848]
+testing delete_list
+[58848]
+testing divide_by_set
+[2]
+[4, 6, 71402]
+
+List1: 1
+List2: 2, 35701
+
+testing count
+count: 1 2
+testing foldl
+Sum of List1 = 1
+Sum of List2 = 35703
+testing union
+[1, 2, 35701]
+testing intersection
+[]
+testing difference
+[1]
+testing remove_least
+1
+[]
+testing delete_list
+[1]
+testing divide_by_set
+[]
+[2, 35701]
+
+List1: 2
+List2: 4, 71402
+
+testing count
+count: 1 2
+testing foldl
+Sum of List1 = 2
+Sum of List2 = 71406
+testing union
+[2, 4, 71402]
+testing intersection
+[]
+testing difference
+[2]
+testing remove_least
+2
+[]
+testing delete_list
+[2]
+testing divide_by_set
+[]
+[4, 71402]
+
+List1: 101, 102
+List2: 1, 2, 3, 35699, 35700, 35701
+
+testing count
+count: 2 6
+testing foldl
+Sum of List1 = 203
+Sum of List2 = 107106
+testing union
+[1, 2, 3, 101, 102, 35699, 35700, 35701]
+testing intersection
+[]
+testing difference
+[101, 102]
+testing remove_least
+101
+[102]
+testing delete_list
+[101, 102]
+testing divide_by_set
+[]
+[1, 2, 3, 35699, 35700, 35701]
+
+List1: 202, 204
+List2: 2, 4, 6, 71398, 71400, 71402
+
+testing count
+count: 2 6
+testing foldl
+Sum of List1 = 406
+Sum of List2 = 214212
+testing union
+[2, 4, 6, 202, 204, 71398, 71400, 71402]
+testing intersection
+[]
+testing difference
+[202, 204]
+testing remove_least
+202
+[204]
+testing delete_list
+[202, 204]
+testing divide_by_set
+[]
+[2, 4, 6, 71398, 71400, 71402]
+
+List1: 35702, 35703, 35705, 36696
+List2: 1, 2, 3, 33416, 334283
+
+testing count
+count: 4 5
+testing foldl
+Sum of List1 = 143806
+Sum of List2 = 367705
+testing union
+[1, 2, 3, 33416, 35702, 35703, 35705, 36696, 334283]
+testing intersection
+[]
+testing difference
+[35702, 35703, 35705, 36696]
+testing remove_least
+35702
+[35703, 35705, 36696]
+testing delete_list
+[35702, 35703, 35705, 36696]
+testing divide_by_set
+[]
+[1, 2, 3, 33416, 334283]
+
+List1: 71404, 71406, 71410, 73392
+List2: 2, 4, 6, 66832, 668566
+
+testing count
+count: 4 5
+testing foldl
+Sum of List1 = 287612
+Sum of List2 = 735410
+testing union
+[2, 4, 6, 66832, 71404, 71406, 71410, 73392, 668566]
+testing intersection
+[]
+testing difference
+[71404, 71406, 71410, 73392]
+testing remove_least
+71404
+[71406, 71410, 73392]
+testing delete_list
+[71404, 71406, 71410, 73392]
+testing divide_by_set
+[]
+[2, 4, 6, 66832, 668566]
+
+List1:
+List2: 2
+
+testing count
+count: 0 1
+testing foldl
+Sum of List1 = 0
+Sum of List2 = 2
+testing union
+[2]
+testing intersection
+[]
+testing difference
+[]
+testing remove_least
+call failed
+testing delete_list
+[]
+testing divide_by_set
+[]
+[2]
+
+List1:
+List2: 4
+
+testing count
+count: 0 1
+testing foldl
+Sum of List1 = 0
+Sum of List2 = 4
+testing union
+[4]
+testing intersection
+[]
+testing difference
+[]
+testing remove_least
+call failed
+testing delete_list
+[]
+testing divide_by_set
+[]
+[4]
+
+List1:
+List2: 2, 35701
+
+testing count
+count: 0 2
+testing foldl
+Sum of List1 = 0
+Sum of List2 = 35703
+testing union
+[2, 35701]
+testing intersection
+[]
+testing difference
+[]
+testing remove_least
+call failed
+testing delete_list
+[]
+testing divide_by_set
+[]
+[2, 35701]
+
+List1:
+List2: 4, 71402
+
+testing count
+count: 0 2
+testing foldl
+Sum of List1 = 0
+Sum of List2 = 71406
+testing union
+[4, 71402]
+testing intersection
+[]
+testing difference
+[]
+testing remove_least
+call failed
+testing delete_list
+[]
+testing divide_by_set
+[]
+[4, 71402]
+
+List1: 2
+List2:
+
+testing count
+count: 1 0
+testing foldl
+Sum of List1 = 2
+Sum of List2 = 0
+testing union
+[2]
+testing intersection
+[]
+testing difference
+[2]
+testing remove_least
+2
+[]
+testing delete_list
+[2]
+testing divide_by_set
+[]
+[]
+
+List1: 4
+List2:
+
+testing count
+count: 1 0
+testing foldl
+Sum of List1 = 4
+Sum of List2 = 0
+testing union
+[4]
+testing intersection
+[]
+testing difference
+[4]
+testing remove_least
+4
+[]
+testing delete_list
+[4]
+testing divide_by_set
+[]
+[]
+
+List1: 2, 35701
+List2:
+
+testing count
+count: 2 0
+testing foldl
+Sum of List1 = 35703
+Sum of List2 = 0
+testing union
+[2, 35701]
+testing intersection
+[]
+testing difference
+[2, 35701]
+testing remove_least
+2
+[35701]
+testing delete_list
+[2, 35701]
+testing divide_by_set
+[]
+[]
+
+List1: 4, 71402
+List2:
+
+testing count
+count: 2 0
+testing foldl
+Sum of List1 = 71406
+Sum of List2 = 0
+testing union
+[4, 71402]
+testing intersection
+[]
+testing difference
+[4, 71402]
+testing remove_least
+4
+[71402]
+testing delete_list
+[4, 71402]
+testing divide_by_set
+[]
+[]
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
testing count
testing foldl
testing union
testing intersection
testing difference
-testing remove_least_element
+testing remove_least
testing delete_list
+testing divide_by_set
Index: tests/hard_coded/test_tree_bitset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/test_tree_bitset.m,v
retrieving revision 1.2
diff -u -b -r1.2 test_tree_bitset.m
--- tests/hard_coded/test_tree_bitset.m 10 Aug 2011 05:11:57 -0000 1.2
+++ tests/hard_coded/test_tree_bitset.m 28 Mar 2012 11:58:08 -0000
@@ -1,4 +1,6 @@
-% vim: ts=4 sw=4 ft=mercury
+%----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%----------------------------------------------------------------------------%
:- module test_tree_bitset.
@@ -10,54 +12,113 @@
:- implementation.
-:- import_module tree_bitset_tester.
+:- import_module test_bitset.
:- import_module bool.
:- import_module enum.
:- import_module int.
:- import_module list.
+:- import_module pair.
:- import_module random.
:- import_module require.
+%----------------------------------------------------------------------------%
+
+:- type maybe_double
+ ---> do_not_double
+ ; do_double.
+
+:- type maybe_write
+ ---> do_not_write
+ ; do_write.
+
+:- type which_test
+ ---> test_count
+ ; test_foldl
+ ; test_union
+ ; test_intersection
+ ; test_difference
+ ; test_remove_least
+ ; test_delete_list
+ ; test_divide_by_set
+ ; test_all.
+
+%----------------------------------------------------------------------------%
+
:- func list1 = list(int).
-list1 = [29, 28, 31, 22, 15, 32, 19, 58, 59, 36, 7, 39, 42,
+list1 =
+ [29, 28, 31, 22, 15, 32, 19, 58, 59, 36, 7, 39, 42,
34, 25, 40, 59, 2, 19, 44, 47, 38].
:- func list2 = list(int).
-list2 = [21, 52, 23, 18, 23, 56, 11, 46, 61, 4, 63, 54, 17, 64,
+list2 =
+ [21, 52, 23, 18, 23, 56, 11, 46, 61, 4, 63, 54, 17, 64,
13, 38, 37, 4, 39, 2, 57, 56, 37, 30, 51, 12, 49,
58, 31, 48, 61, 42, 53, 44, 55, 14, 9, 40, 43, 50].
main(!IO) :-
+ % This control makes it easy to test only a specific operation being
+ % being worked on.
+ WhichTest = test_all,
+
+ SimpleTest = list1 - list2,
+ StressTests = [
+ % The values of X and Y on 32 bit machines (or 2X and 2Y on 64 bit
+ % machines) are intended to end up in near the start and the end
+ % of one interior node, while Z (or 2Z) ends up near the start of
+ % the next interior node. These stress tests were derived from a bug
+ % in the implementation of the difference operation. The bug was in
+ % how the difference operation handled interior nodes at the same level
+ % but not at the same starting address.
+
+ [532, 32431] - [32794],
+ [1, 29424] - [1, 2, 3, 35701],
+ [1] - [2, 35701],
+ [101, 102] - [1, 2, 3, 35699, 35700, 35701],
+ [36696, 35702, 35703, 35705] -
+ [1, 2, 3, 33416, 334283],
+
+ % These test the handling of empty sets, which several operations
+ % handle with special case code.
+ [] - [2],
+ [] - [2, 35701],
+ [2] - [],
+ [2, 35701] - []
+ ],
+
% Run one lot of tests with known input lists,
% to generate some visible output.
- Write = yes,
- run_test(Write, list1, list2, !IO),
+ run_test(do_not_double, do_write, WhichTest, SimpleTest, !IO),
+ run_tests(do_double, do_write, WhichTest, StressTests, !IO),
- % Run some more tests with random input, checking
- % the output against that of set_ordlist.
- % XXX this is wholly inadequate
+ % Run some more tests with random input, checking the output against the
+ % output of the corresponding predicatess in set_ordlist.
+ % XXX Ten runs with small input sets is not a rigourous test.
Iterations = 10,
+ List1Size = 20,
+ List2Size = 40,
random.init(1, Supply),
- run_tests(Iterations, Supply, !IO).
+ run_random_tests(Iterations, List1Size, List2Size, WhichTest, Supply, !IO).
-:- pred run_tests(int::in, random.supply::mdi, io::di, io::uo) is det.
+%----------------------------------------------------------------------------%
-run_tests(Iterations, Supply0, !IO) :-
+:- pred run_random_tests(int::in, int::in, int::in, which_test::in,
+ random.supply::mdi, io::di, io::uo) is det.
+
+run_random_tests(Iterations, List1Size, List2Size, WhichTest, !.Supply, !IO) :-
( Iterations = 0 ->
true
;
- Num1 = 20,
- get_random_numbers(Num1, [], List1, Supply0, Supply1),
- Num2 = 40,
- get_random_numbers(Num2, [], List2, Supply1, Supply),
-
- Write = no,
- run_test(Write, List1, List2, !IO),
+ get_random_numbers(List1Size, [], List1, !Supply),
+ get_random_numbers(List2Size, [], List2, !Supply),
+ % We cannot write out the random tests, since we cannot anticipate
+ % the random numbers in the .exp file.
+ run_test(do_not_double, do_not_write, WhichTest, List1 - List2, !IO),
- run_tests(Iterations - 1, Supply, !IO)
+ run_random_tests(Iterations - 1, List1Size, List2Size, WhichTest,
+ !.Supply, !IO)
).
:- pred get_random_numbers(int::in, list(int)::in, list(int)::out,
@@ -68,50 +129,94 @@
List = List0,
Supply = Supply0
;
- random.random(0, 256, RN, Supply0, Supply1),
+ % 1048576 = 2^20
+ random.random(0, 1048576, RN, Supply0, Supply1),
get_random_numbers(Num - 1, [RN | List0], List, Supply1, Supply)
).
-:- pred run_test(bool::in, list(int)::in, list(int)::in,
- io::di, io::uo) is det.
+%----------------------------------------------------------------------------%
-run_test(Write, List1, List2, !IO) :-
+:- pred run_tests(maybe_double::in, maybe_write::in, which_test::in,
+ list(pair(list(int), list(int)))::in, io::di, io::uo) is det.
+
+run_tests(_Double, _Write, _WhichTest, [], !IO).
+run_tests(Double, Write, WhichTest, [Test | Tests], !IO) :-
+ run_test(Double, Write, WhichTest, Test, !IO),
+ run_tests(Double, Write, WhichTest, Tests, !IO).
+
+:- pred run_test(maybe_double::in, maybe_write::in, which_test::in,
+ pair(list(int), list(int))::in, io::di, io::uo) is det.
+
+run_test(Double, Write, WhichTest, List1 - List2, !IO) :-
+ do_run_test(Write, WhichTest, List1 - List2, !IO),
(
- Write = yes,
+ Double = do_not_double
+ ;
+ Double = do_double,
+ DoubleList1 = list.map(double, List1),
+ DoubleList2 = list.map(double, List2),
+ do_run_test(Write, WhichTest, DoubleList1 - DoubleList2, !IO)
+ ).
+
+:- func double(int) = int.
+
+double(X) = 2 * X.
+
+%----------------------------------------------------------------------------%
+
+:- pred do_run_test(maybe_write::in, which_test::in,
+ pair(list(int), list(int))::in, io::di, io::uo) is det.
+
+do_run_test(Write, WhichTest, List1 - List2, !IO) :-
+ (
+ Write = do_write,
+ io.nl(!IO),
io.write_string("List1: ", !IO),
io.write_list(list.sort(List1), ", ", io.write_int, !IO),
io.nl(!IO),
- io.nl(!IO),
io.write_string("List2: ", !IO),
io.write_list(list.sort(List2), ", ", io.write_int, !IO),
io.nl(!IO),
io.nl(!IO)
;
- Write = no
+ Write = do_not_write
),
- Set1 = tree_bitset_tester.list_to_set(List1),
- Set2 = tree_bitset_tester.list_to_set(List2),
+ Set1 = test_bitset.list_to_set(List1),
+ Set2 = test_bitset.list_to_set(List2),
+ (
+ ( WhichTest = test_count
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing count\n", !IO),
- Count1 = count(Set1),
- Count2 = count(Set2),
+ Count1 = test_bitset.count(Set1),
+ Count2 = test_bitset.count(Set2),
(
- Write = yes,
+ Write = do_write,
io.write_string("count: ", !IO),
io.write_int(Count1, !IO),
io.write_string(" ", !IO),
io.write_int(Count2, !IO),
io.nl(!IO)
;
- Write = no
+ Write = do_not_write
+ )
+ ;
+ true
),
+ (
+ ( WhichTest = test_foldl
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing foldl\n", !IO),
Sum = (func(Elem, Acc) = Elem + Acc),
- Result1 = foldl(Sum, Set1, 0),
- Result2 = foldl(Sum, Set2, 0),
+ Result1 = test_bitset.foldl(Sum, Set1, 0),
+ Result2 = test_bitset.foldl(Sum, Set2, 0),
(
- Write = yes,
+ Write = do_write,
io.write_string("Sum of List1 = ", !IO),
io.write_int(Result1, !IO),
io.nl(!IO),
@@ -119,53 +224,118 @@
io.write_int(Result2, !IO),
io.nl(!IO)
;
- Write = no
+ Write = do_not_write
+ )
+ ;
+ true
),
+ (
+ ( WhichTest = test_union
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing union\n", !IO),
- Union = union(Set1, Set2),
- write_bitset_result(Write, Union, !IO),
+ Union = test_bitset.union(Set1, Set2),
+ maybe_write_bitset(Write, Union, !IO)
+ ;
+ true
+ ),
+ (
+ ( WhichTest = test_intersection
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing intersection\n", !IO),
- Intersection = intersect(Set1, Set2),
- write_bitset_result(Write, Intersection, !IO),
+ Intersection = test_bitset.intersect(Set1, Set2),
+ maybe_write_bitset(Write, Intersection, !IO)
+ ;
+ true
+ ),
+ (
+ ( WhichTest = test_difference
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing difference\n", !IO),
- Difference = difference(Set1, Set2),
- write_bitset_result(Write, Difference, !IO),
+ Difference = test_bitset.difference(Set1, Set2),
+ maybe_write_bitset(Write, Difference, !IO)
+ ;
+ true
+ ),
- io.write_string("testing remove_least_element\n", !IO),
- ( remove_least(Set1, Least, RemovedLeast) ->
(
- Write = yes,
+ ( WhichTest = test_remove_least
+ ; WhichTest = test_all
+ )
+ ->
+ io.write_string("testing remove_least\n", !IO),
+ ( test_bitset.remove_least(Least, Set1, RemovedLeast) ->
+ (
+ Write = do_write,
io.write_int(Least, !IO),
io.nl(!IO)
;
- Write = no
+ Write = do_not_write
),
- write_bitset_result(Write, RemovedLeast, !IO)
+ maybe_write_bitset(Write, RemovedLeast, !IO)
+ ;
+ (
+ Write = do_write,
+ io.write_string("call failed\n", !IO)
;
- error("remove_least failed")
+ Write = do_not_write
+ )
+ )
+ ;
+ true
),
+ (
+ ( WhichTest = test_delete_list
+ ; WhichTest = test_all
+ )
+ ->
io.write_string("testing delete_list\n", !IO),
- Delete = delete_list(Set1, List2),
- write_bitset_result(Write, Delete, !IO),
+ test_bitset.delete_list(List2, Set1, Delete2From1),
+ maybe_write_bitset(Write, Delete2From1, !IO),
- require(unify(delete_list(Set1, List1),
- init : tree_bitset_tester.bitset_tester(int)),
- "delete_list_failed").
+ test_bitset.delete_list(List1, Set1, Delete1From1),
+ test_bitset.init(Empty),
+ require(unify(Delete1From1, Empty), "Delete1From1 is not empty")
+ ;
+ true
+ ),
-:- pred write_bitset_result(bool::in, bitset_tester(int)::in,
+ (
+ ( WhichTest = test_divide_by_set
+ ; WhichTest = test_all
+ )
+ ->
+ io.write_string("testing divide_by_set\n", !IO),
+ test_bitset.divide_by_set(Set1, Set2, InSet, OutSet),
+ maybe_write_bitset(Write, InSet, !IO),
+ maybe_write_bitset(Write, OutSet, !IO)
+ ;
+ true
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred maybe_write_bitset(maybe_write::in, test_bitset(int)::in,
io::di, io::uo) is det.
-:- pragma no_inline(write_bitset_result/4).
+:- pragma no_inline(maybe_write_bitset/4).
-write_bitset_result(Write, Set, !IO) :-
+maybe_write_bitset(Write, Set, !IO) :-
(
- Write = yes,
- List `with_type` list(int) = to_sorted_list(Set),
+ Write = do_write,
+ test_bitset.to_sorted_list(Set, List),
io.write(List, !IO),
io.nl(!IO)
;
- Write = no
+ Write = do_not_write
).
+
+%----------------------------------------------------------------------------%
Index: tests/hard_coded/tree_bitset_difference.exp
===================================================================
RCS file: tests/hard_coded/tree_bitset_difference.exp
diff -N tests/hard_coded/tree_bitset_difference.exp
Index: tests/hard_coded/tree_bitset_difference.m
===================================================================
RCS file: tests/hard_coded/tree_bitset_difference.m
diff -N tests/hard_coded/tree_bitset_difference.m
--- tests/hard_coded/tree_bitset_difference.m 4 Aug 2011 02:01:39 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,83 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% This is a regression test for Mantis bug #207.
-%-----------------------------------------------------------------------------%
-
-:- module tree_bitset_difference.
-:- interface.
-
-:- import_module io.
-
-:- pred main(io::di, io::uo) is det.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module int.
-:- import_module list.
-:- import_module pair.
-:- import_module set.
-:- import_module tree_bitset.
-
-%-----------------------------------------------------------------------------%
-
-main(!IO) :-
- Tests = [
- % The values of X and Y (or 2X and 2Y) are intended to end up
- % in near the start and the end of one interior node, while Z (or 2Z)
- % ends up near the start of the next interior node. The bug was in how
- % the difference operation handled interior nodes at the same level
- % but not at the same starting address.
-
- [532, 32431] - [32794],
- [1, 29424] - [1, 2, 3, 35701],
- [1] - [2, 35701],
- [101, 102] - [1, 2, 3, 35699, 35700, 35701],
- [36696, 35702, 35703, 35705] -
- [1, 2, 3, 33416, 334283]
- ],
- list.foldl(test_32_64, Tests, !IO).
-
-:- pred test_32_64(pair(list(int), list(int))::in, io::di, io::uo) is det.
-
-test_32_64(ListA - ListB, !IO) :-
- test(ListA, ListB, !IO),
- test(list.map(double, ListA), list.map(double, ListB), !IO).
-
-:- func double(int) = int.
-
-double(X) = 2 * X.
-
-:- pred test(list(int)::in, list(int)::in, io::di, io::uo) is det.
-
-test(ListA, ListB, !IO) :-
- SetA = set.from_list(ListA),
- SetB = set.from_list(ListB),
- set.difference(SetA, SetB, SetC),
- set.to_sorted_list(SetC, ListC_set),
-
- BitSetA = tree_bitset.list_to_set(ListA),
- BitSetB = tree_bitset.list_to_set(ListB),
- tree_bitset.difference(BitSetA, BitSetB, BitSetC),
- ListC_bitset = tree_bitset.to_sorted_list(BitSetC),
-
- ( ListC_set = ListC_bitset ->
- true
- ;
- io.write_string("DIFFERENCE:\n", !IO),
- io.write_string("list A: ", !IO),
- io.write(ListA, !IO),
- io.nl(!IO),
- io.write_string("list B: ", !IO),
- io.write(ListB, !IO),
- io.nl(!IO),
- io.write_string("set difference: ", !IO),
- io.write(ListC_set, !IO),
- io.nl(!IO),
- io.write_string("tree_bitset difference: ", !IO),
- io.write(ListC_bitset, !IO),
- io.nl(!IO)
- ).
Index: tests/hard_coded/tree_bitset_tester.m
===================================================================
RCS file: tests/hard_coded/tree_bitset_tester.m
diff -N tests/hard_coded/tree_bitset_tester.m
--- tests/hard_coded/tree_bitset_tester.m 10 Aug 2011 05:11:57 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,339 +0,0 @@
-% vim: ts=4 sw=4 ft=mercury
-%
-% Test operations on tree_bitsets by comparing the output with the output
-% from an ordinary set.
-
-:- module tree_bitset_tester.
-
-:- interface.
-
-:- import_module enum.
-:- import_module list.
-
-:- type bitset_tester(T).
-
-:- type bitset_error(T)
- ---> one_argument(
- string,
- bitset_tester(T),
- bitset_tester(T)
- )
- ; two_arguments(
- string,
- bitset_tester(T),
- bitset_tester(T),
- bitset_tester(T)
- ).
-
-:- func init = bitset_tester(T).
-:- func insert(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
-:- func insert_list(bitset_tester(T), list(T)) = bitset_tester(T) <= enum(T).
-:- func list_to_set(list(T)) = bitset_tester(T) <= enum(T).
-:- func sorted_list_to_set(list(T)) = bitset_tester(T) <= enum(T).
-:- func delete(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
-:- func delete_list(bitset_tester(T), list(T)) = bitset_tester(T) <= enum(T).
-:- func remove(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
-:- mode remove(in, in) = out is semidet.
-:- func remove_list(bitset_tester(T), list(T)) = bitset_tester(T) <= enum(T).
-:- mode remove_list(in, in) = out is semidet.
-
-:- func to_sorted_list(bitset_tester(T)) = list(T) <= enum(T).
-
-:- func singleton_set(T) = bitset_tester(T) <= enum(T).
-
-:- func union(bitset_tester(T), bitset_tester(T)) = bitset_tester(T)
- <= enum(T).
-:- func intersect(bitset_tester(T), bitset_tester(T)) = bitset_tester(T)
- <= enum(T).
-:- func difference(bitset_tester(T), bitset_tester(T)) = bitset_tester(T)
- <= enum(T).
-
-:- pred remove_least(bitset_tester(T), T, bitset_tester(T)) <= enum(T).
-:- mode remove_least(in, out, out) is semidet.
-
-:- pred subset(bitset_tester(T), bitset_tester(T)).
-:- mode subset(in, in) is semidet.
-
-:- pred superset(bitset_tester(T), bitset_tester(T)).
-:- mode superset(in, in) is semidet.
-
-:- func count(bitset_tester(T)) = int <= enum(T).
-
-:- func foldl(func(T, U) = U, bitset_tester(T), U) = U <= enum(T).
-
-:- pred empty(bitset_tester(T)).
-:- mode empty(in) is semidet.
-
-:- pred contains(bitset_tester(T)::in, T::in) is semidet <= enum(T).
-
-:- pred init(bitset_tester(T)::out) is det.
-:- pred singleton_set(bitset_tester(T)::out, T::in) is det <= enum(T).
-
-:- pred list_to_set(list(T)::in, bitset_tester(T)::out) is det <= enum(T).
-:- pred sorted_list_to_set(list(T)::in, bitset_tester(T)::out) is det
- <= enum(T).
-:- pred to_sorted_list(bitset_tester(T)::in, list(T)::out) is det <= enum(T).
-:- pred insert(bitset_tester(T)::in, T::in, bitset_tester(T)::out) is det
- <= enum(T).
-:- pred insert_list(bitset_tester(T)::in, list(T)::in, bitset_tester(T)::out)
- is det <= enum(T).
-:- pred delete(bitset_tester(T)::in, T::in, bitset_tester(T)::out) is det
- <= enum(T).
-:- pred delete_list(bitset_tester(T)::in, list(T)::in, bitset_tester(T)::out)
- is det <= enum(T).
-:- pred union(bitset_tester(T)::in, bitset_tester(T)::in,
- bitset_tester(T)::out) is det <= enum(T).
-:- pred intersect(bitset_tester(T)::in, bitset_tester(T)::in,
- bitset_tester(T)::out) is det <= enum(T).
-:- pred difference(bitset_tester(T)::in, bitset_tester(T)::in,
- bitset_tester(T)::out) is det <= enum(T).
-
-:- implementation.
-
-:- import_module bool.
-:- import_module exception.
-:- import_module int.
-:- import_module list.
-:- import_module pair.
-:- import_module require.
-:- import_module set.
-:- import_module string.
-
-:- import_module tree_bitset.
-
-:- type bitset_tester(T) == pair(tree_bitset(T), set.set(T)).
-
-%-----------------------------------------------------------------------------%
-
-init = init - init.
-
-singleton_set(A) = make_singleton_set(A) - make_singleton_set(A).
-
-init(init).
-empty(A - B) :-
- ( empty(A) -> EmptyA = yes; EmptyA = no),
- ( empty(B) -> EmptyB = yes; EmptyB = no),
- ( EmptyA = EmptyB ->
- EmptyA = yes
- ;
- error("empty failed")
- ).
-singleton_set(singleton_set(A), A).
-insert(A, B, insert(A, B)).
-insert_list(A, B, insert_list(A, B)).
-delete(A, B, delete(A, B)).
-delete_list(A, B, delete_list(A, B)).
-list_to_set(A, list_to_set(A)).
-to_sorted_list(A, to_sorted_list(A)).
-sorted_list_to_set(A, sorted_list_to_set(A)).
-union(A, B, union(A, B)).
-intersect(A, B, intersect(A, B)).
-difference(A, B, difference(A, B)).
-
-%-----------------------------------------------------------------------------%
-
-to_sorted_list(A - B) = List :-
- ListA = to_sorted_list(A),
- ListB = set.to_sorted_list(B),
- ( ListA = ListB ->
- List = ListB
- ;
- error("to_sorted_list failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-delete(SetA - SetB, Var) =
- check("delete", SetA - SetB, delete(SetA, Var) - set.delete(SetB, Var)).
-
-delete_list(SetA - SetB, List) =
- check("delete_list", SetA - SetB,
- delete_list(SetA, List) - set.delete_list(SetB, List)).
-
-remove(SetA0 - SetB0, Elem) = Result :-
- ( remove(Elem, SetA0, SetA1) ->
- ( remove(Elem, SetB0, SetB1) ->
- SetA = SetA1,
- SetB = SetB1
- ;
- error("remove succeeded unexpectedly")
- )
- ; set.remove(Elem, SetB0, _) ->
- error("remove failed unexpectedly")
- ;
- fail
- ),
- Result = check("remove", SetA0 - SetB0, SetA - SetB).
-
-remove_list(SetA0 - SetB0, List) = Result :-
- ( remove_list(List, SetA0, SetA1) ->
- ( set.remove_list(List, SetB0, SetB1) ->
- SetA = SetA1,
- SetB = SetB1
- ;
- error("remove succeeded unexpectedly")
- )
- ; set.remove_list(List, SetB0, _) ->
- error("remove failed unexpectedly")
- ;
- fail
- ),
- Result = check("remove_list", SetA0 - SetB0, SetA - SetB).
-
-%-----------------------------------------------------------------------------%
-
-insert(SetA - SetB, Var) =
- check("insert", SetA - SetB,
- insert(SetA, Var) - set.insert(SetB, Var)).
-
-%-----------------------------------------------------------------------------%
-
-insert_list(SetA - SetB, Vars) =
- check("insert_list", SetA - SetB,
- insert_list(SetA, Vars) - set.insert_list(SetB, Vars)).
-
-%-----------------------------------------------------------------------------%
-
-list_to_set(List) =
- check("list_to_set", init - init,
- list_to_set(List) - set.list_to_set(List)).
-
-sorted_list_to_set(List) =
- check("sorted_list_to_set", init - init,
- sorted_list_to_set(List) - set.sorted_list_to_set(List)).
-
-%-----------------------------------------------------------------------------%
-
-contains(SetA - SetB, Var) :-
- ( contains(SetA, Var) -> InSetA = yes ; InSetA = no),
- ( set.contains(SetB, Var) -> InSetB = yes ; InSetB = no),
- ( InSetA = InSetB ->
- InSetA = yes
- ;
- error("contains failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-foldl(F, SetA - SetB, Acc0) = Acc :-
- AccA = foldl(F, SetA, Acc0),
- AccB = fold(F, SetB, Acc0),
- ( AccA = AccB ->
- Acc = AccA
- ;
- error("bitset_tester: fold failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-count(SetA - SetB) = Count :-
- CountA = count(SetA),
- CountB = count(SetB),
- ( CountA = CountB ->
- Count = CountA
- ;
- error("bitset_tester: count failed")
- ).
-
-%-----------------------------------------------------------------------------%
-
-subset(SetA1 - SetB1, SetA2 - SetB2) :-
- ( subset(SetA1, SetA2) ->
- ( subset(SetB1, SetB2) ->
- true
- ;
- error("bitset_tester: subset succeeded unexpectedly")
- )
- ; subset(SetB1, SetB2) ->
- error("bitset_tester: subset failed unexpectedly")
- ;
- fail
- ).
-
-superset(SetA1 - SetB1, SetA2 - SetB2) :-
- ( superset(SetA1, SetA2) ->
- ( superset(SetB1, SetB2) ->
- true
- ;
- error("bitset_tester: superset succeeded unexpectedly")
- )
- ; superset(SetB1, SetB2) ->
- error("bitset_tester: superset failed unexpectedly")
- ;
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-union(SetA1 - SetB1, SetA2 - SetB2) =
- check2("union", SetA1 - SetB1, SetA2 - SetB2,
- union(SetA1, SetA2) - set.union(SetB1, SetB2)).
-
-%-----------------------------------------------------------------------------%
-
-intersect(SetA1 - SetB1, SetA2 - SetB2) =
- check2("intersect", SetA1 - SetB1, SetA2 - SetB2,
- intersect(SetA1, SetA2) - set.intersect(SetB1, SetB2)).
-
-%-----------------------------------------------------------------------------%
-
-difference(SetA1 - SetB1, SetA2 - SetB2) =
- check2("difference", SetA1 - SetB1, SetA2 - SetB2,
- difference(SetA1, SetA2) - set.difference(SetB1, SetB2)).
-
-%-----------------------------------------------------------------------------%
-
-remove_least(SetA0 - SetB0, Least, SetA - SetB) :-
- ( remove_least(LeastA, SetA0, SetA1) ->
- ( remove_least(LeastB, SetB0, SetB1) ->
- ( LeastA = LeastB ->
- SetA = SetA1,
- SetB = SetB1,
- Least = LeastA
- ;
- error("remove_least: wrong least element")
- )
- ;
- error("remove_least: should be no least value")
- )
- ; remove_least(_, SetB0, _) ->
- error("remove_least: failed")
- ;
- fail
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- func check(string, bitset_tester(T), bitset_tester(T)) = bitset_tester(T)
- <= enum(T).
-
-check(Op, Tester1, Tester) = Tester :-
- Tester1 = BitSet1 - Set1,
- BitSetSet1 = tree_bitset.sorted_list_to_set(set.to_sorted_list(Set1)),
- Tester = BitSet - Set,
- BitSetSet = tree_bitset.sorted_list_to_set(set.to_sorted_list(Set)),
- ( BitSetSet1 = BitSet1, BitSet = BitSetSet ->
- true
- ;
- throw(one_argument(Op, Tester1, Tester))
- ).
-
-:- func check2(string, bitset_tester(T), bitset_tester(T), bitset_tester(T))
- = bitset_tester(T) <= enum(T).
-
-check2(Op, Tester1, Tester2, Tester) = Result :-
- Tester1 = BitSet1 - Set1,
- BitSetSet1 = tree_bitset.sorted_list_to_set(set.to_sorted_list(Set1)),
- Tester2 = BitSet2 - Set2,
- BitSetSet2 = sorted_list_to_set(set.to_sorted_list(Set2)),
-
- Tester = BitSet - Set,
- BitSetSet = tree_bitset.sorted_list_to_set(set.to_sorted_list(Set)),
-
- ( BitSetSet1 = BitSet1, BitSetSet2 = BitSet2, BitSet = BitSetSet ->
- Result = Tester
- ;
- throw(two_arguments(Op, Tester1, Tester2, Tester))
- ).
-
-%-----------------------------------------------------------------------------%
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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