// Map values to ints.
static value_t value_to_int(value_t value, runtime_t *runtime, void *ptr) {
test_resolver_data_t *data = (test_resolver_data_t*) ptr;
if (value_identity_compare(value, data->i0)) {
return new_integer(0);
} else if (value_identity_compare(value, data->i1)) {
return new_integer(1);
} else {
return new_condition(ccNothing);
}
}
static value_t lambda_scope_lookup(lambda_scope_o *self, value_t symbol,
binding_info_t *info_out) {
size_t capture_count_before = get_array_buffer_length(self->captures);
// See if we've captured this variable before.
for (size_t i = 0; i < capture_count_before; i++) {
value_t captured = get_array_buffer_at(self->captures, i);
if (value_identity_compare(captured, symbol)) {
// Found it. Record that we did if necessary and return success.
if (info_out != NULL)
binding_info_set(info_out, btLambdaCaptured, i, 0);
return success();
}
}
// We haven't seen this one before so look it up outside.
value_t value = scope_lookup(self->outer, symbol, info_out);
if (info_out != NULL && !in_condition_cause(ccNotFound, value)) {
// We found something and this is a read. Add it to the list of captures.
runtime_t *runtime = self->assembler->runtime;
if (get_array_buffer_length(self->captures) == 0) {
// The first time we add something we have to create a new array buffer
// since all empty capture scopes share the singleton empty buffer.
TRY_SET(self->captures, new_heap_array_buffer(runtime, 2));
}
TRY(add_to_array_buffer(runtime, self->captures, symbol));
binding_info_set(info_out, btLambdaCaptured, capture_count_before, 0);
}
return value;
}
// Returns true if the given signature could possibly match an invocation where
// the given tag maps to the given value.
static bool can_match_eq(value_t signature, value_t tag, value_t value) {
int64_t paramc = get_signature_parameter_count(signature);
// First look for a matching parameter in the signature.
value_t match = nothing();
for (int64_t i = 0; i < paramc; i++) {
value_t param = get_signature_parameter_at(signature, i);
value_t tags = get_parameter_tags(param);
if (in_array(tags, tag)) {
match = param;
break;
}
}
if (is_nothing(match)) {
// There was no matching parameter so this can only match if the signature
// permits it as an extra argument.
return get_signature_allow_extra(signature);
} else {
value_t guard = get_parameter_guard(match);
if (get_guard_type(guard) == gtEq) {
value_t eq_value = get_guard_value(guard);
return value_identity_compare(value, eq_value);
} else {
return true;
}
}
}
TEST(plankton, env_resolution) {
CREATE_RUNTIME();
test_resolver_data_t data;
data.i0 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
data.i1 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_t i2 = new_heap_instance(runtime, ROOT(runtime, empty_instance_species));
value_mapping_t resolver;
value_mapping_init(&resolver, value_to_int, &data);
value_mapping_t access;
value_mapping_init(&access, int_to_value, &data);
value_t d0 = transcode_plankton(runtime, &resolver, &access, data.i0);
ASSERT_TRUE(value_identity_compare(data.i0, d0));
value_t d1 = transcode_plankton(runtime, &resolver, &access, data.i1);
ASSERT_TRUE(value_identity_compare(data.i1, d1));
value_t d2 = transcode_plankton(runtime, &resolver, &access, i2);
ASSERT_FALSE(value_identity_compare(i2, d2));
value_t a0 = new_heap_array(runtime, 4);
set_array_at(a0, 0, data.i0);
set_array_at(a0, 1, data.i1);
set_array_at(a0, 2, i2);
set_array_at(a0, 3, data.i0);
value_t da0 = transcode_plankton(runtime, &resolver, &access, a0);
ASSERT_TRUE(value_identity_compare(data.i0, get_array_at(da0, 0)));
ASSERT_TRUE(value_identity_compare(data.i1, get_array_at(da0, 1)));
ASSERT_FALSE(value_identity_compare(i2, get_array_at(da0, 2)));
ASSERT_TRUE(value_identity_compare(data.i0, get_array_at(da0, 3)));
DISPOSE_RUNTIME();
}
// Performs a lookup for a single symbol scope.
static value_t single_symbol_scope_lookup(single_symbol_scope_o *self, value_t symbol,
binding_info_t *info_out) {
if (value_identity_compare(symbol, self->symbol)) {
if (info_out != NULL)
*info_out = self->binding;
return success();
} else {
return scope_lookup(self->outer, symbol, info_out);
}
}
void check_call_tags_entries_unique(value_t tags) {
if (get_pair_array_length(tags) == 0)
return;
value_t last_tag = get_pair_array_first_at(tags, 0);
for (int64_t i = 1; i < get_pair_array_length(tags); i++) {
value_t next_tag = get_pair_array_first_at(tags, i);
if (value_identity_compare(last_tag, next_tag))
FATAL("Tag %v occurs twice in %v", last_tag, tags);
last_tag = next_tag;
}
}
static value_t call_data_get(builtin_arguments_t *args) {
value_t self = get_builtin_subject(args);
CHECK_FAMILY(ofCallData, self);
value_t needle = get_builtin_argument(args, 0);
value_t tags = get_call_data_tags(self);
for (int64_t i = 0; i < get_call_tags_entry_count(tags); i++) {
value_t tag = get_call_tags_tag_at(tags, i);
if (value_identity_compare(needle, tag))
return get_call_data_value_at(self, i);
}
ESCAPE_BUILTIN(args, no_such_tag, needle);
}
// Returns true iff the given identifier is $:core.
static bool is_present_core(runtime_t *runtime, value_t ident) {
CHECK_FAMILY(ofIdentifier, ident);
value_t path = get_identifier_path(ident);
value_t stage = get_identifier_stage(ident);
if (get_stage_offset_value(stage) != 0)
// Not present.
return false;
if (is_path_empty(path) || !is_path_empty(get_path_tail(path)))
// Not length 1.
return false;
value_t head = get_path_head(path);
return value_identity_compare(head, RSTR(runtime, core));
}
static value_t find_best_match(runtime_t *runtime, value_t current,
value_t target, value_t current_score, value_t space, value_t *score_out) {
if (value_identity_compare(current, target)) {
*score_out = current_score;
return success();
} else {
TRY_DEF(parents, get_type_parents(runtime, space, current));
int64_t length = get_array_buffer_length(parents);
value_t score = new_no_match_score();
for (int64_t i = 0; i < length; i++) {
value_t parent = get_array_buffer_at(parents, i);
value_t next_score = whatever();
TRY(find_best_match(runtime, parent, target, get_score_successor(current_score),
space, &next_score));
score = best_score(score, next_score);
}
*score_out = score;
return success();
}
}
value_t guard_match(value_t guard, value_t value, runtime_t *runtime,
value_t space, value_t *score_out) {
CHECK_FAMILY(ofGuard, guard);
switch (get_guard_type(guard)) {
case gtEq: {
value_t guard_value = get_guard_value(guard);
bool match = value_identity_compare(guard_value, value);
*score_out = match ? new_identical_match_score() : new_no_match_score();
return success();
}
case gtIs: {
TRY_DEF(primary, get_primary_type(value, runtime));
value_t target = get_guard_value(guard);
return find_best_match(runtime, primary, target,
new_perfect_is_match_score(), space, score_out);
}
case gtAny:
*score_out = new_any_match_score();
return success();
default:
UNREACHABLE("Unknown guard type");
return new_condition(ccWat);
}
}
// Add synthetic fragment entries corresponding to imported fragments where
// there is no real fragment to import the fragment into.
static value_t build_synthetic_fragment_entries(binding_context_t *context) {
// Keep adding synthetic modules as long as changes are being made to the
// map. We'll scan through the fragments currently in the map, then scan
// through their imports, and for each check that the fragment that should
// receive the import exists. If it doesn't it is created.
loop: do {
id_hash_map_iter_t module_iter;
id_hash_map_iter_init(&module_iter, context->fragment_entry_map);
while (id_hash_map_iter_advance(&module_iter)) {
value_t module_path;
value_t module_fragments;
// Scan through the fragments.
id_hash_map_iter_get_current(&module_iter, &module_path, &module_fragments);
id_hash_map_iter_t fragment_iter;
id_hash_map_iter_init(&fragment_iter, module_fragments);
while (id_hash_map_iter_advance(&fragment_iter)) {
value_t stage;
value_t entry;
id_hash_map_iter_get_current(&fragment_iter, &stage, &entry);
value_t unbound_fragment = get_fragment_entry_fragment(entry);
// If there is no fragment associated with this entry it is synthetic
// and hence we're done.
if (is_nothing(unbound_fragment))
continue;
// Scan through the fragment's imports and ensure that their import
// targets have been created.
value_t imports = get_fragment_entry_imports(entry);
for (size_t i = 0; i < get_array_buffer_length(imports); i++) {
value_t import = get_array_buffer_at(imports, i);
value_t import_fragment_stage = get_identifier_stage(import);
if (!value_identity_compare(import_fragment_stage, present_stage()))
// We'll record past imports but ignore them for the purposes of
// closing the import map since they're redundant.
continue;
value_t import_module_path = get_identifier_path(import);
value_t import_module = get_id_hash_map_at(context->fragment_entry_map,
import_module_path);
// Scan through the fragments of the imported module.
id_hash_map_iter_t imported_fragment_iter;
id_hash_map_iter_init(&imported_fragment_iter, import_module);
bool has_changed_anything = false;
while (id_hash_map_iter_advance(&imported_fragment_iter)) {
value_t import_stage;
value_t import_entry;
id_hash_map_iter_get_current(&imported_fragment_iter,
&import_stage, &import_entry);
value_t target_stage = add_stage_offsets(import_stage, stage);
// Ensure that there is a target entry to add the import to. If it
// already exists this is a no-op, if it doesn't a synthetic entry
// is created.
TRY_DEF(target_entry, binding_context_ensure_fragment_entry(
context, target_stage, module_path, nothing(),
&has_changed_anything));
value_t target_imports = get_fragment_entry_imports(target_entry);
value_t import_ident = get_fragment_entry_identifier(import_entry);
if (!in_array_buffer(target_imports, import_ident)) {
has_changed_anything = true;
TRY(add_to_array_buffer(get_ambience_runtime(context->ambience),
target_imports, import_ident));
}
}
// If any changes were made we have to start over.
if (has_changed_anything)
goto loop;
}
}
}
} while (false);
return success();
}
