src/core/string.slate

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