//: Go from an address to the payload it points at using /lookup.
//:
//: The tests in this layer use unsafe operations so as to stay decoupled from
//: 'new'.

void test_copy_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:num
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 94\n"
      // Treat locations 10 and 11 as an address to look up, pointing at the
      // payload in locations 20 and 21.
      "  30:num <- copy 10:&:num/lookup\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 94 in location 30\n"
  );
}

:(before "End Preprocess read_memory(x)")
canonize(x);

//: similarly, write to addresses pointing at other locations using the
//: 'lookup' property
:(code)
void test_store_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:num
      "  11:num <- copy 10\n"
      "  10:&:num/lookup <- copy 94\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 94 in location 11\n"
  );
}

:(before "End Preprocess write_memory(x, data)")
canonize(x);

//: writes to address 0 always loudly fail
:(code)
void test_store_to_0_fails() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  10:&:num <- copy null\n"
      "  10:&:num/lookup <- copy 94\n"
      "]\n"
  );
  CHECK_TRACE_DOESNT_CONTAIN("mem: storing 94 in location 0");
  CHECK_TRACE_CONTENTS(
      "error: main: tried to lookup 0 in '10:&:num/lookup <- copy 94'\n"
  );
}

//: attempts to /lookup address 0 always loudly fail
void test_lookup_0_fails() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  10:&:num <- copy null\n"
      "  20:num <- copy 10:&:num/lookup\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "error: main: tried to lookup 0 in '20:num <- copy 10:&:num/lookup'\n"
  );
}

void test_lookup_0_dumps_callstack() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  foo null\n"
      "]\n"
      "def foo [\n"
      "  10:&:num <- next-input\n"
      "  20:num <- copy 10:&:num/lookup\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "error: foo: tried to lookup 0 in '20:num <- copy 10:&:num/lookup'\n"
      "error:   called from main: foo null\n"
  );
}

void canonize(reagent& x) {
  if (is_literal(x)) return;
  // Begin canonize(x) Lookups
  while (has_property(x, "lookup"))
    lookup_memory(x);
}

void lookup_memory(reagent& x) {
  if (!x.type || x.type->atom || x.type->left->value != Address_type_ordinal) {
    raise << maybe(current_recipe_name()) << "tried to lookup '" << x.original_string << "' but it isn't an address\n" << end();
    dump_callstack();
    return;
  }
  // compute value
  if (x.value == 0) {
    raise << maybe(current_recipe_name()) << "tried to lookup 0\n" << end();
    dump_callstack();
    return;
  }
  lookup_memory_core(x, /*check_for_null*/true);
}

void lookup_memory_core(reagent& x, bool check_for_null) {
  double address = x.value + /*skip alloc id in address*/1;
  double new_value = get_or_insert(Memory, address);
  trace(Callstack_depth+1, "mem") << "location " << address << " contains " << no_scientific(new_value) << end();
  // check for null
  if (check_for_null && new_value == 0) {
    if (Current_routine) {
      raise << maybe(current_recipe_name()) << "tried to lookup 0 in '" << to_original_string(current_instruction()) << "'\n" << end();
      dump_callstack();
    }
    else {
      raise << "tried to lookup 0\n" << end();
    }
  }
  // validate alloc-id
  double alloc_id_in_address = get_or_insert(Memory, x.value);
  double alloc_id_in_payload = get_or_insert(Memory, new_value);
//?   cerr << x.value << ": " << alloc_id_in_address << " vs " << new_value << ": " << alloc_id_in_payload << '\n';
  if (alloc_id_in_address != alloc_id_in_payload) {
      raise << maybe(current_recipe_name()) << "address is already abandoned in '" << to_original_string(current_instruction()) << "'\n" << end();
      dump_callstack();
  }
  // all well; complete the lookup
  x.set_value(new_value+/*skip alloc id in payload*/1);
  drop_from_type(x, "address");
  drop_one_lookup(x);
}

