string.spad

)abbrev domain CHAR Character
++ Author: Stephen M. Watt
++ Date Created: July 1986
++ Basic Operations: char
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: character, string
++ Examples:
++ References:
++ Description:
++   This domain provides the basic character data type.

Character : Join(OrderedFinite(), Hashable) with
        ord : % -> Integer
            ++ ord(c) provides an integral code corresponding to the
            ++ character c.  It is always true that \spad{char ord c = c}.
        char : Integer  -> %
            ++ char(i) provides a character corresponding to the integer
            ++ code i.  It is always true that \spad{ord char i = i}.
        char : String   -> %
            ++ char(s) provides a character from a string s of length one.
        space :  () -> %
            ++ space() provides the blank character.
        quote :  () -> %
            ++ quote() provides the string quote character, \spad{"}.
        underscore : () -> %
            ++ underscore() provides the underscore character, \spad{_},
            ++ which is used to allow quotes and other characters
            ++ {\em within} strings.
        newline : () -> %
            ++ newline() provides the newline character.
        upperCase : % -> %
            ++ upperCase(c) converts a lower case letter to the corresponding
            ++ upper case letter.  If c is not a lower case letter, then
            ++ it is returned unchanged.
        lowerCase : % -> %
            ++ lowerCase(c) converts an upper case letter to the corresponding
            ++ lower case letter.  If c is not an upper case letter, then
            ++ it is returned unchanged.
        digit? : % -> Boolean
            ++ digit?(c) tests if c is a digit character,
            ++ i.e. one of 0..9.
        hexDigit? : % -> Boolean
            ++ hexDigit?(c) tests if c is a hexadecimal numeral,
            ++ i.e. one of 0..9, a..f or A..F.
        alphabetic? : % -> Boolean
            ++ alphabetic?(c) tests if c is a letter,
            ++ i.e. one of a..z or A..Z.
        upperCase? : % -> Boolean
            ++ upperCase?(c) tests if c is an upper case letter,
            ++ i.e. one of A..Z.
        lowerCase? : % -> Boolean
            ++ lowerCase?(c) tests if c is an lower case letter,
            ++ i.e. one of a..z.
        alphanumeric? : % -> Boolean
            ++ alphanumeric?(c) tests if c is either a letter or number,
            ++ i.e. one of 0..9, a..z or A..Z.

    == add
        Rep := SingleInteger      -- 0..(1114112 - 1)

        CC ==> CharacterClass()
        import from CC

        --cl: Record(dig: CC, hex: CC, upp: CC, low: CC, alpha: CC, alnum: CC) :=
        --    [ digit(), hexDigit(),
        --      upperCase(), lowerCase(), alphabetic(), alphanumeric() ]

        a = b                  == a =$Rep b
        a < b                  == a <$Rep b
        -- size()                 == 256
        size()                 == 1114112
        index n                == char((n - 1)::Integer)
        lookup c               == (1 + ord c)::PositiveInteger
        char(n : Integer)        == n::%
        ord c                  == convert(c)$Rep
        -- random()               == char(random(size())$Integer)
        -- FIXME: limit to ASCII for now
        random()               == char(random(128)$Integer)
        space                  == char 32 -- STR_ELT("   ", 0$Lisp)$Lisp
        quote                  == char 34 -- STR_ELT("_" ", 0$Lisp)$Lisp
        underscore             == char 95 -- STR_ELT("__ ", 0$Lisp)$Lisp
        newline                == char(10)
        coerce(c : %) : OutputForm == NUM2USTR(ord c)$Lisp
        digit? c               == member?(c pretend Character, digit())
        hexDigit? c            == member?(c pretend Character, hexDigit())
        upperCase? c           == member?(c pretend Character, upperCase())
        lowerCase? c           == member?(c pretend Character, lowerCase())
        alphabetic? c          == member?(c pretend Character, alphabetic())
        alphanumeric? c        == member?(c pretend Character, alphanumeric())

        char(s : String) == STR_to_CHAR(s)$Lisp
        --  (#s) = 1 => s(minIndex s) pretend %
        --  error "String is not a single character"

        upperCase c ==
            STR_ELT(PNAME(UPCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,
                0$Lisp)$Lisp

        lowerCase c ==
            STR_ELT(PNAME(DOWNCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,
                0$Lisp)$Lisp

        hashUpdate!(hs : HashState, c : %) : HashState ==
            update!(hs, c pretend SingleInteger)$HashState


)abbrev domain CCLASS CharacterClass
++ Author: Stephen M. Watt
++ Date Created: July 1986
++ Basic Operations: charClass
++ Related Domains: Character, Bits
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++   This domain allows classes of characters to be defined and manipulated
++   efficiently.


CharacterClass : Join(SetCategory, ConvertibleTo String,
  FiniteSetAggregate Character, ConvertibleTo List Character) with
        charClass : String -> %
            ++ charClass(s) creates a character class which contains
            ++ exactly the characters given in the string s.
        charClass : List Character -> %
            ++ charClass(l) creates a character class which contains
            ++ exactly the characters given in the list l.
        digit :  constant -> %
            ++ digit() returns the class of all characters
            ++ for which \spadfunFrom{digit?}{Character} is true.
        hexDigit : constant -> %
            ++ hexDigit() returns the class of all characters for which
            ++ \spadfunFrom{hexDigit?}{Character} is true.
        upperCase : constant -> %
            ++ upperCase() returns the class of all characters for which
            ++ \spadfunFrom{upperCase?}{Character} is true.
        lowerCase :  constant -> %
            ++ lowerCase() returns the class of all characters for which
            ++ \spadfunFrom{lowerCase?}{Character} is true.
        alphabetic  :  constant -> %
            ++ alphabetic() returns the class of all characters for which
            ++ \spadfunFrom{alphabetic?}{Character} is true.
        alphanumeric :  constant -> %
            ++ alphanumeric() returns the class of all characters for which
            ++ \spadfunFrom{alphanumeric?}{Character} is true.

    == add
        Rep := IndexedBits(0)
        -- N   := size()$Character

        import from Character

        N   := 256

        a, b : %

        digit()         == charClass "0123456789"
        hexDigit()      == charClass "0123456789abcdefABCDEF"
        upperCase()     == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        lowerCase()     == charClass "abcdefghijklmnopqrstuvwxyz"
        alphabetic()    == union(upperCase(), lowerCase())
        alphanumeric()  == union(alphabetic(), digit())

        a = b           == a =$Rep b

        member?(c, a)   ==
            (i := ord c) < N => a(i)
            false

        union(a, b)      == Or(a, b)
        intersect (a, b) == And(a, b)
        difference(a, b) == And(a, Not b)
        -- FIXME: this is bogus for codes >= N
        complement a    == Not a

        convert(cl) : String ==
          construct(convert(cl)@List(Character))
        convert(cl : %) : List(Character) ==
          [char(i) for i in 0..N-1 | cl.i]

        charClass(s : String) ==
            cl := new(N, false)
            for i in minIndex(s)..maxIndex(s) repeat
                (j := ord s.i) >= N => error "character code too large"
                cl(j) := true
            cl

        charClass(l : List Character) ==
            cl := new(N, false)
            for c in l repeat
                (j := ord c) >= N => error "character code too large"
                cl(j) := true
            cl

        coerce(cl) : OutputForm == (convert(cl)@String)::OutputForm

        -- Stuff to make a legal SetAggregate view
        # a             == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n)
        empty() : %       == charClass []
        set() : % == empty()

        insert!(c, a)  ==
            (i := ord c) < N => (a(i) := true; a)
            error "character code too large"

        remove!(c : Character, a)  ==
            if(i := ord c) < N then a(i) := false
            a

        inspect(a) ==
            for i in 0..N-1 | a.i repeat
                 return char i
            error "Cannot take a character from an empty class."

        extract!(a) ==
            for i in 0..N-1 | a.i repeat
                 a.i := false
                 return char i
            error "Cannot take a character from an empty class."

        map(f, a) ==
            b := new(N, false)
            for i in 0..N-1 | a.i repeat b(ord f char i) := true
            b

        temp : % := new(N, false)$Rep
        map!(f, a) ==
            fill!(temp, false)
            for i in 0..N-1 | a.i repeat temp(ord f char i) := true
            copyInto!(a, temp, 0)

        parts a ==
            [char i for i in 0..N-1 | a.i]

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

IndexedString(mn : Integer) : Export == Implementation where
  B ==> Boolean
  C ==> Character
  I ==> Integer
  N ==> NonNegativeInteger
  U ==> UniversalSegment Integer

  Export ==> StringAggregate()

  Implementation ==> add
    -- These assume Character's Rep is Small I
    Qelt    ==> STR_ELT$Lisp
    Qequal  ==> EQUAL$Lisp
    Qsetelt ==> STR_SETELT$Lisp
    Qsize   ==> QCSIZE$Lisp
    Cheq    ==> eql_SI$Lisp
    Chlt    ==> less_SI$Lisp
    Chgt    ==> greater_SI$Lisp

    c :  Character
    cc : CharacterClass

    new(n, c)              == make_full_CVEC2(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)

    replace(s, sg, t) ==
        l := low(sg) - mn
        m := #s
        n := #t
        h : I := if hasHi sg then high(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

    qsetelt!(s : %, i : I, c : C) == Qsetelt(s, i - mn, c)

    setelt!(s : %, i : I, c : C) ==
        i < mn or i > maxIndex(s) => error "index out of range"
        Qsetelt(s, i - mn, 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 : None := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
        EQ(r, NIL$Lisp)$Lisp => mn - 1
        (r pretend I) + 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 initialized
        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 initialized
        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, cc) ==
        n := maxIndex s
        for i in mn .. n while member?(s.i, cc) repeat 0
        s(i..n)

    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

    qelt(s : %, i : I) == Qelt(s, i - mn)

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

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

    hashUpdate!(hs, s) == update!(hs, SXHASH(s)$Lisp)$HashState

    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


)abbrev domain STRING String
++ Description:
++   This is the domain of character strings.
MINSTRINGINDEX ==> 1          -- as of 3/14/90.

String() : StringCategory with

    ucodeToString : Integer -> %
      ++ ucodeToString(n) converts Unicode code point to one-character
      ++ string.  If UTF-8 is in use the string may contain multiple
      ++ octets.
    uentries : % -> List(SingleInteger)
      ++ uentries(s) converts s to a list of Unicode code points
      ++ encoding characters in s.  It work even if lower layer
      ++ does not support Unicode, in such case string is treated
      ++ as sequence of octets using UTF-8 encoding.  Consegently
      ++ length of returened list may be smaller than length
      ++ of the string in octets.

  == IndexedString(MINSTRINGINDEX) add

    ucodeToString(n : Integer) : %       == NUM2USTR(n)$Lisp
    uentries(s : %) : List(SingleInteger) == UENTRIES(s)$Lisp
    string n == STRINGIMAGE(n)$Lisp

    OMwrite(dev : OpenMathDevice, x : %, wholeObj : Boolean) : Void ==
      if wholeObj then
        OMputObject(dev)
      OMputString(dev, x pretend String)
      if wholeObj then
        OMputEndObject(dev)

    convert(x : %) : InputForm == x pretend InputForm

    qelt(s : %, i : Integer) == STR_ELT1(s, i)$Lisp

    qsetelt!(s : %, i : Integer, c : Character) == STR_SETELT1(s, i, c)$Lisp

)abbrev category STRICAT StringCategory
-- Note that StringCategory is built into the old compiler
-- redundant SetCategory added to help Aldor compiler
++ Description:
++ A category for string-like objects

StringCategory() : Category == Join(StringAggregate(), SetCategory, OpenMath) with
  string : Integer -> %
    ++ string(i) returns the decimal representation of i as a string.

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.