## rw-bool-vector.pkg
# Compiled by:
# src/lib/std/standard.lib### "A complex system that works is
### invariably found to have evolved
### from a simple system that worked."
###
### -- John Gall
#DO set_control "compiler::trap_int_overflow" "TRUE";
package rw_bool_vector
: Rw_Bool_Vector # Rw_Bool_Vector is from src/lib/src/rw-bool-vector.api{
package vector {
#
stipulate
#
package w8a = rw_vector_of_one_byte_unts; # rw_vector_of_one_byte_unts is from src/lib/std/src/rw-vector-of-one-byte-unts.pkg package w8v = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg # Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
get = w8a::get;
(_[]) = get;
my (<<) = (one_byte_unt::(<<) );
my (>>) = (one_byte_unt::(>>) );
my (|) = one_byte_unt::bitwise_or;
my (&) = one_byte_unt::bitwise_and;
infix val get << >> | & ;
fun bad_arg (f, msg)
=
lib_base::failure { module=>"bit_rw_vector", func=>f, msg };
hexs = byte::string_to_bytes "0123456789abcdef";
lomask = w8v::from_list [ 0ux00, 0ux01, 0ux03, 0ux07,
0ux0f, 0ux1f, 0ux3f, 0ux7f, 0uxff
];
himask = w8v::from_list [0uxff, 0uxfe, 0uxfc, 0uxf8,
0uxf0, 0uxe0, 0uxc0, 0ux80, 0ux00];
fun hibits i = w8v::get (himask, i);
fun lobits i = w8v::get (lomask, i);
fun wmask7 i = unt::bitwise_and (unt::from_int i, 0u7);
mask7 = unt::to_int_x o wmask7;
# Number of bytes needed to represent the given number of bits
#
fun size_of n
=
(n + 7) / 8;
# Index of byte that holds bit i:
#
fun byte_of i
=
i / 8;
# Mask for bit i in a byte:
#
fun bit i: one_byte_unt::Unt
=
0u1 << unt::bitwise_and (unt::from_int i, 0u7);
herein
# A bitvector is stored in a rw_vector_of_one_byte_unts::rw_vector.
# Bit n is stored in bit (n mod 8) of word (n div 8).
# We maintain the invariant that all bits >= nbits are 0.
Element = Bool;
max_len = 8*rw_vector_of_one_byte_unts::max_len;
Vector
=
VECTOR
{ nbits: Int,
bits: w8a::Rw_Vector
};
fun make_rw_vector (0, init ) => VECTOR { nbits=>0, bits=>w8a::make_rw_vector (0, 0u0) };
make_rw_vector (len, FALSE) => VECTOR { nbits=>len, bits=>w8a::make_rw_vector (size_of len, 0u0) };
make_rw_vector (len, TRUE ) => {
size = size_of len;
bits = w8a::make_rw_vector (size, 0uxff);
case (len % 8)
0 => ();
idx => w8a::set (bits, size - 1, lobits idx);
esac;
VECTOR { nbits => len, bits };
};
end;
char0 = byte::char_to_byte '0';
char9 = byte::char_to_byte '9';
char_a = byte::char_to_byte 'A';
char_f = byte::char_to_byte 'F';
chara = byte::char_to_byte 'a';
charf = byte::char_to_byte 'f';
fun from_string s
=
{ len = 4 * (size s); # 4 bits per hex digit
my (bv as VECTOR { bits, ... } )
=
make_rw_vector (len, FALSE);
fun nibble x
=
{ d = byte::char_to_byte x;
if (char0 <= d and d <= char9)
d - char0;
else
if (char_a <= d and d <= char_f)
d - char_a + 0u10;
else
if (chara <= d and d <= charf)
d - chara + 0u10;
else
bad_arg("stringToBits", "illegal character: ord = 0ux" + (one_byte_unt::to_string d));
fi;
fi;
fi;
};
fun init ([], _) => ();
init ([x], i) => w8a::set (bits, i, nibble x);
init (x1 ! x2 ! r, i)
=>
{ w8a::set (bits, i, ((nibble x2) << 0u4) | (nibble x1));
init (r, i+1);
};
end;
init (reverse (explode s), 0);
bv;
};
fun to_string (VECTOR { nbits=>0, ... } )
=>
"";
to_string (VECTOR { nbits, bits } )
=>
{ len = (nbits + 3) / 4;
buf = w8a::make_rw_vector (len, 0u0);
fun put (i, j)
=
{ v = bits get i;
w8a::set (buf, j, w8v::get (hexs, one_byte_unt::to_int (v & 0ux0f)));
w8a::set (buf, j - 1, w8v::get (hexs, one_byte_unt::to_int (v >> 0u4)));
put (i+1, j - 2);
};
(put (0, len - 1))
except
_ = ();
byte::bytes_to_string (w8a::to_vector buf);
};
end;
fun bits (len, l)
=
{ my (bv as VECTOR { bits, ... } )
=
make_rw_vector (len, FALSE);
fun init i
=
{ idx = byte_of i;
b = 0u1 << unt::bitwise_and (unt::from_int i, 0u7);
w8a::set (bits, idx, ((bits get idx) | b));
};
list::apply init l;
bv;
};
fun from_list []
=>
make_rw_vector (0, FALSE);
from_list l
=>
{ len = length l;
my ba as VECTOR { bits, ... }
=
make_rw_vector (len, FALSE);
fun getbyte ([], _, b) => ([], b);
getbyte (l, 0u0, b) => (l, b);
getbyte (FALSE ! r, bit, b) => getbyte (r, bit << 0u1, b);
getbyte (TRUE ! r, bit, b) => getbyte (r, bit << 0u1, b | bit);
end;
fun fill ([], _)
=>
();
fill (l, idx)
=>
{ my (l', byte)
=
getbyte (l, 0u1, 0u0);
if (byte != 0u0)
w8a::set (bits, idx, byte);
fi;
fill (l', idx+1);
};
end;
fill (l, 0);
ba;
};
end;
fun tabulate (len, genf)
=
{ my ba as VECTOR { bits, ... }
=
make_rw_vector (len, FALSE);
fun getbyte (count, 0u0, b)
=>
(count, b);
getbyte (count, bit, b)
=>
if (count == len)
(count, b);
else
case (genf count)
FALSE => getbyte (count+1, bit << 0u1, b);
TRUE => getbyte (count+1, bit << 0u1, b | bit);
esac;
fi;
end;
fun fill (count, idx)
=
if (count != len)
my (count', byte)
=
getbyte (count, 0u1, 0u0);
if (byte != 0u0)
w8a::set (bits, idx, byte);
fi;
fill (count', idx+1);
fi;
fill (0, 0);
ba;
};
fun get_bits (VECTOR { nbits => 0, ... } )
=>
[];
get_bits (VECTOR { nbits, bits } )
=>
{ fun extract_bits (_, 0u0, l)
=>
l;
extract_bits (bit, data, l)
=>
{ l' = if( (data & 0ux80) == 0u0 ) l; else bit ! l;fi;
extract_bits (bit - 1, data<<0u1, l');
};
end;
fun extract (-1, _, l)
=>
l;
extract (i, bitnum, l)
=>
extract (i - 1, bitnum - 8, extract_bits (bitnum, bits[i], l));
end;
maxbit = nbits - 1;
hi_byte = byte_of maxbit;
delta = unt::bitwise_and (unt::from_int maxbit, 0u7);
extract (hi_byte - 1, maxbit - (unt::to_int_x delta) - 1,
extract_bits (maxbit, (bits[hi_byte]) << (0u7-delta),[]));
};
end;
fun bit_of (VECTOR { nbits, bits }, i)
=
if (i >= nbits)
raise exception SUBSCRIPT;
else
((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
fi;
fun is_zero (VECTOR { bits, ... } )
=
{ fun isz i
=
(bits[i]) == 0u0 and (isz (i+1));
isz 0;
}
except
_ = TRUE;
fun copybits (bits, newbits)
=
{ fun cpy i
=
{ w8a::set (newbits, i, bits[i]);
cpy (i+1);
};
(cpy 0) except _ => (); end ;
};
fun mk_copy (VECTOR { nbits, bits } )
=
{ my ba as VECTOR { bits=>newbits, ... }
=
make_rw_vector (nbits, FALSE);
copybits (bits, newbits);
ba;
};
fun eq_bits arg
=
{ fun order (arg as (ba as VECTOR { nbits, ... }, ba' as VECTOR { nbits=>nbits', ... } ))
=
if (nbits >= nbits') arg;
else (ba', ba); fi;
my (VECTOR { nbits, bits }, VECTOR { bits=>bits', nbits=>nbits' } )
=
order arg;
minlen = w8a::length bits';
fun iszero i
=
(bits[i]) == 0u0 and (iszero (i+1));
fun compare i
=
if (i == minlen) iszero i;
else (bits[i]) == (bits'[i]) and compare (i+1); fi;
(compare 0)
except
_ = TRUE;
};
fun equal (arg as (VECTOR { nbits, ... }, VECTOR { nbits=>nbits', ... } ))
=
nbits == nbits' and eq_bits arg;
fun extend0 (ba as VECTOR { nbits, bits }, n)
=
if (nbits >= n)
mk_copy ba;
else
newbits = w8a::make_rw_vector (size_of n, 0u0);
fun cpy i
=
{ w8a::set (newbits, i, bits[i]);
cpy (i+1);
};
(cpy 0)
except
_ = ();
VECTOR { nbits=>n, bits=>newbits };
fi;
fun extend1 (ba as VECTOR { nbits, bits }, n)
=
if (nbits >= n)
mk_copy ba;
else
len = size_of n;
newbits = w8a::make_rw_vector (len, 0uxff);
nbytes = byte_of nbits;
left = mask7 nbits;
fun last ()
=
case (mask7 n)
0 => ();
lft => w8a::set (newbits, len - 1, (newbits[len - 1]) & (lobits lft));
esac;
fun adjust j
=
{ if (left != 0)
w8a::set (newbits, j, (bits[j]) | (hibits left));
fi;
last ();
};
fun cpy i
=
if (i == nbytes)
adjust i;
else
w8a::set (newbits, i, bits[i]);
cpy (i+1);
fi;
cpy 0;
VECTOR { nbits=>n, bits=>newbits };
fi;
fun fit (lb, rb, rbits)
=
(rb & (lobits rbits)) | (lb & (hibits rbits));
fun simple_copy (from, to, lastbyte, len) arg
=
{ fun last (s, d)
=
case (mask7 len)
0 => w8a::set (to, d, from[s]);
lft => w8a::set (to, d, fit (to[d], from[s], lft));
esac;
fun cpy (arg as (s, d))
=
if (d == lastbyte)
last arg;
else
w8a::set (to, d, from[s]);
cpy (s+1, d+1);
fi;
cpy arg;
};
# rightablet copies bits [shft, shft+len - 1] of 'from' to
# bits [0, len - 1] in target.
# Assume all parameters and lengths are okay.
fun rightablet (from, to, shft, len)
=
{ byte = byte_of shft;
bitshift = wmask7 shft;
fun copy lastbyte
=
loop (from[byte], byte+1, 0)
where
lshift = 0u8 - bitshift;
fun finish (sb, s, d)
=
{ left = mask7 (len - 1) + 1;
if (unt::from_int left <= lshift) # enough bits in sb
w8a::set (to, d, fit (to[d], sb >> bitshift, left));
else
sb' = (sb >> bitshift) | ((from[s]) << lshift);
w8a::set (to, d, fit (to[d], sb', left));
fi;
};
fun loop (arg as (sb, s, d))
=
if (d == lastbyte)
finish arg;
else
sb' = from[s];
w8a::set (to, d, (sb >> bitshift) | ((sb' << lshift) & 0uxFF));
loop (sb', s+1, d+1);
fi;
end;
if (bitshift == 0u0)
simple_copy (from, to, byte_of (len - 1), len) (byte, 0);
else
copy (byte_of (len - 1));
fi;
};
# leftablet copies bits [0, len - 1] of 'from' to
# bits [shft, shft+len - 1] in target.
# Assume all parameters and lengths are okay.
fun leftablet (_, _, _, 0)
=>
();
leftablet (from, to, shft, len)
=>
{ byte = byte_of shft;
bitshift = wmask7 shft;
lastbyte = byte_of (shft+len - 1);
fun slice_copy (s, d, len) = {
mask = (lobits len) << bitshift;
sb = ((from[s]) << bitshift) & mask;
db = (to[d]) & (one_byte_unt::bitwise_not mask);
w8a::set (to, d, sb | db);
};
fun copy ()
=
loop (sb, 1, byte+1)
where
sb = from[0];
rshift = 0u8 - bitshift;
fun finish (sb, s, d)
=
{ left = mask7 (shft + len - 1) + 1;
if (unt::from_int left <= bitshift) # enough bits in sb
w8a::set (to, d, fit (to[d], sb >> rshift, left));
else
sb' = (sb >> rshift) | ((from[s]) << bitshift);
w8a::set (to, d, fit (to[d], sb', left));
fi;
};
fun loop (arg as (sb, s, d))
=
if (d == lastbyte)
finish arg;
else
sb' = from[s];
w8a::set (to, d, (sb >> rshift) | ((sb' << bitshift) & 0uxFF));
loop (sb', s+1, d+1);
fi;
w8a::set (to, byte, fit (sb << bitshift, to[byte], unt::to_int_x bitshift));
end;
if (bitshift == 0u0)
simple_copy (from, to, lastbyte, len) (0, byte);
else
if (lastbyte == byte)
slice_copy (0, byte, len);
else
copy ();
fi;
fi;
};
end;
fun lshift (ba as VECTOR { nbits, bits }, shft)
=
if (shft < 0 ) bad_arg("lshift", "negative shift");
else
if (shft == 0)
mk_copy ba;
else
newlen = nbits + shft;
newbits = w8a::make_rw_vector (size_of newlen, 0u0);
leftablet (bits, newbits, shft, nbits);
VECTOR { nbits=>newlen, bits=>newbits };
fi;
fi;
fun (@) (VECTOR { nbits, bits }, VECTOR { nbits=>nbits', bits=>bits' } )
=
{ newlen = nbits + nbits';
newbits = w8a::make_rw_vector (size_of newlen, 0u0);
copybits (bits', newbits);
leftablet (bits, newbits, nbits', nbits);
VECTOR { nbits=>newlen, bits=>newbits };
};
fun cat [] => make_rw_vector (0, FALSE);
cat [ba] => mk_copy ba;
cat (l as (VECTOR { bits, nbits } ! tl))
=>
{ newlen = (fold_left (fn (VECTOR { nbits, ... }, a) = a+nbits) 0 l)
except OVERFLOW = raise exception SIZE;
newbits = w8a::make_rw_vector (size_of newlen, 0u0);
fun cpy (VECTOR { bits, nbits }, shft)
=
{ leftablet (bits, newbits, shft, nbits);
shft+nbits;
};
copybits (bits, newbits);
fold_left cpy nbits tl;
VECTOR { nbits=>newlen, bits=>newbits };
};
end;
fun slice (ba as VECTOR { nbits, bits }, sbit, 0)
=>
make_rw_vector (0, FALSE);
slice (ba as VECTOR { nbits, bits }, sbit, len)
=>
{ newbits = w8a::make_rw_vector (size_of len, 0u0);
rightablet (bits, newbits, sbit, len);
VECTOR { nbits=>len, bits=>newbits };
};
end;
fun extract (ba as VECTOR { nbits, bits }, sbit, THE len)
=>
if (sbit < 0 or len < 0 or sbit > nbits - len )
raise exception SUBSCRIPT;
else
slice (ba, sbit, len);
fi;
extract (ba as VECTOR { nbits, bits }, sbit, NULL)
=>
if (sbit < 0 or sbit > nbits)
raise exception SUBSCRIPT;
else
slice (ba, sbit, nbits-sbit);
fi;
end;
fun rshift (ba as VECTOR { nbits, bits }, shft)
=
if (shft < 0 ) bad_arg("rshift", "negative shift");
elif (shft == 0 ) mk_copy ba;
elif (shft >= nbits ) make_rw_vector (0, FALSE);
else
newlen = nbits - shft;
newbits = w8a::make_rw_vector (size_of newlen, 0u0);
rightablet (bits, newbits, shft, newlen);
VECTOR { nbits=>newlen, bits=>newbits };
fi;
fun trim (tgt, len)
=
case (mask7 len)
0 => ();
lft => {
n = (w8a::length tgt) - 1;
w8a::set (tgt, n, (tgt[n]) & (lobits lft));
};
esac;
fun and_blend (VECTOR { nbits, bits }, VECTOR { bits=>bits', nbits=>nbits'}, tgt, len)
=
{ fun copy i
=
{ w8a::set (tgt, i, (bits[i])&(bits'[i]));
copy (i+1);
};
(copy 0)
except
_ = ();
trim (tgt, len);
};
fun or_blend f (ba, ba', tgt, len)
=
{ fun order (arg as (ba as VECTOR { nbits, ... }, ba' as VECTOR { nbits=>nbits', ... } ))
=
if (nbits >= nbits') arg;
else (ba', ba); fi;
my (VECTOR { nbits, bits }, VECTOR { bits=>bits', nbits=>nbits' } )
=
order (ba, ba');
bnd = w8a::length bits'; # number of bytes in smaller rw_vector
fun copy2 i
=
{ w8a::set (tgt, i, bits[i]);
copy2 (i+1);
};
fun copy1 i
=
if (i == bnd)
copy2 bnd;
else
w8a::set (tgt, i, f (bits[i], bits'[i]));
copy1 (i+1);
fi;
(copy1 0)
except
_ = ();
trim (tgt, len);
};
fun newblend blendf (ba, ba', len)
=
{ my nb as VECTOR { bits, ... }
=
make_rw_vector (len, FALSE);
blendf (ba, ba', bits, len);
nb;
};
bitwise_or = newblend (or_blend one_byte_unt::bitwise_or);
bitwise_xor = newblend (or_blend one_byte_unt::bitwise_xor);
bitwise_and = newblend and_blend;
fun union ba ba'
=
{
ba -> VECTOR { bits, nbits };
ba' -> VECTOR { bits=>bits', nbits=>nbits'};
nbytes = w8a::length bits ;
nbytes' = w8a::length bits';
fun copy bnd
=
loop 0
where
fun loop i
=
if (i != bnd )
w8a::set (bits, i, bits[i] | bits'[i]);
loop (i+1);
fi;
end;
if (nbytes <= nbytes')
copy nbytes;
trim (bits, nbits);
else
copy nbytes';
fi;
};
fun intersection ba ba'
=
{ my VECTOR { bits, nbits } = ba;
my VECTOR { bits=>bits', nbits=>nbits' } = ba';
nbytes = w8a::length bits;
nbytes' = w8a::length bits';
fun zero_from (b, j)
=
{ fun loop i
=
{ w8a::set (b, i, 0u0);
loop (i+1);
};
(loop j)
except
_ = ();
};
if (nbytes <= nbytes')
and_blend (ba, ba', bits, nbytes * 8);
else
and_blend (ba, ba', bits, nbytes' * 8);
zero_from (bits, nbytes');
fi;
};
fun flip (nbits, from, tgt)
=
flp 0
where
nbytes = byte_of nbits;
left = mask7 nbits;
fun last j
=
w8a::set (tgt, j, (one_byte_unt::bitwise_not (from[j])) & (lobits left));
fun flp i
=
if (i == nbytes)
if (left != 0 ) last i; fi;
else
w8a::set (tgt, i, one_byte_unt::bitwise_not (from[i]) & 0uxff);
flp (i+1);
fi;
end;
fun bitwise_not (VECTOR { nbits, bits } )
=
{ my ba as VECTOR { bits => newbits, ... }
=
make_rw_vector (nbits, FALSE);
flip (nbits, bits, newbits);
ba;
};
fun set_bit (VECTOR { nbits, bits }, i)
=
{ j = byte_of i;
b = bit i;
if (i >= nbits)
raise exception SUBSCRIPT;
else
w8a::set (bits, j, ((bits[j]) | b));
fi;
};
fun clr_bit (VECTOR { nbits, bits }, i)
=
{
j = byte_of i;
b = one_byte_unt::bitwise_not (bit i);
if (i >= nbits) raise exception SUBSCRIPT;
else w8a::set (bits, j, ((bits[j]) & b)); fi;
};
fun complement (VECTOR { bits, nbits } )
=
flip (nbits, bits, bits);
fun set (ba, i, TRUE) => set_bit (ba, i);
set (ba, i, _) => clr_bit (ba, i);
end;
fun (get) arg
=
bit_of arg;
# Note: The (_[]) enables 'vec[index]' notation;
# The (_[]:=) enables 'vec[index] := value' notation;
(_[]) = (get);
(_[]:=) = set ;
fun length (VECTOR { nbits, ... } )
=
nbits;
fun apply f (VECTOR { nbits=>0, bits } )
=>
();
apply f (VECTOR { nbits, bits } )
=>
{
last = byte_of (nbits - 1);
fun loop (0, _)
=>
();
loop (n, byte)
=>
{ f ((byte&0u1) == 0u1);
loop (n - 1, byte >> 0u1);
};
end;
fun f' (i, byte)
=
if (i < last) loop (8, byte);
else loop (mask7 (nbits - 1) + 1, byte); fi;
w8a::keyed_apply f' bits;
};
end;
# FIX: Reimplement using w8a::foldi XXX BUGGO FIXME
#
fun fold_left f a (VECTOR { nbits, bits } )
=
loop (0, a)
where
fun loop (i, a)
=
if (i == nbits )
a;
else
b = ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
loop (i+1, f (b, a));
fi;
end;
# FIX: Reimplement using w8a::fold_right XXX BUGGO FIXME
#
fun fold_right f a (VECTOR { nbits, bits } )
=
loop (nbits - 1, a)
where
fun loop (-1, a) => a;
loop (i, a)
=>
{ b = ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
loop (i - 1, f (b, a));
};
end;
end;
fun valid (nbits, sbit, NULL)
=>
if (sbit < 0 or sbit > nbits) raise exception SUBSCRIPT;
else nbits - sbit; fi;
valid (nbits, sbit, THE len)
=>
if (sbit < 0 or len < 0 or sbit > nbits - len) raise exception SUBSCRIPT;
else len; fi;
end;
# FIX: Reimplement using w8a::keyed_apply
#
fun keyed_apply' f (VECTOR { nbits=>0, bits }, _, _) => ();
keyed_apply' f (VECTOR { nbits, bits }, sbit, l)
=>
{
len = valid (nbits, sbit, l);
fun loop (_, 0) => ();
loop (i, n) => {
b = ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
f (i, b);
loop (i+1, n - 1);
}; end;
loop (sbit, len);
};
end;
# FIX: Reimplement using w8a::foldi
#
fun keyed_fold_left' f a (VECTOR { nbits, bits }, sbit, l)
=
{
len = valid (nbits, sbit, l);
last = sbit+len;
fun loop (i, a)
=
if (i == last ) a;
else
b = ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
loop (i+1, f (i, b, a));
fi;
loop (sbit, a);
};
# FIX: Reimplement using w8a::fold_right
#
fun keyed_fold_right' f a (VECTOR { nbits, bits }, sbit, l)
=
{
len = valid (nbits, sbit, l);
fun loop (i, a)
=
if (i < sbit ) a;
else
b = ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
loop (i - 1, f (i, b, a));
fi;
loop (sbit+len - 1, a);
};
# FIX: Reimplement using general-purpose copy
#
fun copy' { from => from as VECTOR { nbits, bits }, si, len, to, di }
=
{
l = valid (nbits, si, len);
to -> VECTOR { nbits=>nbits', bits=>bits' };
if (di < 0 or nbits' - di < l)
raise exception SUBSCRIPT;
fi;
last = si + l;
fun loop (si, di)
=
if (si != last)
if (bit_of (from, si)) set_bit (to, di);
else clr_bit (to, di);
fi;
loop (si+1, di+1);
fi;
loop (si, di);
};
fun modify f (VECTOR { nbits=>0, bits } )
=>
();
modify f (VECTOR { nbits, bits } )
=>
{
last = byte_of (nbits - 1);
fun loop (0, _, a, _) => a;
loop (n, byte, a, mask)
=>
if (f ((byte&mask) == mask)) loop (n - 1, byte, a&mask, mask << 0u1);
else loop (n - 1, byte, a, mask << 0u1);
fi;
end;
fun f' (i, byte)
=
if (i < last) loop (8, byte, 0u0, 0u1);
else loop (mask7 (nbits - 1) + 1, byte, 0u0, 0u1);
fi;
w8a::modifyi f' bits;
};
end;
# FIX: Reimplement using w8a::modifyi
#
fun modifyi' f (VECTOR { nbits=>0, bits }, sbit, l)
=>
();
modifyi' f (VECTOR { nbits, bits }, sbit, l)
=>
{
len = valid (nbits, sbit, l);
last = sbit+len;
fun loop i
=
if (i != last)
index = byte_of i;
biti = bit i;
byte = w8a::get (bits, index);
b = (byte & biti) != 0u0;
b' = f (i, b);
if (b == b' ) ();
elif b' w8a::set (bits, index, byte | biti);
else w8a::set (bits, index, byte & (one_byte_unt::bitwise_not biti));
fi;
loop (i+1);
fi;
loop sbit;
};
end;
end; # stipulate
}; # package vector
include vector;
Rw_Vector = Vector;
fun to_vector a
=
a;
fun copy { from, to, di }
=
copy' { from, to, di, si => 0, len => NULL };
copy_vec = copy;
fun keyed_apply f a = keyed_apply' f (a, 0, NULL);
fun modifyi f a = modifyi' f (a, 0, NULL);
fun keyed_fold_left f init a = keyed_fold_left' f init (a, 0, NULL);
fun keyed_fold_right f init a = keyed_fold_right' f init (a, 0, NULL);
# These are slow, pedestrian implementations....
#
fun findi p a
=
{
len = length a;
fun fnd i =
if (i >= len ) NULL;
else { x = get (a, i);
if (p (i, x) ) THE (i, x); else fnd (i + 1);fi;
};fi;
fnd 0;
};
fun find p a
=
{
len = length a;
fun fnd i =
if (i >= len ) NULL;
else { x = get (a, i);
if (p x ) THE x; else fnd (i + 1);fi;
};fi;
fnd 0;
};
fun exists p a
=
{
len = length a;
fun ex i = i < len and (p (get (a, i)) or ex (i + 1));
ex 0;
};
fun all p a
=
{
len = length a;
fun al i = i >= len or (p (get (a, i)) and al (i + 1));
al 0;
};
fun collate c (a1, a2)
=
col 0
where
l1 = length a1;
l2 = length a2;
l12 = int::min (l1, l2);
fun col i
=
if (i >= l12)
int::compare (l1, l2);
else
case (c (get (a1, i), get (a2, i)))
EQUAL => col (i + 1);
unequal => unequal;
esac;
fi;
end;
}; # package rw_bool_vector