static bool check_machine_words(ast_t* sub, ast_t* super, errorframe_t* errors)
{
// If either result type is a machine word, the other must be as well.
if(is_machine_word(sub) && !is_machine_word(super))
{
if(errors != NULL)
{
ast_error_frame(errors, sub, "%s is a machine word and %s is not",
ast_print_type(sub), ast_print_type(super));
}
return false;
}
if(is_machine_word(super) && !is_machine_word(sub))
{
if(errors != NULL)
{
ast_error_frame(errors, sub, "%s is a machine word and %s is not",
ast_print_type(super), ast_print_type(sub));
}
return false;
}
return true;
}
static void print_types(compile_t* c, FILE* fp, printbuf_t* buf)
{
size_t i = HASHMAP_BEGIN;
reachable_type_t* t;
while((t = reachable_types_next(c->reachable, &i)) != NULL)
{
// Print the docstring if we have one.
ast_t* def = (ast_t*)ast_data(t->ast);
ast_t* docstring = ast_childidx(def, 6);
if(ast_id(docstring) == TK_STRING)
fprintf(fp, "/*\n%s*/\n", ast_name(docstring));
if(!is_pointer(t->ast) && !is_maybe(t->ast) && !is_machine_word(t->ast))
{
// Forward declare an opaque type.
fprintf(fp, "typedef struct %s %s;\n\n", t->name, t->name);
// Function signature for the allocator.
printbuf(buf,
"/* Allocate a %s without initialising it. */\n%s* %s_Alloc();\n\n",
t->name,
t->name,
t->name
);
}
print_methods(c, t, buf);
}
}
static bool contains_boxable(ast_t* type)
{
switch(ast_id(type))
{
case TK_TUPLETYPE:
return true;
case TK_NOMINAL:
return is_machine_word(type);
case TK_UNIONTYPE:
case TK_ISECTTYPE:
{
ast_t* child = ast_child(type);
while(child != NULL)
{
if(contains_boxable(type))
return true;
child = ast_sibling(child);
}
return false;
}
default:
pony_assert(0);
return false;
}
}
void dwarf_composite(dwarf_t* dwarf, gentype_t* g)
{
if(is_machine_word(g->ast) || is_pointer(g->ast))
return;
dwarf_meta_t meta;
setup_dwarf(dwarf, &meta, g, false, false);
symbols_composite(dwarf->symbols, &meta);
}
static trace_t trace_type_nominal(ast_t* type)
{
switch(ast_id((ast_t*)ast_data(type)))
{
case TK_INTERFACE:
case TK_TRAIT:
switch(cap_single(type))
{
case TK_VAL:
return TRACE_VAL_UNKNOWN;
case TK_TAG:
return TRACE_TAG_UNKNOWN;
default: {}
}
return TRACE_MUT_UNKNOWN;
case TK_PRIMITIVE:
{
if(is_machine_word(type))
return TRACE_MACHINE_WORD;
return TRACE_PRIMITIVE;
}
case TK_STRUCT:
case TK_CLASS:
if(is_maybe(type))
return TRACE_MAYBE;
switch(cap_single(type))
{
case TK_VAL:
return TRACE_VAL_KNOWN;
case TK_TAG:
return TRACE_TAG_KNOWN;
default: {}
}
return TRACE_MUT_KNOWN;
case TK_ACTOR:
return TRACE_TAG_KNOWN;
default: {}
}
pony_assert(0);
return TRACE_NONE;
}
static void setup_dwarf(dwarf_t* dwarf, dwarf_meta_t* meta, gentype_t* g,
bool opaque, bool field)
{
memset(meta, 0, sizeof(dwarf_meta_t));
ast_t* ast = g->ast;
LLVMTypeRef type = g->primitive;
if(is_machine_word(ast))
{
if(is_float(ast))
meta->flags |= DWARF_FLOAT;
else if(is_signed(dwarf->opt, ast))
meta->flags |= DWARF_SIGNED;
else if(is_bool(ast))
meta->flags |= DWARF_BOOLEAN;
}
else if(is_pointer(ast) || is_maybe(ast) || !is_concrete(ast) ||
(is_constructable(ast) && field))
{
type = g->use_type;
}
else if(is_constructable(ast))
{
type = g->structure;
}
bool defined_type = g->underlying != TK_TUPLETYPE &&
g->underlying != TK_UNIONTYPE && g->underlying != TK_ISECTTYPE;
source_t* source;
if(defined_type)
ast = (ast_t*)ast_data(ast);
source = ast_source(ast);
meta->file = source->file;
meta->name = g->type_name;
meta->line = ast_line(ast);
meta->pos = ast_pos(ast);
if(!opaque)
{
meta->size = LLVMABISizeOfType(dwarf->target_data, type) << 3;
meta->align = LLVMABIAlignmentOfType(dwarf->target_data, type) << 3;
}
}
bool expr_fun(pass_opt_t* opt, ast_t* ast)
{
AST_GET_CHILDREN(ast, cap, id, typeparams, params, type, can_error, body);
if(ast_id(body) == TK_NONE)
return true;
if(!coerce_literals(&body, type, opt))
return false;
switch(ast_id(ast))
{
case TK_NEW:
{
bool ok = true;
if(is_machine_word(type))
{
if(!check_return_type(opt, ast))
ok = false;
}
if(!check_fields_defined(opt, ast))
ok = false;
return ok;
}
case TK_FUN:
return check_return_type(opt, ast);
default: {}
}
return true;
}
static void trace_maybe(compile_t* c, LLVMValueRef ctx, LLVMValueRef value,
ast_t* type, bool tag)
{
ast_t* type_args = ast_childidx(type, 2);
ast_t* elem = ast_child(type_args);
if(is_machine_word(elem))
return;
LLVMValueRef test = genprim_maybe_is_null(c, elem, value);
LLVMBasicBlockRef is_false = codegen_block(c, "");
LLVMBasicBlockRef is_true = codegen_block(c, "");
LLVMBuildCondBr(c->builder, test, is_true, is_false);
LLVMPositionBuilderAtEnd(c->builder, is_false);
if(tag)
trace_tag(c, ctx, value);
else
gentrace(c, ctx, value, elem);
LLVMBuildBr(c->builder, is_true);
LLVMPositionBuilderAtEnd(c->builder, is_true);
}
bool expr_fun(pass_opt_t* opt, ast_t* ast)
{
typecheck_t* t = &opt->check;
AST_GET_CHILDREN(ast,
cap, id, typeparams, params, type, can_error, body);
if(ast_id(body) == TK_NONE)
return true;
if(!coerce_literals(&body, type, opt))
return false;
bool is_trait =
(ast_id(t->frame->type) == TK_TRAIT) ||
(ast_id(t->frame->type) == TK_INTERFACE) ||
(ast_id((ast_t*)ast_data(ast)) == TK_TRAIT) ||
(ast_id((ast_t*)ast_data(ast)) == TK_INTERFACE);
// Check partial functions.
if(ast_id(can_error) == TK_QUESTION)
{
// If a partial function, check that we might actually error.
ast_t* body_type = ast_type(body);
if(body_type == NULL)
{
// An error has already occurred.
assert(get_error_count() > 0);
return false;
}
if(!is_trait &&
!ast_canerror(body) &&
(ast_id(body_type) != TK_COMPILE_INTRINSIC))
{
ast_error(can_error, "function body is not partial but the function is");
return false;
}
} else {
// If not a partial function, check that we can't error.
if(ast_canerror(body))
{
ast_error(can_error, "function body is partial but the function is not");
show_partiality(body);
return false;
}
}
if(!check_primitive_init(t, ast) || !check_finaliser(t, ast))
return false;
switch(ast_id(ast))
{
case TK_NEW:
{
bool ok = true;
if(is_machine_word(type))
{
if(!check_return_type(ast))
ok = false;
}
if(!check_fields_defined(ast))
ok = false;
if(!check_main_create(t, ast))
ok = false;
return ok;
}
case TK_FUN:
return check_return_type(ast);
default: {}
}
return true;
}
bool is_composite(ast_t* type)
{
return !is_machine_word(type) && !is_pointer(type);
}
static bool is_reified_fun_sub_fun(ast_t* sub, ast_t* super,
ast_t* isub, ast_t* isuper)
{
AST_GET_CHILDREN(sub, sub_cap, sub_id, sub_typeparams, sub_params,
sub_result, sub_throws);
AST_GET_CHILDREN(super, super_cap, super_id, super_typeparams, super_params,
super_result, super_throws);
switch(ast_id(sub))
{
case TK_NEW:
{
// Covariant receiver.
if(!is_cap_sub_cap(ast_id(sub_cap), TK_NONE, ast_id(super_cap), TK_NONE))
return false;
// Covariant result. Don't check this for interfaces, as it produces
// an infinite loop. It will be true if the whole interface is provided.
if(isuper == NULL)
{
if(!is_subtype(sub_result, super_result))
return false;
// If either result type is a machine word, the other must be as well.
if(is_machine_word(sub_result) && !is_machine_word(super_result))
return false;
if(is_machine_word(super_result) && !is_machine_word(sub_result))
return false;
}
break;
}
case TK_FUN:
case TK_BE:
{
// Contravariant receiver.
if(!is_cap_sub_cap(ast_id(super_cap), TK_NONE, ast_id(sub_cap), TK_NONE))
return false;
// Covariant result.
if(!is_recursive_interface(sub_result, super_result, isub, isuper))
{
if(!is_subtype(sub_result, super_result))
return false;
// If either result type is a machine word, the other must be as well.
if(is_machine_word(sub_result) && !is_machine_word(super_result))
return false;
if(is_machine_word(super_result) && !is_machine_word(sub_result))
return false;
}
break;
}
default: {}
}
// Contravariant type parameter constraints.
ast_t* sub_typeparam = ast_child(sub_typeparams);
ast_t* super_typeparam = ast_child(super_typeparams);
while((sub_typeparam != NULL) && (super_typeparam != NULL))
{
ast_t* sub_constraint = ast_childidx(sub_typeparam, 1);
ast_t* super_constraint = ast_childidx(super_typeparam, 1);
if(!is_recursive_interface(super_constraint, sub_constraint, isub, isuper)
&& !is_subtype(super_constraint, sub_constraint))
return false;
sub_typeparam = ast_sibling(sub_typeparam);
super_typeparam = ast_sibling(super_typeparam);
}
// Contravariant parameters.
ast_t* sub_param = ast_child(sub_params);
ast_t* super_param = ast_child(super_params);
while((sub_param != NULL) && (super_param != NULL))
{
ast_t* sub_type = ast_childidx(sub_param, 1);
ast_t* super_type = ast_childidx(super_param, 1);
// If either parameter type is a machine word, the other must be as well.
if(is_machine_word(sub_type) && !is_machine_word(super_type))
return false;
if(is_machine_word(super_type) && !is_machine_word(sub_type))
return false;
// Contravariant: the super type must be a subtype of the sub type.
if(!is_recursive_interface(super_type, sub_type, isub, isuper) &&
!is_subtype(super_type, sub_type))
return false;
sub_param = ast_sibling(sub_param);
super_param = ast_sibling(super_param);
}
if((sub_param != NULL) || (super_param != NULL))
return false;
// Covariant throws.
if((ast_id(sub_throws) == TK_QUESTION) &&
(ast_id(super_throws) != TK_QUESTION))
return false;
return true;
}
