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   reply-if address-equal?, 1/true
   9   reply-unless a, 0/false
  10   reply-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 # todo: make this shape-shifting.
 127 container buffer [
 128   length:num
 129   data:text
 130 ]
 131 
 132 def new-buffer capacity:num -> result:&:buffer [
 133   local-scope
 134   load-ingredients
 135   result <- new buffer:type
 136   *result <- put *result, length:offset, 0
 137   {
 138     break-if capacity
 139     # capacity not provided
 140     capacity <- copy 10
 141   }
 142   data:text <- new character:type, capacity
 143   *result <- put *result, data:offset, data
 144   return result
 145 ]
 146 
 147 def grow-buffer buf:&:buffer -> buf:&:buffer [
 148   local-scope
 149   load-ingredients
 150   # double buffer size
 151   olddata:text <- get *buf, data:offset
 152   oldlen:num <- length *olddata
 153   newlen:num <- multiply oldlen, 2
 154   newdata:text <- new character:type, newlen
 155   *buf <- put *buf, data:offset, newdata
 156   # copy old contents
 157   i:num <- copy 0
 158   {
 159     done?:bool <- greater-or-equal i, oldlen
 160     break-if done?
 161     src:char <- index *olddata, i
 162     *newdata <- put-index *newdata, i, src
 163     i <- add i, 1
 164     loop
 165   }
 166 ]
 167 
 168 def buffer-full? in:&:buffer -> result:bool [
 169   local-scope
 170   load-ingredients
 171   len:num <- get *in, length:offset
 172   s:text <- get *in, data:offset
 173   capacity:num <- length *s
 174   result <- greater-or-equal len, capacity
 175 ]
 176 
 177 # most broadly applicable definition of append to a buffer: just call to-text
 178 def append buf:&:buffer, x:_elem -> buf:&:buffer [
 179   local-scope
 180   load-ingredients
 181   text:text <- to-text x
 182   len:num <- length *text
 183   i:num <- copy 0
 184   {
 185     done?:bool <- greater-or-equal i, len
 186     break-if done?
 187     c:char <- index *text, i
 188     buf <- append buf, c
 189     i <- add i, 1
 190     loop
 191   }
 192 ]
 193 
 194 def append buf:&:buffer, c:char -> buf:&:buffer [
 195   local-scope
 196   load-ingredients
 197   len:num <- get *buf, length:offset
 198   {
 199     # backspace? just drop last character if it exists and return
 200     backspace?:bool <- equal c, 8/backspace
 201     break-unless backspace?
 202     empty?:bool <- lesser-or-equal len, 0
 203     return-if empty?
 204     len <- subtract len, 1
 205     *buf <- put *buf, length:offset, len
 206     return
 207   }
 208   {
 209     # grow buffer if necessary
 210     full?:bool <- buffer-full? buf
 211     break-unless full?
 212     buf <- grow-buffer buf
 213   }
 214   s:text <- get *buf, data:offset
 215   *s <- put-index *s, len, c
 216   len <- add len, 1
 217   *buf <- put *buf, length:offset, len
 218 ]
 219 
 220 def append buf:&:buffer, t:text -> buf:&:buffer [
 221   local-scope
 222   load-ingredients
 223   len:num <- length *t
 224   i:num <- copy 0
 225   {
 226     done?:bool <- greater-or-equal i, len
 227     break-if done?
 228     c:char <- index *t, i
 229     buf <- append buf, c
 230     i <- add i, 1
 231     loop
 232   }
 233 ]
 234 
 235 scenario append-to-empty-buffer [
 236   local-scope
 237   x:&:buffer <- new-buffer
 238   run [
 239     c:char <- copy 97/a
 240     x <- append x, c
 241     10:num/raw <- get *x, length:offset
 242     s:text <- get *x, data:offset
 243     11:char/raw <- index *s, 0
 244     12:char/raw <- index *s, 1
 245   ]
 246   memory-should-contain [
 247     10 <- 1  # buffer length
 248     11 <- 97  # a
 249     12 <- 0  # rest of buffer is empty
 250   ]
 251 ]
 252 
 253 scenario append-to-buffer [
 254   local-scope
 255   x:&:buffer <- new-buffer
 256   c:char <- copy 97/a
 257   x <- append x, c
 258   run [
 259     c <- copy 98/b
 260     x <- append x, c
 261     10:num/raw <- get *x, length:offset
 262     s:text <- get *x, data:offset
 263     11:char/raw <- index *s, 0
 264     12:char/raw <- index *s, 1
 265     13:char/raw <- index *s, 2
 266   ]
 267   memory-should-contain [
 268     10 <- 2  # buffer length
 269     11 <- 97  # a
 270     12 <- 98  # b
 271     13 <- 0  # rest of buffer is empty
 272   ]
 273 ]
 274 
 275 scenario append-grows-buffer [
 276   local-scope
 277   x:&:buffer <- new-buffer 3
 278   s1:text <- get *x, data:offset
 279   x <- append x, [abc]  # buffer is now full
 280   s2:text <- get *x, data:offset
 281   run [
 282     10:bool/raw <- equal s1, s2
 283     11:@:char/raw <- copy *s2
 284     +buffer-filled
 285     c:char <- copy 100/d
 286     x <- append x, c
 287     s3:text <- get *x, data:offset
 288     20:bool/raw <- equal s1, s3
 289     21:num/raw <- get *x, length:offset
 290     30:@:char/raw <- copy *s3
 291   ]
 292   memory-should-contain [
 293     # before +buffer-filled
 294     10 <- 1   # no change in data pointer after original append
 295     11 <- 3   # size of data
 296     12 <- 97  # data
 297     13 <- 98
 298     14 <- 99
 299     # in the end
 300     20 <- 0   # data pointer has grown after second append
 301     21 <- 4   # final length
 302     30 <- 6   # but data's capacity has doubled
 303     31 <- 97  # data
 304     32 <- 98
 305     33 <- 99
 306     34 <- 100
 307     35 <- 0
 308     36 <- 0
 309   ]
 310 ]
 311 
 312 scenario buffer-append-handles-backspace [
 313   local-scope
 314   x:&:buffer <- new-buffer
 315   x <- append x, [ab]
 316   run [
 317     c:char <- copy 8/backspace
 318     x <- append x, c
 319     s:text <- buffer-to-array x
 320     10:@:char/raw <- copy *s
 321   ]
 322   memory-should-contain [
 323     10 <- 1   # length
 324     11 <- 97  # contents
 325     12 <- 0
 326   ]
 327 ]
 328 
 329 def buffer-to-array in:&:buffer -> result:text [
 330   local-scope
 331   load-ingredients
 332   {
 333     # propagate null buffer
 334     break-if in
 335     return 0
 336   }
 337   len:num <- get *in, length:offset
 338   s:text <- get *in, data:offset
 339   # we can't just return s because it is usually the wrong length
 340   result <- new character:type, len
 341   i:num <- copy 0
 342   {
 343     done?:bool <- greater-or-equal i, len
 344     break-if done?
 345     src:char <- index *s, i
 346     *result <- put-index *result, i, src
 347     i <- add i, 1
 348     loop
 349   }
 350 ]
 351 
 352 # Append any number of texts together.
 353 # A later layer also translates calls to this to implicitly call to-text, so
 354 # append to string becomes effectively dynamically typed.
 355 #
 356 # Beware though: this hack restricts how much 'append' can be overridden. Any
 357 # new variants that match:
 358 #   append _:text, ___
 359 # will never ever get used.
 360 def append first:text -> result:text [
 361   local-scope
 362   load-ingredients
 363   buf:&:buffer <- new-buffer 30
 364   # append first ingredient
 365   {
 366     break-unless first
 367     buf <- append buf, first
 368   }
 369   # append remaining ingredients
 370   {
 371     arg:text, arg-found?:bool <- next-ingredient
 372     break-unless arg-found?
 373     loop-unless arg
 374     buf <- append buf, arg
 375     loop
 376   }
 377   result <- buffer-to-array buf
 378 ]
 379 
 380 scenario text-append-1 [
 381   local-scope
 382   x:text <- new [hello,]
 383   y:text <- new [ world!]
 384   run [
 385     z:text <- append x, y
 386     10:@:char/raw <- copy *z
 387   ]
 388   memory-should-contain [
 389     10:array:character <- [hello, world!]
 390   ]
 391 ]
 392 
 393 scenario text-append-null [
 394   local-scope
 395   x:text <- copy 0
 396   y:text <- new [ world!]
 397   run [
 398     z:text <- append x, y
 399     10:@:char/raw <- copy *z
 400   ]
 401   memory-should-contain [
 402     10:array:character <- [ world!]
 403   ]
 404 ]
 405 
 406 scenario text-append-null-2 [
 407   local-scope
 408   x:text <- new [hello,]
 409   y:text <- copy 0
 410   run [
 411     z:text <- append x, y
 412     10:@:char/raw <- copy *z
 413   ]
 414   memory-should-contain [
 415     10:array:character <- [hello,]
 416   ]
 417 ]
 418 
 419 scenario text-append-multiary [
 420   local-scope
 421   x:text <- new [hello, ]
 422   y:text <- new [world]
 423   z:text <- new [!]
 424   run [
 425     z:text <- append x, y, z
 426     10:@:char/raw <- copy *z
 427   ]
 428   memory-should-contain [
 429     10:array:character <- [hello, world!]
 430   ]
 431 ]
 432 
 433 scenario replace-character-in-text [
 434   local-scope
 435   x:text <- new [abc]
 436   run [
 437     x <- replace x, 98/b, 122/z
 438     10:@:char/raw <- copy *x
 439   ]
 440   memory-should-contain [
 441     10:array:character <- [azc]
 442   ]
 443 ]
 444 
 445 def replace s:text, oldc:char, newc:char, from:num/optional -> s:text [
 446   local-scope
 447   load-ingredients
 448   len:num <- length *s
 449   i:num <- find-next s, oldc, from
 450   done?:bool <- greater-or-equal i, len
 451   return-if done?
 452   *s <- put-index *s, i, newc
 453   i <- add i, 1
 454   s <- replace s, oldc, newc, i
 455 ]
 456 
 457 scenario replace-character-at-start [
 458   local-scope
 459   x:text <- new [abc]
 460   run [
 461     x <- replace x, 97/a, 122/z
 462     10:@:char/raw <- copy *x
 463   ]
 464   memory-should-contain [
 465     10:array:character <- [zbc]
 466   ]
 467 ]
 468 
 469 scenario replace-character-at-end [
 470   local-scope
 471   x:text <- new [abc]
 472   run [
 473     x <- replace x, 99/c, 122/z
 474     10:@:char/raw <- copy *x
 475   ]
 476   memory-should-contain [
 477     10:array:character <- [abz]
 478   ]
 479 ]
 480 
 481 scenario replace-character-missing [
 482   local-scope
 483   x:text <- new [abc]
 484   run [
 485     x <- replace x, 100/d, 122/z
 486     10:@:char/raw <- copy *x
 487   ]
 488   memory-should-contain [
 489     10:array:characte
# Some useful helpers for dealing with text (arrays of characters)

def equal a:text, b:text -> result:bool [
  local-scope
  load-inputs
  an:num, bn:num <- deaddress a, b
  address-equal?:boolean <- equal an, bn
  return-if address-equal?, true
  return-unless a, false
  return-unless b, false
  a-len:num <- length *a
  b-len:num <- length *b
  # compare lengths
  trace 99, [text-equal], [comparing lengths]
  length-equal?:bool <- equal a-len, b-len
  return-unless length-equal?, false
  # compare each corresponding character
  trace 99, [text-equal], [comparing characters]
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, a-len
    break-if done?
    a2:char <- index *a, i
    b2:char <- index *b, i
    chars-match?:bool <- equal a2, b2
    return-unless chars-match?, false
    i <- add i, 1
    loop
  }
  return true
]

scenario text-equal-reflexive [
  local-scope
  x:text <- new [abc]
  run [
    10:bool/raw <- equal x, x
  ]
  memory-should-contain [
    10 <- 1  # x == x for all x
  ]
]

scenario text-equal-identical [
  local-scope
  x:text <- new [abc]
  y:text <- new [abc]
  run [
    10:bool/raw <- equal x, y
  ]
  memory-should-contain [
    10 <- 1  # abc == abc
  ]
]

scenario text-equal-distinct-lengths [
  local-scope
  x:text <- new [abc]
  y:text <- new [abcd]
  run [
    10:bool/raw <- equal x, y
  ]
  memory-should-contain [
    10 <- 0  # abc != abcd
  ]
  trace-should-contain [
    text-equal: comparing lengths
  ]
  trace-should-not-contain [
    text-equal: comparing characters
  ]
]

scenario text-equal-with-empty [
  local-scope
  x:text <- new []
  y:text <- new [abcd]
  run [
    10:bool/raw <- equal x, y
  ]
  memory-should-contain [
    10 <- 0  # "" != abcd
  ]
]

scenario text-equal-with-null [
  local-scope
  x:text <- new [abcd]
  y:text <- copy null
  run [
    10:bool/raw <- equal x, null
    11:bool/raw <- equal null, x
    12:bool/raw <- equal x, y
    13:bool/raw <- equal y, x
    14:bool/raw <- equal y, y
  ]
  memory-should-contain [
    10 <- 0
    11 <- 0
    12 <- 0
    13 <- 0
    14 <- 1
  ]
  check-trace-count-for-label 0, [error]
]

scenario text-equal-common-lengths-but-distinct [
  local-scope
  x:text <- new [abc]
  y:text <- new [abd]
  run [
    10:bool/raw <- equal x, y
  ]
  memory-should-contain [
    10 <- 0  # abc != abd
  ]
]

# A new type to help incrementally construct texts.
container buffer:_elem [
  length:num
  data:&:@:_elem
]

def new-buffer capacity:num -> result:&:buffer:_elem [
  local-scope
  load-inputs
  result <- new {(buffer _elem): type}
  *result <- put *result, length:offset, 0
  {
    break-if capacity
    # capacity not provided
    capacity <- copy 10
  }
  data:&:@:_elem <- new _elem:type, capacity
  *result <- put *result, data:offset, data
  return result
]

def grow-buffer buf:&:buffer:_elem -> buf:&:buffer:_elem [
  local-scope
  load-inputs
  # double buffer size
  olddata:&:@:_elem <- get *buf, data:offset
  oldlen:num <- length *olddata
  newlen:num <- multiply oldlen, 2
  newdata:&:@:_elem <- new _elem:type, newlen
  *buf <- put *buf, data:offset, newdata
  # copy old contents
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, oldlen
    break-if done?
    src:_elem <- index *olddata, i
    *newdata <- put-index *newdata, i, src
    i <- add i, 1
    loop
  }
]

