Fuzion Logo
flang.dev — The Fuzion Language Portal
JavaScript seems to be disabled. Functionality is limited.

string.fz


# This file is part of the Fuzion language implementation.
#
# The Fuzion language implementation is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation, version 3 of the License.
#
# The Fuzion language implementation is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
# License for more details.
#
# You should have received a copy of the GNU General Public License along with The
# Fuzion language implementation.  If not, see <https://www.gnu.org/licenses/>.


# -----------------------------------------------------------------------
#
#  Tokiwa Software GmbH, Germany
#
#  Source code of Fuzion standard library feature string
#
#  Author: Fridtjof Siebert (siebert@tokiwa.software)
#
# -----------------------------------------------------------------------

# string -- immutable sequences of utf8 encoded unicode characters
#
string ref : hasHash string, ordered string, strings is

  redef orderedThis => string.this

  # converting a string to a string is just returning string.this
  redef asString => string.this

  # any concrete string must implement utf8
  utf8 Sequence u8 is abstract

  # is this string empty?
  isEmpty => !utf8.asStream.hasNext

  # returns true if string is empty or contains whitespace only
  isBlank => utf8 ∀ u -> isAsciiWhiteSpace u

  # length of this string in bytes
  byteLength => utf8.count

  # length of this string in codepoints
  codepointLength => asCodepoints.count

  # concatenate string with string representation of another object
  infix + (other Object) string is
    ma := (marrays Object).new 2 string.this
    ma[1] := other
    strings.fromArray ma

  # repeat string given number of times
  infix * (n i32) ref : string
  pre
    n >= 0
  is
    redef utf8 ref : Sequence u8 is
      redef asStream ref : stream u8 is
        i := 0
        bytes := string.this.utf8.asStream

        redef hasNext => i < n && bytes.hasNext
        redef next u8 is
          res := bytes.next
          if !bytes.hasNext
            set i := i + 1
            if i < n
              set bytes := string.this.utf8.asStream
          res


  # compare string byte-by-byte with other string
  redef infix = (other string) =>
    s1 :=       utf8.asStream
    s2 := other.utf8.asStream
    while s1.hasNext && s2.hasNext
    until s1.next    != s2.next
      false
    else
      !s1.hasNext && !s2.hasNext

    /* NYI: when lazy evaluation works, this should be possible:

    s1 :=       utf8.asStream
    s2 := other.utf8.asStream
    while s1.hasNext == s2.hasNext && (!s1.hasNext || s1.next == s2.next)
    until !s1.hasNext

    */

  infix == (other string) => string.this = other    # NYI: replace by 'infix ='

  # does this come before other?
  #
  # This defines a total order over strings that is unrelated to alphabetic order.
  #
  infix <= (other string) =>
    s1 :=       utf8.asStream     # NYI: can this be made more beautiful using lists?
    s2 := other.utf8.asStream
    for
      b1 := if (s1.hasNext) s1.next.as_i32 else -1
      b2 := if (s2.hasNext) s2.next.as_i32 else -1
    until b1 != b2 || b1 < 0
      b1 <= b2


  # create hash code from a string
  hash u64 is
    shL := u64 13
    shR := u64 51
    for
      h u64 := 0, ((h << shL) | (h >> shR)) ^ b.as_u64;
      b in utf8
    while true
    else
      h


  # internal helper to create error for failed parsing
  #
  private parseError(msg string) => error "failed to parse '{string.this}': $msg"


  # parse this string as a signed 32-bit integer value
  #
  parse_i32       => parse_i32 10
  parse_i32_binary => parse_i32 2
  parse_i32_octal  => parse_i32 8
  parse_i32_hex    => parse_i32 16
  parse_i32 (base i32) outcome i32
    pre 1 < base <= 36
  is
    parse_integer i32 base


  # parse this string as an unsigned 32-bit integer value
  #
  parse_u32       => parse_u32 10
  parse_u32_binary => parse_u32 2
  parse_u32_octal  => parse_u32 8
  parse_u32_hex    => parse_u32 16
  parse_u32 (base u32) outcome u32
    pre u32 1 < base <= 36
  is
    parse_integer u32 base


  # parse this string as a signed 64-bit integer value
  #
  parse_i64       => parse_i64 10
  parse_i64_binary => parse_i64 2
  parse_i64_octal  => parse_i64 8
  parse_i64_hex    => parse_i64 16
  parse_i64 (base i64) outcome i64
    pre i64 1 < base <= 36
  is
    parse_integer i64 base


  # parse this string as an unsigned 64-bit integer value
  #
  parse_u64       => parse_u64 10
  parse_u64_binary => parse_u64 2
  parse_u64_octal  => parse_u64 8
  parse_u64_hex    => parse_u64 16
  parse_u64 (base u64) outcome u64
    pre u64 1 < base <= 36
  is
    parse_integer u64 base


  # parse this string as an int value of arbitrary size
  #
  parse_int       => parse_int int(10)
  parse_int_binary => parse_int int(2)
  parse_int_octal  => parse_int int(8)
  parse_int_hex    => parse_int int(16)
  parse_int (base int) outcome int
    pre (int 1) < base <= int 36
  is
    parse_integer int base


  # parse this string as a integer value given as type parameter
  #
  parse_integer(
    # the integer type
    T (integer T).type,

    # base gives the base of the integer, must be between 2 and 36, inclusive.
    base T

    ) outcome T

    pre base.one < base <= base.from_u32 36

  is
    s := utf8.asStream
    if s.hasNext
      c := s.next
      negate := c = minusChar
      d := if (negate || c = plusChar) zeroChar else c
      parse_integer T base negate base.zero d s
    else
      parseError "empty string"


  # recursive helper for parse_integer T
  #
  private parse_integer(
    # the integer type
    T (integer T).type,

    # base gives the base, between 2 and 36
    base T,

    # do we parse a negative number?
    neg bool,

    # the value of the highest digits already parsed
    hi numOption T,

    # the current character to be parsed
    c u8,

    # the remaining characters to be parsed
    s stream u8

    ) outcome T

  is

    d u8 | error := if      (zeroChar <= c <= nineChar) c - zeroChar
                    else if (aChar    <= c <= zChar   ) c - aChar    + 10
                    else if (capAChar <= c <= capZChar) c - capAChar + 10
                    else parseError "non-digit found"

    # NYI: with more syntactic sugar, the following 3 lines could become
    #
    # i := d?

    match d
      e error => e
      b u8 =>
        t := base.from_u32 b.as_u32  # i converted to T
        if t >= base
          parseError "invalid integer digit for base $base"
        else
          hi := hi *? base;
          v := if (neg) hi -? t
               else     hi +? t
          if s.hasNext
            parse_integer T base neg v s.next s
          else
            v ? nil => parseError "numerical overflow"
              | u T => u


  # convert this string into an array of codepoints.
  #
  codepointsArray => asCodepoints.asArray


  # convert this string into a Sequence of codepoint and errors for encoding problems
  # found in the underlying utf8 bytes
  #
  asCodepoints : Sequence codepoint is
    redef asStream ref : stream codepoint is
      s := codepointsAndErrors
      n option codepoint := nil

      redef hasNext => s.hasNext
      redef next =>
        s.next ? c codepoint => c
               | e error     => codepoint 0xFFFD # 'REPLACEMENT CHARACTER' (U+FFFD)

  # convert this string into a stream of codepoint and errors for encoding problems
  # found in the underlying utf8 bytes
  #
  codepointsAndErrors stream (outcome codepoint) is codepointStream


  # the stream instance returned by asCodepoints
  #
  private codepointStream : stream (outcome codepoint) is  # NYI: better list than stream!
    s := utf8.asStream
    hasNext => s.hasNext
    next outcome codepoint is
      p := codepoints
      e(msg string) => error "Bad UTF8 encoding found: cannot decode $msg"

      b1 := s.next
      e1(msg string) => e "$b1: $msg"
      # UTF-8 definition taken from https://en.wikipedia.org/wiki/UTF-8
      if b1.as_u32 ∈ p.utf8EncodedInOneByte           # ASCII
        codepoint b1.as_u32
      else if u8 0xc0 <= b1 <= 0xf4
        if !s.hasNext
          e1 "end of string, expected continuation byte"
        else
          b2 := s.next
          e2(msg string) => e "$b1, $b2: $msg"
          if (b2 & 0xc0) != 0x80
            e2 "expected continuation byte in the range 0x80..0xbf."
          else if u8 0xc0 <= b1 <= 0xdf   # 0x0080..0x7ff encoded in 2 bytes
            res := (b1.as_u32 & 0x1f) << 6 | (b2.as_u32 & 0x3f)
            if res ∉ p.utf8EncodedInTwoBytes
              e2 "codepoint $res uses overlong 2-byte encoding, allowed for range {p.utf8EncodedInTwoBytes}."
            else
              codepoint res
          else if u8 0xe0 <= b1
            if !s.hasNext
              e2 "end of string, expected continuation byte"
            else
              b3 := s.next
              e3(msg string) => e "$b1, $b2, $b3: $msg"
              if (b3 & 0xc0) != 0x80
                e3 "expected two continuation bytes in the range 0x80..0xbf."
              else if b1 <= 0xef       # 0x0800..0xffff encoded in 3 bytes
                res := (((b1.as_u32 & 0x0f) << 12) |
                        ((b2.as_u32 & 0x3f) <<  6) |
                        ((b3.as_u32 & 0x3f)      )   )
                if res ∉ p.utf8EncodedInThreeBytes
                  e3 "codepoint $res uses overlong 3-byte encoding, allowed for range {p.utf8EncodedInTwoBytes}."
                else if res ∈ p.utf16Surrogate
                  e3 "codepoint $res is invalid, values in the range {p.utf16Surrogate} are reserved for UTF-16 surrogate halves."
                else if res ∈ p.notACharacter
                  e3 "codepoint $res is not a valid unicode character {p.notACharacter}."
                else
                  codepoint res
              else                     # 0x010000..0x10ffff encoded in 4 bytes
                if !s.hasNext
                  e3 "end of string, expected continuation byte"
                else
                  b4 := s.next
                  e4(msg string) => e "$b1, $b2, $b3, $b4: $msg"
                  if (b4 & 0xc0) != 0x80
                    e4 "expected three continuation bytes in the range 0x80..0xbf."
                  else
                    res := (((b1.as_u32 & 0x07) << 18) |
                            ((b2.as_u32 & 0x3f) << 12) |
                            ((b3.as_u32 & 0x3f) <<  6) |
                            ((b4.as_u32 & 0x3f)      )   )
                    if res ∉ p.utf8EncodedInFourBytes
                      e4 "codepoint $res uses overlong 4-byte encoding."
                    else if res > 0x10ffff
                      e4 "codepoint $res is outside of the allowed range for codepoints 0x000000..0x10ffff."
                    else
                      codepoint res
      else if u8 0x80 <= b1 <= 0xbf then e1 "stray continuation byte without preceding leading byte."
      else if u8 0xf5 <= b1 <= 0xfd then e1 "codes 0xf5..0xfd are undefined."
      else if u8 0xfe <= b1 <= 0xff then e1 "codes 0xfe and 0xff are undefined, used for endianess checking."
      else
        fuzion.std.panic "string.codepointStream: missing case for $b1"


  # create substring of this string consisting of codepoints from (inclusive) .. to (exclusive).
  #
  substring(from, to i32) string
    pre
      debug: 0 <= from <= to <= codepointLength
  is
    codepointsArray
      .slice(from, to)
      .map string (c -> c)  # NYI: this should maybe not be needed since codepoint is a string
      .fold strings.concat


  # create substring of this string consisting of codepoints from (inclusive) .. codepointLength (exclusive).
  #
  substring(from i32) string
    pre
      debug: 0 <= from <= codepointLength
  is
    substring from codepointLength


  # check if this string starts with given prefix
  #
  startsWith(prefx string) =>
    (searchableSequence utf8).startsWith prefx.utf8


  # check if this string ends with given suffix
  #
  endsWith(suffix string) =>
    l  := byteLength
    sl := suffix.byteLength
    end := utf8.drop l-sl
    (searchableSequence end).startsWith suffix.utf8


  # find (utf8-byte-) index of 'substring' witin this string.
  #
  find(substring string) =>
    (searchableSequence utf8).find substring.utf8


  # replace all occurances of f within l by r
  #
  replace (f, r string) => strings.fromBytes ((searchableSequence utf8).replace f.utf8 r.utf8)


  # does this string contain the given 'substring'
  #
  contains (substring string) => find(substring).exists


  # count number of occurances of given 'substring' in this string
  #
  count (substring string) =>
    (searchableSequence utf8).countMatches substring.utf8


  # is c an ASCII white-space character?
  #
  private isAsciiWhiteSpace(c u8) =>
    (c =  9 ||  // HT
     c = 10 ||  // LF
     c = 11 ||  // VT
     c = 12 ||  // FF
     c = 13 ||  // CR
     c = 32     // SPACE
     )


  # Split string separated by (ASCII) white space
  #
  # Leading and trailing white space is ignored, repeated white space is treated
  # like a single white space
  #
  # The result is a, possibly empty, list of separate non-empty strings.
  #
  split list string is
    l := utf8.asList.dropWhile (c -> isAsciiWhiteSpace c)
    if l.isEmpty
      nil
    else
      ref : Cons string (list string)
        head =>  strings.fromBytes (l.takeWhile (c -> !isAsciiWhiteSpace c))
        tail => (strings.fromBytes (l.dropWhile (c -> !isAsciiWhiteSpace c))).split
        # NYI using the inherited 'fromBytes' as in
        #
        #   head =>  fromBytes l.takeWhile fun (c i32) => !isAsciiWhiteSpace c
        #
        # currerntly creates an error (recursive value type), this needs to be fixed (or,
        # at least, understood better).


  # split string at s
  #
  split(s string) list string
    pre
      !s.isEmpty
    is
    match (find s)
      nil => [string.this].asList
      idx i32 => ref : Cons string (list string)
                   head => substring 0 idx
                   tail =>
                     rest := substring (idx + s.codepointLength) string.this.codepointLength
                     rest.split s


  # remove leading and trailing white space from this string
  #
  trim string is
    s0 := utf8

    s1 := (s0.dropWhile (fun isAsciiWhiteSpace)).reverse
    s2 := (s1.dropWhile (fun isAsciiWhiteSpace)).reverse

