PreviousUpNext

15.4.998  src/lib/src/rw-bool-vector.pkg

## 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";

stipulate
    package byt =  byte;                                                                # byte                          is from   src/lib/std/src/byte.pkg
    package u1b =  one_byte_unt;                                                        # one_byte_unt                  is from   src/lib/std/one-byte-unt.pkg
    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
herein

    package   rw_bool_vector
    :         Rw_Bool_Vector                                                            # Rw_Bool_Vector                is from   src/lib/src/rw-bool-vector.api
    {
        package vector {
            #
            stipulate
                #
                get   =  w8a::get; 
                (_[]) =  get;                                                           # (_[])   enables   'vec[index]'           notation;

                (<<)  =  u1b::(<<);
                (>>)  =  u1b::(>>);

                (|)   =   u1b::bitwise_or;
                (&)   =   u1b::bitwise_and;

                infix my  get << >> | & ;

                fun bad_arg (f, msg)
                    =
                    lib_base::failure { module=>"bit_rw_vector", fn=>f, msg };

                hexs = byt::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:  u1b::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;

                maximum_vector_length =  8 * rw_vector_of_one_byte_unts::maximum_vector_length;

                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  = byt::char_to_byte '0';
                char9  = byt::char_to_byte '9';
                #
                char_a = byt::char_to_byte 'A';
                char_f = byt::char_to_byte 'F';
                #
                chara  = byt::char_to_byte 'a';
                charf  = byt::char_to_byte 'f';

                fun from_string s
                    =
                    {   len = 4 * (size s);          #  4 bits per hex digit 
                        #
                        (make_rw_vector (len, FALSE))
                            ->
                            (bv as VECTOR { bits, ... } );

                        fun nibble x
                            =
                            {   d =  byt::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" + (u1b::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, u1b::to_int (v & 0ux0f)));
                                    w8a::set (buf, j - 1, w8v::get (hexs, u1b::to_int (v >> 0u4)));
                                    put (i+1, j - 2);
                                };

                            (put (0, len - 1))
                            except
                                _ =  ();

                           byt::bytes_to_string (w8a::to_vector buf);
                       };
                end;

                fun bits (len, l)
                    =
                    {   (make_rw_vector (len, FALSE))
                            ->
                            (bv as VECTOR { bits, ... } );

                        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));
                            };

                        apply init l;

                        bv;
                    };

                fun from_list []
                        =>
                        make_rw_vector (0, FALSE);

                    from_list l
                        =>
                        {   len =  length l;
                            #
                            (make_rw_vector (len, FALSE))
                                ->
                                ba as VECTOR { bits, ... };

                            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)
                                    =>
                                    {   (getbyte (l, 0u1, 0u0))
                                            ->
                                            (l', byte);

                                        if (byte != 0u0)        w8a::set (bits, idx, byte);             fi;

                                        fill (l', idx+1);
                                   };
                            end;

                            fill (l, 0);
                            ba;
                       };
                end;

                fun from_fn (len, genf)
                    =
                    {   (make_rw_vector (len, FALSE))
                            ->
                            ba as VECTOR { bits, ... };

                        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)
                                #
                                (getbyte (count, 0u1, 0u0))
                                    ->
                                    (count', byte);

                                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 INDEX_OUT_OF_BOUNDS;    fi;
                        #
                        ((w8a::get (bits, byte_of i)) & (bit i)) != 0u0;
                    };

                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 _ = ();
                    };

                fun mk_copy (VECTOR { nbits, bits } )
                    =
                    {   (make_rw_vector (nbits, FALSE))
                            ->
                            ba as VECTOR { bits=>newbits, ... };

                        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;

                        (order arg)
                            ->
                            (VECTOR { nbits, bits }, VECTOR { bits=>bits', nbits=>nbits' } );

                        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]) & (u1b::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_forward (\\ (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_forward 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 ( len < 0
                            or  sbit < 0
                            or  sbit > nbits - len)     raise exception INDEX_OUT_OF_BOUNDS;    fi;
                            #
                            slice (ba, sbit, len);
                        };

                    extract (ba as VECTOR { nbits, bits }, sbit, NULL)
                        =>
                        {   if (sbit < 0
                            or  sbit > nbits)           raise exception INDEX_OUT_OF_BOUNDS;    fi;
                            #
                            slice (ba, sbit, nbits-sbit);
                        };
                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;

                        (order (ba, ba'))
                            ->
                            (VECTOR { nbits, bits }, VECTOR { bits=>bits', nbits=>nbits' } );

                        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)
                    =
                    {   (make_rw_vector (len, FALSE))
                            ->
                            nb as VECTOR { bits, ... };

                        blendf (ba, ba', bits, len);

                        nb;
                      };

                bitwise_or  =  newblend (or_blend u1b::bitwise_or);
                bitwise_xor =  newblend (or_blend u1b::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)
                            =
                            {   (loop j)   except   _ = ();
                            }
                            where
                                fun loop i
                                    =
                                    {   w8a::set (b, i, 0u0);
                                        #
                                        loop (i+1);
                                    };
                            end;

                        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, (u1b::bitwise_not (from[j])) & (lobits left));

                        fun flp i
                            =
                            if   (i == nbytes)
                                 if (left != 0 )   last i;   fi;
                            else
                                 w8a::set (tgt, i, u1b::bitwise_not (from[i]) & 0uxff);
                                 flp (i+1);
                            fi;
                    end;

                fun bitwise_not (VECTOR { nbits, bits } )
                    =
                    {   (make_rw_vector (nbits, FALSE))
                            ->
                            ba as VECTOR { bits => newbits, ... };

                        flip (nbits, bits, newbits);

                        ba;
                    };

                fun set_bit (VECTOR { nbits, bits }, i)
                    =
                    {   j = byte_of i;
                        b = bit i;

                        if (i >= nbits)      raise exception INDEX_OUT_OF_BOUNDS;               fi;

                        w8a::set (bits, j, ((bits[j]) | b));
                    };

                fun clr_bit (VECTOR { nbits, bits }, i)
                    =
                    {   j = byte_of i;
                        b = u1b::bitwise_not (bit i);

                        if (i >= nbits)   raise exception INDEX_OUT_OF_BOUNDS;   fi;

                        w8a::set (bits, j, ((bits[j]) & b));
                    };


                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_forward 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_backward     XXX BUGGO FIXME
                #
                fun fold_backward 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 INDEX_OUT_OF_BOUNDS; 
                      else                            nbits - sbit;        fi;

                    valid (nbits, sbit, THE len)
                      =>
                      if (sbit < 0 or len < 0 or sbit > nbits - len)   raise exception INDEX_OUT_OF_BOUNDS; 
                      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_forward' 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_backward 
                #
                fun keyed_fold_backward' 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   XXX SUCKO FIXME
                #
                fun copy' { from as VECTOR { nbits, bits }, si, len, into, at }         # Copy l entries starting with  from[si] -> into[at].
                    =
                    {   l = valid (nbits, si, len);
                        #
                        into ->  VECTOR { nbits=>nbits', bits=>bits' };

                        if (at < 0 or nbits' - at < l)    raise exception INDEX_OUT_OF_BOUNDS;    fi;

                        last = si + l;

                        fun loop (si, at)
                            =
                              if   (si != last)

                                   if (bit_of (from, si))  set_bit (into, at);
                                   else                    clr_bit (into, at);
                                   fi;

                                   loop (si+1, at+1);
                              fi;

                          loop (si, at);
                      };

                fun map_in_place f (VECTOR { nbits=>0, bits } )
                        =>
                        ();

                    map_in_place 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::keyed_map_in_place f' bits;
                      };
                end;

                #  FIX: Reimplement using w8a::keyed_map_in_place 
                #
                fun keyed_map_in_place' f (VECTOR { nbits=>0, bits }, sbit, l)
                        =>
                        ();

                    keyed_map_in_place' f (VECTOR { nbits, bits }, sbit, l)
                        =>
                        loop sbit
                        where
                            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 & (u1b::bitwise_not biti));
                                    fi;

                                    loop (i+1);
                                fi;
                        end;
                end;

              end;                      # stipulate
        };                              # package vector 

        include package   vector;

        Rw_Vector = Vector;

        fun to_vector  a
            =
            a;

        fun copy { from, into, at }
            =
            copy' { from, into, at, si => 0, len => NULL };

        copy_vector = copy;


        fun keyed_apply f a =   keyed_apply' f (a, 0, NULL);


        fun keyed_map_in_place f a =   keyed_map_in_place' f (a, 0, NULL);

        fun keyed_fold_forward  f init a = keyed_fold_forward'  f init (a, 0, NULL);
        fun keyed_fold_backward f init a = keyed_fold_backward' f init (a, 0, NULL);

        #  These are slow, pedestrian implementations.... 
        #
        fun keyed_find p a
            =
            fnd 0
            where
                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;
            end;

        fun find p a
            =
            fnd 0
            where
                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;
            end;

        fun exists p a
            =
            ex 0
            where
                len = length a;
                fun ex i = i < len and (p (get (a, i)) or ex (i + 1));
            end;

        fun all p a
            =
            al 0
            where
                len = length a;
                #
                fun al i
                    =
                    i >= len or (p (get (a, i)) and al (i + 1));
            end;

        fun compare_sequences 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 
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext