-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

-- old bit vector implementation based on using 30 bits of a 32 bit integer.  
-- has the advantage of being expressible at the Cecil src level instead
-- of relying on lots of RTL primitives.  contrast with bit-vector.cecil.

(--DOC
  Bit vectors are a dense representation of a mutable indexed collection of
  zeros and ones. A new bit vector of zeros (using the old implementation) 
  can be created with `new_old_bit_vector'. A bit vector can be resized in 
  place; if expanded, then the new positions are filled in with zeros.
--)

module OldBitVector {

template object old_bit_vector isa m_indexed[int];
  private put var field bits(@:old_bit_vector):m_indexed[int];
  private put var field length(@:old_bit_vector):int := 0;

-- to make conservative GC work better, use only 30 bits with 2-bit tag of 10
private let num_tag_bits:int := 1;
private let bits_per_word:int := 30  (-- num_int_bits - num_tag_bits --);

private method set_tag(i:int):int { i.set_bit(0) }
private let all_zeros_word:int := set_tag(0);
private let all_ones_word:int := set_tag(-1);

private method word_num(bit:int):int { bit / bits_per_word }
private method bit_num_in_word(bit:int):int {
    bit % bits_per_word + num_tag_bits }
private method num_words(num_bits:int):int {
    (num_bits + bits_per_word - 1) / bits_per_word }

-- Returns the idxth word of the bit vector, or 0 if idx is not in
private method word(t@:old_bit_vector, idx:int):int {
    t.bits.fetch(idx, { all_zeros_word }) }

private method canonicalize_final_word(t@:old_bit_vector):void {
    if(t.length % bits_per_word > 0, {
	-- clear any bits past the end in the last word
	let word_num:int := word_num(t.length.pred);
	let var w:int := t.bits!word_num;
	let var bit:int := bit_num_in_word(t.length);
	while({ bit < bits_per_word }, {
	    w := clear_bit(w, bit);
	    bit := bit.succ;
	});
	t.bits!word_num := w;
    });
}

method new_old_bit_vector(sz:int):old_bit_vector {
    concrete object isa old_bit_vector {
      bits := new_m_vector[int](num_words(sz), all_zeros_word),
      length := sz } }

method copy(t@:old_bit_vector):old_bit_vector {
    concrete object isa old_bit_vector {
      bits := t.bits.copy, length := t.length } }

method resize(t@:old_bit_vector, new_size:int):void {
    t.bits :=
      new_m_vector_init[int](num_words(new_size), &(i:int){ t.word(i) });
    t.length := new_size;
    t.canonicalize_final_word;
}


method =(l@:old_bit_vector, r@:old_bit_vector):bool {
    l == r | { l.length = r.length & { l.bits = r.bits } } }
method hash(l@:old_bit_vector, range:int):int { l.bits.hash(range) }

-- bit-set support functions; work specially to ignore explicit trailing zeros
method =_or_zero(l@:old_bit_vector, r@:old_bit_vector):bool {
    max(l.bits.length, r.bits.length).do(&(word_num:int){
        if(l.word(word_num) != r.word(word_num), { ^ false });
    });
    true }


--DOC Bit vectors can be or'd, and'd, xor'd, subtracted, and negated, all
--DOC bitwise, to compute new bit vectors from old.

method bit_or(l@:old_bit_vector, r@:old_bit_vector):old_bit_vector {
    let new_size:int := max(l.length, r.length);
    let result:old_bit_vector := new_old_bit_vector(new_size);
    result.bits.length.do(&(i:int){
	result.bits!i := l.word(i) _bit_or r.word(i);	-- doesn't affect tag
    });
    result }

method bit_and(l@:old_bit_vector, r@:old_bit_vector):old_bit_vector {
    let new_size:int := max(l.length, r.length);
    let result:old_bit_vector := new_old_bit_vector(new_size);
    result.bits.length.do(&(i:int){
	result.bits!i := l.word(i) _bit_and r.word(i);	-- doesn't affect tag
    });
    result }

method bit_xor(l@:old_bit_vector, r@:old_bit_vector):old_bit_vector {
    let new_size:int := max(l.length, r.length);
    let result:old_bit_vector := new_old_bit_vector(new_size);
    result.bits.length.do(&(i:int){
	result.bits!i := set_tag(l.word(i) _bit_xor r.word(i));
    });
    result.canonicalize_final_word;	-- need to zero excess bits
    result }

method bit_xnor(l@:old_bit_vector, r@:old_bit_vector):old_bit_vector {
    let new_size:int := max(l.length, r.length);
    let result:old_bit_vector := new_old_bit_vector(new_size);
    result.bits.length.do(&(i:int){
	result.bits!i := set_tag(l.word(i) _bit_xnor r.word(i));
    });
    result.canonicalize_final_word;	-- need to zero excess bits
    result }

method bit_not(l@:old_bit_vector):old_bit_vector {
    let result:old_bit_vector := new_old_bit_vector(l.length);
    l.bits.length.do(&(i:int){
	result.bits!i := set_tag(bit_not(l.bits!i));
    });
    result.canonicalize_final_word;	-- need to zero excess bits
    result }

-- similar to bit_and(l, bit_not(r)), if r is padded out to the length of l
method bit_difference(l@:old_bit_vector, r@:old_bit_vector):old_bit_vector {
    let result:old_bit_vector := new_old_bit_vector(l.length);
    result.bits.length.do(&(i:int){
	result.bits!i := set_tag(l.word(i) _bit_and _bit_not r.word(i));
    });
    result }

-- includes_all and is_disjoint are implemented here to avoid allocating
-- a whole new bit vector to answer a simple boolean query

-- Returns true iff l includes all the bits that are set in r
method includes_all(l@:old_bit_vector, r@:old_bit_vector):bool {
    let sz:int := max(l.length, r.length);
    sz.do(&(i:int){
	let lw:int := l.word(i);
	let rw:int := r.word(i);
	if((lw _bit_and rw) != rw, { ^ false });
    });
    true }

--DOC A bit vector can be mutated to be all zeros (`clear_all_bits')
--DOC or all ones (`set_all_bits') or tested for those conditions.
--DOC The `is_disjoint' method returns true if its arguments share no
--DOC set bits; is_disjoint(a,b) is equivalent to `is_all_zeros(bit_and(a,b))'.

-- Returns true iff l and r have no bits in common
method is_disjoint(l@:old_bit_vector, r@:old_bit_vector):bool {
    let sz:int := max(l.length, r.length);
    sz.do(&(i:int){
	let lw:int := l.word(i);
	let rw:int := r.word(i);
	if((lw _bit_and rw) != all_zeros_word, { ^ false });
    });
    true }


method fetch(v@:old_bit_vector, bit:int, if_absent:&():int):int {
    if(bit < 0 | { bit >= v.length }, if_absent, {
	get_bit(v.bits!word_num(bit), bit_num_in_word(bit)) }) }

method store(v@:old_bit_vector, bit:int, value:int, if_absent:&():void):void {
    if(bit < 0 | { bit >= v.length }, if_absent, {
	let idx:int := word_num(bit);
	let offset:int := bit_num_in_word(bit);
	if(value != 0,
	   { v.bits!idx := set_bit(v.bits!idx, offset); },
	   { v.bits!idx := clear_bit(v.bits!idx, offset); });
    });
}

method set_all_bits(v@:old_bit_vector):void {
    v.bits.length.do(&(i:int){ v.bits!i := all_ones_word; });
    v.canonicalize_final_word;	-- need to zero excess bits
}

method clear_all_bits(v@:old_bit_vector):void {
    v.bits.length.do(&(i:int){ v.bits!i := all_zeros_word; });
}

method is_all_zeros(v@:old_bit_vector):bool {
    v.bits.do(&(i:int){ if(i != all_zeros_word, { ^ false }); });
    true }

method is_all_ones(v@:old_bit_vector):bool {
    v.bits.do_associations(&(word_num:int, i:int){
	if(i != all_ones_word, {
	    if(word_num = v.bits.length.pred, {
		-- need to process last word specially
		((v.length - 1) % bits_per_word + 1).do(&(bit_num:int){
		    if(get_bit(i, bit_num) != 1, { ^ false });
		});
		-- all defined positions are 1; OK
	    }, {
		^ false
	    });
	});
    });
    true }

--DOC The `do_ones' control structure iterates over all the set
--DOC positions in the bit vector; this operation runs faster than a
--DOC regular `do' loop containing a test in each iteration.

-- Evalutes the argument closure for each position in the bit vector that is
-- non-zero.  Does a quick test to skip words that are 0.  Assumes that the
-- bit vector is padded with 0 bits, if it doesn't exactly fit in the last word
method do_ones(v@:old_bit_vector, cl:&(int):void):void {
    let var bit_pos:int := 0;
    v.bits.do(&(wd:int){
	if(wd != all_zeros_word, {
	    bits_per_word.do(&(i:int){
		if(get_bit(wd, bit_num_in_word(i)) = 1, {
		    eval(cl, bit_pos + i);
		});
	    });
	});
	bit_pos := bit_pos + bits_per_word;
    });
}

method collection_name(@:old_bit_vector):string { "old_bit_vector" }
method elem_separator(@:old_bit_vector):string { "" }

}; -- end module OldBitVector