axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / ISTRING.spad

)abbrev domain ISTRING IndexedString
++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
++ Description:
++ This domain implements low-level strings

IndexedString(mn) : SIG == CODE where
  mn : Integer

  B ==> Boolean
  C ==> Character
  I ==> Integer
  N ==> NonNegativeInteger
  U ==> UniversalSegment Integer

  SIG ==> StringAggregate() with

    hash : % -> I
      ++ hash(x) provides a hashing function for strings

  CODE ==> add

    -- These assume Character's Rep is Small I
    Qelt    ==> QENUM$Lisp
    Qequal  ==> EQUAL$Lisp
    Qsetelt ==> QESET$Lisp
    Qsize   ==> QCSIZE$Lisp
    Cheq    ==> EQL$Lisp
    Chlt    ==> QSLESSP$Lisp
    Chgt    ==> QSGREATERP$Lisp

    c: Character
    cc: CharacterClass

    new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp

    empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp

    empty?(s) == Qsize(s) = 0

    #s == Qsize(s)

    s = t == Qequal(s, t)

    s < t == CGREATERP(t,s)$Lisp

    concat(s:%,t:%) == STRCONC(s,t)$Lisp

    copy s == COPY_-SEQ(s)$Lisp

    insert(s:%, t:%, i:I)  == concat(concat(s(mn..i-1), t), s(i..))

    coerce(s:%):OutputForm == outputForm(s pretend String)

    minIndex s == mn

    upperCase_! s == map_!(upperCase, s)

    lowerCase_! s == map_!(lowerCase, s)

    latex s == concat("\mbox{``", concat(s pretend String, "''}"))

    replace(s, sg, t) ==
      l := lo(sg) - mn
      m := #s
      n := #t
      h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn
      l < 0 or h >= m or h < l-1 => error "index out of range"
      r := new((m-(h-l+1)+n)::N, space$C)
      for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i))
      for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i))
      for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i))
      r

    setelt(s:%, i:I, c:C) ==
      i < mn or i > maxIndex(s) => error "index out of range"
      Qsetelt(s, i - mn, c)
      c

    substring?(part, whole, startpos) ==
      np:I := Qsize part
      nw:I := Qsize whole
      (startpos := startpos - mn) < 0 => error "index out of bounds"
      np > nw - startpos => false
      for ip in 0..np-1 for iw in startpos.. repeat
          not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
      true

    position(s:%, t:%, startpos:I) ==
      (startpos := startpos - mn) < 0 => error "index out of bounds"
      startpos >= Qsize t => mn - 1
      r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
      EQ(r, NIL$Lisp)$Lisp => mn - 1
      r + mn

    position(c: Character, t: %, startpos: I) ==
      (startpos := startpos - mn) < 0 => error "index out of bounds"
      startpos >= Qsize t => mn - 1
      for r in startpos..Qsize t - 1 repeat
          if Cheq(Qelt(t, r), c) then return r + mn
      mn - 1

    position(cc: CharacterClass, t: %, startpos: I) ==
      (startpos := startpos - mn) < 0 => error "index out of bounds"
      startpos >= Qsize t => mn - 1
      for r in startpos..Qsize t - 1 repeat
          if member?(Qelt(t,r), cc) then return r + mn
      mn - 1

    suffix?(s, t) ==
      (m := maxIndex s) > (n := maxIndex t) => false
      substring?(s, t, mn + n - m)

    split(s, c) ==
      n := maxIndex s
      for i in mn..n while s.i = c repeat 0
      l := empty()$List(%)
      j:Integer -- j is conditionally intialized
      while i <= n and (j := position(c, s, i)) >= mn repeat
          l := concat(s(i..j-1), l)
          for i in j..n while s.i = c repeat 0
      if i <= n then l := concat(s(i..n), l)
      reverse_! l

    split(s, cc) ==
      n := maxIndex s
      for i in mn..n while member?(s.i,cc) repeat 0
      l := empty()$List(%)
      j:Integer -- j is conditionally intialized
      while i <= n and (j := position(cc, s, i)) >= mn repeat
          l := concat(s(i..j-1), l)
          for i in j..n while member?(s.i,cc) repeat 0
      if i <= n then l := concat(s(i..n), l)
      reverse_! l

    leftTrim(s, c) ==
      n := maxIndex s
      for i in mn .. n while s.i = c repeat 0
      s(i..n)

    leftTrim(s, cc) ==
      n := maxIndex s
      for i in mn .. n while member?(s.i,cc) repeat 0
      s(i..n)

    rightTrim(s, c) ==
      for j in maxIndex s .. mn by -1 while s.j = c repeat 0
      s(minIndex(s)..j)

    rightTrim(s, cc) ==
      for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0
      s(minIndex(s)..j)

    concat l ==
      t := new(+/[#s for s in l], space$C)
      i := mn
      for s in l repeat
          copyInto_!(t, s, i)
          i := i + #s
      t

    copyInto_!(y, x, s) ==
      m := #x
      n := #y
      s := s - mn
      s < 0 or s+m > n => error "index out of range"
      RPLACSTR(y, s, m, x, 0, m)$Lisp
      y

    elt(s:%, i:I) ==
      i < mn or i > maxIndex(s) => error "index out of range"
      Qelt(s, i - mn)

    elt(s:%, sg:U) ==
      l := lo(sg) - mn
      h := if hasHi sg then hi(sg) - mn else maxIndex s - mn
      l < 0 or h >= #s => error "index out of bound"
      SUBSTRING(s, l, max(0, h-l+1))$Lisp

    hash(s:$):Integer ==
      n:I := Qsize s
      zero? n => 0
      (n = 1) => ord(s.mn)
      ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2)

    match(pattern,target,wildcard) ==
      stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp
 
    match?(pattern, target, dontcare) ==
      n := maxIndex pattern
      p := position(dontcare, pattern, m := minIndex pattern)::N
      p = m-1 => pattern = target
      (p ^= m) and not prefix?(pattern(m..p-1), target) => false
      i := p      -- index into target
      q := position(dontcare, pattern, p + 1)::N
      while q ^= m-1 repeat
         s := pattern(p+1..q-1)
         i := position(s, target, i)::N
         i = m-1 => return false
         i := i + #s
         p := q
         q := position(dontcare, pattern, q + 1)::N
      (p ^= n) and not suffix?(pattern(p+1..n), target) => false
      true