strings.dylan

Module: %strings


// TODO: optimization

// TODO: which are sealed?

// TODO: what to do about methods for non byte-strings?

define constant <string-or-char> = type-union(<string>, <character>);

// eXpression IF.  (Not that the built-in IF isn't an expression.)
define macro xif
    { xif(?test:expression, ?true:expression, ?false:expression) }
 => { if (?test) ?true else ?false end }

    { xif(?test:expression, ?true:expression) }
 => { if (?test) ?true end }
end;



define sealed generic alphabetic?
    (string-or-character :: <string-or-char>, #key) => (alphabetic? :: <boolean>);

define method alphabetic?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  uppercase-code?(code) | lowercase-code?(code)
end;

define method alphabetic?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(alphabetic?, slice(string, start, epos))
end;



define sealed generic alphanumeric?
    (string-or-character :: <string-or-char>, #key) => (alphanumeric? :: <boolean>);

define method alphanumeric?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  uppercase-code?(code) | lowercase-code?(code) | decimal-digit?(char)
end;

define method alphanumeric?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(alphanumeric?, slice(string, start, epos))
end;


define sealed generic graphic?
    (string-or-character :: <string-or-char>, #key) => (graphic? :: <boolean>);

define method graphic?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  as(<integer>, ' ') <= code & code <= as(<integer>, '~')
end;

define method graphic?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(graphic?, slice(string, start, epos))
end;


define sealed generic printable?
    (string-or-character :: <string-or-char>, #key) => (printable? :: <boolean>);

define method printable?
    (char :: <character>, #key) => (b :: <boolean>)
  graphic?(char) | whitespace?(char)
end;

define method printable?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(printable?, slice(string, start, epos))
end;


define sealed generic control?
    (string-or-character :: <string-or-char>, #key) => (control? :: <boolean>);

define method control?
    (char :: <character>, #key) => (b :: <boolean>)
  ~ printable?(char)
end;

define method control?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(control?, slice(string, start, epos))
end;


define sealed generic whitespace?
    (string-or-character :: <string-or-char>, #key) => (whitespace? :: <boolean>);

define method whitespace?
    (char :: <character>, #key) => (b :: <boolean>)
  select (char)
    // Space, tab, newline, formfeed, carriage return
    ' ', '\t', '\n', '\f', '\r' => #t;
    otherwise => #f;
  end select
end;

define method whitespace?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(whitespace?, slice(string, start, epos))
end;


define sealed generic uppercase?
    (string-or-character :: <string-or-char>, #key) => (uppercase? :: <boolean>);

define method uppercase?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  uppercase-code?(code)
end;

define method uppercase?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(uppercase?, slice(string, start, epos))
end;


define sealed generic lowercase?
    (string-or-character :: <string-or-char>, #key) => (lowercase? :: <boolean>);

define method lowercase?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  lowercase-code?(code)
end;

define method lowercase?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(lowercase?, slice(string, start, epos))
end;


define sealed generic octal-digit?
    (string-or-character :: <string-or-char>, #key) => (octal? :: <boolean>);

define method octal-digit?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  as(<integer>, '0') <= code & code <= as(<integer>, '7')
end;

define method octal-digit?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(octal-digit?, slice(string, start, epos))
end;


define sealed generic decimal-digit?
    (string-or-character :: <string-or-char>, #key) => (decimal? :: <boolean>);

define method decimal-digit?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  as(<integer>, '0') <= code & code <= as(<integer>, '9')
end;

define method decimal-digit?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(decimal-digit?, slice(string, start, epos))
end;


define sealed generic hexadecimal-digit?
    (string-or-character :: <string-or-char>, #key) => (hexadecimal? :: <boolean>);

define method hexadecimal-digit?
    (char :: <character>, #key) => (b :: <boolean>)
  let code = as(<integer>, char);
  as(<integer>, '0') <= code & code <= as(<integer>, '9')
end;

define method hexadecimal-digit?
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (b :: <boolean>)
  every?(hexadecimal-digit?, slice(string, start, epos))
end;


define sealed generic char-equal-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);

define method char-equal-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);
  lowercase(char1) = lowercase(char2)
end;


define sealed generic char-less-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);

define method char-less-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);
  lowercase(char1) < lowercase(char2)
end;


define sealed generic char-greater-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);

define method char-greater-ic?
    (char1 :: <character>, char2 :: <character>) => (eq? :: <boolean>);
  lowercase(char1) > lowercase(char2)
end;


define sealed generic  string-compare
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2, ignore-case?)
 => (result :: one-of(-1, 0, 1));

define method string-compare
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>),
          ignore-case? :: <boolean>)
 => (result :: one-of(-1, 0, 1))
  %string-compare(string1, string2, start1, end1, start2, end2, ignore-case?)
end;


define sealed generic  string-equal?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (equal? :: <boolean>);

define method string-equal?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0,
          end1 :: false-or(<integer>),
          start2 :: <integer> = 0,
          end2 :: false-or(<integer>))
 => (equal? :: <boolean>)
  let ignore-case? = #f;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = 0
end method string-equal?;


define sealed generic string-less?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (less? :: <boolean>);

define method string-less?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>))
 => (less? :: <boolean>)
  let ignore-case? = #f;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = -1
end method string-less?;


define sealed generic string-greater?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (greater? :: <boolean>);

define method string-greater?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>))
 => (greater? :: <boolean>)
  let ignore-case? = #f;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = 1
end method string-greater?;


define sealed generic string-equal-ic?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (equal? :: <boolean>);

define method string-equal-ic?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>))
 => (equal? :: <boolean>)
  let ignore-case? = #t;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = 0
