bit-array.sml

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

                in
                  if bitshift = 0w0 then simpleCopy (src,dest,lastbyte,len) (0,byte)
                  else if lastbyte = byte then sliceCopy (0,byte,len)
                  else copy ()
                end
      
          fun lshift (ba as BA{nbits,bits},shft) =
                if shft < 0 then badArg("lshift","negative shift")
                else if shft = 0 then mkCopy ba
                else let
                  val newlen = nbits + shft
                  val newbits = W8A.array(sizeOf newlen,0w0)
                  in
                    leftblt(bits,newbits,shft,nbits);
                    BA{nbits=newlen,bits=newbits}
                  end
      
          fun op @ (BA{nbits,bits},BA{nbits=nbits',bits=bits'}) = let
                val newlen = nbits + nbits'
                val newbits = W8A.array(sizeOf newlen, 0w0)
                in
                  copybits(bits',newbits);
                  leftblt(bits,newbits,nbits',nbits);
                  BA{nbits=newlen,bits=newbits}
                end
      
          fun concat [] = array (0, false)
            | concat [ba] = mkCopy ba
            | concat (l as (BA{bits,nbits}::tl)) = let
                val newlen = (foldl (fn (BA{nbits,...},a) => a+nbits) 0 l)
                            handle Overflow => raise Size
                val newbits = W8A.array(sizeOf newlen,0w0)
                fun cpy (BA{bits,nbits}, shft) = (
                        leftblt(bits,newbits,shft,nbits);
                        shft+nbits
                      )
                in
                  copybits(bits,newbits);
                  foldl cpy nbits tl;
                  BA{nbits=newlen,bits=newbits}
                end
      
          fun slice (ba as BA{nbits,bits},sbit,0) = array (0, false)
            | slice (ba as BA{nbits,bits},sbit,len) = let
                val newbits = W8A.array(sizeOf len,0w0)
                in
                  rightblt(bits,newbits,sbit,len);
                  BA{nbits=len,bits=newbits}
                end
      
          fun extract (ba as BA{nbits,bits},sbit,SOME len) =
                if sbit < 0 orelse len < 0 orelse sbit > nbits - len 
                  then raise Subscript
                  else slice (ba,sbit,len)
            | extract (ba as BA{nbits,bits},sbit,NONE) =
                if sbit < 0 orelse sbit > nbits
                  then raise Subscript
                  else slice (ba,sbit,nbits-sbit)
      
          fun rshift (ba as BA{nbits,bits},shft) =
                if shft < 0 then badArg("rshift","negative shift")
                else if shft = 0 then mkCopy ba
                else if shft >= nbits then array (0, false)
                else let
                  val newlen = nbits - shft
                  val newbits = W8A.array(sizeOf newlen,0w0)
                  in
                    rightblt(bits,newbits,shft,newlen);
                    BA{nbits=newlen,bits=newbits}
                  end
      
          fun trim (tgt,len) =
                case mask7 len of
                  0 => ()
                | lft => let
                    val n = (W8A.length tgt) - 1
                    in
                      W8A.update(tgt, n, (tgt sub n) & (lobits lft))
                    end
      
          fun andBlend (BA{nbits,bits},BA{bits=bits',nbits=nbits'},tgt,len) = let
                fun copy i = (W8A.update(tgt,i,(bits sub i)&(bits' sub i));copy(i+1))
                in
                  (copy 0) handle _ => ();
                  trim (tgt,len)
                end
      
          fun orBlend f (ba,ba',tgt,len) = 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 (ba,ba')
                val bnd = W8A.length bits' (* number of bytes in smaller array *)
                fun copy2 i = (W8A.update(tgt,i,bits sub i);copy2(i+1))
                fun copy1 i = 
                      if i = bnd
                        then copy2 bnd
                        else (W8A.update(tgt,i,f(bits sub i, bits' sub i));copy1(i+1))
                in
                  (copy1 0) handle _ => ();
                  trim (tgt,len)
                end
      
          fun newblend blendf (ba,ba',len) = let
                val nb as BA{bits,...} = array (len, false)
                in
                  blendf(ba,ba',bits,len);
                  nb
                end
      
          val orb = newblend (orBlend Word8.orb)
          val xorb = newblend (orBlend Word8.xorb)
          val andb = newblend andBlend
      
          fun union ba ba' = let
                val BA{bits,nbits} = ba 
                val BA{bits=bits',nbits=nbits'} = ba'
                val nbytes = W8A.length bits
                val nbytes' = W8A.length bits'
                fun copy bnd = let
                      fun loop i =
                            if i = bnd 
                              then () 
                              else (W8A.update(bits,i,(bits sub i) ++ (bits' sub i));loop(i+1))
                      in
                        loop 0
                      end
                in
                  if nbytes <= nbytes'
                    then (copy nbytes; trim (bits,nbits))
                    else copy nbytes'
                end
      
          fun intersection ba ba' = let
                val BA{bits,nbits} = ba 
                val BA{bits=bits',nbits=nbits'} = ba'
                val nbytes = W8A.length bits
                val nbytes' = W8A.length bits'
                fun zeroFrom(b,j) = let
                      fun loop i = (W8A.update(b,i,0w0);loop(i+1))
                      in
                        (loop j) handle _ => ()
                      end
                in
                  if nbytes <= nbytes'
                    then andBlend(ba,ba',bits,nbytes * 8)
                    else (
                      andBlend(ba,ba',bits,nbytes' * 8);
                      zeroFrom (bits,nbytes')
                    )
                end
      
          fun flip (nbits, src, tgt) = let
                val nbytes = byteOf nbits and left = mask7 nbits
                fun last j = 
                      W8A.update(tgt,j,(Word8.notb(src sub j)) & (lobits left))
                fun flp i =
                      if i = nbytes 
                        then if left = 0 then () else last i
                        else (W8A.update(tgt,i,Word8.notb(src sub i) & 0wxff); flp(i+1))
                in
                  flp 0
                end
      
          fun notb (BA{nbits, bits}) = let
                val ba as BA{bits=newbits,...} = array (nbits, false)
                in
                  flip (nbits,bits,newbits);
                  ba
                end
      
          fun setBit (BA{nbits, bits}, i) = let
                val j = byteOf i and b = bit i
                in
                  if i >= nbits
                    then raise Subscript
                    else W8A.update (bits, j, ((bits sub j) ++ b))
                end
      
          fun clrBit (BA{nbits, bits}, i) = let
            val j = byteOf i and b = Word8.notb(bit i)
            in
              if i >= nbits
                then raise Subscript
                else W8A.update (bits, j, ((bits sub j) & b))
            end
      
          fun complement (BA{bits,nbits}) = flip(nbits, bits, bits)
      
          fun update (ba,i,true) = setBit (ba,i)
            | update (ba,i,_) = clrBit (ba,i)
      
          fun op sub arg = bitOf arg
      
          fun length (BA{nbits, ...}) = nbits
      
          fun app f (BA{nbits=0,bits}) = ()
            | app f (BA{nbits,bits}) = let
                val last = byteOf (nbits-1)
                fun loop (0,_) = ()
                  | loop (n,byte) = (f ((byte&0w1) = 0w1); loop (n-1,byte >> 0w1))
                fun f' (i,byte) =
                       if i < last then loop (8,byte)
                       else loop (mask7 (nbits - 1) + 1, byte)
                in
                  W8A.appi f' (bits,0,NONE)
                end
      
            (* FIX: Reimplement using W8A.foldi *)
          fun foldl f a (BA{nbits,bits}) = let
                fun loop (i,a) =
                      if i = nbits then a
                      else let
                        val b = ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
                        in
                          loop (i+1, f(b,a))
                        end
                in
                  loop (0,a)
                end
      
            (* FIX: Reimplement using W8A.foldr *)
          fun foldr f a (BA{nbits,bits}) = let
                fun loop (~1,a) = a
                  | loop (i,a) = let
                      val b = ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
                      in
                        loop (i-1, f(b,a))
                      end
                in
                  loop (nbits-1,a)
                end
      
          fun valid (nbits,sbit,NONE) =
                if sbit < 0 orelse sbit > nbits 
                  then raise Subscript 
                  else nbits - sbit
            | valid (nbits,sbit,SOME len) =
                if sbit < 0 orelse len < 0 orelse sbit > nbits - len 
                  then raise Subscript 
                  else len
      
            (* FIX: Reimplement using W8A.appi *)
          fun appi f (BA{nbits=0,bits},_,_) = ()
            | appi f (BA{nbits,bits},sbit,l) = let
                val len = valid (nbits, sbit, l)
                fun loop (_, 0) = ()
                  | loop (i, n) = let
                      val b = ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
                      in
                        f(i,b);
                        loop (i+1,n-1)
                      end
                in
                  loop (sbit,len)
                end
      
            (* FIX: Reimplement using W8A.foldi *)
          fun foldli f a (BA{nbits,bits},sbit,l) = let
                val len = valid (nbits, sbit, l)
                val last = sbit+len
                fun loop (i,a) =
                      if i = last then a
                      else let
                        val b = ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
                        in
                          loop (i+1, f(i,b,a))
                        end
                in
                  loop (sbit,a)
                end
      
            (* FIX: Reimplement using W8A.foldr *)
          fun foldri f a (BA{nbits,bits},sbit,l) = let
                val len = valid (nbits, sbit, l)
                fun loop (i,a) = 
                      if i < sbit then a
                      else let
                        val b = ((W8A.sub (bits,byteOf i)) & (bit i)) <> 0w0
                        in
                          loop (i-1, f(i,b,a))
                        end
                in
                  loop (sbit+len-1,a)
                end
      
            (* FIX: Reimplement using general-purpose copy *)
          fun copy {src = src as BA{nbits,bits},si,len,dst,di} = let
                val l = valid (nbits, si, len)
                val BA{nbits=nbits',bits=bits'} = dst
                val _ = if di < 0 orelse nbits' - di < l then raise Subscript
                        else ()
                val last = si + l
                fun loop (si,di) =
                      if si = last then ()
                      else (
                        if bitOf (src, si) then setBit(dst,di) else clrBit(dst,di);
                        loop (si+1,di+1)
                      )
                in
                  loop (si,di)
                end
      
          fun modify f (BA{nbits=0,bits}) = ()
            | modify f (BA{nbits,bits}) = let
                val last = byteOf (nbits-1)
                fun loop (0,_,a,_) = a
                  | loop (n,byte,a,mask) = 
                      if f ((byte&mask) = mask)
                        then loop (n-1,byte, a&mask, mask << 0w1)
                        else loop (n-1,byte, a, mask << 0w1)
                fun f' (i,byte) =
                       if i < last then loop (8,byte,0w0,0w1)
                       else loop (mask7 (nbits - 1) + 1, byte,0w0,0w1)
                in
                  W8A.modifyi f' (bits,0,NONE)
                end
      
            (* FIX: Reimplement using W8A.modifyi *)
          fun modifyi f (BA{nbits=0,bits},sbit,l) = ()
            | modifyi f (BA{nbits,bits},sbit,l) = let
                val len = valid (nbits, sbit, l)
                val last = sbit+len
                fun loop i =
                      if i = last then ()
                      else let
                        val index = byteOf i
                        val biti = bit i
                        val byte = W8A.sub (bits,index)
                        val b = (byte & biti) <> 0w0
                        val b' = f(i,b)
                        in
                          if b = b' then ()
                          else if b' then W8A.update(bits,index,byte ++ biti)
                          else W8A.update(bits,index,byte & (Word8.notb biti));
                          loop (i+1)
                        end
                in
                  loop sbit
                end
      
          end (* local *)
        end (* structure Vector *)

    open Vector
    type array = vector
    val copyVec = copy

end (* structure BitArray *)