# NYI: This causes fz to crash:
#   fromBytes s2

    strings.fromBytes s2


  # remove leading white space from this string
  #
  trimStart =>
# NYI: This causes fz to crash:
#   fromBytes ...
    strings.fromBytes (utf8.dropWhile (fun isAsciiWhiteSpace))


  # remove trailing white space from this string
  #
  trimEnd =>
# NYI: This causes fz to crash:
#   fromBytes ...
    strings.fromBytes (utf8.asList.reverse.dropWhile (fun isAsciiWhiteSpace)).reverse


  # is this part of given set
  #
  elementOf(s Set string) => s.contains string.this
  infix ∈ (s Set string) => string.this.elementOf s


  # is this not part of given set
  #
  notElementOf(s Set string) => !elementOf s
  infix ∉ (s Set string) => string.this.notElementOf s


# strings -- unit type defining features related to string but not
# requiring an instance
#
strings is


  # monoid of strings with infix + operation.
  #
  concat : Monoid string is
    redef infix ∙ (a, b string) => a + b
    redef infix == (a, b string) => a == b
    redef e => ""


  # monoid of strings with infix '+ sep +' operation, i.e., concatenate with
  # given separator
  #
  concat(sep string) : Monoid string is
    redef infix ∙ (a, b string) string is if (a.isEmpty || b.isEmpty) a + b else a + sep + b
    redef infix == (a, b string) => a == b
    redef e => ""


  # create string by concatenating the results of $a[a.indices].
  #
  # This uses a growing array if further strings are appended using 'infix +',
  # so it avoids quadratic runtime caused if each 'infix +' would create its
  # own concatenation-string.
  #
  # The performance of creating a string a0+a1+a2+...+a<n> is in O(n) since the
  # backing array is shared and doubled in size when full (so the final array size
  # is less than 2n in size and the sum of all arrays is less than 4n = 2n + n +
  # n/2+n/4+...).
  #
  # The performance of iterating the utf8 bytes of a string is O(l+n) for an
  # array of length l created by concatenating n sub-strings.
  #
  fromArray(a marray Object) ref : string is
    redef infix + (other Object) string is
      fromArray (a.add other)

    redef utf8 ref : Sequence u8 is
      redef asStream ref : stream u8 is
        i := 0
        s := a[i].asString.utf8.asStream
        gotNext := false

        findNext bool is
          set gotNext := gotNext || (
            for hs := s.hasNext
            while !hs && i+1 < a.length
              set i := i + 1
              set s := a[i].asString.utf8.asStream
            else
              hs)
          gotNext

        redef hasNext => findNext
        redef next    => findNext; set gotNext := false; s.next


  # create string from the given utf8 bytes
  #
  fromBytes(utf8Bytes Sequence u8) string is
    ref : string
      redef utf8 => utf8Bytes


  # create string from the given codepoints
  #
  fromCodepoints(codePoints Sequence codepoint) string is
    # NYI: would be nicer if result was created lazily
    for
      res := "", res + cp
      cp in codePoints
    else
      res


  # NYI: remove the convenience functions when Fuzion supports char literals
  #
  minusChar => "-".utf8.asStream.next
  plusChar  => "+".utf8.asStream.next
  zeroChar  => "0".utf8.asStream.next
  nineChar  => "9".utf8.asStream.next
  aChar     => "a".utf8.asStream.next
  zChar     => "z".utf8.asStream.next
  capAChar  => "A".utf8.asStream.next
  capZChar  => "Z".utf8.asStream.next