//: So far we've been calling a fixed recipe in each instruction, but we'd //: also like to make the recipe a variable, pass recipes to "higher-order" //: recipes, return recipes from recipes and so on. void test_call_literal_recipe() { run( "def main [\n" " 1:num <- call f, 34\n" "]\n" "def f x:num -> y:num [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } :(before "End Mu Types Initialization") put(Type_ordinal, "recipe-literal", 0); // 'recipe' variables can store recipe-literal type_ordinal recipe = put(Type_ordinal, "recipe", Next_type_ordinal++); get_or_insert(Type, recipe).name = "recipe"; :(after "Deduce Missing Type(x, caller)") if (!x.type) try_initialize_recipe_literal(x, caller); :(before "Type Check in Type-ingredient-aware check_or_set_types_by_name") if (!x.type) try_initialize_recipe_literal(x, variant); :(code) void try_initialize_recipe_literal(reagent& x, const recipe& caller) { if (x.type) return; if (!contains_key(Recipe_ordinal, x.name)) return; if (contains_reagent_with_non_recipe_literal_type(caller, x.name)) return; x.type = new type_tree("recipe-literal"); x.set_value(get(Recipe_ordinal, x.name)); } bool contains_reagent_with_non_recipe_literal_type(const recipe& caller, const string& name) { for (int i = 0; i < SIZE(caller.steps); ++i) { const instruction& inst = caller.steps.at(i); for (int i = 0; i < SIZE(inst.ingredients); ++i) if (is_matching_non_recipe_literal(inst.ingredients.at(i), name)) return true; for (int i = 0; i < SIZE(inst.products); ++i) if (is_matching_non_recipe_literal(inst.products.at(i), name)) return true; } return false; } bool is_matching_non_recipe_literal(const reagent& x, const string& name) { if (x.name != name) return false; if (!x.type) return false; return !x.type->atom || x.type->name != "recipe-literal"; } //: It's confusing to use variable names that are also recipe names. Always //: assume variable types override recipe literals. void test_error_on_recipe_literal_used_as_a_variable() { Hide_errors = true; run( "def main [\n" " local-scope\n" " a:bool <- equal break 0\n" " break:bool <- copy 0\n" "]\n" ); CHECK_TRACE_CONTENTS( "error: main: missing type for 'break' in 'a:bool <- equal break, 0'\n" ); } :(before "End Primitive Recipe Declarations") CALL, :(before "End Primitive Recipe Numbers") put(Recipe_ordinal, "call", CALL); :(before "End Primitive Recipe Checks") case CALL: { if (inst.ingredients.empty()) { raise << maybe(get(Recipe, r).name) << "'call' requires at least one ingredient (the recipe to call)\n" << end(); break; } if (!is_mu_recipe(inst.ingredients.at(0))) { raise << maybe(get(Recipe, r).name) << "first ingredient of 'call' should be a recipe, but got '" << inst.ingredients.at(0).original_string << "'\n" << end(); break; } break; } :(before "End Primitive Recipe Implementations") case CALL: { // Begin Call trace(Callstack_depth+1, "trace") << "indirect 'call': incrementing callstack depth to " << Callstack_depth << end(); ++Callstack_depth; assert(Callstack_depth < Max_depth); if (!ingredients.at(0).at(0)) { raise << maybe(current_recipe_name()) << "tried to call empty recipe in '" << to_string(current_instruction()) << "'" << end(); break; } const call& caller_frame = current_call(); instruction/*copy*/ call_instruction = to_instruction(caller_frame); call_instruction.operation = ingredients.at(0).at(0); call_instruction.ingredients.erase(call_instruction.ingredients.begin()); Current_routine->calls.push_front(call(ingredients.at(0).at(0))); ingredients.erase(ingredients.begin()); // drop the callee finish_call_housekeeping(call_instruction, ingredients); // not done with caller write_products = false; fall_through_to_next_instruction = false; break; } :(code) void test_call_variable() { run( "def main [\n" " {1: (recipe number -> number)} <- copy f\n" " 2:num <- call {1: (recipe number -> number)}, 34\n" "]\n" "def f x:num -> y:num [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 2\n" ); } void test_call_literal_recipe_repeatedly() { run( "def main [\n" " 1:num <- call f, 34\n" " 1:num <- call f, 35\n" "]\n" "def f x:num -> y:num [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" "mem: storing 35 in location 1\n" ); } void test_call_shape_shifting_recipe() { run( "def main [\n" " 1:num <- call f, 34\n" "]\n" "def f x:_elem -> y:_elem [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } void test_call_shape_shifting_recipe_inside_shape_shifting_recipe() { run( "def main [\n" " 1:num <- f 34\n" "]\n" "def f x:_elem -> y:_elem [\n" " local-scope\n" " load-ingredients\n" " y <- call g x\n" "]\n" "def g x:_elem -> y:_elem [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } void test_call_shape_shifting_recipe_repeatedly_inside_shape_shifting_recipe() { run( "def main [\n" " 1:num <- f 34\n" "]\n" "def f x:_elem -> y:_elem [\n" " local-scope\n" " load-ingredients\n" " y <- call g x\n" " y <- call g x\n" "]\n" "def g x:_elem -> y:_elem [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } //:: check types for 'call' instructions void test_call_check_literal_recipe() { Hide_errors = true; run( "def main [\n" " 1:num <- call f, 34\n" "]\n" "def f x:point -> y:point [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "error: main: ingredient 0 has the wrong type at '1:num <- call f, 34'\n" "error: main: product 0 has the wrong type at '1:num <- call f, 34'\n" ); } void test_call_check_variable_recipe() { Hide_errors = true; run( "def main [\n" " {1: (recipe point -> point)} <- copy f\n" " 2:num <- call {1: (recipe point -> point)}, 34\n" "]\n" "def f x:point -> y:point [\n" " local-scope\n" " load-ingredients\n"
# write-int: add (the binary representation of) a single int to a stream

