mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-20 08:19:28 +00:00
Code Issues Projects Releases Wiki Activity
Files
bf196b8be90de48c83cff7d0ab1efead209267cf
mercury/library/tree_bitset.m
Zoltan Somogyi 28301fd9ad Make the documentation a bit more consistent. 
Estimated hours taken: 0.1
Branches: main

library/tree_bitset.m:
	Make the documentation a bit more consistent.
2009-10-19 23:55:59 +00:00

2628 lines
96 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006, 2009 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: tree_bitset.m.
% Author: zs, based on sparse_bitset.m by stayl.
% Stability: medium.
%
% This module provides an ADT for storing sets of non-negative integers.
% If the integers stored are closely grouped, a tree_bitset is more compact
% than the representation provided by set.m, and the operations will be much
% faster. Compared to sparse_bitset.m, the operations provided by this module
% for contains, union, intersection and difference can be expected to have
% lower asymptotic complexity (often logarithmic in the number of elements in
% the sets, rather than linear). The price for this is a representation that
% requires more memory, higher constant factors, and an additional factor
% representing the tree in the complexity of the operations that construct
% tree_bitsets. However, since the depth of the tree has a small upper bound,
% we will fold this into the "higher constant factors" in the descriptions of
% the complexity of the individual operations below.
%
% All this means that using a tree_bitset in preference to a sparse_bitset
% is likely to be a good idea only when the sizes of the sets to be manipulated
% are quite big, or when worst-case performance is important.
%
% For the time being, this module can only handle items that map to nonnegative
% integers. This may change once unsigned integer operations are available.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module tree_bitset.
:- interface.
:- import_module enum.
:- import_module list.
:- import_module term.
:- use_module set.
%-----------------------------------------------------------------------------%
:- type tree_bitset(T). % <= enum(T).
% Return an empty set.
%
:- func init = tree_bitset(T).
:- pred empty(tree_bitset(T)).
:- mode empty(in) is semidet.
:- mode empty(out) is det.
% `equal(SetA, SetB)' is true iff `SetA' and `SetB' contain the same
% elements. Takes O(min(card(SetA), card(SetB))) time.
%
:- pred equal(tree_bitset(T)::in, tree_bitset(T)::in) is semidet <= enum(T).
% `list_to_set(List)' returns a set containing only the members of `List'.
% Takes O(length(List)) time and space.
%
:- func list_to_set(list(T)) = tree_bitset(T) <= enum(T).
% `sorted_list_to_set(List)' returns a set containing only the members
% of `List'. `List' must be sorted. Takes O(length(List)) time and space.
%
:- func sorted_list_to_set(list(T)) = tree_bitset(T) <= enum(T).
% `from_set(Set)' returns a bitset containing only the members of `Set'.
% Takes O(card(Set)) time and space.
%
:- func from_set(set.set(T)) = tree_bitset(T) <= enum(T).
% `to_sorted_list(Set)' returns a list containing all the members of `Set',
% in sorted order. Takes O(card(Set)) time and space.
%
:- func to_sorted_list(tree_bitset(T)) = list(T) <= enum(T).
% `to_sorted_list(Set)' returns a set.set containing all the members
% of `Set', in sorted order. Takes O(card(Set)) time and space.
%
:- func to_set(tree_bitset(T)) = set.set(T) <= enum(T).
% `make_singleton_set(Elem)' returns a set containing just the single
% element `Elem'.
%
:- func make_singleton_set(T) = tree_bitset(T) <= enum(T).
% `subset(Subset, Set)' is true iff `Subset' is a subset of `Set'.
% Same as `intersect(Set, Subset, Subset)', but may be more efficient.
%
:- pred subset(tree_bitset(T)::in, tree_bitset(T)::in) is semidet.
% `superset(Superset, Set)' is true iff `Superset' is a superset of `Set'.
% Same as `intersect(Superset, Set, Set)', but may be more efficient.
%
:- pred superset(tree_bitset(T)::in, tree_bitset(T)::in) is semidet.
% `contains(Set, X)' is true iff `X' is a member of `Set'.
% Takes O(log(card(Set))) time.
%
:- pred contains(tree_bitset(T)::in, T::in) is semidet <= enum(T).
% `member(Set, X)' is true iff `X' is a member of `Set'.
% Takes O(card(Set)) time for the semidet mode.
%
:- pred member(T, tree_bitset(T)) <= enum(T).
:- mode member(in, in) is semidet.
:- mode member(out, in) is nondet.
% `insert(Set, X)' returns the union of `Set' and the set containing
% only `X'. Takes O(log(card(Set))) time and space.
%
:- func insert(tree_bitset(T), T) = tree_bitset(T) <= enum(T).
:- pred insert(tree_bitset(T)::in, T::in, tree_bitset(T)::out)
is det <= enum(T).
% `insert_list(Set, X)' returns the union of `Set' and the set containing
% only the members of `X'. Same as `union(Set, list_to_set(X))', but may be
% more efficient.
%
:- func insert_list(tree_bitset(T), list(T)) = tree_bitset(T) <= enum(T).
:- pred insert_list(tree_bitset(T)::in, list(T)::in, tree_bitset(T)::out)
is det <= enum(T).
% `delete(Set, X)' returns the difference of `Set' and the set containing
% only `X'. Takes O(card(Set)) time and space.
%
:- func delete(tree_bitset(T), T) = tree_bitset(T) <= enum(T).
:- pred delete(tree_bitset(T)::in, T::in, tree_bitset(T)::out)
is det <= enum(T).
% `delete_list(Set, X)' returns the difference of `Set' and the set
% containing only the members of `X'. Same as
% `difference(Set, list_to_set(X))', but may be more efficient.
%
:- func delete_list(tree_bitset(T), list(T)) = tree_bitset(T) <= enum(T).
:- pred delete_list(tree_bitset(T)::in, list(T)::in, tree_bitset(T)::out)
is det <= enum(T).
% `remove(Set0, X, Set)' returns in `Set' the difference of `Set0'
% and the set containing only `X', failing if `Set0' does not contain `X'.
% Takes O(log(card(Set))) time and space.
%
:- pred remove(tree_bitset(T)::in, T::in, tree_bitset(T)::out)
is semidet <= enum(T).
% `remove_list(Set0, X, Set)' returns in `Set' the difference of `Set0'
% and the set containing all the elements of `X', failing if any element
% of `X' is not in `Set0'. Same as `subset(list_to_set(X), Set0),
% difference(Set0, list_to_set(X), Set)', but may be more efficient.
%
:- pred remove_list(tree_bitset(T)::in, list(T)::in, tree_bitset(T)::out)
is semidet <= enum(T).
% `remove_leq(Set, X)' returns `Set' with all elements less than or equal
% to `X' removed. In other words, it returns the set containing all the
% elements of `Set' which are greater than `X'. Takes O(log(card(Set)))
% time and space.
%
:- func remove_leq(tree_bitset(T), T) = tree_bitset(T) <= enum(T).
% `remove_gt(Set, X)' returns `Set' with all elements greater than `X'
% removed. In other words, it returns the set containing all the elements
% of `Set' which are less than or equal to `X'. Takes O(log(card(Set)))
% time and space.
%
:- func remove_gt(tree_bitset(T), T) = tree_bitset(T) <= enum(T).
% `remove_least(Set0, X, Set)' is true iff `X' is the least element in
% `Set0', and `Set' is the set which contains all the elements of `Set0'
% except `X'. Takes O(1) time and space.
%
:- pred remove_least(tree_bitset(T)::in, T::out, tree_bitset(T)::out)
is semidet <= enum(T).
% `union(SetA, SetB)' returns the union of `SetA' and `SetB'. The
% efficiency of the union operation is not sensitive to the argument
% ordering. Takes somewhere between O(log(card(SetA)) + log(card(SetB)))
% and O(card(SetA) + card(SetB)) time and space.
%
:- func union(tree_bitset(T), tree_bitset(T)) = tree_bitset(T).
:- pred union(tree_bitset(T)::in, tree_bitset(T)::in, tree_bitset(T)::out)
is det.
% `intersect(SetA, SetB)' returns the intersection of `SetA' and `SetB'.
% The efficiency of the intersection operation is not sensitive to the
% argument ordering. Takes somewhere between
% O(log(card(SetA)) + log(card(SetB))) and O(card(SetA) + card(SetB)) time,
% and O(min(card(SetA)), card(SetB)) space.
%
:- func intersect(tree_bitset(T), tree_bitset(T)) = tree_bitset(T).
:- pred intersect(tree_bitset(T)::in, tree_bitset(T)::in, tree_bitset(T)::out)
is det.
% `difference(SetA, SetB)' returns the set containing all the elements
% of `SetA' except those that occur in `SetB'. Takes somewhere between
% O(log(card(SetA)) + log(card(SetB))) and O(card(SetA) + card(SetB)) time,
% and O(card(SetA)) space.
%
:- func difference(tree_bitset(T), tree_bitset(T)) = tree_bitset(T).
:- pred difference(tree_bitset(T)::in, tree_bitset(T)::in, tree_bitset(T)::out)
is det.
% `count(Set)' returns the number of elements in `Set'.
% Takes O(card(Set)) time.
%
:- func count(tree_bitset(T)) = int <= enum(T).
% `foldl(Func, Set, Start)' calls Func with each element of `Set'
% (in sorted order) and an accumulator (with the initial value of `Start'),
% and returns the final value. Takes O(card(Set)) time.
%
:- func foldl(func(T, U) = U, tree_bitset(T), U) = U <= enum(T).
:- pred foldl(pred(T, U, U), tree_bitset(T), U, U) <= enum(T).
:- mode foldl(pred(in, di, uo) is det, in, di, uo) is det.
:- 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.
:- mode foldl(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode foldl(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode foldl(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pred foldl2(pred(T, U, U, V, V), tree_bitset(T), U, U, V, V) <= enum(T).
:- mode foldl2(pred(in, di, uo, di, uo) is det, in, di, uo, di, uo) is det.
:- mode foldl2(pred(in, in, out, di, uo) is det, in, in, out, di, uo) is det.
:- mode foldl2(pred(in, in, out, in, out) is det, in, in, out, in, out) is det.
:- mode foldl2(pred(in, in, out, in, out) is semidet, in, in, out, in, out)
is semidet.
:- mode foldl2(pred(in, in, out, in, out) is nondet, in, in, out, in, out)
is nondet.
:- mode foldl2(pred(in, di, uo, di, uo) is cc_multi, in, di, uo, di, uo)
is cc_multi.
:- mode foldl2(pred(in, in, out, di, uo) is cc_multi, in, in, out, di, uo)
is cc_multi.
:- mode foldl2(pred(in, in, out, in, out) is cc_multi, in, in, out, in, out)
is cc_multi.
% `foldr(Func, Set, Start)' calls Func with each element of `Set'
% (in reverse sorted order) and an accumulator (with the initial value
% of `Start'), and returns the final value. Takes O(card(Set)) time.
%
:- func foldr(func(T, U) = U, tree_bitset(T), U) = U <= enum(T).
:- pred foldr(pred(T, U, U), tree_bitset(T), U, U) <= enum(T).
:- mode foldr(pred(in, di, uo) is det, in, di, uo) is det.
:- mode foldr(pred(in, in, out) is det, in, in, out) is det.
:- mode foldr(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode foldr(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode foldr(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode foldr(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pred foldr2(pred(T, U, U, V, V), tree_bitset(T), U, U, V, V) <= enum(T).
:- mode foldr2(pred(in, di, uo, di, uo) is det, in, di, uo, di, uo) is det.
:- mode foldr2(pred(in, in, out, di, uo) is det, in, in, out, di, uo) is det.
:- mode foldr2(pred(in, in, out, in, out) is det, in, in, out, in, out) is det.
:- mode foldr2(pred(in, in, out, in, out) is semidet, in, in, out, in, out)
is semidet.
:- mode foldr2(pred(in, in, out, in, out) is nondet, in, in, out, in, out)
is nondet.
:- mode foldr2(pred(in, di, uo, di, uo) is cc_multi, in, di, uo, di, uo)
is cc_multi.
:- mode foldr2(pred(in, in, out, di, uo) is cc_multi, in, in, out, di, uo)
is cc_multi.
:- mode foldr2(pred(in, in, out, in, out) is cc_multi, in, in, out, in, out)
is cc_multi.
% `filter(Pred, Set)' removes those elements from `Set' for which
% `Pred' fails. In other words, it returns the set consisting of those
% elements of `Set' for which `Pred' succeeds.
%
:- func filter(pred(T), tree_bitset(T)) = tree_bitset(T) <= enum(T).
:- mode filter(pred(in) is semidet, in) = out is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
% Everything below here is not intended to be part of the public interface,
% and will not be included in the Mercury library reference manual.
:- interface.
:- pragma type_spec(list_to_set/1, T = var(_)).
:- pragma type_spec(list_to_set/1, T = int).
:- pragma type_spec(sorted_list_to_set/1, T = var(_)).
:- pragma type_spec(sorted_list_to_set/1, T = int).
:- pragma type_spec(to_sorted_list/1, T = var(_)).
:- pragma type_spec(to_sorted_list/1, T = int).
:- pragma type_spec(to_set/1, T = var(_)).
:- pragma type_spec(to_set/1, T = int).
:- pragma type_spec(from_set/1, T = var(_)).
:- pragma type_spec(from_set/1, T = int).
:- pragma type_spec(make_singleton_set/1, T = var(_)).
:- pragma type_spec(make_singleton_set/1, T = int).
:- pragma type_spec(contains/2, T = var(_)).
:- pragma type_spec(contains/2, T = int).
:- pragma type_spec(insert/2, T = var(_)).
:- pragma type_spec(insert/2, T = int).
:- pragma type_spec(insert/3, T = var(_)).
:- pragma type_spec(insert/3, T = int).
:- pragma type_spec(insert_list/2, T = var(_)).
:- pragma type_spec(insert_list/2, T = int).
:- pragma type_spec(insert_list/3, T = var(_)).
:- pragma type_spec(insert_list/3, T = int).
:- pragma type_spec(delete/2, T = var(_)).
:- pragma type_spec(delete/2, T = int).
:- pragma type_spec(delete/3, T = var(_)).
:- pragma type_spec(delete/3, T = int).
:- pragma type_spec(delete_list/2, T = var(_)).
:- pragma type_spec(delete_list/2, T = int).
:- pragma type_spec(delete_list/3, T = var(_)).
:- pragma type_spec(delete_list/3, T = int).
:- pragma type_spec(foldl/3, T = int).
:- pragma type_spec(foldl/3, T = var(_)).
:- pragma type_spec(foldl/4, T = int).
:- pragma type_spec(foldl/4, T = var(_)).
:- pragma type_spec(foldr/3, T = int).
:- pragma type_spec(foldr/3, T = var(_)).
:- pragma type_spec(foldr/4, T = int).
:- pragma type_spec(foldr/4, T = var(_)).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- 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.
:- import_module maybe.
:- import_module pair.
%-----------------------------------------------------------------------------%
% We describe a set using a tree. The basic idea is the following.
%
% - Level 0 nodes are leaf nodes. A leaf node contains a bitmap of
% 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.
%
% - 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
% bits formed from the concatenation of its child nodes.
%
% - A node at level k, therefore, is isomorphic to a bitmap of
% m = bits_per_int * 2 ^ (k * bits_per_level) bits.
%
% - All the bitmaps are naturally aligned, so the first bit in the bitmap
% of m bits represented by a level k node will have an index that is
% a multiple of m.
%
% For leaf nodes, we store the index of the first bit it represents.
% For interior nodes, we store the index of the first bit it represents,
% and the first bit after the last bit it represents.
%
% Leaf nodes contain bitmaps directly. Given leaf_node(Offset, Bits),
% the bits of `Bits' describe which of the elements of the range
% `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
% a list of leaf nodes; for interior nodes of level k+1, this means
% a list of interior nodes of level k.)
%
% Invariants:
%
% - In every list of nodes, all the nodes in the list have the same level.
%
% - In every list of nodes, the list elements are sorted on offset, and
% no two elements have the same offset.
%
% - A list of nodes of level k must have the ranges of all its nodes
% contained within the range of a single level k+1 node.
%
% - If a node's range contains no items, the node must be deleted.
%
% - The top level list should not be a singleton, unless it consists
% of a single leaf node.
%
% These invariants ensure that every set of items has a unique
% representation.
%
% Leaf node cells should only be constructed using make_leaf_node/2.
:- type tree_bitset(T) % <= enum(T)
---> tree_bitset(node_list).
:- type node_list
---> leaf_list(
leaf_nodes :: list(leaf_node)
)
; interior_list(
level :: int,
% Convenient but redundant; could be computed
% from the init_offset and limit_offset fields
% of the nodes.
interior_nodes :: list(interior_node)
).
:- type leaf_node
---> leaf_node(
leaf_offset :: int,
% multiple of bits_per_int
leaf_bits :: int
% bits offset .. offset + bits_per_int - 1
% The tree_bitset operations all remove
% elements of the list with a `bits'
% field of zero.
).
:- type interior_node
---> interior_node(
init_offset :: int,
% multiple of
% bits_per_int * 2 ^ (level * bits_per_level)
limit_offset :: int,
% limit_offset = init_offset +
% bits_per_int * 2 ^ (level * bits_per_level)
components :: node_list
).
:- func bits_per_level = int.
bits_per_level = 5.
%-----------------------------------------------------------------------------%
:- func make_leaf_node(int, int) = leaf_node.
:- pragma inline(make_leaf_node/2).
make_leaf_node(Offset, Bits) = leaf_node(Offset, Bits).
%-----------------------------------------------------------------------------%
:- func enum_to_index(T) = int <= enum(T).
enum_to_index(Elem) = Index :-
Int = enum.to_int(Elem),
( Int < 0 ->
error("tree_bitset.m: enums must map to nonnegative integers")
;
Index = Int
).
:- func index_to_enum(int) = T <= enum(T).
index_to_enum(Index) = Elem :-
( Elem0 = enum.from_int(Index) ->
Elem = Elem0
;
% We only apply `from_int/1' to integers returned by `to_int/1',
% so it should never fail.
error("tree_bitset.m: `enum.from_int/1' failed")
).
%-----------------------------------------------------------------------------%
% 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.
%
% 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:
% --trace-flag="tree-bitset-integrity"
:- func wrap_tree_bitset(node_list) = tree_bitset(T).
:- pragma inline(wrap_tree_bitset/1).
wrap_tree_bitset(NodeList) = Set :-
trace [compile_time(flag("tree-bitset-interity"))] (
( integrity(no, NodeList) = no ->
error("wrap_tree_bitset: integrity failed")
;
true
)
),
Set = tree_bitset(NodeList).
:- func integrity(maybe(pair(int)), node_list) = bool.
integrity(MaybeBounds, NodeList) = OK :-
(
NodeList = leaf_list(LeafNodes),
(
LeafNodes = [],
(
MaybeBounds = no,
OK = yes
;
MaybeBounds = yes(_),
OK = no
)
;
LeafNodes = [LeafHead | _],
range_of_parent_node(LeafHead ^ leaf_offset, 0,
ParentInitOffset, ParentLimitOffset),
(
MaybeBounds = no,
LimitOK = yes
;
MaybeBounds = yes(Init - Limit),
(
Init = ParentInitOffset,
Limit = ParentLimitOffset
->
LimitOK = yes
;
LimitOK = no
)
),
(
LimitOK = no,
OK = no
;
LimitOK = yes,
OK = integrity_leaf_nodes(LeafNodes,
ParentInitOffset, ParentLimitOffset)
)
)
;
NodeList = interior_list(Level, InteriorNodes),
(
InteriorNodes = [],
ListOK = no
;
InteriorNodes = [IH | IT],
(
IT = [],
(
MaybeBounds = no,
ListOK = no
;
MaybeBounds = yes(_),
ListOK = yes(IH)
)
;
IT = [_ | _],
ListOK = yes(IH)
)
),
(
ListOK = no,
OK = no
;
ListOK = yes(InteriorHead),
range_of_parent_node(InteriorHead ^ init_offset, Level,
ParentInitOffset, ParentLimitOffset),
(
MaybeBounds = no,
LimitOK = yes
;
MaybeBounds = yes(Init - Limit),
(
Init = ParentInitOffset,
Limit = ParentLimitOffset
->
LimitOK = yes
;
LimitOK = no
)
),
(
LimitOK = no,
OK = no
;
LimitOK = yes,
OK = integrity_interior_nodes(InteriorNodes, Level,
ParentInitOffset, ParentLimitOffset)
)
)
).
:- func integrity_leaf_nodes(list(leaf_node), int, int) = bool.
integrity_leaf_nodes([], _Init, _Limit) = yes.
integrity_leaf_nodes([Head | Tail], Init, Limit) = OK :-
Offset = Head ^ leaf_offset,
( Offset rem bits_per_int > 0 ->
OK = no
; \+ (Init =< Offset, Offset + bits_per_int - 1 < Limit) ->
OK = no
;
OK = integrity_leaf_nodes(Tail, Init, Limit)
).
:- func integrity_interior_nodes(list(interior_node), int, int, int) = bool.
integrity_interior_nodes([], _Level, _Init, _Limit) = yes.
integrity_interior_nodes([Head | Tail], Level, Init, Limit) = OK :-
Head = interior_node(NodeInit, NodeLimit, Components),
CalcLimit = NodeInit +
unchecked_left_shift(bits_per_int, Level * bits_per_level),
( NodeInit rem bits_per_int > 0 ->
OK = no
; NodeLimit rem bits_per_int > 0 ->
OK = no
; NodeLimit \= CalcLimit ->
OK = no
; \+ (Init =< NodeInit, NodeLimit - 1 < Limit) ->
OK = no
;
(
Components = leaf_list(LeafNodes),
( Level = 1 ->
SubOK = integrity_leaf_nodes(LeafNodes, NodeInit, NodeLimit)
;
SubOK = no
)
;
Components = interior_list(CompLevel, InteriorNodes),
( CompLevel = Level - 1 ->
SubOK = integrity_interior_nodes(InteriorNodes, CompLevel,
NodeInit, NodeLimit)
;
SubOK = no
)
),
(
SubOK = no,
OK = no
;
SubOK = yes,
OK = integrity_interior_nodes(Tail, Level, Init, Limit)
)
).
%-----------------------------------------------------------------------------%
:- pred range_of_parent_node(int::in, int::in, int::out, int::out) is det.
range_of_parent_node(NodeOffset, NodeLevel,
ParentInitOffset, ParentLimitOffset) :-
HigherLevel = NodeLevel + 1,
ParentRangeSize = unchecked_left_shift(int.bits_per_int,
HigherLevel * bits_per_level),
ParentInitOffset = NodeOffset /\ \ (ParentRangeSize - 1),
ParentLimitOffset = ParentInitOffset + ParentRangeSize.
:- pred expand_range(int::in, node_list::in, int::in, int::in, int::in,
interior_node::out, int::out) is det.
expand_range(Index, SubNodes, CurLevel, CurInitOffset, CurLimitOffset,
TopNode, TopLevel) :-
trace [compile_time(flag("tree-bitset-integrity"))] (
(
Range = unchecked_left_shift(bits_per_int,
CurLevel * bits_per_level),
( CurLimitOffset - CurInitOffset = Range ->
true
;
error("tree_bitset.m: expand_range: bad range for level")
)
;
true
)
),
CurNode = interior_node(CurInitOffset, CurLimitOffset, SubNodes),
range_of_parent_node(CurInitOffset, CurLevel,
ParentInitOffset, ParentLimitOffset),
(
ParentInitOffset =< Index,
Index < ParentLimitOffset
->
TopNode = CurNode,
TopLevel = CurLevel
;
expand_range(Index, interior_list(CurLevel, [CurNode]), CurLevel + 1,
ParentInitOffset, ParentLimitOffset, TopNode, TopLevel)
).
:- pred raise_leaves_to_interior(leaf_node::in, list(leaf_node)::in,
interior_node::out) is det.
:- pragma inline(raise_leaves_to_interior/3).
raise_leaves_to_interior(LeafNode, LeafNodes, InteriorNode) :-
range_of_parent_node(LeafNode ^ leaf_offset, 0,
ParentInitOffset, ParentLimitOffset),
NodeList = leaf_list([LeafNode | LeafNodes]),
InteriorNode = interior_node(ParentInitOffset, ParentLimitOffset,
NodeList).
:- pred raise_leaf_to_level(int::in, leaf_node::in, interior_node::out)
is det.
:- pragma inline(raise_leaf_to_level/3).
raise_leaf_to_level(TargetLevel, LeafNode, TopNode) :-
raise_leaves_to_interior(LeafNode, [], ParentNode),
raise_one_interior_to_level(TargetLevel, 1, ParentNode, TopNode).
:- pred raise_one_interior_to_level(int::in, int::in,
interior_node::in, interior_node::out) is det.
raise_one_interior_to_level(TargetLevel, CurLevel, CurNode, TopNode) :-
( CurLevel = TargetLevel ->
TopNode = CurNode
;
range_of_parent_node(CurNode ^ init_offset, CurLevel,
ParentInitOffset, ParentLimitOffset),
NodeList = interior_list(CurLevel, [CurNode]),
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
NodeList),
raise_one_interior_to_level(TargetLevel, CurLevel + 1,
ParentNode, TopNode)
).
:- pred raise_interiors_to_level(int::in, int::in,
interior_node::in, list(interior_node)::in,
interior_node::out, list(interior_node)::out) is det.
raise_interiors_to_level(TargetLevel, CurLevel, CurNodesHead, CurNodesTail,
TopNodesHead, TopNodesTail) :-
( CurLevel = TargetLevel ->
TopNodesHead = CurNodesHead,
TopNodesTail = CurNodesTail
;
range_of_parent_node(CurNodesHead ^ init_offset, CurLevel,
ParentInitOffset, ParentLimitOffset),
NodeList = interior_list(CurLevel, [CurNodesHead | CurNodesTail]),
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
NodeList),
raise_one_interior_to_level(TargetLevel, CurLevel + 1,
ParentNode, TopNodesHead),
TopNodesTail = []
).
:- pred raise_to_common_level(int::in,
interior_node::in, list(interior_node)::in,
interior_node::in, list(interior_node)::in,
interior_node::out, list(interior_node)::out,
interior_node::out, list(interior_node)::out,
int::out) is det.
raise_to_common_level(CurLevel, HeadA, TailA, HeadB, TailB,
TopHeadA, TopTailA, TopHeadB, TopTailB, TopLevel) :-
range_of_parent_node(HeadA ^ init_offset, CurLevel,
ParentInitOffsetA, ParentLimitOffsetA),
range_of_parent_node(HeadB ^ init_offset, CurLevel,
ParentInitOffsetB, ParentLimitOffsetB),
( ParentInitOffsetA = ParentInitOffsetB ->
require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
"tree_bitset.m: raise_to_common_level: limit mismatch"),
TopHeadA = HeadA,
TopTailA = TailA,
TopHeadB = HeadB,
TopTailB = TailB,
TopLevel = CurLevel
;
ComponentsA = interior_list(CurLevel, [HeadA | TailA]),
ParentA = interior_node(ParentInitOffsetA, ParentLimitOffsetA,
ComponentsA),
ComponentsB = interior_list(CurLevel, [HeadB | TailB]),
ParentB = interior_node(ParentInitOffsetB, ParentLimitOffsetB,
ComponentsB),
raise_to_common_level(CurLevel + 1, ParentA, [], ParentB, [],
TopHeadA, TopTailA, TopHeadB, TopTailB, TopLevel)
).
:- pred prune_top_levels(node_list::in, node_list::out) is det.
prune_top_levels(List, PrunedList) :-
(
List = leaf_list(_),
PrunedList = List
;
List = interior_list(_, Nodes),
(
Nodes = [],
% This can happen if e.g. we subtract a set from itself.
PrunedList = leaf_list([])
;
Nodes = [Node],
prune_top_levels(Node ^ components, PrunedList)
;
Nodes = [_, _ | _],
PrunedList = List
)
).
:- pred head_and_tail(list(interior_node)::in,
interior_node::out, list(interior_node)::out) is det.
head_and_tail([], _, _) :-
error("tree_bitset.m: empty list in head_and_tail").
head_and_tail([Head | Tail], Head, Tail).
%-----------------------------------------------------------------------------%
init = wrap_tree_bitset(leaf_list([])).
empty(init).
equal(SetA, SetB) :-
trace [compile_time(flag("tree-bitset-interity"))] (
(
ListA = to_sorted_list(SetA),
ListB = to_sorted_list(SetB),
(
SetA = SetB
<=>
ListA = ListB
)
->
true
;
error("tree_bitset.m: equal: set and list equality differ")
)
),
SetA = SetB.
%-----------------------------------------------------------------------------%
to_sorted_list(Set) = foldr(list.cons, Set, []).
to_set(Set) = set.sorted_list_to_set(to_sorted_list(Set)).
from_set(Set) = sorted_list_to_set(set.to_sorted_list(Set)).
%-----------------------------------------------------------------------------%
% XXX We should make this more efficient. At least, we could filter the bits in
% the leaf nodes, yielding a new list of leaf nodes, and we could put the
% interior nodes on top, just as we do in sorted_list_to_set.
filter(Pred, Set0) = Set :-
SortedList0 = to_sorted_list(Set0),
FilteredList = list.filter(Pred, SortedList0),
Set = sorted_list_to_set(FilteredList).
%-----------------------------------------------------------------------------%
count(Set) = foldl((func(_, Acc) = Acc + 1), Set, 0).
%-----------------------------------------------------------------------------%
make_singleton_set(A) = insert(init, A).
insert(Set0, Elem) = Set :-
Set0 = tree_bitset(List0),
Index = enum_to_index(Elem),
(
List0 = leaf_list(LeafList0),
(
LeafList0 = [],
bits_for_index(Index, Offset, Bits),
Set = wrap_tree_bitset(leaf_list([make_leaf_node(Offset, Bits)]))
;
LeafList0 = [Leaf0 | _],
range_of_parent_node(Leaf0 ^ leaf_offset, 0,
ParentInitOffset, ParentLimitOffset),
(
ParentInitOffset =< Index,
Index < ParentLimitOffset
->
leaflist_insert(Index, LeafList0, LeafList),
Set = wrap_tree_bitset(leaf_list(LeafList))
;
expand_range(Index, List0, 1,
ParentInitOffset, ParentLimitOffset,
InteriorNode1, InteriorLevel1),
interiorlist_insert(Index, InteriorLevel1,
[InteriorNode1], InteriorList),
Set = wrap_tree_bitset(
interior_list(InteriorLevel1, InteriorList))
)
)
;
List0 = interior_list(InteriorLevel, InteriorList0),
(
InteriorList0 = [],
% This is a violation of our invariants.
error("tree_bitset.m :insert into empty list of interior nodes")
;
InteriorList0 = [InteriorNode0 | _],
range_of_parent_node(InteriorNode0 ^ init_offset, InteriorLevel,
ParentInitOffset, ParentLimitOffset),
(
ParentInitOffset =< Index,
Index < ParentLimitOffset
->
interiorlist_insert(Index, InteriorLevel,
InteriorList0, InteriorList),
Set = wrap_tree_bitset(
interior_list(InteriorLevel, InteriorList))
;
expand_range(Index, List0, InteriorLevel + 1,
ParentInitOffset, ParentLimitOffset,
InteriorNode1, InteriorLevel1),
interiorlist_insert(Index, InteriorLevel1,
[InteriorNode1], InteriorList),
Set = wrap_tree_bitset(
interior_list(InteriorLevel1, InteriorList))
)
)
).
:- pred leaflist_insert(int::in, list(leaf_node)::in, list(leaf_node)::out)
is det.
leaflist_insert(Index, [], Leaves) :-
bits_for_index(Index, Offset, Bits),
Leaves = [make_leaf_node(Offset, Bits)].
leaflist_insert(Index, Leaves0 @ [Head0 | Tail0], Leaves) :-
Offset0 = Head0 ^ leaf_offset,
( Index < Offset0 ->
bits_for_index(Index, Offset, Bits),
Leaves = [make_leaf_node(Offset, Bits) | Leaves0]
; BitToSet = Index - Offset0, BitToSet < bits_per_int ->
Bits0 = Head0 ^ leaf_bits,
( get_bit(Bits0, BitToSet) \= 0 ->
Leaves = Leaves0
;
Bits = set_bit(Bits0, BitToSet),
Leaves = [make_leaf_node(Offset0, Bits) | Tail0]
)
;
leaflist_insert(Index, Tail0, Tail),
Leaves = [Head0 | Tail]
).
:- pred interiorlist_insert(int::in, int::in,
list(interior_node)::in, list(interior_node)::out) is det.
interiorlist_insert(Index, Level, [], Nodes) :-
bits_for_index(Index, Offset, Bits),
raise_leaf_to_level(Level, make_leaf_node(Offset, Bits), Node),
Nodes = [Node].
interiorlist_insert(Index, Level, Nodes0 @ [Head0 | Tail0], Nodes) :-
Offset0 = Head0 ^ init_offset,
( Index < Offset0 ->
bits_for_index(Index, Offset, Bits),
raise_leaf_to_level(Level, make_leaf_node(Offset, Bits), Node),
Nodes = [Node | Nodes0]
; Head0 ^ init_offset =< Index, Index < Head0 ^ limit_offset ->
Components0 = Head0 ^ components,
(
Components0 = leaf_list(LeafList0),
require(unify(Level, 1),
"interiorlist_insert: bad component list (leaf)"),
leaflist_insert(Index, LeafList0, LeafList),
Components = leaf_list(LeafList)
;
Components0 = interior_list(InteriorLevel, InteriorList0),
require(unify(InteriorLevel, Level - 1),
"interiorlist_insert: bad component list (interior)"),
interiorlist_insert(Index, InteriorLevel,
InteriorList0, InteriorList),
Components = interior_list(InteriorLevel, InteriorList)
),
Head = Head0 ^ components := Components,
Nodes = [Head | Tail0]
;
interiorlist_insert(Index, Level, Tail0, Tail),
Nodes = [Head0 | Tail]
).
%-----------------------------------------------------------------------------%
insert_list(Set, List) = union(list_to_set(List), Set).
delete(Set, Elem) = difference(Set, insert(init, Elem)).
delete_list(Set, List) = difference(Set, list_to_set(List)).
remove(Set0, Elem, Set) :-
contains(Set0, Elem),
Set = delete(Set0, Elem).
remove_list(Set0, Elems, Set) :-
ElemsSet = list_to_set(Elems),
subset(ElemsSet, Set0),
Set = difference(Set0, ElemsSet).
%-----------------------------------------------------------------------------%
remove_leq(Set0, Elem) = Set :-
Set0 = tree_bitset(List0),
Index = enum_to_index(Elem),
(
List0 = leaf_list(LeafNodes0),
remove_leq_leaf(LeafNodes0, Index, LeafNodes),
List = leaf_list(LeafNodes)
;
List0 = interior_list(Level, InteriorNodes0),
remove_leq_interior(InteriorNodes0, Index, InteriorNodes),
List1 = interior_list(Level, InteriorNodes),
prune_top_levels(List1, List)
),
Set = wrap_tree_bitset(List).
:- pred remove_leq_interior(list(interior_node)::in, int::in,
list(interior_node)::out) is det.
remove_leq_interior([], _, []).
remove_leq_interior([Head0 | Tail0], Index, Result) :-
( Head0 ^ limit_offset =< Index ->
remove_leq_interior(Tail0, Index, Result)
; Head0 ^ init_offset =< Index ->
Components0 = Head0 ^ components,
(
Components0 = leaf_list(LeafNodes0),
remove_leq_leaf(LeafNodes0, Index, LeafNodes),
(
LeafNodes = [],
Result = Tail0
;
LeafNodes = [_ | _],
Components = leaf_list(LeafNodes),
Head = interior_node(
Head0 ^ init_offset, Head0 ^ limit_offset, Components),
Result = [Head | Tail0]
)
;
Components0 = interior_list(Level, InteriorNodes0),
remove_leq_interior(InteriorNodes0, Index, InteriorNodes),
(
InteriorNodes = [],
Result = Tail0
;
InteriorNodes = [_ | _],
Components = interior_list(Level, InteriorNodes),
Head = interior_node(
Head0 ^ init_offset, Head0 ^ limit_offset, Components),
Result = [Head | Tail0]
)
)
;
Result = [Head0 | Tail0]
).
:- pred remove_leq_leaf(list(leaf_node)::in, int::in,
list(leaf_node)::out) is det.
remove_leq_leaf([], _, []).
remove_leq_leaf([Head0 | Tail0], Index, Result) :-
Offset = Head0 ^ leaf_offset,
( Offset + bits_per_int =< Index ->
remove_leq_leaf(Tail0, Index, Result)
; Offset =< Index ->
(
Bits = Head0 ^ leaf_bits /\
unchecked_left_shift(\ 0, Index - Offset + 1),
Bits \= 0
->
Result = [make_leaf_node(Offset, Bits) | Tail0]
;
Result = Tail0
)
;
Result = [Head0 | Tail0]
).
%-----------------------------------------------------------------------------%
remove_gt(Set0, Elem) = Set :-
Set0 = tree_bitset(List0),
Index = enum_to_index(Elem),
(
List0 = leaf_list(LeafNodes0),
remove_gt_leaf(LeafNodes0, Index, LeafNodes),
List = leaf_list(LeafNodes)
;
List0 = interior_list(Level, InteriorNodes0),
remove_gt_interior(InteriorNodes0, Index, InteriorNodes),
List1 = interior_list(Level, InteriorNodes),
prune_top_levels(List1, List)
),
Set = wrap_tree_bitset(List).
:- pred remove_gt_interior(list(interior_node)::in, int::in,
list(interior_node)::out) is det.
remove_gt_interior([], _, []).
remove_gt_interior([Head0 | Tail0], Index, Result) :-
( Head0 ^ limit_offset =< Index ->
remove_gt_interior(Tail0, Index, Tail),
Result = [Head0 | Tail]
; Head0 ^ init_offset =< Index ->
Components0 = Head0 ^ components,
(
Components0 = leaf_list(LeafNodes0),
remove_gt_leaf(LeafNodes0, Index, LeafNodes),
(
LeafNodes = [],
Result = []
;
LeafNodes = [_ | _],
Components = leaf_list(LeafNodes),
Head = interior_node(
Head0 ^ init_offset, Head0 ^ limit_offset, Components),
Result = [Head]
)
;
Components0 = interior_list(Level, InteriorNodes0),
remove_gt_interior(InteriorNodes0, Index, InteriorNodes),
(
InteriorNodes = [],
Result = []
;
InteriorNodes = [_ | _],
Components = interior_list(Level, InteriorNodes),
Head = interior_node(
Head0 ^ init_offset, Head0 ^ limit_offset, Components),
Result = [Head]
)
)
;
Result = []
).
:- pred remove_gt_leaf(list(leaf_node)::in, int::in,
list(leaf_node)::out) is det.
remove_gt_leaf([], _, []).
remove_gt_leaf([Head0 | Tail0], Index, Result) :-
Offset = Head0 ^ leaf_offset,
( Offset + bits_per_int - 1 =< Index ->
remove_gt_leaf(Tail0, Index, Tail),
Result = [Head0 | Tail]
; Offset =< Index ->
(
Bits = Head0 ^ leaf_bits /\
\ unchecked_left_shift(\ 0, Index - Offset + 1),
Bits \= 0
->
Result = [make_leaf_node(Offset, Bits)]
;
Result = []
)
;
Result = []
).
%-----------------------------------------------------------------------------%
remove_least(Set0, Elem, Set) :-
Set0 = tree_bitset(List0),
(
List0 = leaf_list(LeafNodes0),
(
LeafNodes0 = [],
% There is no least element to remove.
fail
;
LeafNodes0 = [LeafHead | LeafTail],
remove_least_leaf(LeafHead, LeafTail, Index, LeafNodes)
),
List = leaf_list(LeafNodes)
;
List0 = interior_list(Level, InteriorNodes0),
(
InteriorNodes0 = [],
error("tree_bitset.m: remove_least: empty InteriorNodes0")
;
InteriorNodes0 = [InteriorHead | InteriorTail],
remove_least_interior(InteriorHead, InteriorTail, Index,
InteriorNodes)
),
List1 = interior_list(Level, InteriorNodes),
prune_top_levels(List1, List)
),
Elem = index_to_enum(Index),
Set = wrap_tree_bitset(List).
:- pred remove_least_interior(interior_node::in, list(interior_node)::in,
int::out, list(interior_node)::out) is det.
remove_least_interior(Head0, Tail0, Index, Nodes) :-
Components0 = Head0 ^ components,
(
Components0 = leaf_list(LeafNodes0),
(
LeafNodes0 = [],
error("tree_bitset.m: remove_least_interior: empty LeafNodes0")
;
LeafNodes0 = [LeafHead0 | LeafTail0],
remove_least_leaf(LeafHead0, LeafTail0, Index, LeafNodes),
(
LeafNodes = [],
Nodes = Tail0
;
LeafNodes = [_ | _],
Components = leaf_list(LeafNodes),
Head = Head0 ^ components := Components,
Nodes = [Head | Tail0]
)
)
;
Components0 = interior_list(Level, InteriorNodes0),
(
InteriorNodes0 = [],
error("tree_bitset.m: remove_least_interior: empty InteriorNodes0")
;
InteriorNodes0 = [InteriorHead0 | InteriorTail0],
remove_least_interior(InteriorHead0, InteriorTail0, Index,
InteriorNodes),
(
InteriorNodes = [],
Nodes = Tail0
;
InteriorNodes = [_ | _],
Components = interior_list(Level, InteriorNodes),
Head = Head0 ^ components := Components,
Nodes = [Head | Tail0]
)
)
).
:- pred remove_least_leaf(leaf_node::in, list(leaf_node)::in, int::out,
list(leaf_node)::out) is det.
remove_least_leaf(Head0, Tail0, Index, Nodes) :-
Bits0 = Head0 ^ leaf_bits,
Offset = Head0 ^ leaf_offset,
Bit = find_least_bit(Bits0),
Bits = clear_bit(Bits0, Bit),
Index = Offset + Bit,
( Bits = 0 ->
Nodes = Tail0
;
Nodes = [make_leaf_node(Offset, Bits) | Tail0]
).
:- func find_least_bit(int) = int.
find_least_bit(Bits0) = BitNum :-
Size = bits_per_int,
BitNum0 = 0,
BitNum = find_least_bit_2(Bits0, Size, BitNum0).
:- func find_least_bit_2(int, int, int) = int.
find_least_bit_2(Bits0, Size, BitNum0) = BitNum :-
( Size = 1 ->
% We can't get here unless the bit is a 1 bit.
BitNum = BitNum0
;
HalfSize = unchecked_right_shift(Size, 1),
Mask = mask(HalfSize),
LowBits = Bits0 /\ Mask,
( LowBits \= 0 ->
BitNum = find_least_bit_2(LowBits, HalfSize, BitNum0)
;
HighBits = Mask /\ unchecked_right_shift(Bits0, HalfSize),
BitNum = find_least_bit_2(HighBits, HalfSize, BitNum0 + HalfSize)
)
).
%-----------------------------------------------------------------------------%
list_to_set(List) = sorted_list_to_set(list.sort(List)).
%-----------------------------------------------------------------------------%
sorted_list_to_set(Elems) = Set :-
items_to_index(Elems, Indexes),
% XXX
% Should we sort Indexes? The fact that Elems is sorted
% does not *necessarily* imply that Indexes is sorted.
LeafNodes = sorted_list_to_leaf_nodes(Indexes),
(
LeafNodes = [],
List = leaf_list([]),
Set = wrap_tree_bitset(List)
;
LeafNodes = [LeafHead | LeafTail],
group_leaf_nodes(LeafHead, LeafTail, InteriorNodes0),
(
InteriorNodes0 = [],
error("tree_bitset.m: sorted_list_to_set: empty InteriorNodes0")
;
InteriorNodes0 = [InteriorNode],
List = InteriorNode ^ components
;
InteriorNodes0 = [_, _ | _],
recursively_group_interior_nodes(1, InteriorNodes0, List)
),
Set = wrap_tree_bitset(List)
).
:- pred items_to_index(list(T)::in, list(int)::out) is det <= enum(T).
:- pragma type_spec(items_to_index/2, T = var(_)).
:- pragma type_spec(items_to_index/2, T = int).
items_to_index([], []).
items_to_index([ElemHead | ElemTail], [IndexHead | IndexTail]) :-
IndexHead = enum_to_index(ElemHead),
items_to_index(ElemTail, IndexTail).
:- pred group_leaf_nodes(leaf_node::in, list(leaf_node)::in,
list(interior_node)::out) is det.
group_leaf_nodes(Head, Tail, ParentList) :-
range_of_parent_node(Head ^ leaf_offset, 0,
ParentInitOffset, ParentLimitOffset),
group_leaf_nodes_in_range(ParentInitOffset, ParentLimitOffset, [Head],
Tail, ParentHead, Remaining),
(
Remaining = [],
ParentTail = []
;
Remaining = [RemainingHead | RemainingTail],
group_leaf_nodes(RemainingHead, RemainingTail, ParentTail)
),
ParentList = [ParentHead | ParentTail].
:- pred group_leaf_nodes_in_range(int::in, int::in,
list(leaf_node)::in, list(leaf_node)::in,
interior_node::out, list(leaf_node)::out) is det.
group_leaf_nodes_in_range(ParentInitOffset, ParentLimitOffset, !.RevAcc,
[], ParentNode, []) :-
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
leaf_list(list.reverse(!.RevAcc))).
group_leaf_nodes_in_range(ParentInitOffset, ParentLimitOffset, !.RevAcc,
[Head | Tail], ParentNode, Remaining) :-
range_of_parent_node(Head ^ leaf_offset, 0,
HeadParentInitOffset, HeadParentLimitOffset),
( ParentInitOffset = HeadParentInitOffset ->
require(unify(ParentLimitOffset, HeadParentLimitOffset),
"tree_bitset.m: group_leaf_nodes_in_range: limit mismatch"),
!:RevAcc = [Head | !.RevAcc],
group_leaf_nodes_in_range(ParentInitOffset, ParentLimitOffset,
!.RevAcc, Tail, ParentNode, Remaining)
;
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
leaf_list(list.reverse(!.RevAcc))),
Remaining = [Head | Tail]
).
:- pred recursively_group_interior_nodes(int::in, list(interior_node)::in,
node_list::out) is det.
recursively_group_interior_nodes(CurLevel, CurNodes, List) :-
(
CurNodes = [],
error("tree_bitset.m: recursively_group_interior_nodes: empty CurNodes")
;
CurNodes = [CurNodesHead | CurNodesTail],
(
CurNodesTail = [],
List = CurNodesHead ^ components
;
CurNodesTail = [_ | _],
group_interior_nodes(CurLevel, CurNodesHead, CurNodesTail,
ParentNodes),
recursively_group_interior_nodes(CurLevel + 1, ParentNodes, List)
)
).
:- pred group_interior_nodes(int::in, interior_node::in,
list(interior_node)::in, list(interior_node)::out) is det.
group_interior_nodes(Level, Head, Tail, ParentList) :-
range_of_parent_node(Head ^ init_offset, Level,
ParentInitOffset, ParentLimitOffset),
group_interior_nodes_in_range(Level, ParentInitOffset, ParentLimitOffset,
[Head], Tail, ParentHead, Remaining),
(
Remaining = [],
ParentTail = []
;
Remaining = [RemainingHead | RemainingTail],
group_interior_nodes(Level, RemainingHead, RemainingTail, ParentTail)
),
ParentList = [ParentHead | ParentTail].
:- pred group_interior_nodes_in_range(int::in, int::in, int::in,
list(interior_node)::in, list(interior_node)::in,
interior_node::out, list(interior_node)::out) is det.
group_interior_nodes_in_range(Level, ParentInitOffset, ParentLimitOffset,
!.RevAcc, [], ParentNode, []) :-
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
interior_list(Level, list.reverse(!.RevAcc))).
group_interior_nodes_in_range(Level, ParentInitOffset, ParentLimitOffset,
!.RevAcc, [Head | Tail], ParentNode, Remaining) :-
range_of_parent_node(Head ^ init_offset, Level,
HeadParentInitOffset, HeadParentLimitOffset),
( ParentInitOffset = HeadParentInitOffset ->
require(unify(ParentLimitOffset, HeadParentLimitOffset),
"tree_bitset.m: group_interior_nodes_in_range: limit mismatch"),
!:RevAcc = [Head | !.RevAcc],
group_interior_nodes_in_range(Level,
ParentInitOffset, ParentLimitOffset,
!.RevAcc, Tail, ParentNode, Remaining)
;
ParentNode = interior_node(ParentInitOffset, ParentLimitOffset,
interior_list(Level, list.reverse(!.RevAcc))),
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) :-
intersect(Set, Subset, Subset).
superset(Superset, Set) :-
subset(Set, Superset).
%-----------------------------------------------------------------------------%
contains(Set, Elem) :-
Set = tree_bitset(NodeList),
Index = enum_to_index(Elem),
(
NodeList = leaf_list(LeafNodes),
leaflist_contains(LeafNodes, Index)
;
NodeList = interior_list(_, InteriorNodes),
interiorlist_contains(InteriorNodes, Index)
).
:- pred leaflist_contains(list(leaf_node)::in, int::in) is semidet.
leaflist_contains([Head | Tail], Index) :-
Offset = Head ^ leaf_offset,
Index >= Offset,
( Index < Offset + bits_per_int ->
get_bit(Head ^ leaf_bits, Index - Offset) \= 0
;
leaflist_contains(Tail, Index)
).
:- pred interiorlist_contains(list(interior_node)::in, int::in) is semidet.
interiorlist_contains([Head | Tail], Index) :-
Index >= Head ^ init_offset,
( Index < Head ^ limit_offset ->
Components = Head ^ components,
(
Components = leaf_list(LeafNodes),
leaflist_contains(LeafNodes, Index)
;
Components = interior_list(_, InteriorNodes),
interiorlist_contains(InteriorNodes, Index)
)
;
interiorlist_contains(Tail, Index)
).
%-----------------------------------------------------------------------------%
:- pragma promise_equivalent_clauses(member/2).
member(Elem::in, Set::in) :-
contains(Set, Elem).
member(Elem::out, Set::in) :-
Set = tree_bitset(NodeList),
(
NodeList = leaf_list(LeafNodes),
leaflist_member(Index, LeafNodes)
;
NodeList = interior_list(_, InteriorNodes),
interiorlist_member(Index, InteriorNodes)
),
Elem = index_to_enum(Index).
:- pred interiorlist_member(int::out, list(interior_node)::in) is nondet.
interiorlist_member(Index, [Elem | Elems]) :-
(
Components = Elem ^ components,
(
Components = leaf_list(LeafNodes),
leaflist_member(Index, LeafNodes)
;
Components = interior_list(_, InteriorNodes),
interiorlist_member(Index, InteriorNodes)
)
;
interiorlist_member(Index, Elems)
).
:- pred leaflist_member(int::out, list(leaf_node)::in) is nondet.
leaflist_member(Index, [Elem | Elems]) :-
(
leafnode_member(Index, Elem ^ leaf_offset, bits_per_int,
Elem ^ leaf_bits)
;
leaflist_member(Index, Elems)
).
:- pred leafnode_member(int::out, int::in, int::in, int::in) is nondet.
leafnode_member(Index, Offset, Size, Bits) :-
( Bits = 0 ->
fail
; Size = 1 ->
Index = Offset
;
HalfSize = unchecked_right_shift(Size, 1),
Mask = mask(HalfSize),
% Extract the low-order half of the bits.
LowBits = Mask /\ Bits,
% Extract the high-order half of the bits.
HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize),
( leafnode_member(Index, Offset, HalfSize, LowBits)
; leafnode_member(Index, Offset + HalfSize, HalfSize, HighBits)
)
).
%-----------------------------------------------------------------------------%
union(SetA, SetB) = Set :-
SetA = tree_bitset(ListA),
SetB = tree_bitset(ListB),
(
ListA = leaf_list(LeafNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesA = [],
LeafNodesB = [],
List = ListA % or ListB
;
LeafNodesA = [_ | _],
LeafNodesB = [],
List = ListA
;
LeafNodesA = [],
LeafNodesB = [_ | _],
List = ListB
;
LeafNodesA = [FirstNodeA | LaterNodesA],
LeafNodesB = [FirstNodeB | LaterNodesB],
range_of_parent_node(FirstNodeA ^ leaf_offset, 0,
ParentInitOffsetA, ParentLimitOffsetA),
range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
ParentInitOffsetB, ParentLimitOffsetB),
( ParentInitOffsetA = ParentInitOffsetB ->
require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
"tree_bitset.m: union: limit mismatch"),
leaflist_union(LeafNodesA, LeafNodesB, LeafNodes),
List = leaf_list(LeafNodes)
;
raise_leaves_to_interior(FirstNodeA, LaterNodesA,
InteriorNodeA),
raise_leaves_to_interior(FirstNodeB, LaterNodesB,
InteriorNodeB),
interiornode_union(1, InteriorNodeA, [],
1, InteriorNodeB, [], Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
)
;
ListA = leaf_list(LeafNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
(
LeafNodesA = [],
List = ListB
;
LeafNodesA = [FirstNodeA | LaterNodesA],
raise_leaves_to_interior(FirstNodeA, LaterNodesA, InteriorNodeA),
head_and_tail(InteriorNodesB, InteriorHeadB, InteriorTailB),
interiornode_union(1, InteriorNodeA, [],
LevelB, InteriorHeadB, InteriorTailB, Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesB = [],
List = ListA
;
LeafNodesB = [FirstNodeB | LaterNodesB],
raise_leaves_to_interior(FirstNodeB, LaterNodesB, InteriorNodeB),
head_and_tail(InteriorNodesA, InteriorHeadA, InteriorTailA),
interiornode_union(LevelA, InteriorHeadA, InteriorTailA,
1, InteriorNodeB, [], Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
head_and_tail(InteriorNodesA, InteriorHeadA, InteriorTailA),
head_and_tail(InteriorNodesB, InteriorHeadB, InteriorTailB),
interiornode_union(LevelA, InteriorHeadA, InteriorTailA,
LevelB, InteriorHeadB, InteriorTailB,
Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
),
Set = wrap_tree_bitset(List).
:- pred interiornode_union(
int::in, interior_node::in, list(interior_node)::in,
int::in, interior_node::in, list(interior_node)::in,
int::out, list(interior_node)::out) is det.
interiornode_union(LevelA, HeadA, TailA, LevelB, HeadB, TailB, Level, List) :-
int.max(LevelA, LevelB, LevelAB),
raise_interiors_to_level(LevelAB, LevelA, HeadA, TailA,
RaisedHeadA, RaisedTailA),
raise_interiors_to_level(LevelAB, LevelB, HeadB, TailB,
RaisedHeadB, RaisedTailB),
raise_to_common_level(LevelAB,
RaisedHeadA, RaisedTailA, RaisedHeadB, RaisedTailB,
TopHeadA, TopTailA, TopHeadB, TopTailB, Level),
interiorlist_union([TopHeadA | TopTailA], [TopHeadB | TopTailB], List).
:- pred leaflist_union(list(leaf_node)::in, list(leaf_node)::in,
list(leaf_node)::out) is det.
leaflist_union([], [], []).
leaflist_union([], ListB @ [_ | _], ListB).
leaflist_union(ListA @ [_ | _], [], ListA).
leaflist_union(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB], List) :-
OffsetA = HeadA ^ leaf_offset,
OffsetB = HeadB ^ leaf_offset,
( OffsetA = OffsetB ->
Head = make_leaf_node(OffsetA,
(HeadA ^ leaf_bits) \/ (HeadB ^ leaf_bits)),
leaflist_union(TailA, TailB, Tail),
List = [Head | Tail]
; OffsetA < OffsetB ->
leaflist_union(TailA, ListB, Tail),
List = [HeadA | Tail]
;
leaflist_union(ListA, TailB, Tail),
List = [HeadB | Tail]
).
:- pred interiorlist_union(list(interior_node)::in, list(interior_node)::in,
list(interior_node)::out) is det.
interiorlist_union([], [], []).
interiorlist_union([], ListB @ [_ | _], ListB).
interiorlist_union(ListA @ [_ | _], [], ListA).
interiorlist_union(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB], List) :-
OffsetA = HeadA ^ init_offset,
OffsetB = HeadB ^ init_offset,
( OffsetA = OffsetB ->
ComponentsA = HeadA ^ components,
ComponentsB = HeadB ^ components,
(
ComponentsA = leaf_list(LeafListA),
ComponentsB = leaf_list(LeafListB),
leaflist_union(LeafListA, LeafListB, LeafList),
Components = leaf_list(LeafList),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components)
;
ComponentsA = leaf_list(_LeafListA),
ComponentsB = interior_list(_LevelB, _InteriorListB),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_union")
;
ComponentsA = interior_list(_LevelA, _InteriorListA),
ComponentsB = leaf_list(_LeafListB),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_union")
;
ComponentsA = interior_list(LevelA, InteriorListA),
ComponentsB = interior_list(LevelB, InteriorListB),
require(unify(LevelA, LevelB),
"tree_bitset.m: inconsistent levels in interiorlist_union"),
interiorlist_union(InteriorListA, InteriorListB, InteriorList),
Components = interior_list(LevelA, InteriorList),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components)
),
interiorlist_union(TailA, TailB, Tail),
List = [Head | Tail]
; OffsetA < OffsetB ->
interiorlist_union(TailA, ListB, Tail),
List = [HeadA | Tail]
;
interiorlist_union(ListA, TailB, Tail),
List = [HeadB | Tail]
).
%-----------------------------------------------------------------------------%
intersect(SetA, SetB) = Set :-
SetA = tree_bitset(ListA),
SetB = tree_bitset(ListB),
(
ListA = leaf_list(LeafNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesA = [],
LeafNodesB = [],
List = ListA % or ListB
;
LeafNodesA = [_ | _],
LeafNodesB = [],
List = ListB
;
LeafNodesA = [],
LeafNodesB = [_ | _],
List = ListA
;
LeafNodesA = [FirstNodeA | _LaterNodesA],
LeafNodesB = [FirstNodeB | _LaterNodesB],
range_of_parent_node(FirstNodeA ^ leaf_offset, 0,
ParentInitOffsetA, ParentLimitOffsetA),
range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
ParentInitOffsetB, ParentLimitOffsetB),
( ParentInitOffsetA = ParentInitOffsetB ->
require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
"tree_bitset.m: intersect: limit mismatch"),
leaflist_intersect(LeafNodesA, LeafNodesB, LeafNodes),
List = leaf_list(LeafNodes)
;
% The ranges of the two sets do not overlap.
List = leaf_list([])
)
)
;
ListA = leaf_list(LeafNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
(
LeafNodesA = [],
List = ListA
;
LeafNodesA = [FirstNodeA | LaterNodesA],
raise_leaves_to_interior(FirstNodeA, LaterNodesA, InteriorNodeA),
descend_and_intersect(1, InteriorNodeA, LevelB, InteriorNodesB,
List)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesB = [],
List = ListB
;
LeafNodesB = [FirstNodeB | LaterNodesB],
raise_leaves_to_interior(FirstNodeB, LaterNodesB, InteriorNodeB),
descend_and_intersect(1, InteriorNodeB, LevelA, InteriorNodesA,
List)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
( LevelA = LevelB ->
interiorlist_intersect(InteriorNodesA, InteriorNodesB,
InteriorNodes),
List = interior_list(LevelA, InteriorNodes)
;
head_and_tail(InteriorNodesA, InteriorHeadA, InteriorTailA),
head_and_tail(InteriorNodesB, InteriorHeadB, InteriorTailB),
% Our basic approach of raising both operands to the same level
% simplifies the code but searching the larger set for the range
% of the smaller set and starting the operation there would be more
% efficient in both time and space.
interiornode_intersect(LevelA, InteriorHeadA, InteriorTailA,
LevelB, InteriorHeadB, InteriorTailB, Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
),
prune_top_levels(List, PrunedList),
Set = wrap_tree_bitset(PrunedList).
:- pred descend_and_intersect(int::in, interior_node::in,
int::in, list(interior_node)::in, node_list::out) is det.
descend_and_intersect(_LevelA, _InteriorNodeA, _LevelB, [], List) :-
List = leaf_list([]).
descend_and_intersect(LevelA, InteriorNodeA, LevelB, [HeadB | TailB], List) :-
(
HeadB ^ init_offset =< InteriorNodeA ^ init_offset,
InteriorNodeA ^ limit_offset =< HeadB ^ limit_offset
->
( LevelA = LevelB ->
require(unify(InteriorNodeA ^ init_offset, HeadB ^ init_offset),
"tree_bitset.m: inconsistent inits in descend_and_intersect"),
require(unify(InteriorNodeA ^ limit_offset, HeadB ^ limit_offset),
"tree_bitset.m: inconsistent limits in descend_and_intersect"),
ComponentsA = InteriorNodeA ^ components,
ComponentsB = HeadB ^ components,
(
ComponentsA = leaf_list(LeafNodesA),
ComponentsB = leaf_list(LeafNodesB),
leaflist_intersect(LeafNodesA, LeafNodesB, LeafNodes),
List = leaf_list(LeafNodes)
;
ComponentsA = leaf_list(_),
ComponentsB = interior_list(_, _),
error("tree_bitset.m: " ++
"inconsistent levels in descend_and_intersect")
;
ComponentsA = interior_list(_, _),
ComponentsB = leaf_list(_),
error("tree_bitset.m: " ++
"inconsistent levels in descend_and_intersect")
;
ComponentsA = interior_list(_SubLevelA, InteriorNodesA),
ComponentsB = interior_list(_SubLevelB, InteriorNodesB),
interiorlist_intersect(InteriorNodesA, InteriorNodesB,
InteriorNodes),
List = interior_list(LevelA, InteriorNodes)
)
;
require(LevelA < LevelB,
"tree_bitset.m: LevelA > LevelB in descend_and_intersect"),
ComponentsB = HeadB ^ components,
(
ComponentsB = leaf_list(_),
error("tree_bitset.m: " ++
"bad ComponentsB in descend_and_intersect")
;
ComponentsB = interior_list(SubLevelB, InteriorNodesB),
descend_and_intersect(LevelA, InteriorNodeA,
SubLevelB, InteriorNodesB, List)
)
)
;
descend_and_intersect(LevelA, InteriorNodeA, LevelB, TailB, List)
).
:- pred interiornode_intersect(
int::in, interior_node::in, list(interior_node)::in,
int::in, interior_node::in, list(interior_node)::in,
int::out, list(interior_node)::out) is det.
interiornode_intersect(LevelA, HeadA, TailA, LevelB, HeadB, TailB,
Level, List) :-
int.max(LevelA, LevelB, LevelAB),
raise_interiors_to_level(LevelAB, LevelA, HeadA, TailA,
RaisedHeadA, RaisedTailA),
raise_interiors_to_level(LevelAB, LevelB, HeadB, TailB,
RaisedHeadB, RaisedTailB),
raise_to_common_level(LevelAB,
RaisedHeadA, RaisedTailA, RaisedHeadB, RaisedTailB,
TopHeadA, TopTailA, TopHeadB, TopTailB, Level),
interiorlist_intersect([TopHeadA | TopTailA], [TopHeadB | TopTailB], List).
:- pred leaflist_intersect(list(leaf_node)::in, list(leaf_node)::in,
list(leaf_node)::out) is det.
leaflist_intersect([], [], []).
leaflist_intersect([], [_ | _], []).
leaflist_intersect([_ | _], [], []).
leaflist_intersect(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB], List) :-
OffsetA = HeadA ^ leaf_offset,
OffsetB = HeadB ^ leaf_offset,
( OffsetA = OffsetB ->
Bits = HeadA ^ leaf_bits /\ HeadB ^ leaf_bits,
( Bits = 0 ->
leaflist_intersect(TailA, TailB, List)
;
Head = make_leaf_node(OffsetA, Bits),
leaflist_intersect(TailA, TailB, Tail),
List = [Head | Tail]
)
; OffsetA < OffsetB ->
leaflist_intersect(TailA, ListB, List)
;
leaflist_intersect(ListA, TailB, List)
).
:- pred interiorlist_intersect(
list(interior_node)::in, list(interior_node)::in,
list(interior_node)::out) is det.
interiorlist_intersect([], [], []).
interiorlist_intersect([], [_ | _], []).
interiorlist_intersect([_ | _], [], []).
interiorlist_intersect(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB],
List) :-
OffsetA = HeadA ^ init_offset,
OffsetB = HeadB ^ init_offset,
( OffsetA = OffsetB ->
ComponentsA = HeadA ^ components,
ComponentsB = HeadB ^ components,
(
ComponentsA = leaf_list(LeafNodesA),
ComponentsB = leaf_list(LeafNodesB),
leaflist_intersect(LeafNodesA, LeafNodesB, LeafNodes),
(
LeafNodes = [],
interiorlist_intersect(TailA, TailB, List)
;
LeafNodes = [_ | _],
Components = leaf_list(LeafNodes),
interiorlist_intersect(TailA, TailB, Tail),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components),
List = [Head | Tail]
)
;
ComponentsA = interior_list(_LevelA, _InteriorNodesA),
ComponentsB = leaf_list(_LeafNodesB),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_intersect")
;
ComponentsB = interior_list(_LevelB, _InteriorNodesB),
ComponentsA = leaf_list(_LeafNodesA),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_intersect")
;
ComponentsA = interior_list(LevelA, InteriorNodesA),
ComponentsB = interior_list(LevelB, InteriorNodesB),
require(unify(LevelA, LevelB),
"tree_bitset.m: inconsistent levels in interiorlist_intersect"),
interiorlist_intersect(InteriorNodesA, InteriorNodesB,
InteriorNodes),
(
InteriorNodes = [],
interiorlist_intersect(TailA, TailB, List)
;
InteriorNodes = [_ | _],
Components = interior_list(LevelA, InteriorNodes),
interiorlist_intersect(TailA, TailB, Tail),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components),
List = [Head | Tail]
)
)
; OffsetA < OffsetB ->
interiorlist_intersect(TailA, ListB, List)
;
interiorlist_intersect(ListA, TailB, List)
).
%-----------------------------------------------------------------------------%
difference(SetA, SetB) = Set :-
SetA = tree_bitset(ListA),
SetB = tree_bitset(ListB),
% 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
% range of the smaller set and starting the operation there would be more
% efficient in both time and space.
(
ListA = leaf_list(LeafNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesA = [],
List = ListA
;
LeafNodesA = [_ | _],
LeafNodesB = [],
List = ListA
;
LeafNodesA = [FirstNodeA | _LaterNodesA],
LeafNodesB = [FirstNodeB | _LaterNodesB],
range_of_parent_node(FirstNodeA ^ leaf_offset, 0,
ParentInitOffsetA, ParentLimitOffsetA),
range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
ParentInitOffsetB, ParentLimitOffsetB),
( ParentInitOffsetA = ParentInitOffsetB ->
require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
"tree_bitset.m: difference: limit mismatch"),
leaflist_difference(LeafNodesA, LeafNodesB, LeafNodes),
List = leaf_list(LeafNodes)
;
% The ranges of the two sets do not overlap.
List = ListA
)
)
;
ListA = leaf_list(LeafNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
(
LeafNodesA = [],
List = ListB
;
LeafNodesA = [FirstNodeA | LaterNodesA],
raise_leaves_to_interior(FirstNodeA, LaterNodesA, InteriorNodeA),
head_and_tail(InteriorNodesB, InteriorHeadB, InteriorTailB),
interiornode_difference(1, InteriorNodeA, [],
LevelB, InteriorHeadB, InteriorTailB, Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = leaf_list(LeafNodesB),
(
LeafNodesB = [],
List = ListA
;
LeafNodesB = [FirstNodeB | LaterNodesB],
raise_leaves_to_interior(FirstNodeB, LaterNodesB, InteriorNodeB),
head_and_tail(InteriorNodesA, InteriorHeadA, InteriorTailA),
interiornode_difference(LevelA, InteriorHeadA, InteriorTailA,
1, InteriorNodeB, [], Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
)
;
ListA = interior_list(LevelA, InteriorNodesA),
ListB = interior_list(LevelB, InteriorNodesB),
head_and_tail(InteriorNodesA, InteriorHeadA, InteriorTailA),
head_and_tail(InteriorNodesB, InteriorHeadB, InteriorTailB),
interiornode_difference(LevelA, InteriorHeadA, InteriorTailA,
LevelB, InteriorHeadB, InteriorTailB, Level, InteriorNodes),
List = interior_list(Level, InteriorNodes)
),
prune_top_levels(List, PrunedList),
Set = wrap_tree_bitset(PrunedList).
:- pred interiornode_difference(
int::in, interior_node::in, list(interior_node)::in,
int::in, interior_node::in, list(interior_node)::in,
int::out, list(interior_node)::out) is det.
interiornode_difference(LevelA, HeadA, TailA, LevelB, HeadB, TailB,
Level, List) :-
( LevelA < LevelB ->
range_of_parent_node(HeadA ^ init_offset, LevelA + 1,
ParentInitOffsetA, ParentLimitOffsetA),
(
find_containing_node(ParentInitOffsetA, ParentLimitOffsetA,
[HeadB | TailB], ChosenB)
->
ComponentsB = ChosenB ^ components,
(
ComponentsB = leaf_list(_),
require(unify(LevelA, 1),
"tree_bitset.m: interiornode_difference: bad leaf level"),
interiorlist_difference([HeadA | TailA], [ChosenB], List),
Level = LevelA
;
ComponentsB = interior_list(SubLevelB, SubNodesB),
require(unify(LevelB, SubLevelB + 1),
"tree_bitset.m: interiornode_difference: bad levels"),
head_and_tail(SubNodesB, SubHeadB, SubTailB),
interiornode_difference(LevelA, HeadA, TailA,
SubLevelB, SubHeadB, SubTailB, Level, List)
)
;
Level = 1,
List = []
)
;
raise_interiors_to_level(LevelA, LevelB, HeadB, TailB,
RaisedHeadB, RaisedTailB),
range_of_parent_node(HeadA ^ init_offset, LevelA,
ParentInitOffsetA, ParentLimitOffsetA),
range_of_parent_node(RaisedHeadB ^ init_offset, LevelA,
ParentInitOffsetB, ParentLimitOffsetB),
( ParentInitOffsetA = ParentInitOffsetB ->
require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
"tree_bitset.m: interiornode_difference: limit mismatch"),
interiorlist_difference([HeadA | TailA],
[RaisedHeadB | RaisedTailB], List),
Level = LevelA
;
Level = 1,
List = []
)
).
:- pred find_containing_node(int::in, int::in, list(interior_node)::in,
interior_node::out) is semidet.
find_containing_node(InitOffsetA, LimitOffsetA, [HeadB | TailB], ChosenB) :-
(
HeadB ^ init_offset =< InitOffsetA,
LimitOffsetA =< HeadB ^ limit_offset
->
ChosenB = HeadB
;
find_containing_node(InitOffsetA, LimitOffsetA, TailB, ChosenB)
).
:- pred leaflist_difference(list(leaf_node)::in, list(leaf_node)::in,
list(leaf_node)::out) is det.
leaflist_difference([], [], []).
leaflist_difference([], [_ | _], []).
leaflist_difference(ListA @ [_ | _], [], ListA).
leaflist_difference(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB], List) :-
OffsetA = HeadA ^ leaf_offset,
OffsetB = HeadB ^ leaf_offset,
( OffsetA = OffsetB ->
Bits = (HeadA ^ leaf_bits) /\ \ (HeadB ^ leaf_bits),
( Bits = 0 ->
leaflist_difference(TailA, TailB, List)
;
Head = make_leaf_node(OffsetA, Bits),
leaflist_difference(TailA, TailB, Tail),
List = [Head | Tail]
)
; OffsetA < OffsetB ->
leaflist_difference(TailA, ListB, Tail),
List = [HeadA | Tail]
;
leaflist_difference(ListA, TailB, List)
).
:- pred interiorlist_difference(
list(interior_node)::in, list(interior_node)::in,
list(interior_node)::out) is det.
interiorlist_difference([], [], []).
interiorlist_difference([], [_ | _], []).
interiorlist_difference(ListA @ [_ | _], [], ListA).
interiorlist_difference(ListA @ [HeadA | TailA], ListB @ [HeadB | TailB],
List) :-
OffsetA = HeadA ^ init_offset,
OffsetB = HeadB ^ init_offset,
( OffsetA = OffsetB ->
ComponentsA = HeadA ^ components,
ComponentsB = HeadB ^ components,
(
ComponentsA = leaf_list(LeafNodesA),
ComponentsB = leaf_list(LeafNodesB),
leaflist_difference(LeafNodesA, LeafNodesB, LeafNodes),
(
LeafNodes = [],
interiorlist_difference(TailA, TailB, List)
;
LeafNodes = [_ | _],
Components = leaf_list(LeafNodes),
interiorlist_difference(TailA, TailB, Tail),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components),
List = [Head | Tail]
)
;
ComponentsA = interior_list(_LevelA, _InteriorNodesA),
ComponentsB = leaf_list(_LeafNodesB),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_difference")
;
ComponentsB = interior_list(_LevelB, _InteriorNodesB),
ComponentsA = leaf_list(_LeafNodesA),
error("tree_bitset.m: " ++
"inconsistent components in interiorlist_difference")
;
ComponentsA = interior_list(LevelA, InteriorNodesA),
ComponentsB = interior_list(LevelB, InteriorNodesB),
require(unify(LevelA, LevelB),
"tree_bitset.m: " ++
"inconsistent levels in interiorlist_difference"),
interiorlist_difference(InteriorNodesA, InteriorNodesB,
InteriorNodes),
(
InteriorNodes = [],
interiorlist_difference(TailA, TailB, List)
;
InteriorNodes = [_ | _],
Components = interior_list(LevelA, InteriorNodes),
interiorlist_difference(TailA, TailB, Tail),
Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
Components),
List = [Head | Tail]
)
)
; OffsetA < OffsetB ->
interiorlist_difference(TailA, ListB, Tail),
List = [HeadA | Tail]
;
interiorlist_difference(ListA, TailB, List)
).
%-----------------------------------------------------------------------------%
% Return the offset of the element of a set which should contain the given
% element, and an int with the bit corresponding to that element set.
%
:- pred bits_for_index(int::in, int::out, int::out) is det.
:- pragma inline(bits_for_index/3).
bits_for_index(Index, Offset, Bits) :-
Offset = int.floor_to_multiple_of_bits_per_int(Index),
BitToSet = Index - Offset,
Bits = set_bit(0, BitToSet).
:- func get_bit(int, int) = int.
:- pragma inline(get_bit/2).
get_bit(Int, Bit) = Int /\ unchecked_left_shift(1, Bit).
:- func set_bit(int, int) = int.
:- pragma inline(set_bit/2).
set_bit(Int0, Bit) = Int0 \/ unchecked_left_shift(1, Bit).
:- func clear_bit(int, int) = int.
:- pragma inline(clear_bit/2).
clear_bit(Int0, Bit) = Int0 /\ \ unchecked_left_shift(1, Bit).
% `mask(N)' returns a mask which can be `and'ed with an integer to return
% the lower `N' bits of the integer. `N' must be less than bits_per_int.
%
:- func mask(int) = int.
:- pragma inline(mask/1).
mask(N) = \ unchecked_left_shift(\ 0, N).
%-----------------------------------------------------------------------------%
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)).
union(A, B, union(A, B)).
intersect(A, B, intersect(A, B)).
difference(A, B, difference(A, B)).
%-----------------------------------------------------------------------------%
:- type fold_direction
---> low_to_high
; high_to_low.
foldl(F, Set, Acc0) = Acc :-
P = (pred(E::in, PAcc0::in, PAcc::out) is det :-
PAcc = F(E, PAcc0)
),
foldl(P, Set, Acc0, Acc).
foldl(P, Set, !Acc) :-
Set = tree_bitset(List),
(
List = leaf_list(LeafNodes),
leaf_foldl_pred(P, LeafNodes, !Acc)
;
List = interior_list(_, InteriorNodes),
do_foldl_pred(P, InteriorNodes, !Acc)
).
foldl2(P, Set, !AccA, !AccB) :-
Set = tree_bitset(List),
(
List = leaf_list(LeafNodes),
leaf_foldl2_pred(P, LeafNodes, !AccA, !AccB)
;
List = interior_list(_, InteriorNodes),
do_foldl2_pred(P, InteriorNodes, !AccA, !AccB)
).
:- pred do_foldl_pred(pred(T, U, U), list(interior_node), U, U) <= enum(T).
:- mode do_foldl_pred(pred(in, di, uo) is det, in, di, uo) is det.
:- mode do_foldl_pred(pred(in, in, out) is det, in, in, out) is det.
:- mode do_foldl_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode do_foldl_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode do_foldl_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode do_foldl_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pragma type_spec(do_foldl_pred/4, T = int).
:- pragma type_spec(do_foldl_pred/4, T = var(_)).
do_foldl_pred(_, [], !Acc).
do_foldl_pred(P, [H | T], !Acc) :-
Components = H ^ components,
(
Components = leaf_list(LeafNodes),
leaf_foldl_pred(P, LeafNodes, !Acc)
;
Components = interior_list(_, InteriorNodes),
do_foldl_pred(P, InteriorNodes, !Acc)
),
do_foldl_pred(P, T, !Acc).
:- pred leaf_foldl_pred(pred(T, U, U), list(leaf_node), U, U) <= enum(T).
:- mode leaf_foldl_pred(pred(in, di, uo) is det, in, di, uo) is det.
:- mode leaf_foldl_pred(pred(in, in, out) is det, in, in, out) is det.
:- mode leaf_foldl_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode leaf_foldl_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode leaf_foldl_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode leaf_foldl_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pragma type_spec(leaf_foldl_pred/4, T = int).
:- pragma type_spec(leaf_foldl_pred/4, T = var(_)).
leaf_foldl_pred(_, [], !Acc).
leaf_foldl_pred(P, [H | T], !Acc) :-
fold_bits(low_to_high, P, H ^ leaf_offset, H ^ leaf_bits, bits_per_int,
!Acc),
leaf_foldl_pred(P, T, !Acc).
:- pred do_foldl2_pred(pred(T, U, U, V, V), list(interior_node), U, U, V, V)
<= enum(T).
:- mode do_foldl2_pred(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
:- mode do_foldl2_pred(pred(in, in, out, di, uo) is det,
in, in, out, di, uo) is det.
:- mode do_foldl2_pred(pred(in, in, out, in, out) is det,
in, in, out, in, out) is det.
:- mode do_foldl2_pred(pred(in, in, out, in, out) is semidet,
in, in, out, in, out) is semidet.
:- mode do_foldl2_pred(pred(in, in, out, in, out) is nondet,
in, in, out, in, out) is nondet.
:- mode do_foldl2_pred(pred(in, di, uo, di, uo) is cc_multi,
in, di, uo, di, uo) is cc_multi.
:- mode do_foldl2_pred(pred(in, in, out, di, uo) is cc_multi,
in, in, out, di, uo) is cc_multi.
:- mode do_foldl2_pred(pred(in, in, out, in, out) is cc_multi,
in, in, out, in, out) is cc_multi.
:- pragma type_spec(do_foldl2_pred/6, T = int).
:- pragma type_spec(do_foldl2_pred/6, T = var(_)).
do_foldl2_pred(_, [], !AccA, !AccB).
do_foldl2_pred(P, [H | T], !AccA, !AccB) :-
Components = H ^ components,
(
Components = leaf_list(LeafNodes),
leaf_foldl2_pred(P, LeafNodes, !AccA, !AccB)
;
Components = interior_list(_, InteriorNodes),
do_foldl2_pred(P, InteriorNodes, !AccA, !AccB)
),
do_foldl2_pred(P, T, !AccA, !AccB).
:- pred leaf_foldl2_pred(pred(T, U, U, V, V), list(leaf_node), U, U, V, V)
<= enum(T).
:- mode leaf_foldl2_pred(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
:- mode leaf_foldl2_pred(pred(in, in, out, di, uo) is det,
in, in, out, di, uo) is det.
:- mode leaf_foldl2_pred(pred(in, in, out, in, out) is det,
in, in, out, in, out) is det.
:- mode leaf_foldl2_pred(pred(in, in, out, in, out) is semidet,
in, in, out, in, out) is semidet.
:- mode leaf_foldl2_pred(pred(in, in, out, in, out) is nondet,
in, in, out, in, out) is nondet.
:- mode leaf_foldl2_pred(pred(in, di, uo, di, uo) is cc_multi,
in, di, uo, di, uo) is cc_multi.
:- mode leaf_foldl2_pred(pred(in, in, out, di, uo) is cc_multi,
in, in, out, di, uo) is cc_multi.
:- mode leaf_foldl2_pred(pred(in, in, out, in, out) is cc_multi,
in, in, out, in, out) is cc_multi.
:- pragma type_spec(leaf_foldl2_pred/6, T = int).
:- pragma type_spec(leaf_foldl2_pred/6, T = var(_)).
leaf_foldl2_pred(_, [], !AccA, !AccB).
leaf_foldl2_pred(P, [H | T], !AccA, !AccB) :-
fold2_bits(low_to_high, P, H ^ leaf_offset, H ^ leaf_bits, bits_per_int,
!AccA, !AccB),
leaf_foldl2_pred(P, T, !AccA, !AccB).
foldr(F, Set, Acc0) = Acc :-
P = (pred(E::in, PAcc0::in, PAcc::out) is det :-
PAcc = F(E, PAcc0)
),
foldr(P, Set, Acc0, Acc).
foldr(P, Set, !Acc) :-
Set = tree_bitset(List),
(
List = leaf_list(LeafNodes),
leaf_foldr_pred(P, LeafNodes, !Acc)
;
List = interior_list(_, InteriorNodes),
do_foldr_pred(P, InteriorNodes, !Acc)
).
foldr2(P, Set, !AccA, !AccB) :-
Set = tree_bitset(List),
(
List = leaf_list(LeafNodes),
leaf_foldr2_pred(P, LeafNodes, !AccA, !AccB)
;
List = interior_list(_, InteriorNodes),
do_foldr2_pred(P, InteriorNodes, !AccA, !AccB)
).
:- pred do_foldr_pred(pred(T, U, U), list(interior_node), U, U) <= enum(T).
:- mode do_foldr_pred(pred(in, di, uo) is det, in, di, uo) is det.
:- mode do_foldr_pred(pred(in, in, out) is det, in, in, out) is det.
:- mode do_foldr_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode do_foldr_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode do_foldr_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode do_foldr_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pragma type_spec(do_foldr_pred/4, T = int).
:- pragma type_spec(do_foldr_pred/4, T = var(_)).
% We don't just use list.foldr here because the overhead of allocating
% the closure for fold_bits is significant for the compiler's runtime,
% so it's best to avoid that even if `--optimize-higher-order' is not set.
do_foldr_pred(_, [], !Acc).
do_foldr_pred(P, [H | T], !Acc) :-
do_foldr_pred(P, T, !Acc),
Components = H ^ components,
(
Components = leaf_list(LeafNodes),
leaf_foldr_pred(P, LeafNodes, !Acc)
;
Components = interior_list(_, InteriorNodes),
do_foldr_pred(P, InteriorNodes, !Acc)
).
:- pred leaf_foldr_pred(pred(T, U, U), list(leaf_node), U, U) <= enum(T).
:- mode leaf_foldr_pred(pred(in, di, uo) is det, in, di, uo) is det.
:- mode leaf_foldr_pred(pred(in, in, out) is det, in, in, out) is det.
:- mode leaf_foldr_pred(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode leaf_foldr_pred(pred(in, in, out) is nondet, in, in, out) is nondet.
:- mode leaf_foldr_pred(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
:- mode leaf_foldr_pred(pred(in, in, out) is cc_multi, in, in, out) is cc_multi.
:- pragma type_spec(leaf_foldr_pred/4, T = int).
:- pragma type_spec(leaf_foldr_pred/4, T = var(_)).
% We don't just use list.foldr here because the overhead of allocating
% the closure for fold_bits is significant for the compiler's runtime,
% so it's best to avoid that even if `--optimize-higher-order' is not set.
leaf_foldr_pred(_, [], !Acc).
leaf_foldr_pred(P, [H | T], !Acc) :-
leaf_foldr_pred(P, T, !Acc),
fold_bits(high_to_low, P, H ^ leaf_offset, H ^ leaf_bits, bits_per_int,
!Acc).
:- pred do_foldr2_pred(pred(T, U, U, V, V), list(interior_node), U, U, V, V)
<= enum(T).
:- mode do_foldr2_pred(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
:- mode do_foldr2_pred(pred(in, in, out, di, uo) is det,
in, in, out, di, uo) is det.
:- mode do_foldr2_pred(pred(in, in, out, in, out) is det,
in, in, out, in, out) is det.
:- mode do_foldr2_pred(pred(in, in, out, in, out) is semidet,
in, in, out, in, out) is semidet.
:- mode do_foldr2_pred(pred(in, in, out, in, out) is nondet,
in, in, out, in, out) is nondet.
:- mode do_foldr2_pred(pred(in, di, uo, di, uo) is cc_multi,
in, di, uo, di, uo) is cc_multi.
:- mode do_foldr2_pred(pred(in, in, out, di, uo) is cc_multi,
in, in, out, di, uo) is cc_multi.
:- mode do_foldr2_pred(pred(in, in, out, in, out) is cc_multi,
in, in, out, in, out) is cc_multi.
:- pragma type_spec(do_foldr2_pred/6, T = int).
:- pragma type_spec(do_foldr2_pred/6, T = var(_)).
% We don't just use list.foldr here because the overhead of allocating
% the closure for fold_bits is significant for the compiler's runtime,
% so it's best to avoid that even if `--optimize-higher-order' is not set.
do_foldr2_pred(_, [], !AccA, !AccB).
do_foldr2_pred(P, [H | T], !AccA, !AccB) :-
do_foldr2_pred(P, T, !AccA, !AccB),
Components = H ^ components,
(
Components = leaf_list(LeafNodes),
leaf_foldr2_pred(P, LeafNodes, !AccA, !AccB)
;
Components = interior_list(_, InteriorNodes),
do_foldr2_pred(P, InteriorNodes, !AccA, !AccB)
).
:- pred leaf_foldr2_pred(pred(T, U, U, V, V), list(leaf_node), U, U, V, V)
<= enum(T).
:- mode leaf_foldr2_pred(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
:- mode leaf_foldr2_pred(pred(in, in, out, di, uo) is det,
in, in, out, di, uo) is det.
:- mode leaf_foldr2_pred(pred(in, in, out, in, out) is det,
in, in, out, in, out) is det.
:- mode leaf_foldr2_pred(pred(in, in, out, in, out) is semidet,
in, in, out, in, out) is semidet.
:- mode leaf_foldr2_pred(pred(in, in, out, in, out) is nondet,
in, in, out, in, out) is nondet.
:- mode leaf_foldr2_pred(pred(in, di, uo, di, uo) is cc_multi,
in, di, uo, di, uo) is cc_multi.
:- mode leaf_foldr2_pred(pred(in, in, out, di, uo) is cc_multi,
in, in, out, di, uo) is cc_multi.
:- mode leaf_foldr2_pred(pred(in, in, out, in, out) is cc_multi,
in, in, out, in, out) is cc_multi.
:- pragma type_spec(leaf_foldr2_pred/6, T = int).
:- pragma type_spec(leaf_foldr2_pred/6, T = var(_)).
% We don't just use list.foldr here because the overhead of allocating
% the closure for fold_bits is significant for the compiler's runtime,
% so it's best to avoid that even if `--optimize-higher-order' is not set.
leaf_foldr2_pred(_, [], !AccA, !AccB).
leaf_foldr2_pred(P, [H | T], !AccA, !AccB) :-
leaf_foldr2_pred(P, T, !AccA, !AccB),
fold2_bits(high_to_low, P, H ^ leaf_offset, H ^ leaf_bits, bits_per_int,
!AccA, !AccB).
% Do a binary search for the 1 bits in an int.
%
:- pred fold_bits(fold_direction, pred(T, U, U),
int, int, int, U, U) <= enum(T).
:- mode fold_bits(in, pred(in, in, out) is det,
in, in, in, in, out) is det.
:- mode fold_bits(in, pred(in, di, uo) is det,
in, in, in, di, uo) is det.
:- mode fold_bits(in, pred(in, in, out) is semidet,
in, in, in, in, out) is semidet.
:- mode fold_bits(in, pred(in, in, out) is nondet,
in, in, in, in, out) is nondet.
:- mode fold_bits(in, pred(in, di, uo) is cc_multi,
in, in, in, di, uo) is cc_multi.
:- mode fold_bits(in, pred(in, in, out) is cc_multi,
in, in, in, in, out) is cc_multi.
:- pragma type_spec(fold_bits/7, T = int).
:- pragma type_spec(fold_bits/7, T = var(_)).
fold_bits(Dir, P, Offset, Bits, Size, !Acc) :-
( Bits = 0 ->
true
; Size = 1 ->
Elem = index_to_enum(Offset),
P(Elem, !Acc)
;
HalfSize = unchecked_right_shift(Size, 1),
Mask = mask(HalfSize),
% Extract the low-order half of the bits.
LowBits = Mask /\ Bits,
% Extract the high-order half of the bits.
HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize),
(
Dir = low_to_high,
fold_bits(Dir, P, Offset, LowBits, HalfSize, !Acc),
fold_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize, !Acc)
;
Dir = high_to_low,
fold_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize, !Acc),
fold_bits(Dir, P, Offset, LowBits, HalfSize, !Acc)
)
).
:- pred fold2_bits(fold_direction, pred(T, U, U, V, V),
int, int, int, U, U, V, V) <= enum(T).
:- mode fold2_bits(in, pred(in, di, uo, di, uo) is det,
in, in, in, di, uo, di, uo) is det.
:- mode fold2_bits(in, pred(in, in, out, di, uo) is det,
in, in, in, in, out, di, uo) is det.
:- mode fold2_bits(in, pred(in, in, out, in, out) is det,
in, in, in, in, out, in, out) is det.
:- mode fold2_bits(in, pred(in, in, out, in, out) is semidet,
in, in, in, in, out, in, out) is semidet.
:- mode fold2_bits(in, pred(in, in, out, in, out) is nondet,
in, in, in, in, out, in, out) is nondet.
:- mode fold2_bits(in, pred(in, di, uo, di, uo) is cc_multi,
in, in, in, di, uo, di, uo) is cc_multi.
:- mode fold2_bits(in, pred(in, in, out, di, uo) is cc_multi,
in, in, in, in, out, di, uo) is cc_multi.
:- mode fold2_bits(in, pred(in, in, out, in, out) is cc_multi,
in, in, in, in, out, in, out) is cc_multi.
:- pragma type_spec(fold2_bits/9, T = int).
:- pragma type_spec(fold2_bits/9, T = var(_)).
fold2_bits(Dir, P, Offset, Bits, Size, !AccA, !AccB) :-
( Bits = 0 ->
true
; Size = 1 ->
Elem = index_to_enum(Offset),
P(Elem, !AccA, !AccB)
;
HalfSize = unchecked_right_shift(Size, 1),
Mask = mask(HalfSize),
% Extract the low-order half of the bits.
LowBits = Mask /\ Bits,
% Extract the high-order half of the bits.
HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize),
(
Dir = low_to_high,
fold2_bits(Dir, P, Offset, LowBits, HalfSize, !AccA, !AccB),
fold2_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize,
!AccA, !AccB)
;
Dir = high_to_low,
fold2_bits(Dir, P, Offset + HalfSize, HighBits, HalfSize,
!AccA, !AccB),
fold2_bits(Dir, P, Offset, LowBits, HalfSize, !AccA, !AccB)
)
).
Reference in New Issue View Git Blame Copy Permalink