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