== code
#   instruction                     effective address                                                   register    displacement    immediate
# . op          subop               mod             rm32          base        index         scale       r32
# . 1-3 bytes   3 bits              2 bits          3 bits        3 bits      3 bits        2 bits      2 bits      0/1/2/4 bytes   0/1/2/4 bytes

write-int:  # out: (addr stream byte), n: int
    # . prologue
    55/push-ebp
    89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
    # . save registers
    50/push-eax
    51/push-ecx
    57/push-edi
    # edi = out
    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .             .           7/r32/edi   8/disp8         .                 # copy *(ebp+8) to edi
    # ecx = out->write
    8b/copy                         0/mod/indirect  7/rm32/edi    .           .             .           1/r32/ecx   .               .                 # copy *edi to ecx
    # if (out->write >= out->size) abort
    3b/compare                      1/mod/*+disp8   7/rm32/edi    .           .             .           1/r32/ecx   8/disp8         .                 # compare ecx with *(edi+8)
    7d/jump-if->=  $write-int:abort/disp8
$write-int:to-stream:
    # out->data[out->write] = n
    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .             .           0/r32/eax   0xc/disp8       .                 # copy *(ebp+12) to eax
    89/copy                         1/mod/*+disp8   4/rm32/sib    7/base/edi  1/index/ecx   .           0/r32/eax   0xc/disp8       .                 # copy eax to *(edi+ecx+12)
    # out->write += 4
    81          0/subop/add         0/mod/indirect  7/rm32/edi    .           .             .           .           .               4/imm32           # add to *edi
$write-int:end:
    # . restore registers
    5f/pop-to-edi
    59/pop-to-ecx
    58/pop-to-eax
    # . epilogue
    89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 # copy ebp to esp
    5d/pop-to-ebp
    c3/return

$write-int:abort:
    # . _write(2/stderr, error)
    # . . push args
    68/push  "write-int: out of space\n"/imm32
    68/push  2/imm32/stderr
    # . . call
    e8/call  _write/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               8/imm32           # add to esp
    # . syscall(exit, 1)
    bb/copy-to-ebx  1/imm32
    e8/call  syscall_exit/disp32
    # never gets here

test-write-int-single:
    # - check that write-int writes to first int of 'stream'
    # setup
    # . clear-stream(_test-stream)
    # . . push args
    68/push  _test-stream/imm32
    # . . call
    e8/call  clear-stream/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               4/imm32           # add to esp
    # write-int(_test-stream, "abcd")
    # . . push args
    68/push  0x64636261/imm32
    68/push  _test-stream/imm32
    # . . call
    e8/call  write-int/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               8/imm32           # add to esp
    # check-stream-equal(_test-stream, "abcd", msg)
    # . . push args
    68/push  "F - test-write-int-single"/imm32
    68/push  "abcd"/imm32
    68/push  _test-stream/imm32
    # . . call
    e8/call  check-stream-equal/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               0xc/imm32         # add to esp
    # . end
    c3/return

test-write-byte-buffered-multiple:
    # - check that write-int correctly appends multiple writes
    # setup
    # . clear-stream(_test-stream)
    # . . push args
    68/push  _test-stream/imm32
    # . . call
    e8/call  clear-stream/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               4/imm32           # add to esp
    # write-int(_test-stream, "abcd")
    # . . push args
    68/push  0x64636261/imm32
    68/push  _test-stream/imm32
    # . . call
    e8/call  write-int/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               8/imm32           # add to esp
    # write-int(_test-stream, "efgh")
    # . . push args
    68/push  0x68676665/imm32
    68/push  _test-stream/imm32
    # . . call
    e8/call  write-int/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               8/imm32           # add to esp
    # check-stream-equal(_test-stream, "abcdefgh", msg)
    # . . push args
    68/push  "F - test-write-byte-buffered-multiple"/imm32
    68/push  "abcdefgh"/imm32
    68/push  _test-stream/imm32
    # . . call
    e8/call  check-stream-equal/disp32
    # . . discard args
    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               0xc/imm32         # add to esp
    # . end
    c3/return

# . . vim:nowrap:textwidth=0
(const string& recipe_name, const reagent& call_types, const recipe_ordinal r, int index, const recipe& caller_recipe) { instruction inst; inst.name = recipe_name; if (!is_mu_recipe(call_types)) return ""; // error raised elsewhere if (is_recipe_literal(call_types)) return ""; // error raised elsewhere construct_fake_call(call_types, inst); resolve_ambiguous_call(r, index, inst, caller_recipe); return inst.name; } void construct_fake_call(const reagent& recipe_var, instruction& out) { assert(recipe_var.type->left->name == "recipe"); type_tree* stem = NULL; for (stem = recipe_var.type->right; stem && stem->left->name != "->"; stem = stem->right) out.ingredients.push_back(copy(stem->left)); if (stem == NULL) return; for (/*skip '->'*/stem = stem->right; stem; stem = stem->right) out.products.push_back(copy(stem->left)); } void test_copy_shape_shifting_recipe_to_variable() { run( "def main [\n" " local-scope\n" " {x: (fn num -> num)} <- copy f\n" " 1:num/raw <- call x, 34\n" "]\n" "def f x:_elem -> y:_elem [\n" " local-scope\n" " load-inputs\n" " y <- copy x\n" "]\n" ); CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } //: passing function literals to (higher-order) functions void test_pass_overloaded_recipe_literal_to_ingredient() { run( // like test_copy_overloaded_recipe_to_variable, except we bind 'x' in // the course of a 'call' rather than 'copy' "def main [\n" " 1:num <- g f\n" "]\n" "def g {x: (fn num -> num)} -> result:num [\n" " local-scope\n" " load-ingredients\n" " result <- call x, 34\n" "]\n" // variant f "def f x:bool -> y:bool [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" // variant f_2 "def f x:num -> y:num [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); // x contains f_2 CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } :(after "End resolve_ambiguous_call(r, index, inst, caller_recipe) Special-cases") for (int i = 0; i < SIZE(inst.ingredients); ++i) { if (!is_mu_recipe(inst.ingredients.at(i))) continue; if (non_ghost_size(get_or_insert(Recipe_variants, inst.ingredients.at(i).name)) < 1) continue; if (get(Recipe_ordinal, inst.name) < MAX_PRIMITIVE_RECIPES) continue; if (non_ghost_size(get_or_insert(Recipe_variants, inst.name)) > 1) { raise << maybe(caller_recipe.name) << "sorry, we're not yet smart enough to simultaneously guess which overloads you want for '" << inst.name << "' and '" << inst.ingredients.at(i).name << "'\n" << end(); return; } const recipe& callee = get(Recipe, get(Recipe_ordinal, inst.name)); if (!callee.has_header) { raise << maybe(caller_recipe.name) << "sorry, we're not yet smart enough to guess which variant of '" << inst.ingredients.at(i).name << "' you want, when the caller '" << inst.name << "' doesn't have a header\n" << end(); return; } string new_name = resolve_ambiguous_call(inst.ingredients.at(i).name, callee.ingredients.at(i), r, index, caller_recipe); if (new_name != "") { inst.ingredients.at(i).name = new_name; inst.ingredients.at(i).value = get(Recipe_ordinal, new_name); } } :(code) void test_return_overloaded_recipe_literal_to_caller() { run( "def main [\n" " local-scope\n" " {x: (fn num -> num)} <- g\n" " 1:num/raw <- call x, 34\n" "]\n" "def g -> {x: (fn num -> num)} [\n" " local-scope\n" " return f\n" "]\n" // variant f "def f x:bool -> y:bool [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" // variant f_2 "def f x:num -> y:num [\n" " local-scope\n" " load-ingredients\n" " y <- copy x\n" "]\n" ); // x contains f_2 CHECK_TRACE_CONTENTS( "mem: storing 34 in location 1\n" ); } :(before "End resolve_ambiguous_call(r, index, inst, caller_recipe) Special-cases") if (inst.name == "return" || inst.name == "reply") { for (int i = 0; i < SIZE(inst.ingredients); ++i) { if (!is_recipe_literal(inst.ingredients.at(i))) continue; if (non_ghost_size(get_or_insert(Recipe_variants, inst.ingredients.at(i).name)) < 1) continue; // potentially overloaded recipe if (!caller_recipe.has_header) { raise << maybe(caller_recipe.name) << "sorry, we're not yet smart enough to guess which variant of '" << inst.ingredients.at(i).name << "' you want, without a recipe header\n" << end(); return; } string new_name = resolve_ambiguous_call(inst.ingredients.at(i).name, caller_recipe.products.at(i), r, index, caller_recipe); if (new_name == "") continue; inst.ingredients.at(i).name = new_name; inst.ingredients.at(i).value = get(Recipe_ordinal, new_name); } return; }