end method string-equal-ic?;


define sealed generic string-less-ic?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (less? :: <boolean>);

define method string-less-ic?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>))
 => (less? :: <boolean>)
  let ignore-case? = #t;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = -1
end method string-less-ic?;


define sealed generic string-greater-ic?
    (string1 :: <string>, string2 :: <string>, #key start1, end1, start2, end2)
 => (greater? :: <boolean>);

define method string-greater-ic?
    (string1 :: <string>, string2 :: <string>,
     #key start1 :: <integer> = 0, end1 :: false-or(<integer>),
          start2 :: <integer> = 0, end2 :: false-or(<integer>))
 => (greater? :: <boolean>)
  let ignore-case? = #t;
  %string-compare(string1, string2,
                  start1, end1 | string1.size,
                  start2, end2 | string2.size, ignore-case?) = 1
end method string-greater-ic?;


define sealed generic lowercase
    (string-or-char :: <string-or-char>, #key)
 => (new-string-or-char :: <string-or-char>);

define method lowercase
    (char :: <character>, #key) => (new-char :: <character>)
  as-lowercase(char)
end;

define method lowercase
    (string :: <string>, #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (new-string :: <string>)
  let epos :: <integer> = epos | string.size;
  lowercase!(copy-sequence(string, start: start, end: epos))
end method lowercase;
  

define sealed generic lowercase!
    (string-or-char :: <string-or-char>, #key)
 => (string-or-char :: <string-or-char>);

define method lowercase!
    (char :: <character>, #key) => (new-char :: <character>)
  as-lowercase(char)
end;

define method lowercase!
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (string :: <string>)
  let epos :: <integer> = epos | string.size;
  range-check(string, string.size, start, epos);
  for (i from start below epos)
    string[i] := lowercase(string[i])
  end;
  string
end method lowercase!;


define sealed generic uppercase
    (string-or-char :: <string-or-char>, #key)
 => (new-string-or-char :: <string-or-char>);

define method uppercase
    (char :: <character>, #key) => (new-char :: <character>)
  as-uppercase(char)
end;

define method uppercase
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (new-string :: <string>)
  let epos :: <integer> = epos | string.size;
  uppercase!(copy-sequence(string, start: start, end: epos))
end method uppercase;


define sealed generic uppercase!
    (string-or-char :: <string-or-char>, #key)
 => (string-or-char :: <string-or-char>);

define method uppercase!
    (char :: <character>, #key) => (new-char :: <character>)
  as-uppercase(char)
end;

define method uppercase!
    (string :: <string>,
     #key start :: <integer> = 0, end: epos :: false-or(<integer>))
 => (string :: <string>)
  let epos :: <integer> = epos | string.size;
  range-check(string, string.size, start, epos);
  for (i from start below epos)
    string[i] := uppercase(string[i])
  end;
  string
end method uppercase!;


define sealed generic pad
    (string :: <string>, width :: <integer>, #key fill, start, end: epos)
 => (new-string :: <string>);

define method pad
      (string :: <string>, width :: <integer>,
       #key fill :: <character> = ' ',
            start :: <integer> = 0,
            end: epos :: false-or(<integer>))
   => (new-string :: <string>)
  // Always return a new string, even if no padding is done.
  let slen = string.size;
  let nlen = max(width, slen);
  let spos = floor/(width - slen, 2);       // start of "string" in "new"
  let new = make(<string>, size: nlen);
  for (i :: <integer> from 0 below spos)
    new[i] := fill;
  end;
  for (si :: <integer> from 0 below slen,
       ni :: <integer> from spos below spos + slen)
    new[ni] := string[si];
  end;
  for (i :: <integer> from spos + slen below nlen)
    new[i] := fill;
  end;
  new
end method pad;


define sealed generic pad-right
    (string :: <string>, width :: <integer>, #key fill, start, end: epos)
   => (new-string :: <string>);

define method pad-right
      (string :: <string>, width :: <integer>,
       #key fill :: <character> = ' ',
            start :: <integer> = 0,
            end: epos :: false-or(<integer>))
   => (new-string :: <string>)
  // Always return a new string, even if no padding is done.
  let slen = string.size;
  let nlen = max(width, slen);
  let spos = width - slen;       // start of "string" in "new"
  let new = make(<string>, size: nlen);
  for (ni :: <integer> from 0 below spos)
    new[ni] := fill;
  end;
  for (si :: <integer> from 0 below slen,
       ni :: <integer> from spos below nlen)
    new[ni] := string[si];
  end;
  new
end method pad-right;


define sealed generic pad-left
    (string :: <string>, width :: <integer>, #key fill, start, end: epos)
 => (new-string :: <string>);

define method pad-left
      (string :: <string>, width :: <integer>,
       #key fill :: <character> = ' ',
            start :: <integer> = 0,
            end: epos :: false-or(<integer>))
   => (new-string :: <string>)
  // Always return a new string, even if no padding is done.
  let slen = string.size;
  let nlen = max(width, slen);
  let new = make(<string>, size: nlen);
  for (i :: <integer> from 0 below slen)
    new[i] := string[i];
  end;
  for (i :: <integer> from slen below nlen)
    new[i] := fill;
  end;
  new
end method pad-left;


define sealed generic strip
    (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);

define method strip
    (string :: <string>,
     #key test :: <function> = whitespace?,
          start :: <integer> = 0,
          end: epos :: false-or(<integer>))
 => (new-string :: <string>)
  let untest = complement(test);
  let epos :: <integer> = epos | string.size;
  let left = %find-key(string, untest, start, epos);
  if (~ left)
    strip-right(string, test: test, start: start, end: epos)
  else
    let right = %find-key-from-end(string, untest, start, epos) | epos;
    copy-sequence(string, start: left, end: right)
  end if
end method strip;

define sealed generic strip-left
    (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);

define method strip-left
    (string :: <string>,
     #key test :: <function> = whitespace?,
          start :: <integer> = 0,
          end: epos :: false-or(<integer>))
 => (new-string :: <string>)
  let epos :: <integer> = epos | string.size;
  copy-sequence(string,
                start: %find-key(string, complement(test), start, epos) | epos,
                end: epos)
end;

define sealed generic strip-right
    (string :: <string>, #key test, start, end: epos) => (new-string :: <string>);

define method strip-right
    (string :: <string>,
     #key test :: <function> = whitespace?,
          start :: <integer> = 0,
          end: epos :: false-or(<integer>))
 => (new-string :: <string>)
  let epos :: <integer> = epos | string.size;
  copy-sequence(string,
               start: start,
               end: %find-key-from-end(string, complement(test), start, epos)
                      | string.size)
end;

define sealed generic starts-with?
    (string :: <string>, pattern :: <string>, #key ignore-case?, start, end: epos)
 => (starts-with? :: <boolean>);

define method starts-with?
    (string :: <string>, pattern :: <string>,
     #key ignore-case?,
          start :: <integer> = 0,
          end: epos :: false-or(<integer>))
 => (starts-with? :: <boolean>)
  let plen :: <integer> = pattern.size;
  let epos :: <integer> = epos | string.size;
  if (plen <= epos - start)
    %string-compare(string, pattern, start, start + plen, 0, plen, ignore-case?) = 0
  end
end method starts-with?;

define sealed generic ends-with?
    (string :: <string>, pattern :: <string>, #key ignore-case?, start, end: epos)
 => (ends-with? :: <boolean>);

define method ends-with?
    (string :: <string>, pattern :: <string>,
     #key ignore-case?,
          start :: <integer> = 0,
          end: epos :: false-or(<integer>))
 => (ends-with? :: <boolean>)
  let slen :: <integer> = string.size;
  let plen :: <integer> = pattern.size;
  let epos :: <integer> = epos | string.size;
  if (plen <= epos - start)
    %string-compare(string, pattern, epos - plen, epos, 0, plen, ignore-case?) = 0
  end
end method ends-with?;


// I decided that slice shouldn't be included in the new strings
// library because it complicates the DEP too much.  At some point it
// may be worth writing a separate DEP to include slice in
// common-dylan.  There are some interesting and complicated issues.
// I think it could be worth it, but it's not a huge win so not
// urgent. --cgay

define function slice
    (string :: <string>, start :: <integer>, _end :: false-or(<integer>))
 => (new-string :: <string>)
  let len :: <integer> = string.size;
  let _end :: <integer> = _end | len;
  // Negative indexes are relative to the end of the string.
  if (_end < 0)
    _end := len + _end;
  end;
  if (start < 0)
    start := len + start;
  end;
  range-check(string, string.size, start, _end);
  copy-sequence(string, start: start, end: _end)
end function slice;

define generic split-lines
    (string :: <string>, #key remove-if-empty?) => (lines :: <sequence>);

define sealed method split-lines
    (string :: <string>, #key remove-if-empty? :: <boolean>) => (lines :: <sequence>)
  let epos :: <integer> = string.size;
  reverse!(iterate loop (bpos :: <integer> = 0, parts :: <list> = #())
             let (sep-start, sep-end)
               = iterate find-eol (i = bpos) // Recognize CR alone, CRLF, or LF alone.
                   if (i < epos)
                     select (string[i])
                       '\r' =>
                         let i2 = i + 1;
                         let char2 = (i2 < epos) & string[i2];
                         values(i, (char2 = '\n' & i + 2) | i2);
                       '\n' =>
                         values(i, i + 1);
                       otherwise =>
                         find-eol(i + 1);
                     end select
                   end if
                 end iterate;
             let part = copy-sequence(string, start: bpos, end: sep-start | epos);
             case
               ~sep-start =>
                 xif(remove-if-empty? & empty?(part),
                     parts,
                     pair(part, parts));
               sep-end = epos =>     // trailing EOL
                 pair(part, parts);
               remove-if-empty? & empty?(part) =>
                 loop(sep-end, parts);
               otherwise =>
                 loop(sep-end, pair(part, parts));
             end
           end)
end method split-lines;


/// Utilities

define inline function uppercase-code?
    (code :: <integer>) => (true? :: <boolean>)
  as(<integer>, 'A') <= code & code <= as(<integer>, 'Z')
end;

define inline function lowercase-code?
    (code :: <integer>) => (true? :: <boolean>)
  as(<integer>, 'a') <= code & code <= as(<integer>, 'z')
end;


define inline function %string-compare
    (string1 :: <string>, string2 :: <string>,
     start1 :: <integer>, end1 :: <integer>,
     start2 :: <integer>, end2 :: <integer>,
     ignore-case? :: <boolean>)
 => (result :: one-of(-1, 0, 1))
  range-check(string1, string1.size, start1, end1);
  range-check(string2, string2.size, start2, end2);
  let eq? :: <function> = xif(ignore-case?,
                              method (c1 :: <character>, c2 :: <character>)
                                as-lowercase(c1) == as-lowercase(c2)
                              end,
                              \==);
  let less? :: <function> = xif(ignore-case?,
                                method (c1 :: <character>, c2 :: <character>)
                                  as-lowercase(c1) < as-lowercase(c2)
                                end,
                                \<);
  iterate loop (i1 :: <integer> = start1, i2 :: <integer> = start2)
    case
      i1 = end1 =>
        xif(i2 = end2, 0, -1);
      i2 = end2 =>
        1;
      otherwise =>
        let c1 = string1[i1];
        let c2 = string2[i2];
        case
          eq?(c1, c2) => loop(i1 + 1, i2 + 1);
          less?(c1, c2) => -1;
          otherwise => 1;
        end;
    end case
  end iterate
end function %string-compare;


define inline function range-check
    (sequence :: <sequence>, _size :: <integer>, _start :: <integer>, _end :: <integer>) => ()
  when (_start < 0 | _start > _size)
    element-range-error(sequence, _start)
  end;
  when (_end < 0 | _end > _size)
    element-range-error(sequence, _end)
  end
end;


define inline function %find-key-from-end
    (string :: <string>, test :: <function>, start :: <integer>, epos :: <integer>)
 => (key :: false-or(<integer>))
  iterate loop (i = epos - 1)
    if (i >= start)
      xif (test(string[i]),
           i + 1,
           loop(i - 1))
    end
  end iterate
end function %find-key-from-end;


// Like find-key but accepts start/end args.  Would like to add them to find-key.
define function %find-key
    (seq :: <sequence>, test :: <function>, start :: <integer>, epos :: <integer>)
 => (key :: false-or(<integer>))
  iterate loop (i = start)
    if (i < epos)
      xif(test(seq[i]),
          i,
          loop(i + 1))
    end
  end
end function %find-key;