:(after "Begin types_coercible(reagent to, reagent from)")
if (!canonize_type(to)) return false;
if (!canonize_type(from)) return false;
:(after "Begin types_match(reagent to, reagent from)")
if (!canonize_type(to)) return false;
if (!canonize_type(from)) return false;
:(after "Begin types_strictly_match(reagent to, reagent from)")
if (!canonize_type(to)) return false;
if (!canonize_type(from)) return false;

:(before "End Preprocess is_mu_array(reagent r)")
if (!canonize_type(r)) return false;

:(before "End Preprocess is_mu_address(reagent r)")
if (!canonize_type(r)) return false;

:(before "End Preprocess is_mu_number(reagent r)")
if (!canonize_type(r)) return false;
:(before "End Preprocess is_mu_boolean(reagent r)")
if (!canonize_type(r)) return false;
:(before "End Preprocess is_mu_character(reagent r)")
if (!canonize_type(r)) return false;

:(after "Update product While Type-checking Merge")
if (!canonize_type(product)) continue;

:(before "End Compute Call Ingredient")
canonize_type(ingredient);
:(before "End Preprocess NEXT_INGREDIENT product")
canonize_type(product);
:(before "End Check RETURN Copy(lhs, rhs)
canonize_type(lhs);
canonize_type(rhs);

:(code)
bool canonize_type(reagent& r) {
  while (has_property(r, "lookup")) {
    if (!r.type || r.type->atom || !r.type->left || !r.type->left->atom || r.type->left->value != Address_type_ordinal) {
      raise << "cannot perform lookup on '" << r.name << "' because it has non-address type " << to_string(r.type) << '\n' << end();
      return false;
    }
    drop_from_type(r, "address");
    drop_one_lookup(r);
  }
  return true;
}

void drop_one_lookup(reagent& r) {
  for (vector<pair<string, string_tree*> >::iterator p = r.properties.begin();  p != r.properties.end();  ++p) {
    if (p->first == "lookup") {
      r.properties.erase(p);
      return;
    }
  }
  assert(false);
}

//: Tedious fixup to support addresses in container/array instructions of previous layers.
//: Most instructions don't require fixup if they use the 'ingredients' and
//: 'products' variables in run_current_routine().

void test_get_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:point
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 94\n"
      "  22:num <- copy 95\n"
      "  30:num <- get 10:&:point/lookup, 0:offset\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 94 in location 30\n"
  );
}

void test_get_indirect2() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:point
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 94\n"
      "  22:num <- copy 95\n"
      // skip alloc id for destination
      "  31:num <- copy 40\n"
      "  30:&:num/lookup <- get 10:&:point/lookup, 0:offset\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 94 in location 41\n"
  );
}

void test_include_nonlookup_properties() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:point
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 94\n"
      "  22:num <- copy 95\n"
      "  30:num <- get 10:&:point/lookup/foo, 0:offset\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 94 in location 30\n"
  );
}

:(after "Update GET base in Check")
if (!canonize_type(base)) break;
:(after "Update GET product in Check")
if (!canonize_type(product)) break;
:(after "Update GET base in Run")
canonize(base);

:(code)
void test_put_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:point
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 94\n"
      "  22:num <- copy 95\n"
      "  10:&:point/lookup <- put 10:&:point/lookup, 0:offset, 96\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 96 in location 21\n"
  );
}

:(after "Update PUT base in Check")
if (!canonize_type(base)) break;
:(after "Update PUT offset in Check")
if (!canonize_type(offset)) break;
:(after "Update PUT base in Run")
canonize(base);

:(code)
void test_put_product_error_with_lookup() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  11:num <- copy 20\n"
      "  21:num <- copy 94\n"
      "  22:num <- copy 95\n"
      "  10:&:point <- put 10:&:point/lookup, x:offset, 96\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "error: main: product of 'put' must be first ingredient '10:&:point/lookup', but got '10:&:point'\n"
  );
}

