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