def buffer-full? in:&:buffer:_elem -> result:bool [
  local-scope
  load-inputs
  len:num <- get *in, length:offset
  s:&:@:_elem <- get *in, data:offset
  capacity:num <- length *s
  result <- greater-or-equal len, capacity
]

# most broadly applicable definition of append to a buffer
def append buf:&:buffer:_elem, x:_elem -> buf:&:buffer:_elem [
  local-scope
  load-inputs
  len:num <- get *buf, length:offset
  {
    # grow buffer if necessary
    full?:bool <- buffer-full? buf
    break-unless full?
    buf <- grow-buffer buf
  }
  s:&:@:_elem <- get *buf, data:offset
  *s <- put-index *s, len, x
  len <- add len, 1
  *buf <- put *buf, length:offset, len
]

# most broadly applicable definition of append to a buffer of characters: just
# call to-text
def append buf:&:buffer:char, x:_elem -> buf:&:buffer:char [
  local-scope
  load-inputs
  text:text <- to-text x
  buf <- append buf, text
]

# specialization for characters that is backspace-aware
def append buf:&:buffer:char, c:char -> buf:&:buffer:char [
  local-scope
  load-inputs
  len:num <- get *buf, length:offset
  {
    # backspace? just drop last character if it exists and return
    backspace?:bool <- equal c, 8/backspace
    break-unless backspace?
    empty?:bool <- lesser-or-equal len, 0
    return-if empty?
    len <- subtract len, 1
    *buf <- put *buf, length:offset, len
    return
  }
  {
    # grow buffer if necessary
    full?:bool <- buffer-full? buf
    break-unless full?
    buf <- grow-buffer buf
  }
  s:text <- get *buf, data:offset
  *s <- put-index *s, len, c
  len <- add len, 1
  *buf <- put *buf, length:offset, len
]