:(before "End PUT Product Checks")
reagent/*copy*/ p = inst.products.at(0);
if (!canonize_type(p)) break;  // error raised elsewhere
reagent/*copy*/ i = inst.ingredients.at(0);
if (!canonize_type(i)) break;  // error raised elsewhere
if (!types_strictly_match(p, i)) {
  raise << maybe(get(Recipe, r).name) << "product of 'put' must be first ingredient '" << inst.ingredients.at(0).original_string << "', but got '" << inst.products.at(0).original_string << "'\n" << end();
  break;
}

:(code)
void test_new_error() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  1:num/raw <- new num:type\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "error: main: product of 'new' has incorrect type: '1:num/raw <- new num:type'\n"
  );
}

:(after "Update NEW product in Check")
canonize_type(product);

:(code)
void test_copy_array_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:@:num
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 3\n"  // array length
      "  22:num <- copy 94\n"
      "  23:num <- copy 95\n"
      "  24:num <- copy 96\n"
      "  30:@:num <- copy 10:&:@:num/lookup\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 3 in location 30\n"
      "mem: storing 94 in location 31\n"
      "mem: storing 95 in location 32\n"
      "mem: storing 96 in location 33\n"
  );
}

void test_create_array_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:@:num:3
      "  11:num <- copy 3000\n"
      "  10:&:array:num:3/lookup <- create-array\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 3 in location 3001\n"
  );
}

:(after "Update CREATE_ARRAY product in Check")
if (!canonize_type(product)) break;
:(after "Update CREATE_ARRAY product in Run")
canonize(product);

:(code)
void test_index_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:@:num
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 3\n"  // array length
      "  22:num <- copy 94\n"
      "  23:num <- copy 95\n"
      "  24:num <- copy 96\n"
      "  30:num <- index 10:&:@:num/lookup, 1\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 95 in location 30\n"
  );
}

:(before "Update INDEX base in Check")
if (!canonize_type(base)) break;
:(before "Update INDEX index in Check")
if (!canonize_type(index)) break;
:(before "Update INDEX product in Check")
if (!canonize_type(product)) break;

:(before "Update INDEX base in Run")
canonize(base);
:(before "Update INDEX index in Run")
canonize(index);

:(code)
void test_put_index_indirect() {
  run(
      "def main [\n"
      // skip alloc id for 10:&:@:num
      "  11:num <- copy 20\n"
      // skip alloc id for payload
      "  21:num <- copy 3\n"  // array length
      "  22:num <- copy 94\n"
      "  23:num <- copy 95\n"
      "  24:num <- copy 96\n"
      "  10:&:@:num/lookup <- put-index 10:&:@:num/lookup, 1, 97\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 97 in location 23\n"
  );
}

void test_put_index_indirect_2() {
  run(
      "def main [\n"
      "  10:num <- copy 3\n"  // array length
      "  11:num <- copy 94\n"
      "  12:num <- copy 95\n"
      "  13:num <- copy 96\n"
      // skip alloc id for address
      "  21:num <- copy 30\n"
      // skip alloc id for payload
      "  31:num <- copy 1\n"  // index
      "  10:@:num <- put-index 10:@:num, 20:&:num/lookup, 97\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "mem: storing 97 in location 12\n"
  );
}

void test_put_index_product_error_with_lookup() {
  Hide_errors = true;
  run(
      "def main [\n"
      "  11:num <- copy 20\n"
      "  21:num <- copy 3\n"  // array length
      "  22:num <- copy 94\n"
      "  23:num <- copy 95\n"
      "  24:num <- copy 96\n"
      "  10:&:@:num <- put-index 10:&:@:num/lookup, 1, 34\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "error: main: product of 'put-index' must be first ingredient '10:&:@:num/lookup', but got '10:&:@:num'\n"
  );
}

