# 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 thou
//: Reclaiming memory when it's no longer used.

void test_new_reclaim() {
  run(
      "def main [\n"
      "  10:&:num <- new number:type\n"
      "  20:num <- deaddress 10:&:num\n"
      "  abandon 10:&:num\n"
      "  30:&:num <- new number:type\n"  // must be same size as abandoned memory to reuse
      "  40:num <- deaddress 30:&:num\n"
      "  50:bool <- equal 20:num, 40:num\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      // both allocations should have returned the same address
      "mem: storing 1 in location 50\n"
  );
}

//: When abandoning addresses we'll save them to a 'free list', segregated by size.

//: Before, suppose variable V contains address A which points to payload P:
//:   location V contains an alloc-id N
//:   location V+1 contains A
//:   location A contains alloc-id N
//:   location A+1 onwards contains P
//: Additionally, suppose the head of the free list is initially F.
//: After abandoning:
//:   location V contains invalid alloc-id -1
//:   location V+1 contains 0
//:   location A contains invalid alloc-id N
//:   location A+1 contains the previous head of free-list F

:(before "End routine Fields")
map<int, int> free_list;

:(before "End Primitive Recipe Declarations")
ABANDON,
:(before "End Primitive Recipe Numbers")
put(Recipe_ordinal, "abandon", ABANDON);
:(before "End Primitive Recipe Checks")
case ABANDON: {
  if (!inst.products.empty()) {
    raise << maybe(get(Recipe, r).name) << "'abandon' shouldn't write to any products in '" << to_original_string(inst) << "'\n" << end();
    break;
  }
  for (int i = 0;  i < SIZE(inst.ingredients);  ++i) {
    if (!is_mu_address(inst.ingredients.at(i)))
      raise << maybe(get(Recipe, r).name) << "ingredients of 'abandon' should be addresses, but ingredient " << i << " is '" << to_string(inst.ingredients.at(i)) << '\n' << end();
    break;
  }
  break;
}
:(before "End Primitive Recipe Implementations")
case ABANDON: {
  for (int i = 0;  i < SIZE(current_instruction().ingredients);  ++i) {
    reagent/*copy*/ ingredient = current_instruction().ingredients.at(i);
    canonize(ingredient);
    abandon(get_or_insert(Memory, ingredient.value+/*skip alloc id*/1), payload_size(ingredient));
//?     cerr << "clear after abandon: " << ingredient.value << '\n';
    put(Memory, /*alloc id*/ingredient.value, /*invalid*/-1);
    put(Memory, /*address*/ingredient.value+1, 0);
  }
  break;
}

:(code)
void abandon(int address, int payload_size) {
  put(Memory, address, /*invalid alloc-id*/-1);
//?   cerr << "abandon: " << address << '\n';
  // clear rest of payload
  for (int curr = address+1;  curr < address+payload_size;  ++curr)
    put(Memory, curr, 0);
  // append existing free list to address
  trace(Callstack_depth+1, "abandon") << "saving " << address << " in free-list of size " << payload_size << end();
  put(Memory, address+/*skip invalid alloc-id*/1, get_or_insert(Current_routine->free_list, payload_size));
  put(Current_routine->free_list, payload_size, address);
}

int payload_size(reagent/*copy*/ x) {
  x.properties.push_back(pair<string, string_tree*>("lookup", NULL));
  lookup_memory_core(x, /*check_for_null*/false);