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