:(before "End PUT_INDEX Product Checks")
reagent/*copy*/ p = inst.products.at(0);
if (!canonize_type(p)) break;  // error raised elsewhere
reagent/*copy*/ i = inst.ingredients.at(0);
if (!canonize_type(i)) break;  // error raised elsewhere
if (!types_strictly_match(p, i)) {
  raise << maybe(get(Recipe, r).name) << "product of 'put-index' must be first ingredient '" << inst.ingredients.at(0).original_string << "', but got '" << inst.products.at(0).original_string << "'\n" << end();
  break;
}

:(code)
void test_dilated_reagent_in_static_array() {
  run(
      "def main [\n"
      "  {1: (array (& num) 3)} <- create-array\n"
      "  10:&:num <- new num:type\n"
      "  {1: (array (& num) 3)} <- put-index {1: (array (& num) 3)}, 0, 10:&:num\n"
      "  *10:&:num <- copy 94\n"
      "  20:num <- copy *10:&:num\n"
      "]\n"
  );
  CHECK_TRACE_CONTENTS(
      "run: creating array from 7 locations\n"
      "mem: storing 94 in location 20\n"
  );
}

:(before "Update PUT_INDEX base in Check")
if (!canonize_type(base)) break;
:(before "Update PUT_INDEX index in Check")
if (!canonize_type(index)) break;
:(before "Update PUT_INDEX value in Check")
if (!canonize_type(value)) break;

:(before "Update PUT_INDEX base in Run")
canonize(base);
:(before "Up<style>pre { line-height: 125%; }
td.linenos .normal { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
span.linenos { color: inherit; background-color: transparent; padding-left: 5px; padding-right: 5px; }
td.linenos .special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
span.linenos.special { color: #000000; background-color: #ffffc0; padding-left: 5px; padding-right: 5px; }
.highlight .hll { background-color: #ffffcc }
.highlight .c { color: #888888 } /* Comment */
.highlight .err { color: #a61717; background-color: #e3d2d2 } /* Error */
.highlight .k { color: #008800; font-weight: bold } /* Keyword */
.highlight .ch { color: #888888 } /* Comment.Hashbang */
.highlight .cm { color: #888888 } /* Comment.Multiline */
.highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */
.highlight .cpf { color: #888888 } /* Comment.PreprocFile */
.highlight .c1 { color: #888888 } /* Comment.Single */
.highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */
.highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */
.highlight .ge { font-style: italic } /* Generic.Emph */
.highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */
.highlight .gr { color: #aa0000 } /* Generic.Error */
.highlight .gh { color: #333333 } /* Generic.Heading */
.highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */
.highlight .go { color: #888888 } /* Generic.Output */
.highlight .gp { color: #555555 } /* Generic.Prompt */
.highlight .gs { font-weight: bold } /* Generic.Strong */
.highlight .gu { color: #666666 } /* Generic.Subheading */
.highlight .gt { color: #aa0000 } /* Generic.Traceback */
.highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */
.highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */
.highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */
.highlight .kp { color: #008800 } /* Keyword.Pseudo */
.highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */
.highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */
.highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */
.highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */
.highlight .na { color: #336699 } /* Name.Attribute */
.highlight .nb { color: #003388 } /* Name.Builtin */
.highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */
.highlight .no { color: #003366; font-weight: bold } /* Name.Constant */
.highlight .nd { color: #555555 } /* Name.Decorator */
.highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */
.highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */
.highlight .nl { color: #336699; font-style: italic } /* Name.Label */
.highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */
.highlight .py { color: #336699; font-weight: bold } /* Name.Property */
.highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */
.highlight .nv { color: #336699 } /* Name.Variable */
.highlight .ow { color: #008800 } /* Operator.Word */
.highlight .w { color: #bbbbbb } /* Text.Whitespace */
.highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */
.highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */
.highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */
.highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */
.highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */
.highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */
.highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */
.highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */
.highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */
.highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */
.highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */
.highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */
.highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */
.highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */
.highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */
.highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */
.highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */
.highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */
.highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */
.highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */
.highlight .vc { colo