def append buf:&:buffer:_elem, t:&:@:_elem -> buf:&:buffer:_elem [
  local-scope
  load-inputs
  len:num <- length *t
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    x:_elem <- index *t, i
    buf <- append buf, x
    i <- add i, 1
    loop
  }
]

scenario append-to-empty-buffer [
  local-scope
  x:&:buffer:char <- new-buffer
  run [
    c:char <- copy 97/a
    x <- append x, c
    10:num/raw <- get *x, length:offset
    s:text <- get *x, data:offset
    11:char/raw <- index *s, 0
    12:char/raw <- index *s, 1
  ]
  memory-should-contain [
    10 <- 1  # buffer length
    11 <- 97  # a
    12 <- 0  # rest of buffer is empty
  ]
]

scenario append-to-buffer [
  local-scope
  x:&:buffer:char <- new-buffer
  c:char <- copy 97/a
  x <- append x, c
  run [
    c <- copy 98/b
    x <- append x, c
    10:num/raw <- get *x, length:offset
    s:text <- get *x, data:offset
    11:char/raw <- index *s, 0
    12:char/raw <- index *s, 1
    13:char/raw <- index *s, 2
  ]
  memory-should-contain [
    10 <- 2  # buffer length
    11 <- 97  # a
    12 <- 98  # b
    13 <- 0  # rest of buffer is empty
  ]
]

