src/core/string.slate

   1
   2 "string is an abstract class basically"
   3 prototypes define: #String &parents: {Sequence. Collection. Mapping}.
   4
   5 String traits define: #Character.
   6
   7 a@(String Character traits) cr [$\r].
   8
   9 a@(String Character traits) lf [$\n].
  10
  11 a@(String Character traits) tab [$\t].
  12
  13 a@(String Character traits) space [$\s].
  14
  15 a@(String Character traits) stringEscape [$\\].
  16
  17 i@(Integer traits) as: a@(String Character traits)
  18 "FIXME: convert Integers to ASCIIString Character by default.
  19 This should later be replaced with some smarter framework or an optional encoding."
  20 [
  21   a == String Character
  22     ifTrue: [i as: ASCIIString Character]
  23     ifFalse: [resend]
  24 ].
  25
  26 "ASCIIString Character traitsWindow atSlotNamed: #traits1 put: String Character traits."
  27
  28 "fix, timmy: i'm not sure what was intended here..."
  29 ASCIIString Character traitsWindow _delegates:
  30 {Root traits. Oddball traits. String Character traits. ASCIIString Character traits}.
  31
  32 ASCIIString Character traits CharacterSet ::= bootstrapCharacters as: Array.
  33 "The full ASCII character set."
  34 ASCIIString Character traits Whitespace ::= '\s\t\n\v\f\r\0'.
  35 ASCIIString Character traits Vowels ::= 'AEIOUaeiou'.
  36 ASCIIString Character traits Delimiters ::= '()[]{}\',` "'.
  37
  38 a@(ASCIIString Character traits) as: _@(Integer traits)
  39 [a code].
  40
  41 i@(Integer traits) as: a@(ASCIIString Character traits)
  42 [a CharacterSet at: i].
  43
  44 a@(ASCIIString Character traits) = b@(ASCIIString Character traits)
  45 [
  46   a code = b code
  47 ].
  48
  49 ch@(ASCIIString Character traits) hash
  50 [
  51   ch code
  52 ].
  53
  54 a@(ASCIIString Character traits) codeRange
  55 [0 to: 255].
  56
  57 a@(ASCIIString Character traits) allCharacters
  58 [
  59   a codeRange collect: #(as: a) `er
  60 ].
  61
  62 ch@(ASCIIString Character traits) isAlphanumeric
  63 [
  64   ch isLetter \/ [ch isDigit]
  65 ].
  66
  67 ch@(ASCIIString Character traits) isWhitespace
  68 [
  69   ch Whitespace includes: ch
  70 ].
  71
  72 ch@(ASCIIString Character traits) isDelimiter
  73 [
  74   ch Delimiters includes: ch
  75 ].
  76
  77 ch@(ASCIIString Character traits) isDigit: radix
  78 [
  79   value ::= ch code.
  80   `conditions: (
  81     [value between: #[$0 code] and: #[$9 code]]
  82       -> [value - #[$0 code] < radix].
  83     [value between: #[$A code] and: #[$Z code]]
  84       -> [value - #[$A code] < (radix - 10)].
  85     [value between: #[$a code] and: #[$z code]]
  86       -> [value - #[$a code] < (radix - 10)]
  87   ) otherwise: [False]
  88 ].
  89
  90 ch@(ASCIIString Character traits) isDigit
  91 [
  92   ch isDigit: 10
  93 ].
  94
  95 ch@(ASCIIString Character traits) toDigit: radix
  96 [
  97   (ch isDigit: radix) ifFalse: [^ Nil].
  98   value ::= ch code.
  99   `conditions: (
 100     [value >= #[$a code]]
 101       -> [value - #[$a code] + 10].
 102     [value >= #[$A code]]
 103       -> [value - #[$A code] + 10].
 104     [value >= #[$0 code]]
 105       -> [value - #[$0 code]]
 106   ) otherwise: [Nil]
 107 ].
 108
 109 ch@(ASCIIString Character traits) toDigit
 110 [
 111   ch toDigit: 10
 112 ].
 113
 114 ch@(ASCIIString Character traits) isLetter
 115 [
 116   ch isUppercase \/ [ch isLowercase]
 117 ].
 118
 119 ch@(ASCIIString Character traits) isLowercase
 120 [ch code between: #[$a code] and: #[$z code]].
 121
 122 ch@(ASCIIString Character traits) toUppercase
 123 [
 124   ch isLowercase
 125     ifTrue: [ch code - #[$\s code] as: ch]
 126     ifFalse: [ch]
 127 ].
 128
 129 ch@(ASCIIString Character traits) isUppercase
 130 [ch code between: #[$A code] and: #[$Z code]].
 131
 132 ch@(ASCIIString Character traits) toLowercase
 133 [
 134   ch isUppercase
 135     ifTrue: [ch code + #[$\s code] as: ch]
 136     ifFalse: [ch]
 137 ].
 138
 139 ch@(ASCIIString Character traits) isVowel
 140 [
 141   ch Vowels includes: ch
 142 ].
 143
 144 ch@(ASCIIString Character traits) isQuote
 145 [
 146   ch = $\' \/ [ch = $\"]
 147 ].
 148
 149 c1@(ASCIIString Character traits) < c2@(ASCIIString Character traits)
 150 [
 151   c1 code < c2 code
 152 ].
 153
 154 c1@(ASCIIString Character traits) > c2@(ASCIIString Character traits)
 155 [
 156   c1 code > c2 code
 157 ].
 158
 159 s1@(ASCIIString traits) < s2@(ASCIIString traits)
 160 [
 161   (s1 lexicographicallyCompare: s2) = -1
 162 ].
 163
 164 s1@(ASCIIString traits) <= s2@(ASCIIString traits)
 165 [
 166   s1 < s2 \/ [s1 = s2]
 167 ].
 168
 169 ch@(ASCIIString Character traits) isPrintable
 170 [ch code between: #[$\s code] and: #[$~ code]].
 171
 172 s@(String traits) new &capacity: n
 173 "By default return ASCIIString's.
 174 FIXME: this should redirect to some better encoding-preserving string implementation..."
 175 [
 176   s == String
 177     ifTrue: [ASCIIString new &capacity: n]
 178     ifFalse: [resend]
 179 ].
 180
 181 s@(ASCIIString traits) size [18 primitiveDo: {s}]. "faster than: #size sendTo: {s} through: {ByteArray}"
 182 s@(String traits) size [overrideThis].
 183
 184 a@(ByteArray traits) as: s@(String traits)
 185 "FIXME: calls to this method should be either converted to direct ASCIIString calls,
 186 or an optional hint should be used to decide on the encoding in the ByteArray."
 187 [
 188   s == String
 189     ifTrue: [a as: ASCIIString]
 190     ifFalse: [resend]
 191 ].
 192
 193 s@(String traits) writer
 194 "FIXME: calls to this method should be either converted to direct ASCIIString calls,
 195 or an optional hint should be used to decide on the encoding in the ByteArray."
 196 [
 197   s == String
 198     ifTrue: [ASCIIString writer]
 199     ifFalse: [resend]
 200 ].
 201
 202 s@(String traits) elementType
 203 [s Character].
 204
 205 _@(String traits) defaultElement
 206 [overrideThis].
 207
 208 _@(String traits) lexicographicallyCompare: _@(String traits)
 209 [overrideThis].
 210
 211 _@(String traits) sorted
 212 "Answers a new String with the same Characters lexicographically sorted."
 213 [overrideThis].
 214
 215 _@(String traits) accepts: _@(Root traits)
 216 [False].
 217
 218 s@(String traits) copy
 219 [s clone].
 220
 221 s@(String traits) hash
 222 [| result bit |
 223   result := 0.
 224   bit := 0.
 225   s do:
 226     [| :c |
 227      result := result + (c hash bitShift: bit) bitAnd: 16rFFFFFF.
 228      bit := bit + 1 bitAnd: 16rF].
 229   result
 230 ].
 231
 232 s@(String traits) capitalize
 233 "Modifies the first Character to be uppercase."
 234 [
 235   s isEmpty
 236     ifFalse: [s at: s indexFirst put: s first toUppercase].
 237   s
 238 ].
 239
 240 s@(String traits) uncapitalize
 241 "Modifies the first Character to be lowercase."
 242 [
 243   s isEmpty
 244     ifFalse: [s at: s indexFirst put: s first toLowercase].
 245   s
 246 ].
 247
 248 s@(String traits) capitalized
 249 [
 250   s isEmpty
 251     ifTrue: [s]
 252     ifFalse: [s copy capitalize]
 253 ].
 254
 255 s@(String traits) uncapitalized
 256 [
 257   s isEmpty
 258     ifTrue: [s]
 259     ifFalse: [s copy uncapitalize]
 260 ].
 261
 262 s@(String traits) toUppercase
 263 "Modifies the Characters to be uppercase."
 264 [s infect: #toUppercase `er ].
 265
 266 s@(String traits) toLowercase
 267 "Modifies the Characters to be lowercase."
 268 [s infect: #toLowercase `er ].
 269
 270 s@(String traits) toSwapCase
 271 "Modifies the Characters to have swapped case."
 272 [
 273   s infect: [| :each | each isLowercase
 274     ifTrue: [each toUppercase]
 275     ifFalse: [each toLowercase]]
 276 ].
 277
 278 s@(String traits) toCamelCase &separators: delims
 279 "Split the String, capitalize the split parts, and concatenate them together."
 280 [((s split &separators: delims) collect: #capitalize `er ) join].
 281
 282 s@(String traits) fromCamelCase &separator: delim
 283 "Separates the String into words based on lowercase-uppercase letter
 284 boundaries, and joins them using the specified delimiter String."
 285 [
 286   delim `defaultsTo: ' '.
 287   indices ::= ExtensibleArray new*, -1.
 288   s indexFirst below: s indexLast - 1 do:
 289     [| :index | (s at: index) isLowercase /\ [(s at: index + 1) isUppercase]
 290        ifTrue: [indices addLast: index]].
 291   indices addLast: s indexLast.
 292   words ::= ExtensibleArray new.
 293   indices chainPairsDo:
 294     [| :last :next | words addLast:
 295       (s copyFrom: last + 1 to: next) toLowercase].
 296   words join &separator: delim
 297 ].
 298
 299 String traits define: #SmallWords -> {'a'. 'an'. 'and'. 'as'. 'at'. 'but'. 'by'. 'en'. 'for'. 'if'. 'in'. 'of'. 'on'. 'or'. 'the'. 'to'. 'v'. 'via'. 'vs'. 'vs.'}.
 300
 301 s@(String traits) titleCase
 302 [
 303   (words ::= s split) doWithIndex:
 304     [| :word :index |
 305      (word includes: $&)
 306        ifTrue: [word toUppercase]
 307        ifFalse:
 308          [(s SmallWords includes: word) /\ [index > 0]
 309             ifTrue: [word toLowercase]
 310             ifFalse: [word capitalize]]].
 311   words join &separator: ' '
 312 ].
 313
 314 s@(String traits) abbreviation
 315 "Answers the usual convention for abbreviation via initials."
 316 [s toCamelCase select: #isUppercase`er].
 317
 318 s@(String traits) escaped
 319 "Answers a new String with printed slash-escapes so it can be read in as the
 320 same value. This gives programmatic access to the right input for any String."
 321 [
 322   [| :result |
 323    s doWithIndex:
 324      [| :c :index |
 325       c caseOf:
 326         {
 327           $\' -> [result ; '\\\''].
 328           $\t -> [result ; '\\t'].
 329           $\n -> [result ; '\\n'].
 330           $\v -> [result ; '\\v'].
 331           $\f -> [result ; '\\f'].
 332           $\r -> [result ; '\\r'].
 333           $\b -> [result ; '\\b'].
 334           $\a -> [result ; '\\a'].
 335           $\e -> [result ; '\\e'].
 336           $\0 -> [result ; '\\0'].
 337           $\s -> [result ; '\\ '].
 338         }
 339         otherwise:
 340           [c isPrintable
 341              ifTrue: [result nextPut: c]
 342              ifFalse:
 343                [result ; '\\x'.
 344                 c code // 16 printOn: result &radix: 16.
 345                 c code \\ 16 printOn: result &radix: 16]]
 346         ]] writingAs: s
 347 ].
 348
 349 s@(String traits) readFrom: src
 350 "Reads the first thing in the String (or Stream) as a String literal.
 351 An error is raised if the return type does not match the requested one."
 352 [
 353   (srcStream ::= src reader) peek = $\'
 354     ifTrue:
 355       [srcStream next.
 356        (Syntax Lexer newOn: srcStream) readString value]
 357     ifFalse: [error: 'The source does not start with a quotation mark.']
 358 ].
 359
 360 s@(String traits) unescaped
 361 [s readFrom: '\'' ; s ; '\''].
 362
 363 s@(String traits) asAn
 364 "Answer a copy of the String prepended with 'a ' or 'an ' in order to treat
 365 it as specifying the instance of a noun named by the String."
 366 [
 367   s first isVowel ifTrue: ['an ' ; s] ifFalse: ['a ' ; s]
 368 ].
 369
 370 s@(String traits) plural
 371 "Answer a copy of the String appended with -s, -es, or -ies in order to treat
 372 it as a pluralized noun. This does not try to be too clever, because that
 373 requires a full lexicon (for English) - only use this for technical purposes."
 374 [
 375   `conditions: (
 376     [s last toLowercase = $o] -> [s ; 'es'].
 377     [s last isVowel] -> [s ; 's'].
 378     [s last toLowercase = $y]
 379       -> [(s at: s indexLast - 1) isVowel not
 380             ifTrue: [s allButLast ; 'ies']
 381             ifFalse: [s ; 's']].
 382     [s endsWith: 'us'] -> [(s allButLast: 2) ; 'i'].
 383     [s endsWith: 'sis'] -> [(s allButLast: 2) ; 'es'].
 384     [s endsWith: 'on'] -> [(s allButLast: 2) ; 'a'].
 385     [#{'ex'. 'ix'} anySatisfy: #(s endsWith: _)] -> [(s allButLast: 2) ; 'ices'].
 386     [#{'ss'. 'sh'. 'ch'. 'dge'} anySatisfy: #(s endsWith: _)] -> [s ; 'es']
 387   ) otherwise: [s ; 's']
 388 ].
 389
 390 s@(String traits) split &separators: delims
 391 [s splitWithAny: (delims ifNil: [s elementType Whitespace])].
 392
 393 s@(String traits) stripAll: c@(Collection traits) startingAt: start
 394 [| each |
 395   result ::= (s copyFrom: 0 to: start - 1) writer.
 396   start below: s size do:
 397     [| :index |
 398      each := s at: index.
 399      (c includes: each)
 400            ifFalse: [result nextPut: each]].
 401   result contents
 402 ].
 403
 404 s@(String traits) stripAll: c@(Collection traits)
 405 [s stripAll: c startingAt: 0 ].
 406
 407 s@(String traits) strip: c@(String Character traits) startingAt: start
 408 [s stripAll: {c} startingAt: start ].
 409
 410 s@(String traits) strip: c@(String Character traits)
 411 [s stripAll: {c} startingAt: 0].
 412
 413 s@(String traits) stripStartingAt: start
 414 [s stripAll: s elementType Whitespace startingAt: start].
 415
 416 s@(String traits) strip
 417 [s stripAll: s elementType Whitespace startingAt: 0].
 418
 419 s@(String traits) trimAll: c@(Collection traits)
 420 [
 421   (s indexOfFirstSatisfying: [| :each | (c includes: each) not])
 422     ifNil: [s new]
 423     ifNotNilDo:
 424       [| :from |
 425        s sliceFrom: from
 426          to: (s indexOfLastSatisfying: [| :each | (c includes: each) not])]
 427 ].
 428
 429 s@(String traits) trim
 430 [
 431   s trimAll: s elementType Whitespace
 432 ].
 433
 434 s@(String traits) format*
 435 "Interpolates arguments formatted as '{N}' with corresponding elements from
 436 an array argument. Curly open-brackets may be escaped by doubling them."
 437 "Test: ('{{ } \\ foo {0} bar {1}' format*, 12, 'string') = '{ } \ foo 12 bar string'"
 438 [| *args index |
 439   input ::= s reader.
 440   [| :result |
 441    input do:
 442      [| :char |
 443       char == $\{
 444         ifTrue:
 445           [input peek == $\{
 446              ifTrue: [result nextPut: input next]
 447              ifFalse: [index := Integer readFrom: (input upTo: $\}).
 448                        result ; ((args at: index ifAbsent: ['[subscript out of bounds: {0}]' format*, index]) as: s)]]
 449         ifFalse: [result nextPut: char]].
 450    ] writingAs: s
 451 ].
 452
 453 s@(String traits) sprintf*
 454 [| *args input argsIndex |
 455   input := s reader.
 456   argsIndex := args indexFirst.
 457   [| :result |
 458    input do:
 459      [| :char |
 460       char == $%
 461         ifTrue: "Placeholder"
 462           [| nextChar |
 463            (nextChar := input next) == $%
 464              ifTrue: [result nextPut: nextChar]
 465              ifFalse:
 466                [| arg argPosition specifier width precision space position alternative plus minus zero star |
 467                 input skip: -1.
 468                 argPosition := input position.
 469                 specifier := (input upToAnyOf: 'diueEfFgGxXoscpn') reader.
 470                 [specifier isAtEnd] whileFalse:
 471                   [nextChar := specifier next.
 472                    "Check for a parameter index spec:"
 473                    ('123456789' includes: nextChar)
 474                      ifTrue:
 475                        [(specifier peek: 1) == $$
 476                           ifTrue:
 477                             [specifier skip: -1.
 478                              position := Integer readFrom: specifier.
 479                              specifier next]
 480                           ifFalse:
 481                             [specifier skip: -1.
 482                              width := Integer readFrom: specifier]]
 483                      ifFalse: "Check for flags:"
 484                        [nextChar caseOf: {
 485                           $\s -> [space := True].
 486                           $#  -> [alternative := True].
 487                           $+  -> [plus := True].
 488                           $-  -> [minus := True].
 489                           $0  -> [zero := True].
 490                           $*  -> [star := True].
 491                           $.  -> [precision := Integer readFrom: specifier]}]].
 492                 input position := argPosition.
 493                 "Check for type specifiers:"
 494                 position ifNil:
 495                   [position := argsIndex.
 496                    argsIndex += 1].
 497                 width isNil /\ [star isNotNil] ifTrue:
 498                   [width := args at: position.
 499                    position += 1.
 500                    argsIndex += 1].
 501                 arg := args at: position.
 502                 arg := (nextChar := input next) toLowercase caseOf: {
 503                   $r -> [arg printString].
 504                   $@ -> [arg printString].
 505                   $s -> [arg as: s].
 506                   $d -> [arg printString &radix: 10 &precision: precision &forceSign: plus isNotNil].
 507                   $i -> [arg printString &radix: 10 &precision: precision &forceSign: plus isNotNil].
 508                   $u -> [arg printString &radix: 10 &precision: precision &forceSign: plus isNotNil].
 509                   $o -> [arg printString &radix: 8 &precision: precision &forceSign: plus isNotNil].
 510                   $x -> [arg printString &radix: 16 &precision: precision &forceSign: plus isNotNil].
 511                   $f -> [arg printString &precision: precision &forceSign: plus isNotNil].
 512                   $e -> [arg printString &precision: precision &forceSign: plus isNotNil].
 513                 } otherwise: [arg as: s].
 514                 nextChar isUppercase ifTrue: [arg toUppercase].
 515                 width ifNotNil:
 516                   [arg := arg truncateTo: width paddedBy: (zero ifNil: [$\s] ifNotNil: [$0]) &onRight: minus isNotNil].
 517                 result ; arg]]
 518         ifFalse: [result nextPut: char]]
 519   ] writingAs: s
 520 ].
 521
 522 s@(String traits) evaluate
 523 [
 524   s evaluateIn: lobby
 525 ].
 526
 527 s@(String traits) evaluateIn: namespace
 528 [| expr |
 529   parser ::= Syntax Parser newOn: s.
 530   [[(expr := parser next) evaluateIn: lobby.
 531     parser isAtEnd] on: Stream Exhaustion do: [False]] whileFalse.
 532 ].
 533
 534 c@(String Character traits) as: s@(String traits)
 535 [(s new &capacity: 1) `>> [at: 0 put: c. ]].
 536
 537 s@(String traits) as: i@(Integer traits) &radix: radix
 538 "Reads a radix-(10) Integer from the string."
 539 [
 540   (s isNotEmpty /\ [s first = $-])
 541     ifTrue: [((s copyFrom: 1) as: i &radix: radix) negated]
 542     ifFalse:
 543       [radix `defaultsTo: 10.
 544        s inject: 0 into:
 545          [| :n :c | (c isDigit: radix) ifFalse: [^ n].
 546                     n * radix + (c toDigit: radix)]]
 547 ].
 548
 549 "ASCIIString traitsWindow `>> [
 550   atSlotNamed: #traits1 put: String traits.
 551   atSlotNamed: #traits3 put: Sequence traits.
 552   atSlotNamed: #traits4 put: Collection traits.
 553   atSlotNamed: #traits5 put: Mapping traits. ].
 554 "
 555 ASCIIString traitsWindow _delegates:
 556  {Root traits. Derivable traits. Cloneable traits. Mapping traits.
 557   Collection traits. Sequence traits. ByteArray traits. String traits. ASCIIString traits}.
 558
 559 s@(ASCIIString traits) at: i
 560 [
 561   (s byteAt: i) as: s elementType
 562 ].
 563
 564 s@(ASCIIString traits) at: i put: c
 565 [
 566   s byteAt: i put: c code
 567 ].
 568
 569 s@(ASCIIString traits) at: i put: code@(Integer traits)
 570 [
 571   s byteAt: i put: code intoByte
 572 ].
 573
 574 _@(ASCIIString traits) defaultElement [$\0].
 575
 576 s@(ASCIIString traits) includes: c@(String Character traits)
 577 "A pure optimization override to avoid coercing all of the elements to Characters.
 578 This is about twice as fast as the very generic Sequence method."
 579 [
 580   c code `cache.
 581   s keysDo: [| :i | (s byteAt: i) == c code ifTrue: [^ True]].
 582   False
 583 ].
 584
 585 _@(ASCIIString traits) accepts: _@(ASCIIString Character traits)
 586 [True].
 587
 588 s1@(ASCIIString traits) lexicographicallyCompare: s2@(ASCIIString traits)
 589 "Answer a sign of comparing the two Strings' Characters in order."
 590 [
 591   s1 with: s2 do:
 592     [| :c1 :c2 cmp | (cmp := c1 code <=> c2 code) isZero ifFalse: [^ cmp]].
 593   s1 size <=> s2 size
 594 ].
 595
 596 s@(ASCIIString traits) sorted
 597 "Answers a new String with the same Characters lexicographically sorted."
 598 [(s sortBy: #<= `er ** #code `er ) as: s].
 599
 600 ch@(ASCIIString Character traits) rot13
 601 [| code |
 602   (code := ch toLowercase code) >= #[$a code] /\ [code < #[$n code]]
 603     ifTrue: [code += 13]
 604     ifFalse: [code > #[$m code] /\ [code <= #[$z code]]
 605                 ifTrue: [code -= 13]].
 606   ch isUppercase
 607     ifTrue: [(code as: ch) toUppercase]
 608     ifFalse: [code as: ch]
 609 ].
 610
 611 s@(ASCIIString traits) rot13
 612 [s collect: #rot13 `er].
 613
 614 s@(ASCIIString traits) as: a@(ByteArray traits)
 615 "Since ByteArrays cannot hold objects, they must store character codes."
 616 [
 617   result ::= a newSizeOf: s.
 618   s doWithIndex:
 619     [| :each :index | result at: index put: (each as: a elementType)].
 620   result
 621 ].
 622
 623 a@(ByteArray traits) as: s@(ASCIIString traits)
 624 "Since ByteArrays cannot hold objects, they must store character codes."
 625 [
 626   result ::= s newSizeOf: a.
 627   a doWithIndex:
 628     [| :each :index | result at: index put: (each as: s elementType)].
 629   result
 630 ].
 631
 632 name@(ASCIIString traits) as: _@(Symbol traits)
 633 [name intern].