https://github.com/akkartik/mu/blob/master/061text.mu

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