scenario append-grows-buffer [
  local-scope
  x:&:buffer:char <- new-buffer 3
  s1:text <- get *x, data:offset
  x <- append x, [abc]  # buffer is now full
  s2:text <- get *x, data:offset
  run [
    10:bool/raw <- equal s1, s2
    11:@:char/raw <- copy *s2
    +buffer-filled
    c:char <- copy 100/d
    x <- append x, c
    s3:text <- get *x, data:offset
    20:bool/raw <- equal s1, s3
    21:num/raw <- get *x, length:offset
    30:@:char/raw <- copy *s3
  ]
  memory-should-contain [
    # before +buffer-filled
    10 <- 1   # no change in data pointer after original append
    11 <- 3   # size of data
    12 <- 97  # data
    13 <- 98
    14 <- 99
    # in the end
    20 <- 0   # data pointer has grown after second append
    21 <- 4   # final length
    30 <- 6   # but data's capacity has doubled
    31 <- 97  # data
    32 <- 98
    33 <- 99
    34 <- 100
    35 <- 0
    36 <- 0
  ]
]

scenario buffer-append-handles-backspace [
  local-scope
  x:&:buffer:char <- new-buffer
  x <- append x, [ab]
  run [
    c:char <- copy 8/backspace
    x <- append x, c
    s:text <- buffer-to-array x
    10:@:char/raw <- copy *s
  ]
  memory-should-contain [
    10 <- 1   # length
    11 <- 97  # contents
    12 <- 0
  ]
]

scenario append-to-buffer-of-non-characters [
  local-scope
  x:&:buffer:text <- new-buffer 1/capacity
  # no errors
]

def buffer-to-array in:&:buffer:_elem -> result:&:@:_elem [
  local-scope
  load-inputs
  # propagate null buffer
  return-unless in, null
  len:num <- get *in, length:offset
  s:&:@:_elem <- get *in, data:offset
  # we can't just return s because it is usually the wrong length
  result <- new _elem:type, len
  i:num <- copy 0
  {
    done?:bool <- greater-or-equal i, len
    break-if done?
    src:_elem <- index *s, i
    *result <- put-index *result, i, src
    i <- add i, 1
    loop
  }
]

def blank? x:&:@:_elem -> result:bool [
  local-scope
  load-inputs
  return-unless x, true
  len:num <- length *x
  result <- equal len, 0
]

# Append any number of texts together.
# A later layer also translates calls to this to implicitly call to-text, so
# append to string becomes effectively dynamically typed.
#
# Beware though: this hack restricts how much 'append' can be overridden. Any
# new variants that match:
#   append _:text, ___
# will never ever get used.
def append first:text -> result:text [