bit-array.sml

这是我们参加06年全国开源软件的竞赛作品

(* bit-array.sml
 *
 * COPYRIGHT (c) 1995 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
 *
 *)

structure BitArray :> BIT_ARRAY =
  struct

    structure Vector =
      struct
        local
          structure W8A = Word8Array
          structure W8V = Word8Vector
          val sub = W8A.sub 
          val << = Word8.<<
          val >> = Word8.>>
          val ++ = Word8.orb
          val & = Word8.andb
          infix sub << >> ++ &
    
          fun badArg(f,msg) = LibBase.failure{module="BitArray",func=f,msg=msg}
    
          val hexs = Byte.stringToBytes "0123456789abcdef"
          val lomask = W8V.fromList [0wx00, 0wx01, 0wx03, 0wx07, 
                                     0wx0f, 0wx1f, 0wx3f, 0wx7f, 0wxff]
          val himask = W8V.fromList [0wxff, 0wxfe, 0wxfc, 0wxf8, 
                                     0wxf0, 0wxe0, 0wxc0, 0wx80, 0wx00]
          fun hibits i = W8V.sub(himask,i)
          fun lobits i = W8V.sub(lomask,i)
          fun wmask7 i = Word.andb(Word.fromInt i, 0w7)
          val mask7 = Word.toIntX o wmask7

        (* return the number of bytes needed to represent the given number of bits *)
          fun sizeOf n = ((n + 7) div 8)
      
        (* return the index of byte that holds bit i *)
          fun byteOf i = (i div 8)
      
        (* return the mask for bit i in a byte *) 
          fun bit i : Word8.word = (0w1 << Word.andb(Word.fromInt i, 0w7))
      
        in
        
        (* A bitvector is stored in a Word8Array.array.
         * Bit n is stored in bit (n mod 8) of word (n div 8).
         * We maintain the invariant that all bits >= nbits are 0.
         *)
          type elem = bool
          val maxLen = 8*Word8Array.maxLen
          datatype vector = BA of {nbits : int, bits : W8A.array}
      
          fun array (0,init) = BA{nbits=0,bits=W8A.array(0,0w0)}
            | array (len,false) = BA{nbits=len,bits=W8A.array(sizeOf len,0w0)}
            | array (len,true) = let
                val sz = sizeOf len
                val bits = W8A.array (sz, 0wxff)
                in
                  case len mod 8 of 0 => () | idx => W8A.update(bits,sz-1,lobits idx);
                  BA{nbits = len, bits = bits}
                end
      
          val char0 = Byte.charToByte #"0"
          val char9 = Byte.charToByte #"9"
          val charA = Byte.charToByte #"A"
          val charF = Byte.charToByte #"F"
          val chara = Byte.charToByte #"a"
          val charf = Byte.charToByte #"f"
          fun fromString s = let
                val len = 4*(size s)          (* 4 bits per hex digit *)
                val (bv as BA{bits, ...}) = array (len, false)
                fun nibble x = let
                      val d = Byte.charToByte x
                      in
                        if (char0 <= d) andalso (d <= char9) 
                          then d - char0
                        else if (charA <= d) andalso (d <= charF) 
                          then d - charA + 0w10
                        else if (chara <= d) andalso (d <= charf)
                          then d - chara + 0w10
                        else badArg("stringToBits", 
                              "illegal character: ord = 0wx"^(Word8.toString d))
                      end
                fun init ([], _) = ()
                  | init ([x], i) = W8A.update(bits, i, nibble x)
                  | init (x1::x2::r, i) = (
                      W8A.update(bits, i, ((nibble x2) << 0w4) ++ (nibble x1));
                      init (r, i+1))
                in
                  init (rev(explode s), 0);
                  bv
                end
      
          fun toString (BA{nbits=0,...}) = ""
            | toString (BA{nbits,bits}) = let
                val len = (nbits + 3) div 4
                val buf = W8A.array (len, 0w0)
                fun put (i,j) = let
                      val v = bits sub i
                      in
                        W8A.update (buf, j, W8V.sub(hexs, Word8.toInt(v & 0wx0f)));
                        W8A.update (buf, j-1, W8V.sub(hexs, Word8.toInt(v >> 0w4)));
                        put (i+1, j-2)
                      end
                in
                  (put(0,len-1)) handle _ => ();
                  Byte.bytesToString (W8A.extract(buf,0,NONE))
                end
      
          fun bits (len,l) = let
                val (bv as BA{bits, ...}) = array (len, false)
                fun init i = let
                      val idx = byteOf i 
                      val b = 0w1 << Word.andb(Word.fromInt i, 0w7)
                      in
                        W8A.update (bits, idx, ((bits sub idx) ++ b))
                      end
                in
                  List.app init l;
                  bv
                end
      
          fun fromList [] = array (0, false)
            | fromList l = let
                val len = length l
                val ba as BA{bits,...} = array (len, false)
                fun getbyte ([],_,b) = ([],b)
                  | getbyte (l,0w0,b) = (l,b)
                  | getbyte (false::r,bit,b) = getbyte(r,bit << 0w1,b)
                  | getbyte (true::r,bit,b) = getbyte(r,bit << 0w1,b ++ bit)
                fun fill ([],_) = ()
                  | fill (l,idx) = let
                      val (l',byte) = getbyte (l,0w1,0w0)
                      in
                        if byte <> 0w0 then W8A.update(bits,idx,byte) else ();
                        fill (l',idx+1)
                      end
                in
                  fill (l,0);
                  ba
                end
      
          fun tabulate (len, genf) = let
                val ba as BA{bits,...} = array (len, false)
                fun getbyte (cnt,0w0,b) = (cnt,b)
                  | getbyte (cnt,bit,b) = 
                      if cnt = len then (cnt,b)
                      else case genf cnt of
                        false => getbyte(cnt+1,bit << 0w1,b)
                      | true => getbyte(cnt+1,bit << 0w1,b ++ bit)
                fun fill (cnt,idx) = 
                      if cnt = len then ()
                      else let
                        val (cnt',byte) = getbyte (cnt,0w1,0w0)
                        in
                          if byte <> 0w0 then W8A.update(bits,idx,byte) else ();
                          fill (cnt',idx+1)
                        end
                in
                  fill (0,0);
                  ba
                end
                
          fun getBits (BA{nbits = 0, ...}) = []
            | getBits (BA{nbits, bits}) = let
                fun extractBits (_, 0w0, l) = l
                  | extractBits (bit, data, l) = let
                      val l' = if (data & 0wx80) = 0w0 then l else bit :: l
                      in
                       extractBits (bit-1, data<<0w1, l')
                      end
                fun extract (~1, _, l) = l
                  | extract (i, bitnum, l) = 
                      extract (i-1,bitnum-8,extractBits (bitnum, bits sub i, l))
                val maxbit = nbits-1 
                val hiByte = byteOf maxbit 
                val delta = Word.andb(Word.fromInt maxbit, 0w7)
                in 
                  extract (hiByte-1, maxbit - (Word.toIntX delta) - 1, 
                    extractBits(maxbit,(bits sub hiByte) << (0w7-delta),[])) 
                end
      
          fun bitOf (BA{nbits, bits}, i) =
                if i >= nbits
                  then raise Subscript
                  else ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
      
          fun isZero (BA{bits,...}) = let
                fun isz i = (bits sub i) = 0w0 andalso (isz (i+1))
                in
                  isz 0
                end handle _ => true
            
          fun copybits (bits, newbits) = let
                fun cpy i = (W8A.update(newbits, i, bits sub i); cpy(i+1))
                in
                  (cpy 0) handle _ => ()
                end
      
          fun mkCopy (BA{nbits, bits}) = let
                val ba as BA{bits=newbits,...} = array (nbits, false)
                in
                  copybits(bits, newbits);
                  ba
                end
      
          fun eqBits arg = let
                fun order (arg as (ba as BA{nbits,...},ba' as BA{nbits=nbits',...})) =
                      if nbits >= nbits'
                        then arg
                        else (ba',ba)
                val (BA{nbits,bits},BA{bits=bits',nbits=nbits'}) = order arg
                val minlen = W8A.length bits'
                fun iszero i = (bits sub i) = 0w0 andalso (iszero (i+1))
                fun cmp i =
                      if i = minlen
                        then iszero i
                        else (bits sub i) = (bits' sub i) andalso cmp(i+1)
                in
                  (cmp 0) handle _ => true
                end
          fun equal (arg as (BA{nbits,...},BA{nbits=nbits',...})) = 
               nbits = nbits' andalso eqBits arg
      
          fun extend0 (ba as BA{nbits, bits}, n) =
                if (nbits >= n)
                  then mkCopy ba
                  else let
                    val newbits = W8A.array(sizeOf n, 0w0)
                    fun cpy i = (W8A.update(newbits, i, bits sub i); cpy(i+1))
                    in
                      (cpy 0) handle _ => ();
                      BA{nbits=n, bits=newbits}
                    end
      
          fun extend1 (ba as BA{nbits, bits}, n) =
                if (nbits >= n)
                  then mkCopy ba
                  else let
                    val len = sizeOf n
                    val newbits = W8A.array(len, 0wxff)
                    val nbytes = byteOf nbits 
                    val left = mask7 nbits
                    fun last () =
                          case mask7 n of
                            0 => ()
                          | lft => W8A.update(newbits, len-1, (newbits sub (len-1)) & (lobits lft))
                    fun adjust j = (
                          if left = 0
                            then ()
                            else W8A.update(newbits, j, (bits sub j) ++ (hibits left));
                          last ())
                    fun cpy i = 
                          if i = nbytes
                            then adjust i
                            else (W8A.update(newbits, i, bits sub i); cpy(i+1))
                    in
                      cpy 0;
                      BA{nbits=n, bits=newbits}
                    end
      
          fun fit(lb,rb,rbits) = (rb & (lobits rbits)) ++ (lb & (hibits rbits))
      
          fun simpleCopy (src,dest,lastbyte,len) arg = let
                fun last (s,d) = 
                      case mask7 len of
                        0 => W8A.update(dest,d,src sub s)
                      | lft => W8A.update(dest,d,fit(dest sub d,src sub s,lft))
                fun cpy (arg as (s,d)) =
                      if d = lastbyte
                        then last arg
                        else (W8A.update(dest,d,src sub s);cpy(s+1,d+1))
                in
                  cpy arg
                end
      
            (* rightblt copies bits [shft,shft+len-1] of src to
             * bits [0,len-1] in target.
             * Assume all parameters and lengths are okay.
             *)
          fun rightblt (src,dest,shft,len) = let
                val byte = byteOf shft and bitshift = wmask7 shft
                fun copy lastbyte = let
                      val lshift = 0w8 - bitshift
                      fun finish (sb,s,d) = let
                            val left = mask7 (len - 1) + 1
                            in
                              if Word.fromInt left <= lshift  (* enough bits in sb *)
                                then W8A.update(dest,d,fit(dest sub d,sb >> bitshift,left))
                                else let
                                  val sb' = (sb >> bitshift) ++ ((src sub s) << lshift)
                                  in
                                    W8A.update(dest,d,fit(dest sub d,sb',left))
                                  end
                            end
                      fun loop (arg as (sb, s, d)) =
                            if d = lastbyte then finish arg
                            else let
                              val sb' = src sub s
                              in
                                W8A.update(dest,d,(sb >> bitshift) ++ ((sb' << lshift) & 0wxFF));
                                loop(sb',s+1,d+1)
                              end
                      in
                        loop (src sub byte, byte+1, 0)
                      end
                in
                  if bitshift = 0w0 then simpleCopy (src,dest,byteOf(len-1),len) (byte,0)
                  else copy (byteOf (len-1))
                end
      
            (* leftblt copies bits [0,len-1] of src to
             * bits [shft,shft+len-1] in target.
             * Assume all parameters and lengths are okay.
             *)
          fun leftblt (_,_,_,0) = ()
            | leftblt (src,dest,shft,len) = let
                val byte = byteOf shft and bitshift = wmask7 shft
                val lastbyte = byteOf (shft+len-1)
                fun sliceCopy (s,d,len) = let
                      val mask = (lobits len) << bitshift
                      val sb = ((src sub s) << bitshift) & mask
                      val db = (dest sub d) & (Word8.notb mask)
                      in
                        W8A.update(dest,d,sb ++ db)
                      end
                fun copy () = let
                      val sb = src sub 0
                      val rshift = 0w8 - bitshift
                      fun finish (sb,s,d) = let
                            val left = mask7(shft + len - 1) + 1
                            in
                              if Word.fromInt left <= bitshift  (* enough bits in sb *)
                                then W8A.update(dest,d,fit(dest sub d,sb >> rshift,left))
                                else let
                                  val sb' = (sb >> rshift) ++ ((src sub s) << bitshift)
                                  in
                                    W8A.update(dest,d,fit(dest sub d,sb',left))
                                  end
                            end
                      fun loop (arg as (sb, s, d)) =
                            if d = lastbyte then finish arg
                            else let
                              val sb' = src sub s
                              in
                                W8A.update(dest,d,(sb >> rshift) ++ ((sb' << bitshift) & 0wxFF));
                                loop(sb',s+1,d+1)
                              end
                      in
                        W8A.update(dest,byte,fit(sb << bitshift, dest sub byte, Word.toIntX bitshift));
                        loop (sb, 1, byte+1)
                      end