mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity
Files
8ece998041d040a4aabb24afe00a0e35bf369473
mercury/library/test_bitset.m
Zoltan Somogyi c76d358766 Add uint versions of length and count operations. 
Where possible, make the uint version the main version,
casting its result to int for the old length/count versions.

In a few places, apply simple speedups.

library/list.m:
library/one_or_more.m:
    Add ulength operations as uint versions of length operations
    for these sequence data structures.

library/edit_seq.m:
    Delete the local definition of what is now list.ulength.

library/diet.m:
library/ranges.m:
library/fat_sparse_bitset.m:
library/fatter_sparse_bitset.m:
library/set.m:
library/set_bbbtree.m:
library/set_ctree234.m:
library/set_ordlist.m:
library/set_tree234.m:
library/set_unordlist.m:
library/sparse_bitset.m:
library/test_bitset.m:
library/tree_bitset.m:
    Add ucount operations as uint versions of count operations
    for these set data structures.

library/bag.m:
    Add ucount operations as uint versions of count operations
    for this bag data structure.

library/map.m:
library/multi_map.m:
library/one_or_more_map.m:
library/rbtree.m:
library/tree234.m:
    Add ucount operations as uint versions of count operations
    for these map data structures.
2026-01-02 15:35:20 +11:00

1160 lines
39 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2011-2012 The University of Melbourne.
% Copyright (C) 2014-2015, 2018, 2024-2026 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% Test operations on bitsets by comparing their 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)).
%---------------------------------------------------------------------------%
%
% Initial creation of sets.
%
:- func init = test_bitset(T).
:- pred init(test_bitset(T)::out) is det.
:- func singleton_set(T) = test_bitset(T) <= uenum(T).
:- pred singleton_set(test_bitset(T)::out, T::in) is det <= uenum(T).
:- func make_singleton_set(T) = test_bitset(T) <= uenum(T).
:- pred make_singleton_set(test_bitset(T)::out, T::in) is det <= uenum(T).
%---------------------------------------------------------------------------%
%
% Emptiness and singleton-ness 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 <= uenum(T).
%---------------------------------------------------------------------------%
%
% Membership tests.
%
:- pred member(T, test_bitset(T)) <= uenum(T).
:- mode member(in, in) is semidet.
:- mode member(out, in) is nondet.
:- pred contains(test_bitset(T)::in, T::in) is semidet <= uenum(T).
%---------------------------------------------------------------------------%
%
% Insertions and deletions.
%
:- pred insert(T::in, test_bitset(T)::in, test_bitset(T)::out)
is det <= uenum(T).
:- pred insert_new(T::in, test_bitset(T)::in, test_bitset(T)::out)
is semidet <= uenum(T).
:- pred insert_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
is det <= uenum(T).
:- pred delete(T::in, test_bitset(T)::in, test_bitset(T)::out)
is det <= uenum(T).
:- pred delete_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
is det <= uenum(T).
:- pred remove(T::in, test_bitset(T)::in, test_bitset(T)::out)
is semidet <= uenum(T).
:- pred remove_list(list(T)::in, test_bitset(T)::in, test_bitset(T)::out)
is semidet <= uenum(T).
:- pred remove_least(T::out, test_bitset(T)::in, test_bitset(T)::out)
is semidet <= uenum(T).
:- pred remove_leq(test_bitset(T)::in, T::in, test_bitset(T)::out)
is det <= uenum(T).
:- pred remove_gt(test_bitset(T)::in, T::in, test_bitset(T)::out)
is det <= uenum(T).
%---------------------------------------------------------------------------%
%
% Comparisons between sets.
%
:- pred equal(test_bitset(T)::in, test_bitset(T)::in) is semidet <= uenum(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.
%---------------------------------------------------------------------------%
%
% Operations on two or more sets.
%
:- func union(test_bitset(T), test_bitset(T)) = test_bitset(T) <= uenum(T).
:- pred union(test_bitset(T)::in,
test_bitset(T)::in, test_bitset(T)::out) is det <= uenum(T).
:- func union_list(list(test_bitset(T))) = test_bitset(T) <= uenum(T).
:- pred union_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
<= uenum(T).
:- func intersect(test_bitset(T), test_bitset(T)) = test_bitset(T) <= uenum(T).
:- pred intersect(test_bitset(T)::in,
test_bitset(T)::in, test_bitset(T)::out) is det <= uenum(T).
:- func intersect_list(list(test_bitset(T))) = test_bitset(T) <= uenum(T).
:- pred intersect_list(list(test_bitset(T))::in, test_bitset(T)::out) is det
<= uenum(T).
:- func difference(test_bitset(T), test_bitset(T)) = test_bitset(T)
<= uenum(T).
:- pred difference(test_bitset(T)::in,
test_bitset(T)::in, test_bitset(T)::out) is det <= uenum(T).
%---------------------------------------------------------------------------%
%
% Operations that divide a set into two parts.
%
:- pred divide(pred(T)::in(pred(in) is semidet), test_bitset(T)::in,
test_bitset(T)::out, test_bitset(T)::out) is det <= uenum(T).
:- pred divide_by_set(test_bitset(T)::in, test_bitset(T)::in,
test_bitset(T)::out, test_bitset(T)::out) is det <= uenum(T).
%---------------------------------------------------------------------------%
%
% Converting lists to sets.
%
:- func list_to_set(list(T)) = test_bitset(T) <= uenum(T).
:- pred list_to_set(list(T)::in, test_bitset(T)::out) is det <= uenum(T).
:- func sorted_list_to_set(list(T)) = test_bitset(T) <= uenum(T).
:- pred sorted_list_to_set(list(T)::in, test_bitset(T)::out) is det
<= uenum(T).
%---------------------------------------------------------------------------%
%
% Converting sets to lists.
%
:- func to_sorted_list(test_bitset(T)) = list(T) <= uenum(T).
:- pred to_sorted_list(test_bitset(T)::in, list(T)::out) is det <= uenum(T).
%---------------------------------------------------------------------------%
%
% Converting between different kinds of sets.
%
:- func set_to_bitset(set(T)) = test_bitset(T) <= uenum(T).
:- func from_set(set(T)) = test_bitset(T) <= uenum(T).
:- func bitset_to_set(test_bitset(T)) = set(T) <= uenum(T).
:- func to_set(test_bitset(T)) = set(T) <= uenum(T).
%---------------------------------------------------------------------------%
%
% Counting.
%
:- func count(test_bitset(T)) = int <= uenum(T).
:- func ucount(test_bitset(T)) = uint <= uenum(T).
%---------------------------------------------------------------------------%
%
% Standard higher order functions on collections.
%
% all_true(Pred, Set) succeeds if-and-only-if
% Pred(Element) succeeds for all the elements of Set.
%
:- pred all_true(pred(T)::in(pred(in) is semidet), test_bitset(T)::in)
is semidet <= uenum(T).
:- func filter(pred(T)::in(pred(in) is semidet), test_bitset(T)::in)
= (test_bitset(T)::out) is det <= uenum(T).
:- pred filter(pred(T)::in(pred(in) is semidet),
test_bitset(T)::in, test_bitset(T)::out, test_bitset(T)::out)
is det <= uenum(T).
:- func foldl(func(T, A) = A, test_bitset(T), A) = A <= uenum(T).
:- mode foldl(in(func(in, in) = out is det), in, in) = out is det.
:- pred foldl(pred(T, A, A), test_bitset(T), A, A) <= uenum(T).
:- mode foldl(in(pred(in, in, out) is det), in, in, out) is det.
:- mode foldl(in(pred(in, in, out) is semidet), in, in, out) is semidet.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module exception.
:- import_module fat_sparse_bitset.
:- import_module fatter_sparse_bitset.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set_ordlist.
:- import_module solutions.
:- import_module sparse_bitset.
:- import_module string.
:- import_module tree_bitset.
:- import_module uint.
:- type test_bitset(T)
---> tb(
tree_bitset(T),
sparse_bitset(T),
fat_sparse_bitset(T),
fatter_sparse_bitset(T),
set_ordlist(T)
).
%---------------------------------------------------------------------------%
init =
tb(
tree_bitset.init,
sparse_bitset.init,
fat_sparse_bitset.init,
fatter_sparse_bitset.init,
set_ordlist.init).
init(init).
singleton_set(A) =
tb(
tree_bitset.make_singleton_set(A),
sparse_bitset.make_singleton_set(A),
fat_sparse_bitset.make_singleton_set(A),
fatter_sparse_bitset.make_singleton_set(A),
set_ordlist.make_singleton_set(A)).
singleton_set(test_bitset.singleton_set(A), A).
make_singleton_set(A) =
tb(
tree_bitset.make_singleton_set(A),
sparse_bitset.make_singleton_set(A),
fat_sparse_bitset.make_singleton_set(A),
fatter_sparse_bitset.make_singleton_set(A),
set_ordlist.make_singleton_set(A)).
make_singleton_set(test_bitset.make_singleton_set(A), A).
%---------------------------------------------------------------------------%
is_empty(tb(A, B, C, D, S)) :-
( if tree_bitset.is_empty(A) then EA = yes else EA = no),
( if sparse_bitset.is_empty(B) then EB = yes else EB = no),
( if fat_sparse_bitset.is_empty(C) then EC = yes else EC = no),
( if fatter_sparse_bitset.is_empty(D) then ED = yes else ED = no),
( if set_ordlist.is_empty(S) then ES = yes else ES = no),
( if EA = ES, EB = ES, EC = ES, ED = ES then
ES = yes
else
unexpected($pred, "failed")
).
is_non_empty(tb(A, B, C, D, S)) :-
( if tree_bitset.is_non_empty(A) then NEA = yes else NEA = no),
( if sparse_bitset.is_non_empty(B) then NEB = yes else NEB = no),
( if fat_sparse_bitset.is_non_empty(C) then NEC = yes else NEC = no),
( if fatter_sparse_bitset.is_non_empty(D) then NED = yes else NED = no),
( if set_ordlist.is_non_empty(S) then NES = yes else NES = no),
( if NEA = NES, NEB = NES, NEC = NES, NED = NES then
NES = yes
else
unexpected($pred, "failed")
).
is_singleton(tb(A, B, C, D, S), R) :-
( if tree_bitset.is_singleton(A, AR) then
ResA = yes(AR)
else
ResA = no
),
( if sparse_bitset.is_singleton(B, BR) then
ResB = yes(BR)
else
ResB = no
),
( if fat_sparse_bitset.is_singleton(C, CR) then
ResC = yes(CR)
else
ResC = no
),
( if fatter_sparse_bitset.is_singleton(D, DR) then
ResD = yes(DR)
else
ResD = no
),
( if set_ordlist.is_singleton(S, SR) then
ResS = yes(SR)
else
ResS = no
),
( if ResA = ResS, ResB = ResS, ResC = ResS, ResD = ResS then
ResS = yes(R)
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
:- pragma promise_equivalent_clauses(pred(member/2)).
member(E::in, tb(SetA, SetB, SetC, SetD, SetS)::in) :-
( if tree_bitset.member(E, SetA) then InA = yes else InA = no),
( if sparse_bitset.member(E, SetB) then InB = yes else InB = no),
( if fat_sparse_bitset.member(E, SetC) then InC = yes else InC = no),
( if fatter_sparse_bitset.member(E, SetD) then InD = yes else InD = no),
( if set_ordlist.member(E, SetS) then InS = yes else InS = no),
( if InA = InS, InB = InS, InC = InS, InD = InS then
InS = yes
else
unexpected($pred, "failed (in, in)")
).
member(E::out, tb(SetA, SetB, SetC, SetD, SetS)::in) :-
PredA = (pred(EA::out) is nondet :- tree_bitset.member(EA, SetA)),
PredB = (pred(EB::out) is nondet :- sparse_bitset.member(EB, SetB)),
PredC = (pred(EC::out) is nondet :- fat_sparse_bitset.member(EC, SetC)),
PredD = (pred(ED::out) is nondet :- fatter_sparse_bitset.member(ED, SetD)),
PredS = (pred(ES::out) is nondet :- set_ordlist.member(ES, SetS)),
solutions(PredA, SolA),
solutions(PredB, SolB),
solutions(PredC, SolC),
solutions(PredD, SolD),
solutions(PredS, SolS),
( if SolA = SolS, SolB = SolS, SolC = SolS, SolD = SolS then
set_ordlist.member(E, SetS)
else
unexpected($pred, "failed (out, in)")
).
contains(tb(SetA, SetB, SetC, SetD, SetS), E) :-
( if tree_bitset.contains(SetA, E) then InA = yes else InA = no),
( if sparse_bitset.contains(SetB, E) then InB = yes else InB = no),
( if fat_sparse_bitset.contains(SetC, E) then InC = yes else InC = no),
( if fatter_sparse_bitset.contains(SetD, E) then InD = yes else InD = no),
( if set_ordlist.contains(SetS, E) then InS = yes else InS = no),
( if InA = InS, InB = InS, InC = InS, InD = InS then
InS = yes
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
insert(E, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
tree_bitset.insert(E, SetA0, SetA),
sparse_bitset.insert(E, SetB0, SetB),
fat_sparse_bitset.insert(E, SetC0, SetC),
fatter_sparse_bitset.insert(E, SetD0, SetD),
set_ordlist.insert(E, SetS0, SetS),
check1("insert", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
insert_new(E, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
( if tree_bitset.insert_new(E, SetA0, SetA) then
MaybeA = yes(SetA)
else
MaybeA = no
),
( if sparse_bitset.insert_new(E, SetB0, SetB) then
MaybeB = yes(SetB)
else
MaybeB = no
),
( if fat_sparse_bitset.insert_new(E, SetC0, SetC) then
MaybeC = yes(SetC)
else
MaybeC = no
),
( if fatter_sparse_bitset.insert_new(E, SetD0, SetD) then
MaybeD = yes(SetD)
else
MaybeD = no
),
( if set_ordlist.insert_new(E, SetS0, SetS) then
MaybeS = yes(SetS)
else
MaybeS = no
),
( if
MaybeA = yes(A),
MaybeB = yes(B),
MaybeC = yes(C),
MaybeD = yes(D),
MaybeS = yes(S)
then
check1("insert_new", In, tb(A, B, C, D, S), Result)
else if
MaybeA = no,
MaybeB = no,
MaybeC = no,
MaybeD = no,
MaybeS = no
then
fail
else
unexpected($pred, "failed")
).
insert_list(Es, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
tree_bitset.insert_list(Es, SetA0, SetA),
sparse_bitset.insert_list(Es, SetB0, SetB),
fat_sparse_bitset.insert_list(Es, SetC0, SetC),
fatter_sparse_bitset.insert_list(Es, SetD0, SetD),
set_ordlist.insert_list(Es, SetS0, SetS),
check1("insert_list", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
delete(E, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
tree_bitset.delete(E, SetA0, SetA),
sparse_bitset.delete(E, SetB0, SetB),
fat_sparse_bitset.delete(E, SetC0, SetC),
fatter_sparse_bitset.delete(E, SetD0, SetD),
set_ordlist.delete(E, SetS0, SetS),
check1("delete", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
delete_list(Es, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
tree_bitset.delete_list(Es, SetA0, SetA),
sparse_bitset.delete_list(Es, SetB0, SetB),
fat_sparse_bitset.delete_list(Es, SetC0, SetC),
fatter_sparse_bitset.delete_list(Es, SetD0, SetD),
set_ordlist.delete_list(Es, SetS0, SetS),
check1("delete_list", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
remove(E, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
( if tree_bitset.remove(E, SetA0, SetA) then
MaybeA = yes(SetA)
else
MaybeA = no
),
( if sparse_bitset.remove(E, SetB0, SetB) then
MaybeB = yes(SetB)
else
MaybeB = no
),
( if fat_sparse_bitset.remove(E, SetC0, SetC) then
MaybeC = yes(SetC)
else
MaybeC = no
),
( if fatter_sparse_bitset.remove(E, SetD0, SetD) then
MaybeD = yes(SetD)
else
MaybeD = no
),
( if set_ordlist.remove(E, SetS0, SetS) then
MaybeS = yes(SetS)
else
MaybeS = no
),
( if
MaybeA = yes(A),
MaybeB = yes(B),
MaybeC = yes(C),
MaybeD = yes(D),
MaybeS = yes(S)
then
check1("remove", In, tb(A, B, C, D, S), Result)
else if
MaybeA = no,
MaybeB = no,
MaybeC = no,
MaybeD = no,
MaybeS = no
then
fail
else
unexpected($pred, "failed")
).
remove_list(Es, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
( if tree_bitset.remove_list(Es, SetA0, SetA) then
MaybeA = yes(SetA)
else
MaybeA = no
),
( if sparse_bitset.remove_list(Es, SetB0, SetB) then
MaybeB = yes(SetB)
else
MaybeB = no
),
( if fat_sparse_bitset.remove_list(Es, SetC0, SetC) then
MaybeC = yes(SetC)
else
MaybeC = no
),
( if fatter_sparse_bitset.remove_list(Es, SetD0, SetD) then
MaybeD = yes(SetD)
else
MaybeD = no
),
( if set_ordlist.remove_list(Es, SetS0, SetS) then
MaybeS = yes(SetS)
else
MaybeS = no
),
( if
MaybeA = yes(A),
MaybeB = yes(B),
MaybeC = yes(C),
MaybeD = yes(D),
MaybeS = yes(S)
then
check1("remove", In, tb(A, B, C, D, S), Result)
else if
MaybeA = no,
MaybeB = no,
MaybeC = no,
MaybeD = no,
MaybeS = no
then
fail
else
unexpected($pred, "failed")
).
remove_least(Least, In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Result) :-
( if tree_bitset.remove_least(LeastA, SetA0, SetA) then
MaybeA = yes(LeastA - SetA)
else
MaybeA = no
),
( if sparse_bitset.remove_least(LeastB, SetB0, SetB) then
MaybeB = yes(LeastB - SetB)
else
MaybeB = no
),
( if fat_sparse_bitset.remove_least(LeastC, SetC0, SetC) then
MaybeC = yes(LeastC - SetC)
else
MaybeC = no
),
( if fatter_sparse_bitset.remove_least(LeastD, SetD0, SetD) then
MaybeD = yes(LeastD - SetD)
else
MaybeD = no
),
( if set_ordlist.remove_least(LeastS, SetS0, SetS) then
MaybeS = yes(LeastS - SetS)
else
MaybeS = no
),
( if
MaybeA = yes(LA - SA),
MaybeB = yes(LB - SB),
MaybeC = yes(LC - Sc), % avoid SC_32 macro on AIX
MaybeD = yes(LD - SD),
MaybeS = yes(LS - SS),
LA = LS, LB = LS, LC = LS, LD = LS
then
Least = LS,
check1("remove_least", In, tb(SA, SB, Sc, SD, SS), Result)
else if
MaybeA = no,
MaybeB = no,
MaybeC = no,
MaybeD = no,
MaybeS = no
then
fail
else
unexpected($pred, "failed")
).
remove_leq(In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Hurdle, Result) :-
tree_bitset.remove_leq(Hurdle, SetA0, SetA),
sparse_bitset.remove_leq(Hurdle, SetB0, SetB),
fat_sparse_bitset.remove_leq(Hurdle, SetC0, SetC),
fatter_sparse_bitset.remove_leq(Hurdle, SetD0, SetD),
RemoveLeq =
( pred(Item::in) is semidet :-
Index = to_uint(Item),
HurdleIndex = to_uint(Hurdle),
not (Index =< HurdleIndex)
),
set.filter(RemoveLeq, SetS0, SetS),
check1("remove_leq", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
remove_gt(In @ tb(SetA0, SetB0, SetC0, SetD0, SetS0), Hurdle, Result) :-
tree_bitset.remove_gt(Hurdle, SetA0, SetA),
sparse_bitset.remove_gt(Hurdle, SetB0, SetB),
fat_sparse_bitset.remove_gt(Hurdle, SetC0, SetC),
fatter_sparse_bitset.remove_gt(Hurdle, SetD0, SetD),
RemoveGt =
( pred(Item::in) is semidet :-
Index = to_uint(Item),
HurdleIndex = to_uint(Hurdle),
not (Index > HurdleIndex)
),
set.filter(RemoveGt, SetS0, SetS),
check1("remove_gt", In, tb(SetA, SetB, SetC, SetD, SetS), Result).
%---------------------------------------------------------------------------%
equal(InL, InR) :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
( if tree_bitset.equal(SetAL, SetAR) then A = yes else A = no),
( if sparse_bitset.equal(SetBL, SetBR) then B = yes else B = no),
( if fat_sparse_bitset.equal(SetCL, SetCR) then C = yes else C = no),
( if fatter_sparse_bitset.equal(SetDL, SetDR) then D = yes else D = no),
( if set_ordlist.equal(SetSL, SetSR) then S = yes else S = no),
( if A = S, B = S, C = S, D = S then
S = yes
else
unexpected($pred, "failed")
).
subset(InL, InR) :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
( if tree_bitset.subset(SetAL, SetAR) then A = yes else A = no),
( if sparse_bitset.subset(SetBL, SetBR) then B = yes else B = no),
( if fat_sparse_bitset.subset(SetCL, SetCR) then C = yes else C = no),
( if fatter_sparse_bitset.subset(SetDL, SetDR) then D = yes else D = no),
( if set_ordlist.subset(SetSL, SetSR) then S = yes else S = no),
( if A = S, B = S, C = S, D = S then
S = yes
else
unexpected($pred, "failed")
).
superset(InL, InR) :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
( if tree_bitset.superset(SetAL, SetAR) then A = yes else A = no),
( if sparse_bitset.superset(SetBL, SetBR) then B = yes else B = no),
( if fat_sparse_bitset.superset(SetCL, SetCR) then C = yes else C = no),
( if fatter_sparse_bitset.superset(SetDL, SetDR) then D = yes else D = no),
( if set_ordlist.superset(SetSL, SetSR) then S = yes else S = no),
( if A = S, B = S, C = S, D = S then
S = yes
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
union(InL, InR) = Result :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
tree_bitset.union(SetAL, SetAR, SetA),
sparse_bitset.union(SetBL, SetBR, SetB),
fat_sparse_bitset.union(SetCL, SetCR, SetC),
fatter_sparse_bitset.union(SetDL, SetDR, SetD),
set_ordlist.union(SetSL, SetSR, SetS),
check2("union", InL, InR, tb(SetA, SetB, SetC, SetD, SetS), Result).
union(A, B, test_bitset.union(A, B)).
union_list(SetsABCS) = Result :-
get_sets("union_list", SetsABCS, SetsA, SetsB, SetsC, SetsD, SetsS),
SetA = tree_bitset.union_list(SetsA),
SetB = sparse_bitset.union_list(SetsB),
SetC = fat_sparse_bitset.union_list(SetsC),
SetD = fatter_sparse_bitset.union_list(SetsD),
SetS = set_ordlist.union_list(SetsS),
check0("union_list", tb(SetA, SetB, SetC, SetD, SetS), Result).
union_list(Sets, test_bitset.union_list(Sets)).
intersect(InL, InR) = Result :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
tree_bitset.intersect(SetAL, SetAR, SetA),
sparse_bitset.intersect(SetBL, SetBR, SetB),
fat_sparse_bitset.intersect(SetCL, SetCR, SetC),
fatter_sparse_bitset.intersect(SetDL, SetDR, SetD),
set_ordlist.intersect(SetSL, SetSR, SetS),
check2("intersect", InL, InR, tb(SetA, SetB, SetC, SetD, SetS), Result).
intersect(A, B, test_bitset.intersect(A, B)).
intersect_list(SetsABCS) = Result :-
get_sets("intersect_list", SetsABCS, SetsA, SetsB, SetsC, SetsD, SetsS),
SetA = tree_bitset.intersect_list(SetsA),
SetB = sparse_bitset.intersect_list(SetsB),
SetC = fat_sparse_bitset.intersect_list(SetsC),
SetD = fatter_sparse_bitset.intersect_list(SetsD),
SetS = set_ordlist.intersect_list(SetsS),
check0("intersect_list", tb(SetA, SetB, SetC, SetD, SetS), Result).
intersect_list(Sets, test_bitset.intersect_list(Sets)).
difference(InL, InR) = Result :-
InL = tb(SetAL, SetBL, SetCL, SetDL, SetSL),
InR = tb(SetAR, SetBR, SetCR, SetDR, SetSR),
tree_bitset.difference(SetAL, SetAR, SetA),
sparse_bitset.difference(SetBL, SetBR, SetB),
fat_sparse_bitset.difference(SetCL, SetCR, SetC),
fatter_sparse_bitset.difference(SetDL, SetDR, SetD),
set_ordlist.difference(SetSL, SetSR, SetS),
check2("difference", InL, InR, tb(SetA, SetB, SetC, SetD, SetS), Result).
difference(A, B, test_bitset.difference(A, B)).
%---------------------%
:- pred get_sets(string::in, list(test_bitset(T))::in,
list(tree_bitset(T))::out, list(sparse_bitset(T))::out,
list(fat_sparse_bitset(T))::out, list(fatter_sparse_bitset(T))::out,
list(set_ordlist(T))::out) is det <= uenum(T).
get_sets(_, [], [], [], [], [], []).
get_sets(Op, [tb(SetA, SetB, SetC, SetD, SetS) | SetsABCDS],
[SetA | SetsA], [SetB | SetsB], [SetC | SetsC], [SetD | SetsD],
[SetS | SetsS]) :-
tree_bitset.to_sorted_list(SetA, ListA),
sparse_bitset.to_sorted_list(SetB, ListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
set_ordlist.to_sorted_list(SetS, ListS),
( if ListA = ListS, ListB = ListS, ListC = ListS, ListD = ListS then
get_sets(Op, SetsABCDS, SetsA, SetsB, SetsC, SetsD, SetsS)
else
unexpected($pred, "unequal sets in " ++ Op ++ " arg list")
).
%---------------------------------------------------------------------------%
divide(Pred, tb(SetA, SetB, SetC, SetD, SetS), ResultIn, ResultOut) :-
tree_bitset.divide(Pred, SetA, InSetA, OutSetA),
sparse_bitset.divide(Pred, SetB, InSetB, OutSetB),
fat_sparse_bitset.divide(Pred, SetC, InSetC, OutSetC),
fatter_sparse_bitset.divide(Pred, SetD, InSetD, OutSetD),
set_ordlist.divide(Pred, SetS, InSetS, OutSetS),
tree_bitset.to_sorted_list(SetA, ListA),
tree_bitset.to_sorted_list(InSetA, InListA),
tree_bitset.to_sorted_list(OutSetA, OutListA),
sparse_bitset.to_sorted_list(SetB, ListB),
sparse_bitset.to_sorted_list(InSetB, InListB),
sparse_bitset.to_sorted_list(OutSetB, OutListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fat_sparse_bitset.to_sorted_list(InSetC, InListC),
fat_sparse_bitset.to_sorted_list(OutSetC, OutListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
fatter_sparse_bitset.to_sorted_list(InSetD, InListD),
fatter_sparse_bitset.to_sorted_list(OutSetD, OutListD),
set_ordlist.to_sorted_list(SetS, ListS),
set_ordlist.to_sorted_list(InSetS, InListS),
set_ordlist.to_sorted_list(OutSetS, OutListS),
( if
ListA = ListS,
ListB = ListS,
ListC = ListS,
ListD = ListS,
InListA = InListS,
InListB = InListS,
InListC = InListS,
InListD = InListS,
OutListA = OutListS,
OutListB = OutListS,
OutListC = OutListS,
OutListD = OutListS
then
ResultIn = tb(InSetA, InSetB, InSetC, InSetD, InSetS),
ResultOut = tb(OutSetA, OutSetB, OutSetC, OutSetD, OutSetS)
else
unexpected($pred, "failed")
).
divide_by_set(DivBy, Set, ResultIn, ResultOut) :-
DivBy = tb(DivByA, DivByB, DivByC, DivByD, DivByS),
Set = tb(SetA, SetB, SetC, SetD, SetS),
tree_bitset.divide_by_set(DivByA, SetA, InSetA, OutSetA),
sparse_bitset.divide_by_set(DivByB, SetB, InSetB, OutSetB),
fat_sparse_bitset.divide_by_set(DivByC, SetC, InSetC, OutSetC),
fatter_sparse_bitset.divide_by_set(DivByD, SetD, InSetD, OutSetD),
set_ordlist.divide_by_set(DivByS, SetS, InSetS, OutSetS),
tree_bitset.to_sorted_list(DivByA, DivListA),
tree_bitset.to_sorted_list(SetA, ListA),
tree_bitset.to_sorted_list(InSetA, InListA),
tree_bitset.to_sorted_list(OutSetA, OutListA),
sparse_bitset.to_sorted_list(DivByB, DivListB),
sparse_bitset.to_sorted_list(SetB, ListB),
sparse_bitset.to_sorted_list(InSetB, InListB),
sparse_bitset.to_sorted_list(OutSetB, OutListB),
fat_sparse_bitset.to_sorted_list(DivByC, DivListC),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fat_sparse_bitset.to_sorted_list(InSetC, InListC),
fat_sparse_bitset.to_sorted_list(OutSetC, OutListC),
fatter_sparse_bitset.to_sorted_list(DivByD, DivListD),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
fatter_sparse_bitset.to_sorted_list(InSetD, InListD),
fatter_sparse_bitset.to_sorted_list(OutSetD, OutListD),
set_ordlist.to_sorted_list(DivByS, DivListS),
set_ordlist.to_sorted_list(SetS, ListS),
set_ordlist.to_sorted_list(InSetS, InListS),
set_ordlist.to_sorted_list(OutSetS, OutListS),
( if
DivListA = DivListS,
DivListB = DivListS,
DivListC = DivListS,
DivListD = DivListS,
ListA = ListS,
ListB = ListS,
ListC = ListS,
ListD = ListS,
InListA = InListS,
InListB = InListS,
InListC = InListS,
InListD = InListS,
OutListA = OutListS,
OutListB = OutListS,
OutListC = OutListS,
OutListD = OutListS
then
ResultIn = tb(InSetA, InSetB, InSetC, InSetD, InSetS),
ResultOut = tb(OutSetA, OutSetB, OutSetC, OutSetD, OutSetS)
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
list_to_set(List) = Result :-
SetA = tree_bitset.list_to_set(List),
SetB = sparse_bitset.list_to_set(List),
SetC = fat_sparse_bitset.list_to_set(List),
SetD = fatter_sparse_bitset.list_to_set(List),
SetS = set_ordlist.list_to_set(List),
check0("list_to_set", tb(SetA, SetB, SetC, SetD, SetS), Result).
list_to_set(A, test_bitset.list_to_set(A)).
sorted_list_to_set(List) = Result :-
SetA = tree_bitset.sorted_list_to_set(List),
SetB = sparse_bitset.sorted_list_to_set(List),
SetC = fat_sparse_bitset.sorted_list_to_set(List),
SetD = fatter_sparse_bitset.sorted_list_to_set(List),
SetS = set_ordlist.sorted_list_to_set(List),
check0("sorted_list_to_set", tb(SetA, SetB, SetC, SetD, SetS), Result).
sorted_list_to_set(A, test_bitset.sorted_list_to_set(A)).
%---------------------------------------------------------------------------%
to_sorted_list(tb(A, B, C, D, S)) = List :-
ListA = tree_bitset.to_sorted_list(A),
ListB = sparse_bitset.to_sorted_list(B),
ListC = fat_sparse_bitset.to_sorted_list(C),
ListD = fatter_sparse_bitset.to_sorted_list(D),
ListS = set_ordlist.to_sorted_list(S),
( if ListA = ListS, ListB = ListS, ListC = ListS, ListD = ListS then
List = ListS
else
unexpected($pred, "failed")
).
to_sorted_list(A, test_bitset.to_sorted_list(A)).
%---------------------------------------------------------------------------%
set_to_bitset(Set) = Result :-
set.to_sorted_list(Set, SortedList),
Result = test_bitset.sorted_list_to_set(SortedList).
from_set(Set) = set_to_bitset(Set).
bitset_to_set(TestBitset) = Set :-
SortedList = test_bitset.to_sorted_list(TestBitset),
set.sorted_list_to_set(SortedList, Set).
to_set(Set) = bitset_to_set(Set).
%---------------------------------------------------------------------------%
count(tb(SetA, SetB, SetC, SetD, SetS)) = Cnt :-
CntA = tree_bitset.count(SetA),
CntB = sparse_bitset.count(SetB),
CntC = fat_sparse_bitset.count(SetC),
CntD = fatter_sparse_bitset.count(SetD),
CntS = set_ordlist.count(SetS),
( if CntA = CntS, CntB = CntS, CntC = CntS, CntD = CntS then
Cnt = CntS
else
unexpected($pred, "failed")
).
ucount(tb(SetA, SetB, SetC, SetD, SetS)) = Cnt :-
CntA = tree_bitset.ucount(SetA),
CntB = sparse_bitset.ucount(SetB),
CntC = fat_sparse_bitset.ucount(SetC),
CntD = fatter_sparse_bitset.ucount(SetD),
CntS = set_ordlist.ucount(SetS),
( if CntA = CntS, CntB = CntS, CntC = CntS, CntD = CntS then
Cnt = CntS
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
all_true(Pred, tb(SetA, SetB, SetC, SetD, SetS)) :-
( if tree_bitset.all_true(Pred, SetA) then
MaybeA = yes
else
MaybeA = no
),
( if sparse_bitset.all_true(Pred, SetB) then
MaybeB = yes
else
MaybeB = no
),
( if fat_sparse_bitset.all_true(Pred, SetC) then
MaybeC = yes
else
MaybeC = no
),
( if fatter_sparse_bitset.all_true(Pred, SetD) then
MaybeD = yes
else
MaybeD = no
),
( if set_ordlist.all_true(Pred, SetS) then
MaybeS = yes
else
MaybeS = no
),
( if
MaybeA = MaybeS, MaybeB = MaybeS, MaybeC = MaybeS, MaybeD = MaybeS
then
MaybeS = yes
else
unexpected($pred, "failed")
).
filter(Pred, tb(SetA, SetB, SetC, SetD, SetS)) = Result :-
tree_bitset.to_sorted_list(SetA, ListA),
sparse_bitset.to_sorted_list(SetB, ListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
set_ordlist.to_sorted_list(SetS, ListS),
InSetA = tree_bitset.filter(Pred, SetA),
InSetB = sparse_bitset.filter(Pred, SetB),
InSetC = fat_sparse_bitset.filter(Pred, SetC),
InSetD = fatter_sparse_bitset.filter(Pred, SetD),
InSetS = set_ordlist.filter(Pred, SetS),
tree_bitset.to_sorted_list(InSetA, InListA),
sparse_bitset.to_sorted_list(InSetB, InListB),
fat_sparse_bitset.to_sorted_list(InSetC, InListC),
fatter_sparse_bitset.to_sorted_list(InSetD, InListD),
set_ordlist.to_sorted_list(InSetS, InListS),
( if
ListA = ListS,
ListB = ListS,
ListC = ListS,
ListD = ListS,
InListA = InListS,
InListB = InListS,
InListC = InListS,
InListD = InListS
then
Result = tb(InSetA, InSetB, InSetC, InSetD, InSetS)
else
unexpected($pred, "failed")
).
filter(Pred, tb(SetA, SetB, SetC, SetD, SetS), ResultIn, ResultOut) :-
tree_bitset.to_sorted_list(SetA, ListA),
sparse_bitset.to_sorted_list(SetB, ListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
set_ordlist.to_sorted_list(SetS, ListS),
tree_bitset.filter(Pred, SetA, InSetA, OutSetA),
sparse_bitset.filter(Pred, SetB, InSetB, OutSetB),
fat_sparse_bitset.filter(Pred, SetC, InSetC, OutSetC),
fatter_sparse_bitset.filter(Pred, SetD, InSetD, OutSetD),
set_ordlist.filter(Pred, SetS, InSetS, OutSetS),
tree_bitset.to_sorted_list(InSetA, InListA),
tree_bitset.to_sorted_list(OutSetA, OutListA),
sparse_bitset.to_sorted_list(InSetB, InListB),
sparse_bitset.to_sorted_list(OutSetB, OutListB),
fat_sparse_bitset.to_sorted_list(InSetC, InListC),
fat_sparse_bitset.to_sorted_list(OutSetC, OutListC),
fatter_sparse_bitset.to_sorted_list(InSetD, InListD),
fatter_sparse_bitset.to_sorted_list(OutSetD, OutListD),
set_ordlist.to_sorted_list(InSetS, InListS),
set_ordlist.to_sorted_list(OutSetS, OutListS),
( if
ListA = ListS,
ListB = ListS,
ListC = ListS,
ListD = ListS,
InListA = InListS,
InListB = InListS,
InListC = InListS,
InListD = InListS,
OutListA = OutListS,
OutListB = OutListS,
OutListC = OutListS,
OutListD = OutListS
then
ResultIn = tb(InSetA, InSetB, InSetC, InSetD, InSetS),
ResultOut = tb(OutSetA, OutSetB, OutSetC, OutSetD, OutSetS)
else
unexpected($pred, "failed")
).
foldl(Func, tb(SetA, SetB, SetC, SetD, SetS), Acc0) = Acc :-
tree_bitset.to_sorted_list(SetA, ListA),
sparse_bitset.to_sorted_list(SetB, ListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
set_ordlist.to_sorted_list(SetS, ListS),
tree_bitset.foldl(Func, SetA, Acc0) = AccA,
sparse_bitset.foldl(Func, SetB, Acc0) = AccB,
fat_sparse_bitset.foldl(Func, SetC, Acc0) = AccC,
fatter_sparse_bitset.foldl(Func, SetD, Acc0) = AccD,
set_ordlist.fold(Func, SetS, Acc0) = AccS,
( if
ListA = ListS, ListB = ListS, ListC = ListS, ListD = ListS,
AccA = AccS, AccB = AccS, AccC = AccS, AccD = AccS
then
Acc = AccS
else
unexpected($pred, "failed")
).
foldl(Pred, tb(SetA, SetB, SetC, SetD, SetS), Acc0, Acc) :-
tree_bitset.to_sorted_list(SetA, ListA),
sparse_bitset.to_sorted_list(SetB, ListB),
fat_sparse_bitset.to_sorted_list(SetC, ListC),
fatter_sparse_bitset.to_sorted_list(SetD, ListD),
set_ordlist.to_sorted_list(SetS, ListS),
tree_bitset.foldl(Pred, SetA, Acc0, AccA),
sparse_bitset.foldl(Pred, SetB, Acc0, AccB),
fat_sparse_bitset.foldl(Pred, SetC, Acc0, AccC),
fatter_sparse_bitset.foldl(Pred, SetD, Acc0, AccD),
set_ordlist.fold(Pred, SetS, Acc0, AccS),
( if
ListA = ListS, ListB = ListS, ListC = ListS, ListD = ListS,
AccA = AccS, AccB = AccS, AccC = AccS, AccD = AccS
then
Acc = AccS
else
unexpected($pred, "failed")
).
%---------------------------------------------------------------------------%
%
% The integrity test operations.
%
:- pred check0(string::in, test_bitset(T)::in, test_bitset(T)::out) is det
<= uenum(T).
check0(Op, TestIn, Result) :-
TestIn = tb(InSetA, InSetB, InSetC, InSetD, InSetS),
tree_bitset.to_sorted_list(InSetA, ListA),
sparse_bitset.to_sorted_list(InSetB, ListB),
fat_sparse_bitset.to_sorted_list(InSetC, ListC),
fatter_sparse_bitset.to_sorted_list(InSetD, ListD),
set_ordlist.to_sorted_list(InSetS, ListS),
( if ListA = ListS, ListB = ListS, ListC = ListS, ListD = ListS then
Result = TestIn
else
throw(zero_argument(Op, TestIn))
).
:- pred check1(string::in, test_bitset(T)::in, test_bitset(T)::in,
test_bitset(T)::out) is det <= uenum(T).
check1(Op, TestIn, TestOut, Result) :-
TestIn = tb(InSetA, InSetB, InSetC, InSetD, InSetS),
TestOut = tb(OutSetA, OutSetB, OutSetC, OutSetD, OutSetS),
tree_bitset.to_sorted_list(InSetA, InsA),
tree_bitset.to_sorted_list(OutSetA, OutsA),
sparse_bitset.to_sorted_list(InSetB, InsB),
sparse_bitset.to_sorted_list(OutSetB, OutsB),
fat_sparse_bitset.to_sorted_list(InSetC, InsC),
fat_sparse_bitset.to_sorted_list(OutSetC, OutsC),
fatter_sparse_bitset.to_sorted_list(InSetD, InsD),
fatter_sparse_bitset.to_sorted_list(OutSetD, OutsD),
set_ordlist.to_sorted_list(InSetS, InsS),
set_ordlist.to_sorted_list(OutSetS, OutsS),
( if
InsA = InsS, InsB = InsS, InsC = InsS, InsD = InsS,
OutsA = OutsS, OutsB = OutsS, OutsC = OutsS, OutsD = OutsS
then
Result = TestOut
else
throw(one_argument(Op, TestIn, TestOut))
).
:- pred check2(string::in, test_bitset(T)::in, test_bitset(T)::in,
test_bitset(T)::in, test_bitset(T)::out) is det <= uenum(T).
check2(Op, TestInL, TestInR, TestOut, Result) :-
TestInL = tb(InSetLA, InSetLB, InSetLC, InSetLD, InSetLS),
TestInR = tb(InSetRA, InSetRB, InSetRC, InSetRD, InSetRS),
TestOut = tb(OutSetA, OutSetB, OutSetC, OutSetD, OutSetS),
tree_bitset.to_sorted_list(InSetLA, InsLA),
tree_bitset.to_sorted_list(InSetRA, InsRA),
tree_bitset.to_sorted_list(OutSetA, OutsA),
sparse_bitset.to_sorted_list(InSetLB, InsLB),
sparse_bitset.to_sorted_list(InSetRB, InsRB),
sparse_bitset.to_sorted_list(OutSetB, OutsB),
fat_sparse_bitset.to_sorted_list(InSetLC, InsLC),
fat_sparse_bitset.to_sorted_list(InSetRC, InsRC),
fat_sparse_bitset.to_sorted_list(OutSetC, OutsC),
fatter_sparse_bitset.to_sorted_list(InSetLD, InsLD),
fatter_sparse_bitset.to_sorted_list(InSetRD, InsRD),
fatter_sparse_bitset.to_sorted_list(OutSetD, OutsD),
set_ordlist.to_sorted_list(InSetLS, InsLS),
set_ordlist.to_sorted_list(InSetRS, InsRS),
set_ordlist.to_sorted_list(OutSetS, OutsS),
( if
InsLA = InsLS, InsLB = InsLS, InsLC = InsLS, InsLD = InsLS,
InsRA = InsRS, InsRB = InsRS, InsRC = InsRS, InsRD = InsRS,
OutsA = OutsS, OutsB = OutsS, OutsC = OutsS, OutsD = OutsS
then
Result = TestOut
else
throw(two_arguments(Op, TestInL, TestInR, TestOut))
).
%---------------------------------------------------------------------------%
:- end_module test_bitset.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink