implementation module BitSet;

// implementation of finite integer sets
import
	StdEnv;

class BitSetAccessors a
where {
	get_bit_set_word_at_index :: !Int !*a -> (!Int,!*a)
};

instance BitSetAccessors BitSet
where {
	get_bit_set_word_at_index index bitset=:{map}
		#! (word,map)
			= map![index];
		= (word,{bitset & map = map});
};
		

roundup_to_multiple s m :== (dec (s + m) / m) * m;

// MACROS	
BITS_IN_WORD	:== 32;
DIV_WSIZE x		:== x >> 5;
MOD_WSIZE x		:== x bitand (dec BITS_IN_WORD);

GBIT_UPDATE_FSET fs x op	:== gbit fs x op
where {
	gbit fs=:{map} x op
		#! div_wsize
			= DIV_WSIZE x;
		#! (map_elem,map)
			= map![div_wsize];
		= { fs & map = { map & [div_wsize] = (op) map_elem (1 << (MOD_WSIZE x)) } };
}

GBIT fs x op	:== gbit fs x op
where {
	gbit fs=:{map} x op
		#! div_wsize
			= DIV_WSIZE x;
		#! (map_elem,map)
			= map![div_wsize];
		= ((op) map_elem (1 << (MOD_WSIZE x)),{fs & map = map});
}

RANGE_CHECK s x	id :== range_check s x id
where {
	range_check s=:{n_elements} x id
		#! i_elem
			= toInt x;
		| i_elem < 0 || i_elem >= n_elements 
			= abort ("RANGE_CHECK!: " +++ id +++ " set t!oo! small, set size: " +++ toString n_elements +++ " asked for element: " +++ toString i_elem); 
			= (i_elem,s);
}

EmptyBitSet :: .BitSet;
EmptyBitSet
	= NewBitSet 0;

NewBitSet :: !Int -> .BitSet;
NewBitSet n_elements
	// compute amount of Clean INTs needed to represent the set
	#! n_map
		= (roundup_to_multiple n_elements BITS_IN_WORD) / BITS_IN_WORD;
	
	// create empty set
	#! set
		= { BitSet |
			n_elements	= n_elements
		,	map			= createArray n_map 0
	}; 
	= set;
	
ClearBitSet :: !.BitSet -> .BitSet;
ClearBitSet bitset=:{map}
	= { bitset & map =  { 0 \\ b <-: map } };
	
EqualBitSet :: !*BitSet !*BitSet -> (!Bool,!*BitSet,!*BitSet);
EqualBitSet fset1=:{n_elements=n_elements1,map=map1} fset2=:{n_elements=n_elements2,map=map2}
	| n_elements1 <> n_elements2
		= (False,fset1,fset2);
	
	// if a complemented set is equal to the same set but not constructed with
	// the complement operation, then the sets are *not* considered the same.	
	#! n_ints
		= (roundup_to_multiple n_elements1 BITS_IN_WORD) / 32;
	#! (equal_fsets,map1,map2)
		= equal_fset 0 n_ints map1 map2
	= (equal_fsets,{fset1 & map = map1},{fset2 & map = map2});
where {
	equal_fset i limit map1 map2		
		| i == limit	
			= (True,map1,map2);
		#! (i1,map1) = map1![i];
		#! (i2,map2) = map2![i];
		| i1 <> i2
			= (False,map1,map2);
		= equal_fset (inc i) limit map1 map2; 
}
		
DelBitSet :: !*BitSet !a -> *BitSet | fromInt, toInt a;
DelBitSet fset elem
	#! (elem,fset)
		= RANGE_CHECK fset elem	"DelBitSet";
	= GBIT_UPDATE_FSET fset elem (\a1 a2 -> a1 bitand (bitnot a2));
	
AddBitSet :: !*BitSet !a -> *BitSet | toInt a;
AddBitSet fset elem
	#! (elem,fset)
		= RANGE_CHECK fset elem	"AddBitSet";
	= GBIT_UPDATE_FSET fset elem (bitor);
	
isBitSetMember :: !u:BitSet !Int -> (Bool,v:BitSet), [u <= v];
isBitSetMember fset elem
	#! (elem,fset)
		= RANGE_CHECK fset elem "isBitSetMember";
	#! (elem,fset)
		= GBIT fset elem (bitand)
	= (elem <> 0,fset);
	
isBitSetMemberE	select_func s elem :== isBitSetMemberE2 select_func s elem;
where {
	isBitSetMemberE2 select_func s elem
		#! div_wsize
			= DIV_WSIZE elem;
		#! (map_elem,s)
			= select_func div_wsize s;
		#! map_elem
			= map_elem bitand (1 << (MOD_WSIZE elem));
		= (map_elem <> 0,s);
};

AddBitSetE select_func update_func s elem :== AddBitSetE select_func update_func s elem;
where {
	AddBitSetE select_func update_func s elem
		#! div_wsize
			= DIV_WSIZE elem;
		#! (map_elem,s)
			= select_func div_wsize s;
		#! map_elem
			= map_elem bitor (1 << (MOD_WSIZE elem));
		#! s
			= update_func map_elem div_wsize s;
		= s;
};

DelBitSetE select_func update_func s elem :== DelBitSetE select_func update_func s elem;
where {
	DelBitSetE select_func update_func s elem
		#! div_wsize
			= DIV_WSIZE elem;
		#! (map_elem,s)
			= select_func div_wsize s;
		#! map_elem
			= map_elem bitand (bitnot (1 << (MOD_WSIZE elem)));
		#! s
			= update_func map_elem div_wsize s;
		= s;		
};

// FINITE SET REPRESENTATION
:: BitSet
	= {
		n_elements	:: !Int
	,	map			:: !.{#Int}
	};
	
ComplementBitSet :: !*BitSet -> *BitSet;
ComplementBitSet fset=:{map}
	#! (s_map,map)
		= usize map;
	#! fset
		= { fset &
			map = complement_fset_loop 0 s_map map
		};
	= fset;
where {
	complement_fset_loop :: !Int !Int !*{#Int} -> *{#Int};
	complement_fset_loop i limit map
		| i == limit
			= map;
			
		#! (e_i,map)
			= map![i]
		#! map
			= { map & [i] = bitnot e_i };
		= complement_fset_loop (inc i) limit map;
}

enum_setSt :: (Int -> .(.a -> .a)) !u:BitSet .a -> (v:BitSet,.a), [u <= v];
enum_setSt f fset=:{n_elements,map} state
	#! (fset,state) 
		= enum_setSt 0 fset state
	= (fset,state);
where {
	enum_setSt i fset state
		| i == n_elements
			= (fset,state)

		#! (is_member,fset)
			= isBitSetMember fset i;
		| is_member
			= enum_setSt (inc i) fset (f i state);
			= enum_setSt (inc i) fset state;
	}