// Executes a method declaration on the given fragment.
static value_t apply_method_declaration(value_t ambience, value_t decl,
value_t fragment) {
CHECK_FAMILY(ofMethodDeclarationAst, decl);
CHECK_FAMILY(ofModuleFragment, fragment);
runtime_t *runtime = get_ambience_runtime(ambience);
// Look for the :builtin annotation on this method.
value_t annots = get_method_declaration_ast_annotations(decl);
value_t builtin_name = new_not_found_condition();
for (size_t i = 0; i < get_array_length(annots); i++) {
value_t annot = get_array_at(annots, i);
TRY_DEF(value, run_expression_until_condition(ambience, fragment, annot));
if (in_family(ofBuiltinMarker, value))
builtin_name = get_builtin_marker_name(value);
}
// Compile the method whether it's a builtin or not. This way we can reuse
// the compilation code for both cases and just patch up the result after
// the fact if it's a builtin.
value_t method_ast = get_method_declaration_ast_method(decl);
TRY_DEF(method, compile_method_ast_to_method(runtime, method_ast, fragment));
if (!in_condition_cause(ccNotFound, builtin_name)) {
// This is a builtin so patch the method with the builtin implementation.
TRY_DEF(impl, runtime_get_builtin_implementation(runtime, builtin_name));
value_t impl_code = get_builtin_implementation_code(impl);
TRY(validate_builtin_method_binding(method, impl));
set_method_code(method, impl_code);
value_t impl_flags = get_builtin_implementation_method_flags(impl);
set_method_flags(method, impl_flags);
}
value_t methodspace = get_module_fragment_methodspace(fragment);
TRY(add_methodspace_method(runtime, methodspace, method));
return success();
}
value_t add_to_signature_map(runtime_t *runtime, value_t map, value_t signature,
value_t value) {
CHECK_FAMILY(ofSignatureMap, map);
CHECK_FAMILY(ofSignature, signature);
value_t entries = get_signature_map_entries(map);
TRY(add_to_pair_array_buffer(runtime, entries, signature, value));
return success();
}
value_t add_methodspace_method(runtime_t *runtime, value_t self,
value_t method) {
CHECK_FAMILY(ofMethodspace, self);
CHECK_MUTABLE(self);
CHECK_FAMILY(ofMethod, method);
invalidate_methodspace_caches(self);
value_t signature = get_method_signature(method);
return add_to_signature_map(runtime, get_methodspace_methods(self), signature,
method);
}
// Executes an is declaration on the given fragment.
static value_t apply_is_declaration(runtime_t *runtime, value_t decl,
value_t fragment) {
CHECK_FAMILY(ofIsDeclarationAst, decl);
CHECK_FAMILY(ofModuleFragment, fragment);
value_t subtype_ast = get_is_declaration_ast_subtype(decl);
value_t supertype_ast = get_is_declaration_ast_supertype(decl);
TRY_DEF(subtype, quick_and_dirty_evaluate_syntax(runtime, fragment, subtype_ast));
TRY_DEF(supertype, quick_and_dirty_evaluate_syntax(runtime, fragment, supertype_ast));
value_t methodspace = get_module_fragment_methodspace(fragment);
TRY(add_methodspace_inheritance(runtime, methodspace, subtype, supertype));
return success();
}
// Adds a namespace binding based on the given declaration ast in the given
// fragment's namespace.
static value_t apply_namespace_declaration(value_t ambience, value_t decl,
value_t fragment) {
CHECK_FAMILY(ofAmbience, ambience);
CHECK_FAMILY(ofNamespaceDeclarationAst, decl);
CHECK_FAMILY(ofModuleFragment, fragment);
runtime_t *runtime = get_ambience_runtime(ambience);
value_t value_syntax = get_namespace_declaration_ast_value(decl);
TRY_DEF(code_block, compile_expression(runtime, value_syntax, fragment,
scope_get_bottom()));
TRY_DEF(value, run_code_block_until_condition(ambience, code_block));
value_t nspace = get_module_fragment_namespace(fragment);
value_t path = get_namespace_declaration_ast_path(decl);
TRY(set_namespace_binding_at(runtime, nspace, path, value));
return success();
}
// Builds an array buffer containing all the modules that are needed to load
// the given unbound module (which is itself added to the array too).
static value_t build_transitive_module_array(runtime_t *runtime,
value_t unbound_module) {
CHECK_FAMILY(ofUnboundModule, unbound_module);
TRY_DEF(result, new_heap_array_buffer(runtime, 16));
TRY(ensure_module_in_array(runtime, result, unbound_module));
return result;
}
// Binds an individual module fragment.
static value_t bind_module_fragment(binding_context_t *context,
value_t entry, value_t bound_fragment) {
CHECK_FAMILY(ofModuleFragment, bound_fragment);
value_t unbound_fragment = get_fragment_entry_fragment(entry);
value_t imports = get_fragment_entry_imports(entry);
if (!is_nothing(unbound_fragment)) {
// This is a real fragment so we have to apply the entries.
CHECK_FAMILY(ofUnboundModuleFragment, unbound_fragment);
CHECK_EQ("fragment already bound", feUnbound,
get_module_fragment_epoch(bound_fragment));
set_module_fragment_epoch(bound_fragment, feBinding);
TRY(bind_module_fragment_imports(context, imports, bound_fragment));
TRY(apply_module_fragment_elements(context, unbound_fragment, bound_fragment));
}
set_module_fragment_epoch(bound_fragment, feComplete);
return success();
}
void parameter_print_on(value_t self, print_on_context_t *context) {
CHECK_FAMILY(ofParameter, self);
string_buffer_printf(context->buf, "#<parameter: gd@");
// We know the guard is a guard, not a parameter, so this can't cause a cycle.
value_print_inner_on(get_parameter_guard(self), context, -1);
string_buffer_printf(context->buf, ", op@%i, ix@%i>",
get_parameter_is_optional(self), get_parameter_index(self));
}
value_t new_heap_array_buffer_with_contents(runtime_t *runtime, value_t elements) {
CHECK_FAMILY(ofArray, elements);
size_t size = kArrayBufferSize;
TRY_DEF(result, alloc_heap_object(runtime, size,
ROOT(runtime, mutable_array_buffer_species)));
set_array_buffer_elements(result, elements);
set_array_buffer_length(result, get_array_length(elements));
return post_create_sanity_check(result, size);
}
value_t module_loader_process_options(runtime_t *runtime, value_t self,
value_t options) {
CHECK_FAMILY(ofIdHashMap, options);
value_t libraries = get_id_hash_map_at_with_default(options, RSTR(runtime, libraries),
ROOT(runtime, empty_array));
for (size_t i = 0; i < get_array_length(libraries); i++) {
value_t library_path = get_array_at(libraries, i);
TRY(module_loader_read_library(runtime, self, library_path));
}
return success();
}
value_t add_methodspace_inheritance(runtime_t *runtime, value_t self,
value_t subtype, value_t supertype) {
CHECK_FAMILY(ofMethodspace, self);
CHECK_MUTABLE(self);
CHECK_FAMILY(ofType, subtype);
CHECK_FAMILY(ofType, supertype);
value_t inheritance = get_methodspace_inheritance(self);
value_t parents = get_id_hash_map_at(inheritance, subtype);
if (in_condition_cause(ccNotFound, parents)) {
// Make the parents buffer small since most types don't have many direct
// parents. If this fails nothing has happened.
TRY_SET(parents, new_heap_array_buffer(runtime, 4));
// If this fails we've wasted some space allocating the parents array but
// otherwise nothing has happened.
TRY(set_id_hash_map_at(runtime, inheritance, subtype, parents));
}
// If this fails we may have set the parents array of the subtype to an empty
// array which is awkward but okay.
invalidate_methodspace_caches(self);
return add_to_array_buffer(runtime, parents, supertype);
}
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));
}
value_t new_heap_instance_species(runtime_t *runtime, value_t primary,
value_t manager) {
size_t size = kInstanceSpeciesSize;
CHECK_FAMILY(ofType, primary);
CHECK_FAMILY_OPT(ofInstanceManager, manager);
TRY_DEF(result, alloc_heap_object(runtime, size,
ROOT(runtime, mutable_species_species)));
set_species_instance_family(result, ofInstance);
set_species_family_behavior(result, &kInstanceBehavior);
set_species_division_behavior(result, &kInstanceSpeciesBehavior);
set_instance_species_primary_type_field(result, primary);
set_instance_species_manager(result, manager);
return post_create_sanity_check(result, size);
}
// Performs the appropriate action for a fragment element to the given fragment.
static value_t apply_unbound_fragment_element(value_t ambience, value_t element,
value_t fragment) {
CHECK_FAMILY(ofAmbience, ambience);
heap_object_family_t family = get_heap_object_family(element);
switch (family) {
case ofNamespaceDeclarationAst:
return apply_namespace_declaration(ambience, element, fragment);
case ofMethodDeclarationAst:
return apply_method_declaration(ambience, element, fragment);
case ofIsDeclarationAst:
return apply_is_declaration(get_ambience_runtime(ambience), element, fragment);
default:
ERROR("Invalid toplevel element %s", get_heap_object_family_name(family));
return success();
}
}
void guard_print_on(value_t self, print_on_context_t *context) {
CHECK_FAMILY(ofGuard, self);
switch (get_guard_type(self)) {
case gtEq:
string_buffer_printf(context->buf, "eq(");
value_print_inner_on(get_guard_value(self), context, -1);
string_buffer_printf(context->buf, ")");
break;
case gtIs:
string_buffer_printf(context->buf, "is(");
value_print_inner_on(get_guard_value(self), context, -1);
string_buffer_printf(context->buf, ")");
break;
case gtAny:
string_buffer_printf(context->buf, "any()");
break;
}
}
value_t push_stack_frame(runtime_t *runtime, value_t stack, frame_t *frame,
size_t frame_capacity, value_t arg_map) {
CHECK_FAMILY(ofStack, stack);
value_t top_piece = get_stack_top_piece(stack);
CHECK_FALSE("stack piece closed", is_stack_piece_closed(top_piece));
if (!try_push_new_frame(frame, frame_capacity, ffOrganic, false)) {
// There wasn't room to push this frame onto the top stack piece so
// allocate a new top piece that definitely has room.
size_t default_capacity = get_stack_default_piece_capacity(stack);
size_t transfer_arg_count = get_array_length(arg_map);
size_t required_capacity
= frame_capacity // the new frame's locals
+ kFrameHeaderSize // the new frame's header
+ 1 // the synthetic bottom frame's one local
+ kFrameHeaderSize // the synthetic bottom frame's header
+ transfer_arg_count; // any arguments to be copied onto the piece
size_t new_capacity = max_size(default_capacity, required_capacity);
// Create and initialize the new stack segment. The frame struct is still
// pointing to the old frame.
TRY_DEF(new_piece, new_heap_stack_piece(runtime, new_capacity, top_piece,
stack));
push_stack_piece_bottom_frame(runtime, new_piece, arg_map);
transfer_top_arguments(new_piece, frame, transfer_arg_count);
set_stack_top_piece(stack, new_piece);
// Close the previous stack piece, recording the frame state.
close_frame(frame);
// Finally, create a new frame on the new stack which includes updating the
// struct. The required_capacity calculation ensures that this call will
// succeed.
open_stack_piece(new_piece, frame);
bool pushed_stack_piece = try_push_new_frame(frame, frame_capacity,
ffOrganic, false);
if (!pushed_stack_piece)
try_push_new_frame(frame, frame_capacity,
ffOrganic, false);
CHECK_TRUE("pushing on new piece failed", pushed_stack_piece);
}
frame_set_argument_map(frame, arg_map);
return success();
}
// Checks whether a fragment entry for the given stage and path already exists
// and if not creates it.
static value_t binding_context_ensure_fragment_entry(binding_context_t *context,
value_t stage, value_t path, value_t fragment, bool *created) {
CHECK_PHYLUM(tpStageOffset, stage);
CHECK_FAMILY(ofPath, path);
CHECK_FAMILY_OPT(ofUnboundModuleFragment, fragment);
value_t path_map = context->fragment_entry_map;
runtime_t *runtime = get_ambience_runtime(context->ambience);
if (!has_id_hash_map_at(path_map, path)) {
TRY_DEF(stage_map, new_heap_id_hash_map(runtime, 16));
TRY(set_id_hash_map_at(runtime, path_map, path, stage_map));
}
value_t stage_map = get_id_hash_map_at(path_map, path);
if (!has_id_hash_map_at(stage_map, stage)) {
TRY_DEF(imports, new_heap_array_buffer(runtime, 4));
TRY_DEF(ident, new_heap_identifier(runtime, stage, path));
TRY_DEF(entry, new_heap_triple(runtime, fragment, imports, ident));
TRY(set_id_hash_map_at(runtime, stage_map, stage, entry));
*created = true;
}
return get_id_hash_map_at(stage_map, stage);
}
// Ensures that the given unbound module is in the given array buffer, as well
// as any other modules imported by the module.
static value_t ensure_module_in_array(runtime_t *runtime, value_t array,
value_t unbound_module) {
CHECK_FAMILY(ofUnboundModule, unbound_module);
if (in_array_buffer(array, unbound_module))
// If it's already there there's nothing to do.
return success();
// Add the module.
TRY(add_to_array_buffer(runtime, array, unbound_module));
// Scan through the imports and recursively add imported modules. Which
// stage the module is imported into doesn't matter at this point, we just
// have to enumerate them.
value_t unbound_fragments = get_unbound_module_fragments(unbound_module);
for (size_t fi = 0; fi < get_array_length(unbound_fragments); fi++) {
value_t unbound_fragment = get_array_at(unbound_fragments, fi);
value_t imports = get_unbound_module_fragment_imports(unbound_fragment);
for (size_t ii = 0; ii < get_array_length(imports); ii++) {
value_t import = get_array_at(imports, ii);
TRY_DEF(imported_module, module_loader_lookup_module(
deref(runtime->module_loader), import));
TRY(ensure_module_in_array(runtime, array, imported_module));
}
}
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);
}
}
void builtin_implementation_print_on(value_t self, print_on_context_t *context) {
CHECK_FAMILY(ofBuiltinImplementation, self);
string_buffer_printf(context->buf, "#<builtin_implementation ");
value_print_inner_on(get_builtin_implementation_name(self), context, -1);
string_buffer_printf(context->buf, ">");
}
void stack_piece_print_on(value_t value, print_on_context_t *context) {
CHECK_FAMILY(ofStackPiece, value);
string_buffer_printf(context->buf, "#<stack piece ~%w: st@%i>", value,
get_stack_piece_capacity(value));
}
void builtin_marker_print_on(value_t self, print_on_context_t *context) {
CHECK_FAMILY(ofBuiltinMarker, self);
string_buffer_printf(context->buf, "#<builtin_marker ");
value_print_inner_on(get_builtin_marker_name(self), context, -1);
string_buffer_printf(context->buf, ">");
}
value_t get_signature_parameter_at(value_t self, int64_t index) {
CHECK_FAMILY(ofSignature, self);
return get_pair_array_second_at(get_signature_tags(self), index);
}
static value_t call_data_length(builtin_arguments_t *args) {
value_t self = get_builtin_subject(args);
CHECK_FAMILY(ofCallData, self);
value_t values = get_call_data_values(self);
return new_integer(get_array_length(values));
}
value_t get_signature_tag_at(value_t self, int64_t index) {
CHECK_FAMILY(ofSignature, self);
return get_pair_array_first_at(get_signature_tags(self), index);
}
int64_t get_call_tags_entry_count(value_t self) {
CHECK_FAMILY(ofCallTags, self);
value_t entries = get_call_tags_entries(self);
return get_pair_array_length(entries);
}
int64_t get_call_tags_offset_at(value_t self, int64_t index) {
CHECK_FAMILY(ofCallTags, self);
value_t entries = get_call_tags_entries(self);
return get_integer_value(get_pair_array_second_at(entries, index));
}
value_t get_call_tags_tag_at(value_t self, int64_t index) {
CHECK_FAMILY(ofCallTags, self);
value_t entries = get_call_tags_entries(self);
return get_pair_array_first_at(entries, index);
}
int64_t get_signature_tag_count(value_t self) {
CHECK_FAMILY(ofSignature, self);
return get_pair_array_length(get_signature_tags(self));
}
