languages/cardinal/src/classes/String.pir

   1 ## $Id$
   2
   3 =head1 TITLE
   4
   5 CardinalString - Cardinal String class and related functions
   6
   7 =head1 DESCRIPTION
   8
   9 This file sets up the C<CardinalString> type.
  10
  11 Stolen from Rakudo
  12
  13 =head1 Methods
  14
  15 =over 4
  16
  17 =cut
  18
  19 .namespace ['CardinalString']
  20
  21 .include 'cclass.pasm'
  22
  23 .sub 'onload' :anon :init :load
  24     .local pmc cardinalmeta, strproto
  25     cardinalmeta = get_hll_global ['CardinalObject'], '!CARDINALMETA'
  26     strproto = cardinalmeta.'new_class'('CardinalString', 'parent'=>'String CardinalObject')
  27     cardinalmeta.'register'('CardinalString', 'parent'=>'CardinalObject', 'protoobject'=>strproto)
  28 .end
  29
  30
  31 .sub 'ACCEPTS' :method
  32     .param string topic
  33     .return 'infix:eq'(topic, self)
  34 .end
  35
  36 .sub 'chars' :method
  37     .local pmc retv
  38
  39     retv = new 'CardinalInteger'
  40     $S0  = self
  41     $I0  = length $S0
  42     retv = $I0
  43
  44     .return (retv)
  45 .end
  46
  47 .sub 'reverse' :method
  48     .local pmc retv
  49
  50     retv = self.'split'('')
  51     retv = retv.'reverse'()
  52     retv = retv.join('')
  53
  54     .return(retv)
  55 .end
  56
  57 .sub split :method :multi('CardinalString')
  58     .param string delim
  59     .local string objst
  60     .local pmc pieces
  61     .local pmc tmps
  62     .local pmc retv
  63     .local int len
  64     .local int i
  65
  66     retv = new 'CardinalArray'
  67
  68     objst = self
  69     split pieces, delim, objst
  70
  71     len = pieces
  72     i = 0
  73   loop:
  74     if i == len goto done
  75
  76     tmps = new 'CardinalString'
  77     tmps = pieces[i]
  78
  79     retv.'push'(tmps)
  80
  81     inc i
  82     goto loop
  83   done:
  84     .return(retv)
  85 .end
  86
  87 .sub lc :method
  88     .local string tmps
  89     .local pmc retv
  90
  91     tmps = self
  92     downcase tmps
  93
  94     retv = new 'CardinalString'
  95     retv = tmps
  96
  97     .return(retv)
  98 .end
  99
 100 .sub uc :method
 101     .local string tmps
 102     .local pmc retv
 103
 104     tmps = self
 105     upcase tmps
 106
 107     retv = new 'CardinalString'
 108     retv = tmps
 109
 110     .return(retv)
 111 .end
 112
 113 .sub lcfirst :method
 114     .local string tmps
 115     .local string fchr
 116     .local pmc retv
 117     .local int len
 118
 119     retv = new 'CardinalString'
 120     tmps = self
 121
 122     len = length tmps
 123     if len == 0 goto done
 124
 125     substr fchr, tmps, 0, 1
 126     downcase fchr
 127
 128     concat retv, fchr
 129     substr tmps, tmps, 1
 130     concat retv, tmps
 131
 132   done:
 133     .return(retv)
 134 .end
 135
 136 .sub ucfirst :method
 137     .local string tmps
 138     .local string fchr
 139     .local pmc retv
 140     .local int len
 141
 142     retv = new 'CardinalString'
 143     tmps = self
 144
 145     len = length tmps
 146     if len == 0 goto done
 147
 148     substr fchr, tmps, 0, 1
 149     upcase fchr
 150
 151     concat retv, fchr
 152     substr tmps, tmps, 1
 153     concat retv, tmps
 154
 155   done:
 156     .return(retv)
 157 .end
 158
 159 .sub capitalize :method
 160     .local string tmps
 161     .local string fchr
 162     .local pmc retv
 163     .local int len
 164
 165     retv = new 'CardinalString'
 166     tmps = self
 167
 168     len = length tmps
 169     if len == 0 goto done
 170
 171     downcase tmps
 172
 173     .local int pos, is_ws, is_lc
 174     pos = 0
 175     goto first_char
 176   next_grapheme:
 177     if pos == len goto done
 178     is_ws = is_cclass .CCLASS_WHITESPACE, tmps, pos
 179     if is_ws goto ws
 180   advance:
 181     pos += 1
 182     goto next_grapheme
 183   ws:
 184     pos += 1
 185   first_char:
 186     is_lc = is_cclass .CCLASS_LOWERCASE, tmps, pos
 187     unless is_lc goto advance
 188     $S1 = substr tmps, pos, 1
 189     upcase $S1
 190     substr tmps, pos, 1, $S1
 191     ## the length may have changed after replacement, so measure it again
 192     len = length tmps
 193     goto advance
 194   done:
 195     retv = tmps
 196     .return (retv)
 197 .end
 198
 199 .sub 'chop' :method
 200     .local string tmps
 201     .local pmc retv
 202     .local int len
 203
 204     retv = new 'CardinalString'
 205     tmps = self
 206
 207     len = length tmps
 208     if len == 0 goto done
 209     dec len
 210     substr tmps,tmps, 0, len
 211   done:
 212     retv = tmps
 213     .return(retv)
 214 .end
 215
 216
 217 =item perl()
 218
 219 Returns a Perl representation of the Str.
 220
 221 =cut
 222
 223 .sub 'perl' :method
 224     $S0 = "\""
 225     $S1 = self
 226     $S1 = escape $S1
 227     concat $S0, $S1
 228     concat $S0, "\""
 229     .return ($S0)
 230 .end
 231
 232 =item to_s()
 233
 234 Returns self
 235
 236 =cut
 237
 238 .sub 'to_s' :method
 239     $P0 = new 'CardinalString'
 240     $P0 = self
 241     .return ($P0)
 242 .end
 243
 244 =back
 245
 246 =head1 Functions
 247
 248 =over 4
 249
 250 =cut
 251
 252 .namespace []
 253
 254 .include 'cclass.pasm'
 255
 256
 257 =item lc
 258
 259  our Str multi Str::lc ( Str $string )
 260
 261 Returns the input string after converting each character to its lowercase
 262 form, if uppercase.
 263
 264 =cut
 265
 266 .sub 'lc'
 267     .param string a
 268     .local pmc s
 269     s = new 'CardinalString'
 270     s = a
 271     .return s.'lc'()
 272 .end
 273
 274
 275 =item lcfirst
 276
 277  our Str multi Str::lcfirst ( Str $string )
 278
 279 Like C<lc>, but only affects the first character.
 280
 281 =cut
 282
 283 .sub 'lcfirst'
 284     .param string a
 285     .local pmc s
 286     s = new 'CardinalString'
 287     s = a
 288     .return s.'lcfirst'()
 289 .end
 290
 291
 292 =item uc
 293
 294  our Str multi Str::uc ( Str $string )
 295
 296 Returns the input string after converting each character to its uppercase
 297 form, if lowercase. This is not a Unicode "titlecase" operation, but a
 298 full "uppercase".
 299
 300 =cut
 301
 302 .sub 'uc'
 303     .param string a
 304     .local pmc s
 305     s = new 'CardinalString'
 306     s = a
 307     .return s.'uc'()
 308 .end
 309
 310
 311 =item ucfirst
 312
 313  our Str multi Str::ucfirst ( Str $string )
 314
 315 Performs a Unicode "titlecase" operation on the first character of the string.
 316
 317 =cut
 318
 319 .sub 'ucfirst'
 320     .param string a
 321     .local pmc s
 322     s = new 'CardinalString'
 323     s = a
 324     .return s.'ucfirst'()
 325 .end
 326
 327
 328 =item capitalize
 329
 330  our Str multi Str::capitalize ( Str $string )
 331
 332 Has the effect of first doing an C<lc> on the entire string, then performing a
 333 C<s:g/(\w+)/{ucfirst $1}/> on it.
 334
 335 =cut
 336
 337 .sub 'capitalize'
 338     .param string a
 339     .local pmc s
 340     s = new 'CardinalString'
 341     s = a
 342     .return s.'capitalize'()
 343 .end
 344
 345
 346 =item split
 347
 348  our CardinalArray multi Str::split ( Str $delimiter ,  Str $input = $+_, Int $limit = inf )
 349  our CardinalArray multi Str::split ( Rule $delimiter = /\s+/,  Str $input = $+_, Int $limit = inf )
 350  our CardinalArray multi Str::split ( Str $input :  Str $delimiter          , Int $limit = inf )
 351  our CardinalArray multi Str::split ( Str $input : Rule $delimiter          , Int $limit = inf )
 352
 353 String delimiters must not be treated as rules but as constants.  The
 354 default is no longer S<' '> since that would be interpreted as a constant.
 355 P5's C<< split('S< >') >> will translate to C<.words> or some such.  Null trailing fields
 356 are no longer trimmed by default.  We might add some kind of :trim flag or
 357 introduce a trimlist function of some sort.
 358
 359 B<Note:> partial implementation only
 360
 361 =cut
 362
 363 .sub 'split'
 364     .param string sep
 365     .param string target
 366     .local pmc a, b
 367
 368     a = new 'CardinalString'
 369     b = new 'CardinalString'
 370
 371     a = target
 372     b = sep
 373
 374     .return a.'split'(b)
 375 .end
 376
 377
 378 =item join
 379
 380 B<Note:> partial implementation only
 381
 382 =cut
 383
 384 .sub 'join'
 385     .param pmc args            :slurpy
 386     .local pmc flatargs
 387     .local string sep
 388
 389     flatargs = new 'CardinalArray'
 390     sep = ''
 391     unless args goto have_flatargs
 392     $P0 = args[0]
 393     $I0 = isa $P0, 'CardinalArray'
 394     if $I0 goto have_sep
 395     $P0 = shift args
 396     sep = $P0
 397   have_sep:
 398   arg_loop:
 399     unless args goto have_flatargs
 400     $P0 = shift args
 401     $I0 = isa $P0, 'CardinalArray'
 402     if $I0 goto arg_array
 403     push flatargs, $P0
 404     goto arg_loop
 405   arg_array:
 406     $I0 = elements flatargs
 407     splice flatargs, $P0, $I0, 0
 408     goto arg_loop
 409   have_flatargs:
 410     $S0 = join sep, flatargs
 411     .return ($S0)
 412 .end
 413
 414
 415 =item substr
 416
 417  multi substr (Str $s, StrPos $start  : StrPos $end,      $replace)
 418  multi substr (Str $s, StrPos $start,   StrLen $length  : $replace)
 419  multi substr (Str $s, StrLen $offset : StrLen $length,   $replace)
 420
 421 B<Note:> partial implementation only
 422
 423 =cut
 424
 425 .sub 'substr'
 426     .param string x
 427     .param int start
 428     .param int len     :optional
 429     .param int has_len :opt_flag
 430     .local pmc s
 431
 432     if has_len goto end
 433     s = new 'CardinalString'
 434     s = x
 435     len = s.'chars'()
 436
 437   end:
 438     $S0 = substr x, start, len
 439     .return ($S0)
 440 .end
 441
 442 =item chop
 443
 444  our Str method Str::chop ( Str  $string: )
 445
 446 Returns string with one Char removed from the end.
 447
 448 =cut
 449
 450 .sub 'chop'
 451     .param string a
 452     .local pmc s
 453     s = new 'CardinalString'
 454     s = a
 455     .return s.'chop'()
 456 .end
 457
 458 =back
 459
 460 =head2 TODO Functions
 461
 462 =over 4
 463
 464 =item p5chop
 465
 466  our Char multi P5emul::Str::p5chop ( Str  $string is rw )
 467  our Char multi P5emul::Str::p5chop ( Str *@strings = ($+_) is rw )
 468
 469 Trims the last character from C<$string>, and returns it. Called with a
 470 list, it chops each item in turn, and returns the last character
 471 chopped.
 472
 473 =item p5chomp
 474
 475  our Int multi P5emul::Str::p5chomp ( Str  $string is rw )
 476  our Int multi P5emul::Str::p5chomp ( Str *@strings = ($+_) is rw )
 477
 478 Related to C<p5chop>, only removes trailing chars that match C</\n/>. In
 479 either case, it returns the number of chars removed.
 480
 481 =item chomp
 482
 483  our Str method Str::chomp ( Str $string: )
 484
 485 Returns string with newline removed from the end.  An arbitrary
 486 terminator can be removed if the input filehandle has marked the
 487 string for where the "newline" begins.  (Presumably this is stored
 488 as a property of the string.)  Otherwise a standard newline is removed.
 489
 490 Note: Most users should just let their I/O handles autochomp instead.
 491 (Autochomping is the default.)
 492
 493 =item length
 494
 495 This word is banned in Cardinal.  You must specify units.
 496
 497 =item index
 498
 499 Needs to be in terms of StrPos, not Int.
 500
 501 =item pack
 502
 503 =item pos
 504
 505 =item quotemeta
 506
 507 =item rindex
 508
 509 Needs to be in terms of StrPos, not Int.
 510
 511 =item sprintf
 512
 513 =item unpack
 514
 515 =item vec
 516
 517 Should replace vec with declared arrays of bit, uint2, uint4, etc.
 518
 519 =item words
 520
 521  our CardinalArray multi Str::words ( Rule $matcher = /\S+/,  Str $input = $+_, Int $limit = inf )
 522  our CardinalArray multi Str::words ( Str $input : Rule $matcher = /\S+/, Int $limit = inf )
 523
 524 =back
 525
 526 =cut
 527
 528 # Local Variables:
 529 #   mode: pir
 530 #   fill-column: 100
 531 # End:
 532 # vim: expandtab shiftwidth=4 ft=pir: