Module:    internal
Author:    Jonathan Bachrach
Copyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.
              All rights reserved.
License:      Functional Objects Library Public License Version 1.0
Dual-license: GNU Lesser General Public License
Warranty:     Distributed WITHOUT WARRANTY OF ANY KIND

//
// SUBSEQUENCE-POSITION
//

define sealed method subsequence-position   
    (big :: <byte-string>, pat :: <byte-string>, 
     #key test :: <function> = \==, count :: <integer> = 1) 
        => (index :: false-or(<integer>));
  let sz :: <integer> = size(big);
  let pat-sz :: <integer> = size(pat);

  select (pat-sz)
    0 =>
      count - 1;
    1 =>
      let ch = pat[0];
      for (key :: <integer> from 0 below sz,
	   until: test(big[key], ch) & (count := count - 1) <= 0)
      finally
	if (key < sz) key end if;
      end for;
    2 =>
      let ch1 = pat[0];
      let ch2 = pat[1];
      for (key :: <integer> from 0 below sz - 1,
	   until: test(big[key], ch1) & test(big[key + 1], ch2)
	     & (count := count - 1) <= 0)
      finally
	if (key < (sz - 1)) key end if;
      end for;
    otherwise =>
      if (test ~= \==)
	local method search(index :: <integer>, 
                            big-key :: <integer>, 
                            pat-key :: <integer>, 
                            count :: <integer>)
		case
		  pat-key >= pat-sz =>
		    if (count = 1) index
		    else search(index + 1, index + 1, 0, count - 1);
		    end if;
		  big-key = sz =>     
		    #f;
		  test(big[big-key], pat[pat-key]) =>
		    search(index, big-key + 1, pat-key + 1, count);
		  otherwise => 
		    search(index + 1, index + 1, 0, count);
		end case;
	      end method search;
	search(0, 0, 0, count);
      else
	// It's worth doing something Boyer-Moore-ish....
	let pat-last :: <integer> = pat-sz - 1;
	let last-char :: <byte-character> = pat[pat-last];
	let skip :: <simple-object-vector> 
          = make(<vector>, size: 256, fill: pat-sz);
	for (i :: <integer> from 0 below pat-last)
	  skip[as(<integer>, pat[i])] := pat-last - i;
	end for;
	local method do-skip(index :: <integer>, count :: <integer>)
		if (index >= sz)
		  #f;
		else 
		  let char :: <byte-character> = big[index];
		  if (char == last-char)
		    search(index - pat-last, index, pat-last, count);
		  else
		    do-skip(index + skip[as(<integer>, char)], count);
		  end if;
		end if;
	      end method,
              method search(index :: <integer>, 
                            big-key :: <integer>, 
                            pat-key :: <integer>, 
                            count :: <integer>)
		case
		  pat-key < 0 =>
		    if (count = 1) index
		    else do-skip(index + pat-sz, count - 1)
		    end if;
		  big[big-key] == pat[pat-key] =>
		    search(index, big-key - 1, pat-key - 1, count);
		  otherwise => 
		    do-skip(index + pat-sz, count);
		end case;
	      end method search;
	do-skip(pat-last, count);
      end if;
  end select;
end method subsequence-position;

//
// COPY-SEQUENCE
// 

define sealed method copy-sequence
    (source :: <byte-string>, 
     #key start: first :: <integer> = 0, end: last = source.size) 
        => (result-sequence :: <byte-string>);
  let last :: <integer> = check-start-compute-end(source, first, last);
  let sz :: <integer> = last - first;
  let target :: <byte-string> = make(<byte-string>, size: sz);
  primitive-replace-bytes!
    (target, primitive-repeated-slot-offset(target), integer-as-raw(0), 
     source, primitive-repeated-slot-offset(source), integer-as-raw(first), 
     integer-as-raw(sz));
  target
end method copy-sequence;

//
// CONCATENATE-AS
//

define sealed method concatenate-as
    (class == <byte-string>, vector :: <byte-string>, 
     #rest more-vectors) => (result :: <byte-string>)
  block (return)
    let total-sz :: <integer> = vector.size;
    let num-non-empty :: <integer> = if (total-sz = 0) 0 else 1 end;
      
    for (v in more-vectors)
      if (~instance?(v, <byte-string>)) return(next-method()) end;
      let sz :: <integer> = v.size;
      if (sz ~= 0)
        total-sz := total-sz + sz;
        num-non-empty := num-non-empty + 1;
      end;
    end for;
      
    select (num-non-empty)
      0 => make(<byte-string>);
      1 => if (vector.size > 0) vector 
           else 
             for (i :: <integer> from 0 below more-vectors.size,
                  while: more-vectors[i].size = 0) finally more-vectors[i] end
           end;
      otherwise =>  
        let result = make(<byte-string>, size: total-sz);
	let index = 0;
	let sz :: <raw-integer> = integer-as-raw(vector.size);
	primitive-replace-bytes!
	  (result, primitive-repeated-slot-offset(result), integer-as-raw(0), 
	   vector, primitive-repeated-slot-offset(vector), integer-as-raw(0), sz);
	let result-index :: <raw-integer> = sz;
	for (v :: <byte-string> in more-vectors)
	  let vsz :: <raw-integer> = integer-as-raw(v.size);
	  primitive-replace-bytes!
	    (result, primitive-repeated-slot-offset(result), result-index, 
	     v,      primitive-repeated-slot-offset(v),      integer-as-raw(0), vsz);
	  result-index := primitive-machine-word-add(result-index, vsz);
	end;
        result        
    end select;
  end block
end method concatenate-as;