1 # Some useful helpers for dealing with text (arrays of characters)
   2 
   3 def equal a:text, b:text -> result:bool [
   4   local-scope
   5   load-ingredients
   6   an:num, bn:num <- copy a, b
   7   address-equal?:boolean <- equal an, bn
   8   reply-if address-equal?, 1/true
   9   reply-unless a, 0/false
  10   reply-unless b, 0/false
  11   a-len:num <- length *a
  12   b-len:num <- length *b
  13   # compare lengths
  14   {
  15     trace 99, [text-equal], [comparing lengths]
  16     length-equal?:bool <- equal a-len, b-len
  17     break-if length-equal?
  18     return 0
  19   }
  20   # compare each corresponding character
  21   trace 99, [text-equal], [comparing characters]
  22   i:num <- copy 0
  23   {
  24     done?:bool <- greater-or-equal i, a-len
  25     break-if done?
  26     a2:char <- index *a, i
  27     b2:char <- index *b, i
  28     {
  29       chars-match?:bool <- equal a2, b2
  30       break-if chars-match?
  31       return 0
  32     }
  33     i <- add i, 1
  34     loop
  35   }
  36   return 1
  37 ]
  38 
  39 scenario text-equal-reflexive [
  40   local-scope
  41   x:text <- new [abc]
  42   run [
  43     10:bool/raw <- equal x, x
  44   ]
  45   memory-should-contain [
  46     10 <- 1  # x == x for all x
  47   ]
  48 ]
  49 
  50 scenario text-equal-identical [
  51   local-scope
  52   x:text <- new [abc]
  53   y:text <- new [abc]
  54   run [
  55     10:bool/raw <- equal x, y
  56   ]
  57   memory-should-contain [
  58     10 <- 1  # abc == abc
  59   ]
  60 ]
  61 
  62 scenario text-equal-distinct-lengths [
  63   local-scope
  64   x:text <- new [abc]
  65   y:text <- new [abcd]
  66   run [
  67     10:bool/raw <- equal x, y
  68   ]
  69   memory-should-contain [
  70     10 <- 0  # abc != abcd
  71   ]
  72   trace-should-contain [
  73     text-equal: comparing lengths
  74   ]
  75   trace-should-not-contain [
  76     text-equal: comparing characters
  77   ]
  78 ]
  79 
  80 scenario text-equal-with-empty [
  81   local-scope
  82   x:text <- new []
  83   y:text <- new [abcd]
  84   run [
  85     10:bool/raw <- equal x, y
  86   ]
  87   memory-should-contain [
  88     10 <- 0  # "" != abcd
  89   ]
  90 ]
  91 
  92 scenario text-equal-with-null [
  93   local-scope
  94   x:text <- new [abcd]
  95   y:text <- copy 0
  96   run [
  97     10:bool/raw <- equal x, 0
  98     11:bool/raw <- equal 0, x
  99     12:bool/raw <- equal x, y
 100     13:bool/raw <- equal y, x
 101     14:bool/raw <- equal y, y
 102   ]
 103   memory-should-contain [
 104     10 <- 0
 105     11 <- 0
 106     12 <- 0
 107     13 <- 0
 108     14 <- 1
 109   ]
 110   check-trace-count-for-label 0, [error]
 111 ]
 112 
 113 scenario text-equal-common-lengths-but-distinct [
 114   local-scope
 115   x:text <- new [abc]
 116   y:text <- new [abd]
 117   run [
 118     10:bool/raw <- equal x, y
 119   ]
 120   memory-should-contain [
 121     10 <- 0  # abc != abd
 122   ]
 123 ]
 124 
 125 # A new type to help incrementally construct texts.
 126 # todo: make this shape-shifting.
 127 container buffer [
 128   length:num
 129   data:text
 130 ]
 131 
 132 def new-buffer capacity:num -> result:&:buffer [
 133   local-scope
 134   load-ingredients
 135   result <- new buffer:type
 136   *result <- put *result, length:offset, 0
 137   {
 138     break-if capacity
 139     # capacity not provided
 140     capacity <- copy 10
 141   }
 142   data:text <- new character:type, capacity
 143   *result <- put *result, data:offset, data
 144   return result
 145 ]
 146 
 147 def grow-buffer buf:&:buffer -> buf:&:buffer [
 148   local-scope
 149   load-ingredients
 150   # double buffer size
 151   olddata:text <- get *buf, data:offset
 152   oldlen:num <- length *olddata
 153   newlen:num <- multiply oldlen, 2
 154   newdata:text <- new character:type, newlen
 155   *buf <- put *buf, data:offset, newdata
 156   # copy old contents
 157   i:num <- copy 0
 158   {
 159     done?:bool <- greater-or-equal i, oldlen
 160     break-if done?
 161     src:char <- index *olddata, i
 162     *newdata <- put-index *newdata, i, src
 163     i <- add i, 1
 164     loop
 165   }
 166 ]
 167 
 168 def buffer-full? in:&:buffer -> result:bool [
 169   local-scope
 170   load-ingredients
 171   len:num <- get *in, length:offset
 172   s:text <- get *in, data:offset
 173   capacity:num <- length *s
 174   result <- greater-or-equal len, capacity
 175 ]
 176 
 177 # most broadly applicable definition of append to a buffer: just call to-text
 178 def append buf:&:buffer, x:_elem -> buf:&:buffer [
 179   local-scope
 180   load-ingredients
 181   text:text <- to-text x
 182   len:num <- length *text
 183   i:num <- copy 0
 184   {
 185     done?:bool <- greater-or-equal i, len
 186     break-if done?
 187     c:char <- index *text, i
 188     buf <- append buf, c
 189     i <- add i, 1
 190     loop
 191   }
 192 ]
 193 
 194 def append buf:&:buffer, c:char -> buf:&:buffer [
 195   local-scope
 196   load-ingredients
 197   len:num <- get *buf, length:offset
 198   {
 199     # backspace? just drop last character if it exists and return
 200     backspace?:bool <- equal c, 8/backspace
 201     break-unless backspace?
 202     empty?:bool <- lesser-or-equal len, 0
 203     return-if empty?
 204     len <- subtract len, 1
 205     *buf <- put *buf, length:offset, len
 206     return
 207   }
 208   {
 209     # grow buffer if necessary
 210     full?:bool <- buffer-full? buf
 211     break-unless full?
 212     buf <- grow-buffer buf
 213   }
 214   s:text <- get *buf, data:offset
 215   *s <- put-index *s, len, c
 216   len <- add len, 1
 217   *buf <- put *buf, length:offset, len
 218 ]
 219 
 220 def append buf:&:buffer, t:text -> buf:&:buffer [
 221   local-scope
 222   load-ingredients
 223   len:num <- length *t
 224   i:num <- copy 0
 225   {
 226     done?:bool <- greater-or-equal i, len
 227     break-if done?
 228     c:char <- index *t, i
 229     buf <- append buf, c
 230     i <- add i, 1
 231     loop
 232   }
 233 ]
 234 
 235 scenario append-to-empty-buffer [
 236   local-scope
 237   x:&:buffer <- new-buffer
 238   run [
 239     c:char <- copy 97/a
 240     x <- append x, c
 241     10:num/raw <- get *x, length:offset
 242     s:text <- get *x, data:offset
 243     11:char/raw <- index *s, 0
 244     12:char/raw <- index *s, 1
 245   ]
 246   memory-should-contain [
 247     10 <- 1  # buffer length
 248     11 <- 97  # a
 249     12 <- 0  # rest of buffer is empty
 250   ]
 251 ]
 252 
 253 scenario append-to-buffer [
 254   local-scope
 255   x:&:buffer <- new-buffer
 256   c:char <- copy 97/a
 257   x <- append x, c
 258   run [
 259     c <- copy 98/b
 260     x <- append x, c
 261     10:num/raw <- get *x, length:offset
 262     s:text <- get *x, data:offset
 263     11:char/raw <- index *s, 0
 264     12:char/raw <- index *s, 1
 265     13:char/raw <- index *s, 2
 266   ]
 267   memory-should-contain [
 268     10 <- 2  # buffer length
 269     11 <- 97  # a
 270     12 <- 98  # b
 271     13 <- 0  # rest of buffer is empty
 272   ]
 273 ]
 274 
 275 scenario append-grows-buffer [
 276   local-scope
 277   x:&:buffer <- new-buffer 3
 278   s1:text <- get *x, data:offset
 279   x <- append x, [abc]  # buffer is now full
 280   s2:text <- get *x, data:offset
 281   run [
 282     10:bool/raw <- equal s1, s2
 283     11:@:char/raw <- copy *s2
 284     +buffer-filled
 285     c:char <- copy 100/d
 286     x <- append x, c
 287     s3:text <- get *x, data:offset
 288     20:bool/raw <- equal s1, s3
 289     21:num/raw <- get *x, length:offset
 290     30:@:char/raw <- copy *s3
 291   ]
 292   memory-should-contain [
 293     # before +buffer-filled
 294     10 <- 1   # no change in data pointer after original append
 295     11 <- 3   # size of data
 296     12 <- 97  # data
 297     13 <- 98
 298     14 <- 99
 299     # in the end
 300     20 <- 0   # data pointer has grown after second append
 301     21 <- 4   # final length
 302     30 <- 6   # but data's capacity has doubled
 303     31 <- 97  # data
 304     32 <- 98
 305     33 <- 99
 306     34 <- 100
 307     35 <- 0
 308     36 <- 0
 309   ]
 310 ]
 311 
 312 scenario buffer-append-handles-backspace [
 313   local-scope
 314   x:&:buffer <- new-buffer
 315   x <- append x, [ab]
 316   run [
 317     c:char <- copy 8/backspace
 318     x <- append x, c
 319     s:text <- buffer-to-array x
 320     10:@:char/raw <- copy *s
 321   ]
 322   memory-should-contain [
 323     10 <- 1   # length
 324     11 <- 97  # contents
 325     12 <- 0
 326   ]
 327 ]
 328 
 329 def buffer-to-array in:&:buffer -> result:text [
 330   local-scope
 331   load-ingredients
 332   {
 333     # propagate null buffer
 334     break-if in
 335     return 0
 336   }
 337   len:num <- get *in, length:offset
 338   s:text <- get *in, data:offset
 339   # we can't just return s because it is usually the wrong length
 340   result <- new character:type, len
 341   i:num <- copy 0
 342   {
 343     done?:bool <- greater-or-equal i, len
 344     break-if done?
 345     src:char <- index *s, i
 346     *result <- put-index *result, i, src
 347     i <- add i, 1
 348     loop
 349   }
 350 ]
 351 
 352 # Append any number of texts together.
 353 # A later layer also translates calls to this to implicitly call to-text, so
 354 # append to string becomes effectively dynamically typed.
 355 #
 356 # Beware though: this hack restricts how much 'append' can be overridden. Any
 357 # new variants that match:
 358 #   append _:text, ___
 359 # will never ever get used.
 360 def append first:text -> result:text [
 361   local-scope
 362   load-ingredients
 363   buf:&:buffer <- new-buffer 30
 364   # append first ingredient
 365   {
 366     break-unless first
 367     buf <- append buf, first
 368   }
 369   # append remaining ingredients
 370   {
 371     arg:text, arg-found?:bool <- next-ingredient
 372     break-unless arg-found?
 373     loop-unless arg
 374     buf <- append buf, arg
 375     loop
 376   }
 377   result <- buffer-to-array buf
 378 ]
 379 
 380 scenario text-append-1 [
 381   local-scope
 382   x:text <- new [hello,]
 383   y:text <- new [ world!]
 384   run [
 385     z:text <- append x, y
 386     10:@:char/raw <- copy *z
 387   ]
 388   memory-should-contain [
 389     10:array:character <- [hello, world!]
 390   ]
 391 ]
 392 
 393 scenario text-append-null [
 394   local-scope
 395   x:text <- copy 0
 396   y:text <- new [ world!]
 397   run [
 398     z:text <- append x, y
 399     10:@:char/raw <- copy *z
 400   ]
 401   memory-should-contain [
 402     10:array:character <- [ world!]
 403   ]
 404 ]
 405 
 406 scenario text-append-null-2 [
 407   local-scope
 408   x:text <- new [hello,]
 409   y:text <- copy 0
 410   run [
 411     z:text <- append x, y
 412     10:@:char/raw <- copy *z
 413   ]
 414   memory-should-contain [
 415     10:array:character <- [hello,]
 416   ]
 417 ]
 418 
 419 scenario text-append-multiary [
 420   local-scope
 421   x:text <- new [hello, ]
 422   y:text <- new [world]
 423   z:text <- new [!]
 424   run [
 425     z:text <- append x, y, z
 426     10:@:char/raw <- copy *z
 427   ]
 428   memory-should-contain [
 429     10:array:character <- [hello, world!]
 430   ]
 431 ]
 432 
 433 scenario replace-character-in-text [
 434   local-scope
 435   x:text <- new [abc]
 436   run [
 437     x <- replace x, 98/b, 122/z
 438     10:@:char/raw <- copy *x
 439   ]
 440   memory-should-contain [
 441     10:array:character <- [azc]
 442   ]
 443 ]
 444 
 445 def replace s:text, oldc:char, newc:char, from:num/optional -> s:text [
 446   local-scope
 447   load-ingredients
 448   len:num <- length *s
 449   i:num <- find-next s, oldc, from
 450   done?:bool <- greater-or-equal i, len
 451   return-if done?
 452   *s <- put-index *s, i, newc
 453   i <- add i, 1
 454   s <- replace s, oldc, newc, i
 455 ]
 456 
 457 scenario replace-character-at-start [
 458   local-scope
 459   x:text <- new [abc]
 460   run [
 461     x <- replace x, 97/a, 122/z
 462     10:@:char/raw <- copy *x
 463   ]
 464   memory-should-contain [
 465     10:array:character <- [zbc]
 466   ]
 467 ]
 468 
 469 scenario replace-character-at-end [
 470   local-scope
 471   x:text <- new [abc]
 472   run [
 473     x <- replace x, 99/c, 122/z
 474     10:@:char/raw <- copy *x
 475   ]
 476   memory-should-contain [
 477     10:array:character <- [abz]
 478   ]
 479 ]
 480 
 481 scenario replace-character-missing [
 482   local-scope
 483   x:text <- new [abc]
 484   run [
 485     x <- replace x, 100/d, 122/z
 486     10:@:char/raw <- copy *x
 487   ]
 488   memory-should-contain [
 489     10:array:character <- [abc]
 490   ]
 491 ]
 492 
 493 scenario replace-all-characters [
 494   local-scope
 495   x:text <- new [banana]
 496   run [
 497     x <- replace x, 97/a, 122/z
 498     10:@:char/raw <- copy *x
 499   ]
 500   memory-should-contain [
 501     10:array:character <- [bznznz]
 502   ]
 503 ]
 504 
 505 # replace underscores in first with remaining args
 506 def interpolate template:text -> result:text [
 507   local-scope
 508   load-ingredients  # consume just the template
 509   # compute result-len, space to allocate for result
 510   tem-len:num <- length *template
 511   result-len:num <- copy tem-len
 512   {
 513     # while ingredients remain
 514     a:text, arg-received?:bool <- next-ingredient
 515     break-unless arg-received?
 516     # result-len = result-len + arg.length - 1 (for the 'underscore' being replaced)
 517     a-len:num <- length *a
 518     result-len <- add result-len, a-len
 519     result-len <- subtract result-len, 1
 520     loop
 521   }
 522   rewind-ingredients
 523   _ <- next-ingredient  # skip template
 524   result <- new character:type, result-len
 525   # repeatedly copy sections of template and 'holes' into result
 526   result-idx:num <- copy 0
 527   i:num <- copy 0
 528   {
 529     # while arg received
 530     a:text, arg-received?:bool <- next-ingredient
 531     break-unless arg-received?
 532     # copy template into result until '_'
 533     {
 534       # while i < template.length
 535       tem-done?:bool <- greater-or-equal i, tem-len
 536       break-if tem-done?, +done
 537       # while template[i] != '_'
 538       in:char <- index *template, i
 539       underscore?:bool <- equal in, 95/_
 540       break-if underscore?
 541       # result[result-idx] = template[i]
 542       *result <- put-index *result, result-idx, in
 543       i <- add i, 1
 544       result-idx <- add result-idx, 1
 545       loop
 546     }
 547     # copy 'a' into result
 548     j:num <- copy 0
 549     {
 550       # while j < a.length
 551       arg-done?:bool <- greater-or-equal j, a-len
 552       break-if arg-done?
 553       # result[result-idx] = a[j]
 554       in:char <- index *a, j
 555       *result <- put-index *result, result-idx, in
 556       j <- add j, 1
 557       result-idx <- add result-idx, 1
 558       loop
 559     }
 560     # skip '_' in template
 561     i <- add i, 1
 562     loop  # interpolate next arg
 563   }
 564   +done
 565   # done with holes; copy rest of template directly into result
 566   {
 567     # while i < template.length
 568     tem-done?:bool <- greater-or-equal i, tem-len
 569     break-if tem-done?
 570     # result[result-idx] = template[i]
 571     in:char <- index *template, i
 572     *result <- put-index *result, result-idx, in
 573     i <- add i, 1
 574     result-idx <- add result-idx, 1
 575     loop
 576   }
 577 ]
 578 
 579 scenario interpolate-works [
 580   local-scope
 581   x:text <- new [abc_ghi]
 582   y:text <- new [def]
 583   run [
 584     z:text <- interpolate x, y
 585     10:@:char/raw <- copy *z
 586   ]
 587   memory-should-contain [
 588     10:array:character <- [abcdefghi]
 589   ]
 590 ]
 591 
 592 scenario interpolate-at-start [
 593   local-scope
 594   x:text <- new [_, hello!]
 595   y:text <- new [abc]
 596   run [
 597     z:text <- interpolate x, y
 598     10:@:char/raw <- copy *z
 599   ]
 600   memory-should-contain [
 601     10:array:character <- [abc, hello!]
 602     22 <- 0  # out of bounds
 603   ]
 604 ]
 605 
 606 scenario interpolate-at-end [
 607   local-scope
 608   x:text <- new [hello, _]
 609   y:text <- new [abc]
 610   run [
 611     z:text <- interpolate x, y
 612     10:@:char/raw <- copy *z
 613   ]
 614   memory-should-contain [
 615     10:array:character <- [hello, abc]
 616   ]
 617 ]
 618 
 619 # result:bool <- space? c:char
 620 def space? c:char -> result:bool [
 621   local-scope
 622   load-ingredients
 623   # most common case first
 624   result <- equal c, 32/space
 625   return-if result
 626   result <- equal c, 10/newline
 627   return-if result
 628   result <- equal c, 9/tab
 629   return-if result
 630   result <- equal c, 13/carriage-return
 631   return-if result
 632   # remaining uncommon cases in sorted order
 633   # http://unicode.org code-points in unicode-set Z and Pattern_White_Space
 634   result <- equal c, 11/ctrl-k
 635   return-if result
 636   result <- equal c, 12/ctrl-l
 637   return-if result
 638   result <- equal c, 133/ctrl-0085
 639   return-if result
 640   result <- equal c, 160/no-break-space
 641   return-if result
 642   result <- equal c, 5760/ogham-space-mark
 643   return-if result
 644   result <- equal c, 8192/en-quad
 645   return-if result
 646   result <- equal c, 8193/em-quad
 647   return-if result
 648   result <- equal c, 8194/en-space
 649   return-if result
 650   result <- equal c, 8195/em-space
 651   return-if result
 652   result <- equal c, 8196/three-per-em-space
 653   return-if result
 654   result <- equal c, 8197/four-per-em-space
 655   return-if result
 656   result <- equal c, 8198/six-per-em-space
 657   return-if result
 658   result <- equal c, 8199/figure-space
 659   return-if result
 660   result <- equal c, 8200/punctuation-space
 661   return-if result
 662   result <- equal c, 8201/thin-space
 663   return-if result
 664   result <- equal c, 8202/hair-space
 665   return-if result
 666   result <- equal c, 8206/left-to-right
 667   return-if result
 668   result <- equal c, 8207/right-to-left
 669   return-if result
 670   result <- equal c, 8232/line-separator
 671   return-if result
 672   result <- equal c, 8233/paragraph-separator
 673   return-if result
 674   result <- equal c, 8239/narrow-no-break-space
 675   return-if result
 676   result <- equal c, 8287/medium-mathematical-space
 677   return-if result
 678   result <- equal c, 12288/ideographic-space
 679 ]
 680 
 681 def trim s:text -> result:text [
 682   local-scope
 683   load-ingredients
 684   len:num <- length *s
 685   # left trim: compute start
 686   start:num <- copy 0
 687   {
 688     {
 689       at-end?:bool <- greater-or-equal start, len
 690       break-unless at-end?
 691       result <- new character:type, 0
 692       return
 693     }
 694     curr:char <- index *s, start
 695     whitespace?:bool <- space? curr
 696     break-unless whitespace?
 697     start <- add start, 1
 698     loop
 699   }
 700   # right trim: compute end
 701   end:num <- subtract len, 1
 702   {
 703     not-at-start?:bool <- greater-than end, start
 704     assert not-at-start?, [end ran up against start]
 705     curr:char <- index *s, end
 706     whitespace?:bool <- space? curr
 707     break-unless whitespace?
 708     end <- subtract end, 1
 709     loop
 710   }
 711   # result = new character[end+1 - start]
 712   new-len:num <- subtract end, start, -1
 713   result:text <- new character:type, new-len
 714   # copy the untrimmed parts between start and end
 715   i:num <- copy start
 716   j:num <- copy 0
 717   {
 718     # while i <= end
 719     done?:bool <- greater-than i, end
 720     break-if done?
 721     # result[j] = s[i]
 722     src:char <- index *s, i
 723     *result <- put-index *result, j, src
 724     i <- add i, 1
 725     j <- add j, 1
 726     loop
 727   }
 728 ]
 729 
 730 scenario trim-unmodified [
 731   local-scope
 732   x:text <- new [abc]
 733   run [
 734     y:text <- trim x
 735     1:@:char/raw <- copy *y
 736   ]
 737   memory-should-contain [
 738     1:array:character <- [abc]
 739   ]
 740 ]
 741 
 742 scenario trim-left [
 743   local-scope
 744   x:text <- new [  abc]
 745   run [
 746     y:text <- trim x
 747     1:@:char/raw <- copy *y
 748   ]
 749   memory-should-contain [
 750     1:array:character <- [abc]
 751   ]
 752 ]
 753 
 754 scenario trim-right [
 755   local-scope
 756   x:text <- new [abc  ]
 757   run [
 758     y:text <- trim x
 759     1:@:char/raw <- copy *y
 760   ]
 761   memory-should-contain [
 762     1:array:character <- [abc]
 763   ]
 764 ]
 765 
 766 scenario trim-left-right [
 767   local-scope
 768   x:text <- new [  abc   ]
 769   run [
 770     y:text <- trim x
 771     1:@:char/raw <- copy *y
 772   ]
 773   memory-should-contain [
 774     1:array:character <- [abc]
 775   ]
 776 ]
 777 
 778 scenario trim-newline-tab [
 779   local-scope
 780   x:text <- new [ abc
 781 ]
 782   run [
 783     y:text <- trim x
 784     1:@:char/raw <- copy *y
 785   ]
 786   memory-should-contain [
 787     1:array:character <- [abc]
 788   ]
 789 ]
 790 
 791 def find-next text:text, pattern:char, idx:num -> next-index:num [
 792   local-scope
 793   load-ingredients
 794   len:num <- length *text
 795   {
 796     eof?:bool <- greater-or-equal idx, len
 797     break-if eof?
 798     curr:char <- index *text, idx
 799     found?:bool <- equal curr, pattern
 800     break-if found?
 801     idx <- add idx, 1
 802     loop
 803   }
 804   return idx
 805 ]
 806 
 807 scenario text-find-next [
 808   local-scope
 809   x:text <- new [a/b]
 810   run [
 811     10:num/raw <- find-next x, 47/slash, 0/start-index
 812   ]
 813   memory-should-contain [
 814     10 <- 1
 815   ]
 816 ]
 817 
 818 scenario text-find-next-empty [
 819   local-scope
 820   x:text <- new []
 821   run [
 822     10:num/raw <- find-next x, 47/slash, 0/start-index
 823   ]
 824   memory-should-contain [
 825     10 <- 0
 826   ]
 827 ]
 828 
 829 scenario text-find-next-initial [
 830   local-scope
 831   x:text <- new [/abc]
 832   run [
 833     10:num/raw <- find-next x, 47/slash, 0/start-index
 834   ]
 835   memory-should-contain [
 836     10 <- 0  # prefix match
 837   ]
 838 ]
 839 
 840 scenario text-find-next-final [
 841   local-scope
 842   x:text <- new [abc/]
 843   run [
 844     10:num/raw <- find-next x, 47/slash, 0/start-index
 845   ]
 846   memory-should-contain [
 847     10 <- 3  # suffix match
 848   ]
 849 ]
 850 
 851 scenario text-find-next-missing [
 852   local-scope
 853   x:text <- new [abcd]
 854   run [
 855     10:num/raw <- find-next x, 47/slash, 0/start-index
 856   ]
 857   memory-should-contain [
 858     10 <- 4  # no match
 859   ]
 860 ]
 861 
 862 scenario text-find-next-invalid-index [
 863   local-scope
 864   x:text <- new [abc]
 865   run [
 866     10:num/raw <- find-next x, 47/slash, 4/start-index
 867   ]
 868   memory-should-contain [
 869     10 <- 4  # no change
 870   ]
 871 ]
 872 
 873 scenario text-find-next-first [
 874   local-scope
 875   x:text <- new [ab/c/]
 876   run [
 877     10:num/raw <- find-next x, 47/slash, 0/start-index
 878   ]
 879   memory-should-contain [
 880     10 <- 2  # first '/' of multiple
 881   ]
 882 ]
 883 
 884 scenario text-find-next-second [
 885   local-scope
 886   x:text <- new [ab/c/]
 887   run [
 888     10:num/raw <- find-next x, 47/slash, 3/start-index
 889   ]
 890   memory-should-contain [
 891     10 <- 4  # second '/' of multiple
 892   ]
 893 ]
 894 
 895 # search for a pattern of multiple characters
 896 # fairly dumb algorithm
 897 def find-next text:text, pattern:text, idx:num -> next-index:num [
 898   local-scope
 899   load-ingredients
 900   first:char <- index *pattern, 0
 901   # repeatedly check for match at current idx
 902   len:num <- length *text
 903   {
 904     # does some unnecessary work checking even when there isn't enough of text left
 905     done?:bool <- greater-or-equal idx, len
 906     break-if done?
 907     found?:bool <- match-at text, pattern, idx
 908     break-if found?
 909     idx <- add idx, 1
 910     # optimization: skip past indices that definitely won't match
 911     idx <- find-next text, first, idx
 912     loop
 913   }
 914   return idx
 915 ]
 916 
 917 scenario find-next-text-1 [
 918   local-scope
 919   x:text <- new [abc]
 920   y:text <- new [bc]
 921   run [
 922     10:num/raw <- find-next x, y, 0
 923   ]
 924   memory-should-contain [
 925     10 <- 1
 926   ]
 927 ]
 928 
 929 scenario find-next-text-2 [
 930   local-scope
 931   x:text <- new [abcd]
 932   y:text <- new [bc]
 933   run [
 934     10:num/raw <- find-next x, y, 1
 935   ]
 936   memory-should-contain [
 937     10 <- 1
 938   ]
 939 ]
 940 
 941 scenario find-next-no-match [
 942   local-scope
 943   x:text <- new [abc]
 944   y:text <- new [bd]
 945   run [
 946     10:num/raw <- find-next x, y, 0
 947   ]
 948   memory-should-contain [
 949     10 <- 3  # not found
 950   ]
 951 ]
 952 
 953 scenario find-next-suffix-match [
 954   local-scope
 955   x:text <- new [abcd]
 956   y:text <- new [cd]
 957   run [
 958     10:num/raw <- find-next x, y, 0
 959   ]
 960   memory-should-contain [
 961     10 <- 2
 962   ]
 963 ]
 964 
 965 scenario find-next-suffix-match-2 [
 966   local-scope
 967   x:text <- new [abcd]
 968   y:text <- new [cde]
 969   run [
 970     10:num/raw <- find-next x, y, 0
 971   ]
 972   memory-should-contain [
 973     10 <- 4  # not found
 974   ]
 975 ]
 976 
 977 # checks if pattern matches at index 'idx'
 978 def match-at text:text, pattern:text, idx:num -> result:bool [
 979   local-scope
 980   load-ingredients
 981   pattern-len:num <- length *pattern
 982   # check that there's space left for the pattern
 983   {
 984     x:num <- length *text
 985     x <- subtract x, pattern-len
 986     enough-room?:bool <- lesser-or-equal idx, x
 987     break-if enough-room?
 988     return 0/not-found
 989   }
 990   # check each character of pattern
 991   pattern-idx:num <- copy 0
 992   {
 993     done?:bool <- greater-or-equal pattern-idx, pattern-len
 994     break-if done?
 995     c:char <- index *text, idx
 996     exp:char <- index *pattern, pattern-idx
 997     {
 998       match?:bool <- equal c, exp
 999       break-if match?
1000       return 0/not-found
1001     }
1002     idx <- add idx, 1
1003     pattern-idx <- add pattern-idx, 1
1004     loop
1005   }
1006   return 1/found
1007 ]
1008 
1009 scenario match-at-checks-pattern-at-index [
1010   local-scope
1011   x:text <- new [abc]
1012   y:text <- new [ab]
1013   run [
1014     10:bool/raw <- match-at x, y, 0
1015   ]
1016   memory-should-contain [
1017     10 <- 1  # match found
1018   ]
1019 ]
1020 
1021 scenario match-at-reflexive [
1022   local-scope
1023   x:text <- new [abc]
1024   run [
1025     10:bool/raw <- match-at x, x, 0
1026   ]
1027   memory-should-contain [
1028     10 <- 1  # match found
1029   ]
1030 ]
1031 
1032 scenario match-at-outside-bounds [
1033   local-scope
1034   x:text <- new [abc]
1035   y:text <- new [a]
1036   run [
1037     10:bool/raw <- match-at x, y, 4
1038   ]
1039   memory-should-contain [
1040     10 <- 0  # never matches
1041   ]
1042 ]
1043 
1044 scenario match-at-empty-pattern [
1045   local-scope
1046   x:text <- new [abc]
1047   y:text <- new []
1048   run [
1049     10:bool/raw <- match-at x, y, 0
1050   ]
1051   memory-should-contain [
1052     10 <- 1  # always matches empty pattern given a valid index
1053   ]
1054 ]
1055 
1056 scenario match-at-empty-pattern-outside-bound [
1057   local-scope
1058   x:text <- new [abc]
1059   y:text <- new []
1060   run [
1061     10:bool/raw <- match-at x, y, 4
1062   ]
1063   memory-should-contain [
1064     10 <- 0  # no match
1065   ]
1066 ]
1067 
1068 scenario match-at-empty-text [
1069   local-scope
1070   x:text <- new []
1071   y:text <- new [abc]
1072   run [
1073     10:bool/raw <- match-at x, y, 0
1074   ]
1075   memory-should-contain [
1076     10 <- 0  # no match
1077   ]
1078 ]
1079 
1080 scenario match-at-empty-against-empty [
1081   local-scope
1082   x:text <- new []
1083   run [
1084     10:bool/raw <- match-at x, x, 0
1085   ]
1086   memory-should-contain [
1087     10 <- 1  # matches because pattern is also empty
1088   ]
1089 ]
1090 
1091 scenario match-at-inside-bounds [
1092   local-scope
1093   x:text <- new [abc]
1094   y:text <- new [bc]
1095   run [
1096     10:bool/raw <- match-at x, y, 1
1097   ]
1098   memory-should-contain [
1099     10 <- 1  # match
1100   ]
1101 ]
1102 
1103 scenario match-at-inside-bounds-2 [
1104   local-scope
1105   x:text <- new [abc]
1106   y:text <- new [bc]
1107   run [
1108     10:bool/raw <- match-at x, y, 0
1109   ]
1110   memory-should-contain [
1111     10 <- 0  # no match
1112   ]
1113 ]
1114 
1115 def split s:text, delim:char -> result:&:@:text [
1116   local-scope
1117   load-ingredients
1118   # empty text? return empty array
1119   len:num <- length *s
1120   {
1121     empty?:bool <- equal len, 0
1122     break-unless empty?
1123     result <- new {(address array character): type}, 0
1124     return
1125   }
1126   # count #pieces we need room for
1127   count:num <- copy 1  # n delimiters = n+1 pieces
1128   idx:num <- copy 0
1129   {
1130     idx <- find-next s, delim, idx
1131     done?:bool <- greater-or-equal idx, len
1132     break-if done?
1133     idx <- add idx, 1
1134     count <- add count, 1
1135     loop
1136   }
1137   # allocate space
1138   result <- new {(address array character): type}, count
1139   # repeatedly copy slices start..end until delimiter into result[curr-result]
1140   curr-result:num <- copy 0
1141   start:num <- copy 0
1142   {
1143     # while next delim exists
1144     done?:bool <- greater-or-equal start, len
1145     break-if done?
1146     end:num <- find-next s, delim, start
1147     # copy start..end into result[curr-result]
1148     dest:text <- copy-range s, start, end
1149     *result <- put-index *result, curr-result, dest
1150     # slide over to next slice
1151     start <- add end, 1
1152     curr-result <- add curr-result, 1
1153     loop
1154   }
1155 ]
1156 
1157 scenario text-split-1 [
1158   local-scope
1159   x:text <- new [a/b]
1160   run [
1161     y:&:@:text <- split x, 47/slash
1162     10:num/raw <- length *y
1163     a:text <- index *y, 0
1164     b:text <- index *y, 1
1165     20:@:char/raw <- copy *a
1166     30:@:char/raw <- copy *b
1167   ]
1168   memory-should-contain [
1169     10 <- 2  # length of result
1170     20:array:character <- [a]
1171     30:array:character <- [b]
1172   ]
1173 ]
1174 
1175 scenario text-split-2 [
1176   local-scope
1177   x:text <- new [a/b/c]
1178   run [
1179     y:&:@:text <- split x, 47/slash
1180     10:num/raw <- length *y
1181     a:text <- index *y, 0
1182     b:text <- index *y, 1
1183     c:text <- index *y, 2
1184     20:@:char/raw <- copy *a
1185     30:@:char/raw <- copy *b
1186     40:@:char/raw <- copy *c
1187   ]
1188   memory-should-contain [
1189     10 <- 3  # length of result
1190     20:array:character <- [a]
1191     30:array:character <- [b]
1192     40:array:character <- [c]
1193   ]
1194 ]
1195 
1196 scenario text-split-missing [
1197   local-scope
1198   x:text <- new [abc]
1199   run [
1200     y:&:@:text <- split x, 47/slash
1201     10:num/raw <- length *y
1202     a:text <- index *y, 0
1203     20:@:char/raw <- copy *a
1204   ]
1205   memory-should-contain [
1206     10 <- 1  # length of result
1207     20:array:character <- [abc]
1208   ]
1209 ]
1210 
1211 scenario text-split-empty [
1212   local-scope
1213   x:text <- new []
1214   run [
1215     y:&:@:text <- split x, 47/slash
1216     10:num/raw <- length *y
1217   ]
1218   memory-should-contain [
1219     10 <- 0  # empty result
1220   ]
1221 ]
1222 
1223 scenario text-split-empty-piece [
1224   local-scope
1225   x:text <- new [a/b//c]
1226   run [
1227     y:&:@:text <- split x:text, 47/slash
1228     10:num/raw <- length *y
1229     a:text <- index *y, 0
1230     b:text <- index *y, 1
1231     c:text <- index *y, 2
1232     d:text <- index *y, 3
1233     20:@:char/raw <- copy *a
1234     30:@:char/raw <- copy *b
1235     40:@:char/raw <- copy *c
1236     50:@:char/raw <- copy *d
1237   ]
1238   memory-should-contain [
1239     10 <- 4  # length of result
1240     20:array:character <- [a]
1241     30:array:character <- [b]
1242     40:array:character <- []
1243     50:array:character <- [c]
1244   ]
1245 ]
1246 
1247 def split-first text:text, delim:char -> x:text, y:text [
1248   local-scope
1249   load-ingredients
1250   # empty text? return empty texts
1251   len:num <- length *text
1252   {
1253     empty?:bool <- equal len, 0
1254     break-unless empty?
1255     x:text <- new []
1256     y:text <- new []
1257     return
1258   }
1259   idx:num <- find-next text, delim, 0
1260   x:text <- copy-range text, 0, idx
1261   idx <- add idx, 1
1262   y:text <- copy-range text, idx, len
1263 ]
1264 
1265 scenario text-split-first [
1266   local-scope
1267   x:text <- new [a/b]
1268   run [
1269     y:text, z:text <- split-first x, 47/slash
1270     10:@:char/raw <- copy *y
1271     20:@:char/raw <- copy *z
1272   ]
1273   memory-should-contain [
1274     10:array:character <- [a]
1275     20:array:character <- [b]
1276   ]
1277 ]
1278 
1279 def copy-range buf:text, start:num, end:num -> result:text [
1280   local-scope
1281   load-ingredients
1282   # if end is out of bounds, trim it
1283   len:num <- length *buf
1284   end:num <- min len, end
1285   # allocate space for result
1286   len <- subtract end, start
1287   result:text <- new character:type, len
1288   # copy start..end into result[curr-result]
1289   src-idx:num <- copy start
1290   dest-idx:num <- copy 0
1291   {
1292     done?:bool <- greater-or-equal src-idx, end
1293     break-if done?
1294     src:char <- index *buf, src-idx
1295     *result <- put-index *result, dest-idx, src
1296     src-idx <- add src-idx, 1
1297     dest-idx <- add dest-idx, 1
1298     loop
1299   }
1300 ]
1301 
1302 scenario copy-range-works [
1303   local-scope
1304   x:text <- new [abc]
1305   run [
1306     y:text <- copy-range x, 1, 3
1307     1:@:char/raw <- copy *y
1308   ]
1309   memory-should-contain [
1310     1:array:character <- [bc]
1311   ]
1312 ]
1313 
1314 scenario copy-range-out-of-bounds [
1315   local-scope
1316   x:text <- new [abc]
1317   run [
1318     y:text <- copy-range x, 2, 4
1319     1:@:char/raw <- copy *y
1320   ]
1321   memory-should-contain [
1322     1:array:character <- [c]
1323   ]
1324 ]
1325 
1326 scenario copy-range-out-of-bounds-2 [
1327   local-scope
1328   x:text <- new [abc]
1329   run [
1330     y:text <- copy-range x, 3, 3
1331     1:@:char/raw <- copy *y
1332   ]
1333   memory-should-contain [
1334     1:array:character <- []
1335   ]
1336 ]
1337 
1338 def parse-whole-number in:text -> out:num, error?:bool [
1339   local-scope
1340   load-ingredients
1341   out <- copy 0
1342   result:num <- copy 0  # temporary location
1343   i:num <- copy 0
1344   len:num <- length *in
1345   {
1346     done?:bool <- greater-or-equal i, len
1347     break-if done?
1348     c:char <- index *in, i
1349     x:num <- character-to-code c
1350     digit:num, error?:bool <- character-code-to-digit x
1351     reply-if error?
1352     result <- multiply result, 10
1353     result <- add result, digit
1354     i <- add i, 1
1355     loop
1356   }
1357   # no error; all digits were valid
1358   out <- copy result
1359 ]
1360 
1361 # (contributed by Ella Couch)
1362 recipe character-code-to-digit character-code:number -> result:number, error?:boolean [
1363   local-scope
1364   load-ingredients
1365   result <- copy 0
1366   error? <- lesser-than character-code, 48  # '0'
1367   reply-if error?
1368   error? <- greater-than character-code, 57  # '9'
1369   reply-if error?
1370   result <- subtract character-code, 48
1371 ]
1372 
1373 scenario character-code-to-digit-contain-only-digit [
1374   local-scope
1375   a:number <- copy 48  # character code for '0'
1376   run [
1377     10:number/raw, 11:boolean/raw <- character-code-to-digit a
1378   ]
1379   memory-should-contain [
1380     10 <- 0
1381     11 <- 0  # no error
1382   ]
1383 ]
1384 
1385 scenario character-code-to-digit-contain-only-digit-2 [
1386   local-scope
1387   a:number <- copy 57  # character code for '9'
1388   run [
1389     1:number/raw, 2:boolean/raw <- character-code-to-digit a
1390   ]
1391   memory-should-contain [
1392     1 <- 9
1393     2 <- 0  # no error
1394   ]
1395 ]
1396 
1397 scenario character-code-to-digit-handles-codes-lower-than-zero [
1398   local-scope
1399   a:number <- copy 47
1400   run [
1401     10:number/raw, 11:boolean/raw <- character-code-to-digit a
1402   ]
1403   memory-should-contain [
1404     10 <- 0
1405     11 <- 1  # error
1406   ]
1407 ]
1408 
1409 scenario character-code-to-digit-handles-codes-larger-than-nine [
1410   local-scope
1411   a:number <- copy 58
1412   run [
1413     10:number/raw, 11:boolean/raw <- character-code-to-digit a
1414   ]
1415   memory-should-contain [
1416     10 <- 0
1417     11 <- 1  # error
1418   ]
1419 ]