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