ast_result_t pass_flatten(ast_t** astp, pass_opt_t* options)
{
typecheck_t* t = &options->check;
ast_t* ast = *astp;
switch(ast_id(ast))
{
case TK_NEW:
{
switch(ast_id(t->frame->type))
{
case TK_CLASS:
return flatten_constructor(ast);
case TK_ACTOR:
return flatten_async(ast);
default: {}
}
break;
}
case TK_BE:
return flatten_async(ast);
case TK_UNIONTYPE:
if(!flatten_union(astp))
return AST_ERROR;
break;
case TK_ISECTTYPE:
if(!flatten_isect(astp))
return AST_ERROR;
break;
case TK_TUPLETYPE:
case TK_ARROW:
return flatten_noconstraint(t, ast);
case TK_TYPEPARAMREF:
return flatten_typeparamref(ast);
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
return flatten_provides_list(ast, 3);
case TK_ACTOR:
case TK_CLASS:
case TK_PRIMITIVE:
case TK_TRAIT:
case TK_INTERFACE:
return flatten_provides_list(ast, 3);
case TK_OBJECT:
return flatten_provides_list(ast, 0);
default: {}
}
return AST_OK;
}
static bool is_valid_pattern(pass_opt_t* opt, ast_t* pattern)
{
if(ast_id(pattern) == TK_NONE)
{
ast_settype(pattern, ast_from(pattern, TK_DONTCARE));
return true;
}
ast_t* pattern_type = ast_type(pattern);
if(is_control_type(pattern_type))
{
ast_error(pattern, "not a matchable pattern");
return false;
}
switch(ast_id(pattern))
{
case TK_VAR:
case TK_LET:
{
// Disallow capturing tuples.
AST_GET_CHILDREN(pattern, id, capture_type);
if(ast_id(capture_type) == TK_TUPLETYPE)
{
ast_error(capture_type,
"can't capture a tuple, change this into a tuple of capture "
"expressions");
return false;
}
// Set the pattern type to be the capture type.
ast_settype(pattern, capture_type);
return true;
}
case TK_TUPLE:
{
ast_t* pattern_child = ast_child(pattern);
// Treat a one element tuple as a normal expression.
if(ast_sibling(pattern_child) == NULL)
{
bool ok = is_valid_pattern(opt, pattern_child);
ast_settype(pattern, ast_type(pattern_child));
return ok;
}
// Check every element pairwise.
ast_t* pattern_type = ast_from(pattern, TK_TUPLETYPE);
bool ok = true;
while(pattern_child != NULL)
{
if(!is_valid_pattern(opt, pattern_child))
ok = false;
ast_append(pattern_type, ast_type(pattern_child));
pattern_child = ast_sibling(pattern_child);
}
ast_settype(pattern, pattern_type);
return ok;
}
case TK_SEQ:
{
// Patterns cannot contain sequences.
ast_t* child = ast_child(pattern);
ast_t* next = ast_sibling(child);
if(next != NULL)
{
ast_error(next, "expression in patterns cannot be sequences");
return false;
}
bool ok = is_valid_pattern(opt, child);
ast_settype(pattern, ast_type(child));
return ok;
}
case TK_DONTCARE:
// It's always ok not to care.
return true;
default:
{
// Structural equality, pattern.eq(match).
ast_t* fun = lookup(opt, pattern, pattern_type, stringtab("eq"));
if(fun == NULL)
{
ast_error(pattern,
"this pattern element doesn't support structural equality");
return false;
}
if(ast_id(fun) != TK_FUN)
{
ast_error(pattern, "eq is not a function on this pattern element");
ast_error(fun, "definition of eq is here");
ast_free_unattached(fun);
return false;
}
AST_GET_CHILDREN(fun, cap, id, typeparams, params, result, partial);
bool ok = true;
if(ast_id(typeparams) != TK_NONE)
{
ast_error(pattern, "polymorphic eq not supported in pattern matching");
ok = false;
}
if(!is_bool(result))
{
ast_error(pattern, "eq must return Bool when pattern matching");
ok = false;
}
if(ast_id(partial) != TK_NONE)
{
ast_error(pattern, "eq cannot be partial when pattern matching");
ok = false;
}
ast_t* param = ast_child(params);
if(param == NULL || ast_sibling(param) != NULL)
{
ast_error(pattern,
"eq must take a single argument when pattern matching");
ok = false;
} else {
AST_GET_CHILDREN(param, param_id, param_type);
ast_settype(pattern, param_type);
}
ast_free_unattached(fun);
return ok;
}
}
assert(0);
return false;
}
bool expr_case(pass_opt_t* opt, ast_t* ast)
{
assert(opt != NULL);
assert(ast_id(ast) == TK_CASE);
AST_GET_CHILDREN(ast, pattern, guard, body);
if((ast_id(pattern) == TK_NONE) && (ast_id(guard) == TK_NONE))
{
ast_error(ast, "can't have a case with no conditions, use an else clause");
return false;
}
ast_t* cases = ast_parent(ast);
ast_t* match = ast_parent(cases);
ast_t* match_expr = ast_child(match);
ast_t* match_type = ast_type(match_expr);
if(is_control_type(match_type) || is_typecheck_error(match_type))
return false;
if(!infer_pattern_type(pattern, match_type, opt))
return false;
if(!is_valid_pattern(opt, pattern))
return false;
ast_t* operand_type = alias(match_type);
ast_t* pattern_type = ast_type(pattern);
bool ok = true;
switch(is_matchtype(operand_type, pattern_type))
{
case MATCHTYPE_ACCEPT:
break;
case MATCHTYPE_REJECT:
ast_error(pattern, "this pattern can never match");
ast_error(match_type, "match type: %s", ast_print_type(operand_type));
ast_error(pattern, "pattern type: %s", ast_print_type(pattern_type));
ok = false;
break;
case MATCHTYPE_DENY:
ast_error(pattern, "this capture violates capabilities");
ast_error(match_type, "match type: %s", ast_print_type(operand_type));
ast_error(pattern, "pattern type: %s", ast_print_type(pattern_type));
ok = false;
break;
}
if(ast_id(guard) != TK_NONE)
{
ast_t* guard_type = ast_type(guard);
if(is_typecheck_error(guard_type))
{
ok = false;
}
else if(!is_bool(guard_type))
{
ast_error(guard, "guard must be a boolean expression");
ok = false;
}
}
ast_free_unattached(operand_type);
ast_inheritflags(ast);
return ok;
}
bool expr_seq(pass_opt_t* opt, ast_t* ast)
{
bool ok = true;
// Any expression other than the last that is still literal is an error
for(ast_t* p = ast_child(ast); ast_sibling(p) != NULL; p = ast_sibling(p))
{
ast_t* p_type = ast_type(p);
if(is_typecheck_error(p_type))
{
ok = false;
} else if(is_type_literal(p_type)) {
ast_error(opt->check.errors, p, "Cannot infer type of unused literal");
ok = false;
}
}
if(ok)
{
// We might already have a type due to a return expression.
ast_t* type = ast_type(ast);
ast_t* last = ast_childlast(ast);
if((type != NULL) && !coerce_literals(&last, type, opt))
return false;
// Type is unioned with the type of the last child.
type = control_type_add_branch(opt, type, last);
ast_settype(ast, type);
}
if(!ast_has_scope(ast))
return ok;
ast_t* parent = ast_parent(ast);
switch(ast_id(parent))
{
case TK_TRY:
case TK_TRY_NO_CHECK:
{
// Propagate consumes forward in a try expression.
AST_GET_CHILDREN(parent, body, else_clause, then_clause);
if(body == ast)
{
// Push our consumes, but not defines, to the else clause.
ast_inheritbranch(else_clause, body);
ast_consolidate_branches(else_clause, 2);
} else if(else_clause == ast) {
// Push our consumes, but not defines, to the then clause. This
// includes the consumes from the body.
ast_inheritbranch(then_clause, else_clause);
ast_consolidate_branches(then_clause, 2);
}
}
default: {}
}
return ok;
}
bool check_id(ast_t* id_node, const char* desc, int spec)
{
assert(id_node != NULL);
assert(ast_id(id_node) == TK_ID);
assert(desc != NULL);
const char* name = ast_name(id_node);
assert(name != NULL);
char prev = '\0';
// Ignore leading $, handled by lexer
if(*name == '$')
{
name++;
prev = '$';
}
// Ignore leading _
if(*name == '_')
{
name++;
prev = '_';
if((spec & ALLOW_LEADING_UNDERSCORE) == 0)
{
ast_error(id_node, "%s name \"%s\" cannot start with underscores", desc,
ast_name(id_node));
return false;
}
}
if((spec & START_LOWER) != 0 && (*name < 'a' || *name > 'z'))
{
ast_error(id_node, "%s name \"%s\" must start a-z or _(a-z)", desc,
ast_name(id_node));
return false;
}
if((spec & START_UPPER) != 0 && (*name < 'A' || *name > 'Z'))
{
ast_error(id_node, "%s name \"%s\" must start A-Z or _(A-Z)", desc,
ast_name(id_node));
return false;
}
// Check each character looking for ticks and underscores
for(; *name != '\0' && *name != '\''; name++)
{
if(*name == '_')
{
if((spec & ALLOW_UNDERSCORE) == 0)
{
ast_error(id_node, "%s name \"%s\" cannot contain underscores", desc,
ast_name(id_node));
return false;
}
if(prev == '_')
{
ast_error(id_node, "%s name \"%s\" cannot contain double underscores",
desc, ast_name(id_node));
return false;
}
}
prev = *name;
}
// Only ticks (or nothing) left
// Check for ending with _
if(prev == '_')
{
ast_error(id_node, "%s name \"%s\" cannot end with underscores", desc,
ast_name(id_node));
return false;
}
if(*name == '\0')
return true;
// Should only be ticks left
assert(*name == '\'');
if((spec & ALLOW_TICK) == 0)
{
ast_error(id_node, "%s name \"%s\" cannot contain prime (')", desc,
ast_name(id_node));
return false;
}
for(; *name != '\0'; name++)
{
if(*name != '\'')
{
ast_error(id_node,
"prime(') can only appear at the end of %s name \"%s\"", desc,
ast_name(id_node));
return false;
}
}
return true;
}
static bool can_inline_message_send(reach_type_t* t, reach_method_t* m,
const char* method_name)
{
switch(t->underlying)
{
case TK_UNIONTYPE:
case TK_ISECTTYPE:
case TK_INTERFACE:
case TK_TRAIT:
break;
default:
pony_assert(0);
return false;
}
size_t i = HASHMAP_BEGIN;
reach_type_t* sub;
while((sub = reach_type_cache_next(&t->subtypes, &i)) != NULL)
{
reach_method_t* m_sub = reach_method(sub, m->cap, method_name, m->typeargs);
if(m_sub == NULL)
continue;
switch(sub->underlying)
{
case TK_CLASS:
case TK_PRIMITIVE:
return false;
case TK_ACTOR:
if(ast_id(m_sub->fun->ast) == TK_FUN)
return false;
break;
default: {}
}
pony_assert(m->param_count == m_sub->param_count);
for(size_t i = 0; i < m->param_count; i++)
{
// If the param is a boxable type for us and an unboxable type for one of
// our subtypes, that subtype will take that param as boxed through an
// interface. In order to correctly box the value the actual function to
// call must be resolved through name mangling, therefore we can't inline
// the message send.
reach_type_t* param = m->params[i].type;
reach_type_t* sub_param = m_sub->params[i].type;
if(param->can_be_boxed)
{
if(!sub_param->can_be_boxed)
return false;
if(param->underlying == TK_TUPLETYPE)
{
ast_t* child = ast_child(param->ast);
while(child != NULL)
{
if(contains_boxable(child))
return false;
}
}
}
}
}
return true;
}
LLVMValueRef gen_pattern_eq(compile_t* c, ast_t* pattern, LLVMValueRef r_value)
{
// This is used for structural equality in pattern matching.
ast_t* pattern_type = deferred_reify(c->frame->reify, ast_type(pattern),
c->opt);
if(ast_id(pattern_type) == TK_NOMINAL)
{
AST_GET_CHILDREN(pattern_type, package, id);
// Special case equality on primitive types.
if(ast_name(package) == c->str_builtin)
{
const char* name = ast_name(id);
if((name == c->str_Bool) ||
(name == c->str_I8) ||
(name == c->str_I16) ||
(name == c->str_I32) ||
(name == c->str_I64) ||
(name == c->str_I128) ||
(name == c->str_ILong) ||
(name == c->str_ISize) ||
(name == c->str_U8) ||
(name == c->str_U16) ||
(name == c->str_U32) ||
(name == c->str_U64) ||
(name == c->str_U128) ||
(name == c->str_ULong) ||
(name == c->str_USize) ||
(name == c->str_F32) ||
(name == c->str_F64)
)
{
ast_free_unattached(pattern_type);
return gen_eq_rvalue(c, pattern, r_value, true);
}
}
}
// Generate the receiver.
LLVMValueRef l_value = gen_expr(c, pattern);
reach_type_t* t = reach_type(c->reach, pattern_type);
pony_assert(t != NULL);
// Static or virtual dispatch.
token_id cap = cap_dispatch(pattern_type);
reach_method_t* m = reach_method(t, cap, c->str_eq, NULL);
LLVMValueRef func = dispatch_function(c, t, m, l_value);
ast_free_unattached(pattern_type);
if(func == NULL)
return NULL;
// Call the function. We know it isn't partial.
LLVMValueRef args[2];
args[0] = l_value;
args[1] = r_value;
codegen_debugloc(c, pattern);
LLVMValueRef result = codegen_call(c, func, args, 2, true);
codegen_debugloc(c, NULL);
return result;
}
// Compare the 2 given signatures to see if they are exactly the same
static bool compare_signatures(ast_t* sig_a, ast_t* sig_b)
{
if(sig_a == NULL && sig_b == NULL)
return true;
if(sig_a == NULL || sig_b == NULL)
return false;
token_id a_id = ast_id(sig_a);
if(a_id != ast_id(sig_b))
return false;
switch(a_id)
{
case TK_BE:
case TK_FUN:
case TK_NEW:
{
// Check everything except body and docstring, ie first 6 children
ast_t* a_child = ast_child(sig_a);
ast_t* b_child = ast_child(sig_b);
for(int i = 0; i < 6; i++)
{
if(a_child == NULL || b_child == NULL)
return false;
if(!compare_signatures(a_child, b_child))
return false;
a_child = ast_sibling(a_child);
b_child = ast_sibling(b_child);
}
return true;
}
case TK_STRING:
case TK_ID:
{
// Can't just use strcmp, string literals may contain \0s
size_t a_len = ast_name_len(sig_a);
size_t b_len = ast_name_len(sig_b);
if(a_len != b_len)
return false;
const char* a_text = ast_name(sig_a);
const char* b_text = ast_name(sig_b);
for(size_t i = 0; i < a_len; i++)
if(a_text[i] != b_text[i])
return false;
return true;
}
case TK_INT: return ast_int(sig_a) == ast_int(sig_b);
case TK_FLOAT: return ast_float(sig_a) == ast_float(sig_b);
case TK_NOMINAL:
if(ast_data(sig_a) != ast_data(sig_b))
return false;
break;
default:
break;
}
ast_t* a_child = ast_child(sig_a);
ast_t* b_child = ast_child(sig_b);
while(a_child != NULL && b_child != NULL)
{
if(!compare_signatures(a_child, b_child))
return false;
a_child = ast_sibling(a_child);
b_child = ast_sibling(b_child);
}
if(a_child != NULL || b_child != NULL)
return false;
return true;
}
static bool assign_id(typecheck_t* t, ast_t* ast, bool let, bool need_value)
{
assert(ast_id(ast) == TK_ID);
const char* name = ast_name(ast);
sym_status_t status;
ast_get(ast, name, &status);
switch(status)
{
case SYM_UNDEFINED:
if(need_value)
{
ast_error(ast, "the left side is undefined but its value is used");
return false;
}
ast_setstatus(ast, name, SYM_DEFINED);
return true;
case SYM_DEFINED:
if(let)
{
ast_error(ast,
"can't assign to a let or embed definition more than once");
return false;
}
return true;
case SYM_CONSUMED:
{
bool ok = true;
if(need_value)
{
ast_error(ast, "the left side is consumed but its value is used");
ok = false;
}
if(let)
{
ast_error(ast,
"can't assign to a let or embed definition more than once");
ok = false;
}
if(t->frame->try_expr != NULL)
{
ast_error(ast,
"can't reassign to a consumed identifier in a try expression");
ok = false;
}
if(ok)
ast_setstatus(ast, name, SYM_DEFINED);
return ok;
}
default: {}
}
assert(0);
return false;
}
ast_t* viewpoint_reifytypeparam(ast_t* type, ast_t* typeparamref)
{
pony_assert(ast_id(typeparamref) == TK_TYPEPARAMREF);
AST_GET_CHILDREN(typeparamref, id, cap, eph);
switch(ast_id(cap))
{
case TK_ISO:
case TK_TRN:
case TK_REF:
case TK_VAL:
case TK_BOX:
case TK_TAG:
return NULL;
case TK_CAP_SEND:
{
ast_t* tuple = ast_from(type, TK_TUPLETYPE);
replace_typeparam(tuple, type, typeparamref, TK_ISO, ast_id(eph));
replace_typeparam(tuple, type, typeparamref, TK_VAL, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_TAG, TK_NONE);
return tuple;
}
case TK_CAP_SHARE:
{
ast_t* tuple = ast_from(type, TK_TUPLETYPE);
replace_typeparam(tuple, type, typeparamref, TK_VAL, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_TAG, TK_NONE);
return tuple;
}
case TK_CAP_READ:
{
ast_t* tuple = ast_from(type, TK_TUPLETYPE);
replace_typeparam(tuple, type, typeparamref, TK_REF, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_VAL, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_BOX, TK_NONE);
return tuple;
}
case TK_CAP_ALIAS:
{
ast_t* tuple = ast_from(type, TK_TUPLETYPE);
replace_typeparam(tuple, type, typeparamref, TK_REF, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_VAL, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_BOX, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_TAG, TK_NONE);
return tuple;
}
case TK_CAP_ANY:
{
ast_t* tuple = ast_from(type, TK_TUPLETYPE);
replace_typeparam(tuple, type, typeparamref, TK_ISO, ast_id(eph));
replace_typeparam(tuple, type, typeparamref, TK_TRN, ast_id(eph));
replace_typeparam(tuple, type, typeparamref, TK_REF, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_VAL, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_BOX, TK_NONE);
replace_typeparam(tuple, type, typeparamref, TK_TAG, TK_NONE);
return tuple;
}
default: {}
}
pony_assert(0);
return NULL;
}
static void make_prototype(compile_t* c, reachable_type_t* t,
reachable_method_t* m)
{
if(m->intrinsic)
return;
// Behaviours and actor constructors also have handler functions.
bool handler = false;
switch(ast_id(m->r_fun))
{
case TK_NEW:
handler = t->underlying == TK_ACTOR;
break;
case TK_BE:
handler = true;
break;
default: {}
}
make_signature(t, m);
switch(t->underlying)
{
case TK_PRIMITIVE:
case TK_STRUCT:
case TK_CLASS:
case TK_ACTOR:
break;
default:
return;
}
if(handler)
{
// Generate the sender prototype.
const char* sender_name = genname_be(m->full_name);
m->func = codegen_addfun(c, sender_name, m->func_type);
// Change the return type to void for the handler.
size_t count = LLVMCountParamTypes(m->func_type);
size_t buf_size = count * sizeof(LLVMTypeRef);
LLVMTypeRef* tparams = (LLVMTypeRef*)ponyint_pool_alloc_size(buf_size);
LLVMGetParamTypes(m->func_type, tparams);
LLVMTypeRef handler_type = LLVMFunctionType(c->void_type, tparams,
(int)count, false);
ponyint_pool_free_size(buf_size, tparams);
// Generate the handler prototype.
m->func_handler = codegen_addfun(c, m->full_name, handler_type);
make_function_debug(c, t, m, m->func_handler);
} else {
// Generate the function prototype.
m->func = codegen_addfun(c, m->full_name, m->func_type);
make_function_debug(c, t, m, m->func);
}
}
static void replace_type(ast_t** astp, ast_t* target, ast_t* with)
{
ast_t* ast = *astp;
ast_t* child = ast_child(ast);
while(child != NULL)
{
replace_type(&child, target, with);
child = ast_sibling(child);
}
ast_t* node_type = ast_type(ast);
if(node_type != NULL)
replace_type(&node_type, target, with);
if(ast_id(ast) == ast_id(target))
{
switch(ast_id(target))
{
case TK_THISTYPE:
// Replace `this`.
ast_replace(astp, ast_dup(with));
break;
case TK_TYPEPARAMREF:
{
// Replace a typeparamref with a reification.
ast_t* target_def = (ast_t*)ast_data(target);
ast_t* left_def = (ast_t*)ast_data(ast);
if(target_def == left_def)
{
AST_GET_CHILDREN(ast, id, cap, eph);
ast_t* a_with = with;
switch(ast_id(eph))
{
case TK_EPHEMERAL:
a_with = consume_type(with, TK_NONE);
break;
case TK_ALIASED:
a_with = alias(with);
break;
default: {}
}
if(a_with == with)
a_with = ast_dup(with);
ast_replace(astp, a_with);
}
break;
}
default:
pony_assert(0);
}
} else if(ast_id(ast) == TK_ARROW) {
// Recalculate all arrow types.
AST_GET_CHILDREN(ast, left, right);
ast_t* r_type = viewpoint_type(left, right);
ast_replace(astp, r_type);
}
}
ast_t* viewpoint_lower(ast_t* type)
{
// T = N | A
// s = {k}
// upper(s p'->T k p) = union[k' in s](T (k'->k) eph(s, p', p))
// eph(s, p', p) = { unalias(p) if p' = ^, exists k in s . k in {iso, trn}
// { p otherwise
pony_assert(ast_id(type) == TK_ARROW);
AST_GET_CHILDREN(type, left, right);
ast_t* r_right = right;
switch(ast_id(right))
{
case TK_NOMINAL:
case TK_TYPEPARAMREF:
break;
case TK_ARROW:
// Arrow types are right associative.
r_right = viewpoint_lower(right);
if(r_right == NULL)
return NULL;
break;
default:
pony_assert(0);
return NULL;
}
token_id l_cap = TK_NONE;
token_id l_eph = TK_NONE;
switch(ast_id(left))
{
case TK_ISO:
case TK_TRN:
case TK_REF:
case TK_VAL:
case TK_BOX:
case TK_TAG:
l_cap = ast_id(left);
break;
case TK_THISTYPE:
l_cap = TK_CAP_READ;
break;
case TK_NOMINAL:
case TK_TYPEPARAMREF:
{
ast_t* left_cap = cap_fetch(left);
ast_t* left_eph = ast_sibling(left_cap);
l_cap = ast_id(left_cap);
l_eph = ast_id(left_eph);
break;
}
default:
pony_assert(0);
return NULL;
}
ast_t* right_cap = cap_fetch(r_right);
ast_t* right_eph = ast_sibling(right_cap);
token_id r_cap = ast_id(right_cap);
token_id r_eph = ast_id(right_eph);
// No result: left side could be a tag.
if(!cap_view_lower(l_cap, l_eph, &r_cap, &r_eph))
return NULL;
ast_t* rr_right = set_cap_and_ephemeral(r_right, r_cap, r_eph);
if(r_right != right)
ast_free_unattached(r_right);
return rr_right;
}
ast_t* viewpoint_type(ast_t* l_type, ast_t* r_type)
{
int upper = VIEW_UPPER_NO;
switch(ast_id(r_type))
{
case TK_UNIONTYPE:
case TK_ISECTTYPE:
case TK_TUPLETYPE:
{
// Adapt each element.
ast_t* type = ast_from(r_type, ast_id(r_type));
ast_t* child = ast_child(r_type);
while(child != NULL)
{
ast_append(type, viewpoint_type(l_type, child));
child = ast_sibling(child);
}
return type;
}
case TK_TYPEPARAMREF:
upper = VIEW_UPPER_NO;
break;
case TK_NOMINAL:
{
ast_t* cap = cap_fetch(r_type);
switch(ast_id(cap))
{
case TK_ISO:
case TK_TRN:
case TK_REF:
case TK_BOX:
// A known refcap on the right can be compacted.
upper = VIEW_UPPER_YES;
break;
case TK_VAL:
case TK_TAG:
case TK_CAP_SHARE:
// No refcap on the left modifies these.
upper = VIEW_UPPER_FORCE;
break;
default: {}
}
break;
}
case TK_ARROW:
break;
default:
pony_assert(0);
return NULL;
}
switch(ast_id(l_type))
{
case TK_NOMINAL:
case TK_TYPEPARAMREF:
{
ast_t* cap = cap_fetch(l_type);
switch(ast_id(cap))
{
case TK_REF:
// ref->T = T
return ast_dup(r_type);
case TK_CAP_SEND:
case TK_CAP_SHARE:
case TK_CAP_READ:
case TK_CAP_ALIAS:
case TK_CAP_ANY:
// Don't compact through an unknown refcap.
if(upper == VIEW_UPPER_YES)
upper = VIEW_UPPER_NO;
break;
default: {}
}
break;
}
case TK_THISTYPE:
if(upper == VIEW_UPPER_YES)
upper = VIEW_UPPER_NO;
break;
case TK_ISO:
case TK_TRN:
case TK_REF:
case TK_VAL:
case TK_BOX:
case TK_TAG:
break;
case TK_ARROW:
{
// (T1->T2)->T3 --> T1->(T2->T3)
AST_GET_CHILDREN(l_type, left, right);
ast_t* r_right = viewpoint_type(right, r_type);
return viewpoint_type(left, r_right);
}
default:
pony_assert(0);
return NULL;
}
BUILD(arrow, l_type,
NODE(TK_ARROW, TREE(ast_dup(l_type)) TREE(ast_dup(r_type))));
if(upper != VIEW_UPPER_NO)
{
ast_t* arrow_upper = viewpoint_upper(arrow);
if(arrow_upper == NULL)
return arrow;
if(arrow != arrow_upper)
{
ast_free_unattached(arrow);
arrow = arrow_upper;
}
}
return arrow;
}
LLVMValueRef gen_funptr(compile_t* c, ast_t* ast)
{
pony_assert((ast_id(ast) == TK_FUNREF) || (ast_id(ast) == TK_BEREF));
AST_GET_CHILDREN(ast, receiver, method);
ast_t* typeargs = NULL;
// Dig through function qualification.
switch(ast_id(receiver))
{
case TK_BEREF:
case TK_FUNREF:
typeargs = method;
AST_GET_CHILDREN_NO_DECL(receiver, receiver, method);
break;
default: {}
}
// Generate the receiver.
LLVMValueRef value = gen_expr(c, receiver);
// Get the receiver type.
ast_t* type = deferred_reify(c->frame->reify, ast_type(receiver), c->opt);
reach_type_t* t = reach_type(c->reach, type);
pony_assert(t != NULL);
const char* name = ast_name(method);
token_id cap = cap_dispatch(type);
reach_method_t* m = reach_method(t, cap, name, typeargs);
LLVMValueRef funptr = dispatch_function(c, t, m, value);
ast_free_unattached(type);
if((m->cap != TK_AT) && (c->linkage != LLVMExternalLinkage))
{
// We must reset the function linkage and calling convention since we're
// passing a function pointer to a FFI call. Bare methods always use the
// external linkage and the C calling convention so we don't need to process
// them.
switch(t->underlying)
{
case TK_PRIMITIVE:
case TK_STRUCT:
case TK_CLASS:
case TK_ACTOR:
{
compile_method_t* c_m = (compile_method_t*)m->c_method;
LLVMSetFunctionCallConv(c_m->func, LLVMCCallConv);
LLVMSetLinkage(c_m->func, LLVMExternalLinkage);
break;
}
case TK_UNIONTYPE:
case TK_ISECTTYPE:
case TK_INTERFACE:
case TK_TRAIT:
set_method_external_interface(t, name, m->vtable_index);
break;
default:
pony_assert(0);
break;
}
}
return funptr;
}
static ast_t* find_infer_type(ast_t* type, infer_path_t* path)
{
assert(type != NULL);
switch(ast_id(type))
{
case TK_TUPLETYPE:
if(path == NULL) // End of path, infer the whole tuple
return type;
if(path->index >= ast_childcount(type)) // Cardinality mismatch
return NULL;
return find_infer_type(ast_childidx(type, path->index), path->next);
case TK_UNIONTYPE:
{
// Infer all children
ast_t* u_type = NULL;
for(ast_t* p = ast_child(type); p != NULL; p = ast_sibling(p))
{
ast_t* t = find_infer_type(p, path);
if(t == NULL)
{
// Propogate error
ast_free_unattached(u_type);
return NULL;
}
u_type = type_union(u_type, t);
}
return u_type;
}
case TK_ISECTTYPE:
{
// Infer all children
ast_t* i_type = NULL;
for(ast_t* p = ast_child(type); p != NULL; p = ast_sibling(p))
{
ast_t* t = find_infer_type(p, path);
if(t == NULL)
{
// Propogate error
ast_free_unattached(i_type);
return NULL;
}
i_type = type_isect(i_type, t);
}
return i_type;
}
default:
if(path != NULL) // Type doesn't match path
return NULL;
// Just return whatever this type is
return type;
}
}
void gen_send_message(compile_t* c, reach_method_t* m, LLVMValueRef args[],
ast_t* args_ast)
{
// Allocate the message, setting its size and ID.
compile_method_t* c_m = (compile_method_t*)m->c_method;
size_t msg_size = (size_t)LLVMABISizeOfType(c->target_data, c_m->msg_type);
LLVMTypeRef msg_type_ptr = LLVMPointerType(c_m->msg_type, 0);
size_t params_buf_size = (m->param_count + 3) * sizeof(LLVMTypeRef);
LLVMTypeRef* param_types =
(LLVMTypeRef*)ponyint_pool_alloc_size(params_buf_size);
LLVMGetStructElementTypes(c_m->msg_type, param_types);
size_t args_buf_size = (m->param_count + 1) * sizeof(LLVMValueRef);
LLVMValueRef* cast_args =
(LLVMValueRef*)ponyint_pool_alloc_size(args_buf_size);
size_t arg_types_buf_size = m->param_count * sizeof(ast_t*);
ast_t** arg_types = (ast_t**)ponyint_pool_alloc_size(arg_types_buf_size);
ast_t* arg_ast = ast_child(args_ast);
deferred_reification_t* reify = c->frame->reify;
for(size_t i = 0; i < m->param_count; i++)
{
arg_types[i] = deferred_reify(reify, ast_type(arg_ast), c->opt);
cast_args[i+1] = gen_assign_cast(c, param_types[i+3], args[i+1],
arg_types[i]);
arg_ast = ast_sibling(arg_ast);
}
LLVMValueRef msg_args[5];
msg_args[0] = LLVMConstInt(c->i32, ponyint_pool_index(msg_size), false);
msg_args[1] = LLVMConstInt(c->i32, m->vtable_index, false);
LLVMValueRef msg = gencall_runtime(c, "pony_alloc_msg", msg_args, 2, "");
LLVMValueRef md = LLVMMDNodeInContext(c->context, NULL, 0);
LLVMSetMetadataStr(msg, "pony.msgsend", md);
LLVMValueRef msg_ptr = LLVMBuildBitCast(c->builder, msg, msg_type_ptr, "");
for(unsigned int i = 0; i < m->param_count; i++)
{
LLVMValueRef arg_ptr = LLVMBuildStructGEP(c->builder, msg_ptr, i + 3, "");
LLVMBuildStore(c->builder, cast_args[i+1], arg_ptr);
}
// Trace while populating the message contents.
bool need_trace = false;
for(size_t i = 0; i < m->param_count; i++)
{
if(gentrace_needed(c, arg_types[i], m->params[i].ast))
{
need_trace = true;
break;
}
}
LLVMValueRef ctx = codegen_ctx(c);
if(need_trace)
{
LLVMValueRef gc = gencall_runtime(c, "pony_gc_send", &ctx, 1, "");
LLVMSetMetadataStr(gc, "pony.msgsend", md);
for(size_t i = 0; i < m->param_count; i++)
{
gentrace(c, ctx, args[i+1], cast_args[i+1], arg_types[i],
m->params[i].ast);
}
gc = gencall_runtime(c, "pony_send_done", &ctx, 1, "");
LLVMSetMetadataStr(gc, "pony.msgsend", md);
}
// Send the message.
msg_args[0] = ctx;
msg_args[1] = LLVMBuildBitCast(c->builder, args[0], c->object_ptr, "");
msg_args[2] = msg;
msg_args[3] = msg;
msg_args[4] = LLVMConstInt(c->i1, 1, false);
LLVMValueRef send;
if(ast_id(m->fun->ast) == TK_NEW)
send = gencall_runtime(c, "pony_sendv_single", msg_args, 5, "");
else
send = gencall_runtime(c, "pony_sendv", msg_args, 5, "");
LLVMSetMetadataStr(send, "pony.msgsend", md);
ponyint_pool_free_size(params_buf_size, param_types);
ponyint_pool_free_size(args_buf_size, cast_args);
for(size_t i = 0; i < m->param_count; i++)
ast_free_unattached(arg_types[i]);
ponyint_pool_free_size(arg_types_buf_size, arg_types);
}
static infer_ret_t infer_local_inner(ast_t* left, ast_t* r_type,
infer_path_t* path)
{
assert(left != NULL);
assert(r_type != NULL);
assert(path != NULL);
assert(path->root != NULL);
infer_ret_t ret_val = INFER_NOP;
switch(ast_id(left))
{
case TK_SEQ:
{
assert(ast_childcount(left) == 1);
infer_ret_t r = infer_local_inner(ast_child(left), r_type, path);
if(r == INFER_OK) // Update seq type
ast_settype(left, ast_type(ast_child(left)));
return r;
}
case TK_TUPLE:
{
// Add a new node to the end of the path
infer_path_t path_node = { 0, NULL, path->root };
path->next = &path_node;
for(ast_t* p = ast_child(left); p != NULL; p = ast_sibling(p))
{
infer_ret_t r = infer_local_inner(p, r_type, &path_node);
if(r == INFER_ERROR)
return INFER_ERROR;
if(r == INFER_OK)
{
// Update tuple type element to remove infer type
ast_t* old_ele = ast_childidx(ast_type(left), path_node.index);
ast_replace(&old_ele, ast_type(p));
ret_val = INFER_OK;
}
path_node.index++;
}
// Pop our node off the path
path->next = NULL;
return ret_val;
}
case TK_VAR:
case TK_LET:
{
ast_t* var_type = ast_type(left);
assert(var_type != NULL);
if(ast_id(var_type) != TK_INFERTYPE) // No inferring needed
return INFER_NOP;
ast_t* infer_type = find_infer_type(r_type, path->root->next);
if(infer_type == NULL)
{
ast_error(left, "could not infer type of local");
ast_settype(left, ast_from(left, TK_ERRORTYPE));
return INFER_ERROR;
}
// Variable type is the alias of the inferred type
ast_t* a_type = alias(infer_type);
ast_settype(left, a_type);
ast_settype(ast_child(left), a_type);
// Add the type to the var / let AST as if it had been specified by the
// user. Not really needed, but makes testing easier
ast_t* speced_type = ast_childidx(left, 1);
assert(ast_id(speced_type) == TK_NONE);
ast_replace(&speced_type, a_type);
ast_free_unattached(infer_type);
return INFER_OK;
}
default:
// No locals to infer here
return INFER_NOP;
}
}
LLVMValueRef gen_call(compile_t* c, ast_t* ast)
{
// Special case calls.
LLVMValueRef special;
if(special_case_call(c, ast, &special))
return special;
AST_GET_CHILDREN(ast, postfix, positional, named, question);
AST_GET_CHILDREN(postfix, receiver, method);
ast_t* typeargs = NULL;
deferred_reification_t* reify = c->frame->reify;
// Dig through function qualification.
switch(ast_id(receiver))
{
case TK_NEWREF:
case TK_NEWBEREF:
case TK_BEREF:
case TK_FUNREF:
case TK_BECHAIN:
case TK_FUNCHAIN:
typeargs = deferred_reify(reify, method, c->opt);
AST_GET_CHILDREN_NO_DECL(receiver, receiver, method);
break;
default: {}
}
// Get the receiver type.
const char* method_name = ast_name(method);
ast_t* type = deferred_reify(reify, ast_type(receiver), c->opt);
reach_type_t* t = reach_type(c->reach, type);
pony_assert(t != NULL);
token_id cap = cap_dispatch(type);
reach_method_t* m = reach_method(t, cap, method_name, typeargs);
ast_free_unattached(type);
ast_free_unattached(typeargs);
// Generate the arguments.
size_t count = m->param_count + 1;
size_t buf_size = count * sizeof(void*);
LLVMValueRef* args = (LLVMValueRef*)ponyint_pool_alloc_size(buf_size);
ast_t* arg = ast_child(positional);
int i = 1;
while(arg != NULL)
{
LLVMValueRef value = gen_expr(c, arg);
if(value == NULL)
{
ponyint_pool_free_size(buf_size, args);
return NULL;
}
args[i] = value;
arg = ast_sibling(arg);
i++;
}
bool is_new_call = false;
// Generate the receiver. Must be done after the arguments because the args
// could change things in the receiver expression that must be accounted for.
if(call_needs_receiver(postfix, t))
{
switch(ast_id(postfix))
{
case TK_NEWREF:
case TK_NEWBEREF:
args[0] = gen_constructor_receiver(c, t, ast);
is_new_call = true;
break;
case TK_BEREF:
case TK_FUNREF:
case TK_BECHAIN:
case TK_FUNCHAIN:
args[0] = gen_expr(c, receiver);
break;
default:
pony_assert(0);
return NULL;
}
} else {
// Use a null for the receiver type.
args[0] = LLVMConstNull(((compile_type_t*)t->c_type)->use_type);
}
// Static or virtual dispatch.
LLVMValueRef func = dispatch_function(c, t, m, args[0]);
bool is_message = false;
if((ast_id(postfix) == TK_NEWBEREF) || (ast_id(postfix) == TK_BEREF) ||
(ast_id(postfix) == TK_BECHAIN))
{
switch(t->underlying)
{
case TK_ACTOR:
is_message = true;
break;
case TK_UNIONTYPE:
case TK_ISECTTYPE:
case TK_INTERFACE:
case TK_TRAIT:
if(m->cap == TK_TAG)
is_message = can_inline_message_send(t, m, method_name);
break;
default: {}
}
}
bool bare = m->cap == TK_AT;
LLVMValueRef r = NULL;
if(is_message)
{
// If we're sending a message, trace and send here instead of calling the
// sender to trace the most specific types possible.
codegen_debugloc(c, ast);
gen_send_message(c, m, args, positional);
codegen_debugloc(c, NULL);
switch(ast_id(postfix))
{
case TK_NEWREF:
case TK_NEWBEREF:
r = args[0];
break;
default:
r = c->none_instance;
break;
}
} else {
LLVMTypeRef f_type = LLVMGetElementType(LLVMTypeOf(func));
LLVMTypeRef* params = (LLVMTypeRef*)ponyint_pool_alloc_size(buf_size);
LLVMGetParamTypes(f_type, params + (bare ? 1 : 0));
arg = ast_child(positional);
i = 1;
while(arg != NULL)
{
ast_t* arg_type = deferred_reify(reify, ast_type(arg), c->opt);
args[i] = gen_assign_cast(c, params[i], args[i], arg_type);
ast_free_unattached(arg_type);
arg = ast_sibling(arg);
i++;
}
uintptr_t arg_offset = 0;
if(bare)
{
arg_offset = 1;
i--;
}
if(func != NULL)
{
// If we can error out and we have an invoke target, generate an invoke
// instead of a call.
codegen_debugloc(c, ast);
if(ast_canerror(ast) && (c->frame->invoke_target != NULL))
r = invoke_fun(c, func, args + arg_offset, i, "", !bare);
else
r = codegen_call(c, func, args + arg_offset, i, !bare);
if(is_new_call)
{
LLVMValueRef md = LLVMMDNodeInContext(c->context, NULL, 0);
LLVMSetMetadataStr(r, "pony.newcall", md);
}
codegen_debugloc(c, NULL);
ponyint_pool_free_size(buf_size, params);
}
}
// Bare methods with None return type return void, special case a None return
// value.
if(bare && is_none(m->result->ast))
r = c->none_instance;
// Class constructors return void, expression result is the receiver.
if(((ast_id(postfix) == TK_NEWREF) || (ast_id(postfix) == TK_NEWBEREF)) &&
(t->underlying == TK_CLASS))
r = args[0];
// Chained methods forward their receiver.
if((ast_id(postfix) == TK_BECHAIN) || (ast_id(postfix) == TK_FUNCHAIN))
r = args[0];
ponyint_pool_free_size(buf_size, args);
return r;
}
bool expr_assign(pass_opt_t* opt, ast_t* ast)
{
// Left and right are swapped in the AST to make sure we type check the
// right side before the left. Fetch them in the opposite order.
assert(ast != NULL);
AST_GET_CHILDREN(ast, right, left);
ast_t* l_type = ast_type(left);
if(!is_lvalue(&opt->check, left, is_result_needed(ast)))
{
ast_error(ast, "left side must be something that can be assigned to");
return false;
}
assert(l_type != NULL);
if(!coerce_literals(&right, l_type, opt))
return false;
ast_t* r_type = ast_type(right);
if(is_typecheck_error(r_type))
return false;
if(!infer_locals(left, r_type))
return false;
// Inferring locals may have changed the left type.
l_type = ast_type(left);
// Assignment is based on the alias of the right hand side.
ast_t* a_type = alias(r_type);
if(!is_subtype(a_type, l_type, true))
{
ast_error(ast, "right side must be a subtype of left side");
ast_error(a_type, "right side type: %s", ast_print_type(a_type));
ast_error(l_type, "left side type: %s", ast_print_type(l_type));
ast_free_unattached(a_type);
return false;
}
if((ast_id(left) == TK_TUPLE) && (ast_id(a_type) != TK_TUPLETYPE))
{
switch(ast_id(a_type))
{
case TK_UNIONTYPE:
ast_error(ast,
"can't destructure a union using assignment, use pattern matching "
"instead");
break;
case TK_ISECTTYPE:
ast_error(ast,
"can't destructure an intersection using assignment, use pattern "
"matching instead");
break;
default:
assert(0);
break;
}
ast_error(a_type, "right side type: %s", ast_print_type(a_type));
ast_free_unattached(a_type);
return false;
}
bool ok_safe = safe_to_write(left, a_type);
if(!ok_safe)
{
if(ast_id(left) == TK_FVARREF && ast_child(left) != NULL &&
ast_id(ast_child(left)) == TK_THIS)
{
// We are writing to a field in this
ast_t* fn = ast_nearest(left, TK_FUN);
if(fn != NULL)
{
ast_t* iso = ast_child(fn);
assert(iso != NULL);
token_id iso_id = ast_id(iso);
if(iso_id == TK_BOX || iso_id == TK_VAL || iso_id == TK_TAG)
{
ast_error(ast, "cannot write to a field in a %s function. If you are trying to change state in a function use fun ref",
lexer_print(iso_id));
ast_free_unattached(a_type);
return false;
}
}
}
ast_error(ast, "not safe to write right side to left side");
ast_error(a_type, "right side type: %s", ast_print_type(a_type));
ast_free_unattached(a_type);
return false;
}
ast_free_unattached(a_type);
// If it's an embedded field, check for a constructor result.
if(ast_id(left) == TK_EMBEDREF)
{
if((ast_id(right) != TK_CALL) ||
(ast_id(ast_childidx(right, 2)) != TK_NEWREF))
{
ast_error(ast, "an embedded field must be assigned using a constructor");
return false;
}
}
ast_settype(ast, consume_type(l_type, TK_NONE));
ast_inheritflags(ast);
return true;
}
bool expr_if(pass_opt_t* opt, ast_t* ast)
{
ast_t* cond = ast_child(ast);
ast_t* left = ast_sibling(cond);
ast_t* right = ast_sibling(left);
if(ast_id(ast) == TK_IF)
{
ast_t* cond_type = ast_type(cond);
if(is_typecheck_error(cond_type))
return false;
if(!is_bool(cond_type))
{
ast_error(opt->check.errors, cond, "condition must be a Bool");
return false;
}
}
ast_t* l_type = ast_type(left);
ast_t* r_type = ast_type(right);
if(is_typecheck_error(l_type) || is_typecheck_error(r_type))
return false;
ast_t* type = NULL;
size_t branch_count = 0;
if(!is_control_type(l_type))
{
type = control_type_add_branch(opt, type, left);
ast_inheritbranch(ast, left);
branch_count++;
}
if(!is_control_type(r_type))
{
type = control_type_add_branch(opt, type, right);
ast_inheritbranch(ast, right);
branch_count++;
}
if(type == NULL)
{
if((ast_id(ast_parent(ast)) == TK_SEQ) && ast_sibling(ast) != NULL)
{
ast_error(opt->check.errors, ast_sibling(ast), "unreachable code");
return false;
}
type = ast_from(ast, TK_IF);
}
ast_settype(ast, type);
ast_consolidate_branches(ast, branch_count);
literal_unify_control(ast, opt);
// Push our symbol status to our parent scope.
ast_inheritstatus(ast_parent(ast), ast);
if(ast_id(ast) == TK_IFDEF)
return resolve_ifdef(opt, ast);
return true;
}
static bool is_lvalue(typecheck_t* t, ast_t* ast, bool need_value)
{
switch(ast_id(ast))
{
case TK_DONTCARE:
// Can only assign to it if we don't need the value.
return !need_value;
case TK_VAR:
case TK_LET:
return assign_id(t, ast_child(ast), ast_id(ast) == TK_LET, need_value);
case TK_VARREF:
{
ast_t* id = ast_child(ast);
return assign_id(t, id, false, need_value);
}
case TK_LETREF:
{
ast_error(ast, "can't assign to a let local");
return false;
}
case TK_FVARREF:
{
AST_GET_CHILDREN(ast, left, right);
if(ast_id(left) == TK_THIS)
return assign_id(t, right, false, need_value);
return true;
}
case TK_FLETREF:
{
AST_GET_CHILDREN(ast, left, right);
if(ast_id(left) != TK_THIS)
{
ast_error(ast, "can't assign to a let field");
return false;
}
if(t->frame->loop_body != NULL)
{
ast_error(ast, "can't assign to a let field in a loop");
return false;
}
return assign_id(t, right, true, need_value);
}
case TK_EMBEDREF:
{
AST_GET_CHILDREN(ast, left, right);
if(ast_id(left) != TK_THIS)
{
ast_error(ast, "can't assign to an embed field");
return false;
}
if(t->frame->loop_body != NULL)
{
ast_error(ast, "can't assign to an embed field in a loop");
return false;
}
return assign_id(t, right, true, need_value);
}
case TK_TUPLE:
{
// A tuple is an lvalue if every component expression is an lvalue.
ast_t* child = ast_child(ast);
while(child != NULL)
{
if(!is_lvalue(t, child, need_value))
return false;
child = ast_sibling(child);
}
return true;
}
case TK_SEQ:
{
// A sequence is an lvalue if it has a single child that is an lvalue.
// This is used because the components of a tuple are sequences.
ast_t* child = ast_child(ast);
if(ast_sibling(child) != NULL)
return false;
return is_lvalue(t, child, need_value);
}
default: {}
}
return false;
}
bool expr_return(pass_opt_t* opt, ast_t* ast)
{
typecheck_t* t = &opt->check;
// return is always the last expression in a sequence
assert(ast_sibling(ast) == NULL);
ast_t* parent = ast_parent(ast);
ast_t* current = ast;
while(ast_id(parent) == TK_SEQ)
{
assert(ast_childlast(parent) == current);
current = parent;
parent = ast_parent(parent);
}
if(current == t->frame->method_body)
{
ast_error(opt->check.errors, ast,
"use return only to exit early from a method, not at the end");
return false;
}
ast_t* type = ast_childidx(t->frame->method, 4);
ast_t* body = ast_child(ast);
if(!coerce_literals(&body, type, opt))
return false;
ast_t* body_type = ast_type(body);
if(is_typecheck_error(body_type))
return false;
if(is_control_type(body_type))
{
ast_error(opt->check.errors, body,
"return value cannot be a control statement");
return false;
}
bool ok = true;
switch(ast_id(t->frame->method))
{
case TK_NEW:
if(is_this_incomplete(t, ast))
{
ast_error(opt->check.errors, ast,
"all fields must be defined before constructor returns");
ok = false;
}
break;
case TK_BE:
assert(is_none(body_type));
break;
default:
{
// The body type must be a subtype of the return type, and an alias of
// the body type must be a subtype of an alias of the return type.
ast_t* a_type = alias(type);
ast_t* a_body_type = alias(body_type);
errorframe_t info = NULL;
if(!is_subtype(body_type, type, &info, opt) ||
!is_subtype(a_body_type, a_type, &info, opt))
{
errorframe_t frame = NULL;
ast_t* last = ast_childlast(body);
ast_error_frame(&frame, last, "returned value isn't the return type");
ast_error_frame(&frame, type, "function return type: %s",
ast_print_type(type));
ast_error_frame(&frame, body_type, "returned value type: %s",
ast_print_type(body_type));
errorframe_append(&frame, &info);
errorframe_report(&frame, opt->check.errors);
ok = false;
}
ast_free_unattached(a_type);
ast_free_unattached(a_body_type);
}
}
ast_settype(ast, ast_from(ast, TK_RETURN));
return ok;
}
bool safe_to_write(ast_t* ast, ast_t* type)
{
switch(ast_id(ast))
{
case TK_VAR:
case TK_LET:
case TK_VARREF:
case TK_DONTCARE:
return true;
case TK_FVARREF:
case TK_FLETREF:
case TK_EMBEDREF:
{
// If the ast is x.f, we need the type of x, which will be a nominal
// type or an arrow type, since we were able to lookup a field on it.
AST_GET_CHILDREN(ast, left, right);
ast_t* l_type = ast_type(left);
// Any viewpoint adapted type will not be safe to write to.
if(ast_id(l_type) != TK_NOMINAL)
return false;
token_id l_cap = cap_single(l_type);
// If the RHS is safe to write, we're done.
if(safe_field_write(l_cap, type))
return true;
// If the field type (without adaptation) is safe, then it's ok as
// well. So iso.tag = ref should be allowed.
ast_t* r_type = ast_type(right);
return safe_field_write(l_cap, r_type);
}
case TK_TUPLE:
{
// At this point, we know these will be the same length.
assert(ast_id(type) == TK_TUPLETYPE);
ast_t* child = ast_child(ast);
ast_t* type_child = ast_child(type);
while(child != NULL)
{
if(!safe_to_write(child, type_child))
return false;
child = ast_sibling(child);
type_child = ast_sibling(type_child);
}
assert(type_child == NULL);
return true;
}
case TK_SEQ:
{
// Occurs when there is a tuple on the left. Each child of the tuple will
// be a sequence, but only sequences with a single writeable child are
// valid. Other types won't appear here.
return safe_to_write(ast_child(ast), type);
}
default: {}
}
assert(0);
return false;
}
static void print_type(printbuf_t* buffer, ast_t* type)
{
switch(ast_id(type))
{
case TK_NOMINAL:
{
AST_GET_CHILDREN(type, package, id, typeargs, cap, ephemeral);
ast_t* origpkg = ast_sibling(ephemeral);
if(origpkg != NULL && ast_id(origpkg) != TK_NONE)
printbuf(buffer, "%s.", ast_name(origpkg));
ast_t* def = (ast_t*)ast_data(type);
if(def != NULL)
id = ast_child(def);
printbuf(buffer, "%s", ast_nice_name(id));
if(ast_id(typeargs) != TK_NONE)
print_typeexpr(buffer, typeargs, ", ", true);
if(ast_id(cap) != TK_NONE)
printbuf(buffer, " %s", token_print(cap->t));
if(ast_id(ephemeral) != TK_NONE)
printbuf(buffer, "%s", token_print(ephemeral->t));
break;
}
case TK_UNIONTYPE:
print_typeexpr(buffer, type, " | ", false);
break;
case TK_ISECTTYPE:
print_typeexpr(buffer, type, " & ", false);
break;
case TK_TUPLETYPE:
print_typeexpr(buffer, type, ", ", false);
break;
case TK_TYPEPARAMREF:
{
AST_GET_CHILDREN(type, id, cap, ephemeral);
printbuf(buffer, "%s", ast_nice_name(id));
if(ast_id(cap) != TK_NONE)
printbuf(buffer, " %s", token_print(cap->t));
if(ast_id(ephemeral) != TK_NONE)
printbuf(buffer, " %s", token_print(ephemeral->t));
break;
}
case TK_ARROW:
{
AST_GET_CHILDREN(type, left, right);
print_type(buffer, left);
printbuf(buffer, "->");
print_type(buffer, right);
break;
}
case TK_THISTYPE:
printbuf(buffer, "this");
break;
case TK_DONTCARE:
printbuf(buffer, "_");
break;
case TK_FUNTYPE:
printbuf(buffer, "function");
break;
case TK_INFERTYPE:
printbuf(buffer, "to_infer");
break;
case TK_ERRORTYPE:
printbuf(buffer, "<type error>");
break;
case TK_NONE:
break;
default:
printbuf(buffer, "%s", token_print(type->t));
}
}
LLVMValueRef gen_ffi(compile_t* c, ast_t* ast)
{
AST_GET_CHILDREN(ast, id, typeargs, args, named_args, can_err);
bool err = (ast_id(can_err) == TK_QUESTION);
// Get the function name, +1 to skip leading @
const char* f_name = ast_name(id) + 1;
deferred_reification_t* reify = c->frame->reify;
// Get the return type.
ast_t* type = deferred_reify(reify, ast_type(ast), c->opt);
reach_type_t* t = reach_type(c->reach, type);
pony_assert(t != NULL);
ast_free_unattached(type);
// Get the function. First check if the name is in use by a global and error
// if it's the case.
ffi_decl_t* ffi_decl;
bool is_func = false;
LLVMValueRef func = LLVMGetNamedGlobal(c->module, f_name);
if(func == NULL)
{
func = LLVMGetNamedFunction(c->module, f_name);
is_func = true;
}
if(func == NULL)
{
// If we have no prototype, declare one.
ast_t* decl = (ast_t*)ast_data(ast);
if(decl != NULL)
{
// Define using the declared types.
AST_GET_CHILDREN(decl, decl_id, decl_ret, decl_params, decl_err);
err = (ast_id(decl_err) == TK_QUESTION);
func = declare_ffi(c, f_name, t, decl_params, false);
} else if(!strncmp(f_name, "llvm.", 5) || !strncmp(f_name, "internal.", 9)) {
// Intrinsic, so use the exact types we supply.
func = declare_ffi(c, f_name, t, args, true);
} else {
// Make it varargs.
func = declare_ffi_vararg(c, f_name, t);
}
size_t index = HASHMAP_UNKNOWN;
#ifndef PONY_NDEBUG
ffi_decl_t k;
k.func = func;
ffi_decl = ffi_decls_get(&c->ffi_decls, &k, &index);
pony_assert(ffi_decl == NULL);
#endif
ffi_decl = POOL_ALLOC(ffi_decl_t);
ffi_decl->func = func;
ffi_decl->decl = (decl != NULL) ? decl : ast;
ffi_decls_putindex(&c->ffi_decls, ffi_decl, index);
} else {
ffi_decl_t k;
k.func = func;
size_t index = HASHMAP_UNKNOWN;
ffi_decl = ffi_decls_get(&c->ffi_decls, &k, &index);
if((ffi_decl == NULL) && (!is_func || LLVMHasMetadataStr(func, "pony.abi")))
{
ast_error(c->opt->check.errors, ast, "cannot use '%s' as an FFI name: "
"name is already in use by the internal ABI", f_name);
return NULL;
}
pony_assert(is_func);
}
// Generate the arguments.
int count = (int)ast_childcount(args);
size_t buf_size = count * sizeof(LLVMValueRef);
LLVMValueRef* f_args = (LLVMValueRef*)ponyint_pool_alloc_size(buf_size);
LLVMTypeRef f_type = LLVMGetElementType(LLVMTypeOf(func));
LLVMTypeRef* f_params = NULL;
bool vararg = (LLVMIsFunctionVarArg(f_type) != 0);
if(!vararg)
{
if(count != (int)LLVMCountParamTypes(f_type))
{
ast_error(c->opt->check.errors, ast,
"conflicting declarations for FFI function: declarations have an "
"incompatible number of parameters");
if(ffi_decl != NULL)
ast_error_continue(c->opt->check.errors, ffi_decl->decl, "first "
"declaration is here");
return NULL;
}
f_params = (LLVMTypeRef*)ponyint_pool_alloc_size(buf_size);
LLVMGetParamTypes(f_type, f_params);
}
ast_t* arg = ast_child(args);
for(int i = 0; i < count; i++)
{
f_args[i] = gen_expr(c, arg);
if(!vararg)
f_args[i] = cast_ffi_arg(c, ffi_decl, ast, f_args[i], f_params[i],
"parameters");
if(f_args[i] == NULL)
{
ponyint_pool_free_size(buf_size, f_args);
return NULL;
}
arg = ast_sibling(arg);
}
// If we can error out and we have an invoke target, generate an invoke
// instead of a call.
LLVMValueRef result;
codegen_debugloc(c, ast);
if(err && (c->frame->invoke_target != NULL))
result = invoke_fun(c, func, f_args, count, "", false);
else
result = LLVMBuildCall(c->builder, func, f_args, count, "");
codegen_debugloc(c, NULL);
ponyint_pool_free_size(buf_size, f_args);
if(!vararg)
ponyint_pool_free_size(buf_size, f_params);
compile_type_t* c_t = (compile_type_t*)t->c_type;
// Special case a None return value, which is used for void functions.
bool isnone = is_none(t->ast);
bool isvoid = LLVMGetReturnType(f_type) == c->void_type;
if(isnone && isvoid)
{
result = c_t->instance;
} else if(isnone != isvoid) {
report_ffi_type_err(c, ffi_decl, ast, "return values");
return NULL;
}
result = cast_ffi_arg(c, ffi_decl, ast, result, c_t->use_type,
"return values");
result = gen_assign_cast(c, c_t->use_type, result, t->ast_cap);
return result;
}
bool expr_match(pass_opt_t* opt, ast_t* ast)
{
assert(ast_id(ast) == TK_MATCH);
AST_GET_CHILDREN(ast, expr, cases, else_clause);
// A literal match expression should have been caught by the cases, but check
// again to avoid an assert if we've missed a case
ast_t* expr_type = ast_type(expr);
if(is_typecheck_error(expr_type))
return false;
if(is_type_literal(expr_type))
{
ast_error(expr, "cannot infer type for literal match expression");
return false;
}
ast_t* cases_type = ast_type(cases);
ast_t* else_type = ast_type(else_clause);
if(is_typecheck_error(cases_type) || is_typecheck_error(else_type))
return false;
ast_t* type = NULL;
size_t branch_count = 0;
if(!is_control_type(cases_type))
{
type = control_type_add_branch(type, cases);
ast_inheritbranch(ast, cases);
branch_count++;
}
if(!is_control_type(else_type))
{
type = control_type_add_branch(type, else_clause);
ast_inheritbranch(ast, else_clause);
branch_count++;
}
if(type == NULL)
{
if(ast_sibling(ast) != NULL)
{
ast_error(ast_sibling(ast), "unreachable code");
return false;
}
type = ast_from(ast, TK_MATCH);
}
ast_settype(ast, type);
ast_inheritflags(ast);
ast_consolidate_branches(ast, branch_count);
literal_unify_control(ast, opt);
// Push our symbol status to our parent scope.
ast_inheritstatus(ast_parent(ast), ast);
return true;
}
static bool special_case_call(compile_t* c, ast_t* ast, LLVMValueRef* value)
{
AST_GET_CHILDREN(ast, postfix, positional, named, question);
if((ast_id(postfix) != TK_FUNREF) || (ast_id(named) != TK_NONE))
return false;
AST_GET_CHILDREN(postfix, receiver, method);
ast_t* receiver_type = deferred_reify(c->frame->reify, ast_type(receiver),
c->opt);
const char* name = NULL;
if(ast_id(receiver_type) == TK_NOMINAL)
{
AST_GET_CHILDREN(receiver_type, package, id);
if(ast_name(package) == c->str_builtin)
name = ast_name(id);
}
ast_free_unattached(receiver_type);
if(name == NULL)
return false;
if(name == c->str_Bool)
return special_case_operator(c, ast, value, true, true);
if((name == c->str_I8) ||
(name == c->str_I16) ||
(name == c->str_I32) ||
(name == c->str_I64) ||
(name == c->str_ILong) ||
(name == c->str_ISize) ||
(name == c->str_U8) ||
(name == c->str_U16) ||
(name == c->str_U32) ||
(name == c->str_U64) ||
(name == c->str_ULong) ||
(name == c->str_USize) ||
(name == c->str_F32) ||
(name == c->str_F64)
)
{
return special_case_operator(c, ast, value, false, true);
}
if((name == c->str_I128) || (name == c->str_U128))
{
bool native128 = target_is_native128(c->opt->triple);
return special_case_operator(c, ast, value, false, native128);
}
if(name == c->str_Platform)
{
*value = special_case_platform(c, ast);
return true;
}
return false;
}
LLVMValueRef gen_expr(compile_t* c, ast_t* ast)
{
LLVMValueRef ret;
bool has_scope = ast_has_scope(ast);
bool has_source = codegen_hassource(c);
if(has_scope)
{
codegen_pushscope(c);
// Dwarf a new lexical scope, if necessary.
if(has_source)
dwarf_lexicalscope(&c->dwarf, ast);
}
switch(ast_id(ast))
{
case TK_SEQ:
ret = gen_seq(c, ast);
break;
case TK_FVARREF:
case TK_FLETREF:
ret = gen_fieldload(c, ast);
break;
case TK_EMBEDREF:
ret = gen_fieldptr(c, ast);
break;
case TK_PARAMREF:
ret = gen_param(c, ast);
break;
case TK_VAR:
case TK_LET:
case TK_MATCH_CAPTURE:
ret = gen_localdecl(c, ast);
break;
case TK_VARREF:
case TK_LETREF:
ret = gen_localload(c, ast);
break;
case TK_IF:
ret = gen_if(c, ast);
break;
case TK_WHILE:
ret = gen_while(c, ast);
break;
case TK_REPEAT:
ret = gen_repeat(c, ast);
break;
case TK_TRY:
case TK_TRY_NO_CHECK:
ret = gen_try(c, ast);
break;
case TK_MATCH:
ret = gen_match(c, ast);
break;
case TK_CALL:
ret = gen_call(c, ast);
break;
case TK_CONSUME:
ret = gen_expr(c, ast_childidx(ast, 1));
break;
case TK_RECOVER:
ret = gen_expr(c, ast_childidx(ast, 1));
break;
case TK_BREAK:
ret = gen_break(c, ast);
break;
case TK_CONTINUE:
ret = gen_continue(c, ast);
break;
case TK_RETURN:
ret = gen_return(c, ast);
break;
case TK_ERROR:
ret = gen_error(c, ast);
break;
case TK_IS:
ret = gen_is(c, ast);
break;
case TK_ISNT:
ret = gen_isnt(c, ast);
break;
case TK_ASSIGN:
ret = gen_assign(c, ast);
break;
case TK_THIS:
ret = gen_this(c, ast);
break;
case TK_TRUE:
ret = LLVMConstInt(c->i1, 1, false);
break;
case TK_FALSE:
ret = LLVMConstInt(c->i1, 0, false);
break;
case TK_INT:
ret = gen_int(c, ast);
break;
case TK_FLOAT:
ret = gen_float(c, ast);
break;
case TK_STRING:
ret = gen_string(c, ast);
break;
case TK_TUPLE:
ret = gen_tuple(c, ast);
break;
case TK_FFICALL:
ret = gen_ffi(c, ast);
break;
case TK_ADDRESS:
ret = gen_addressof(c, ast);
break;
case TK_IDENTITY:
ret = gen_identity(c, ast);
break;
case TK_DONTCARE:
ret = GEN_NOVALUE;
break;
case TK_COMPILE_INTRINSIC:
ast_error(ast, "unimplemented compile intrinsic");
return NULL;
case TK_COMPILE_ERROR:
{
ast_t* reason_seq = ast_child(ast);
ast_t* reason = ast_child(reason_seq);
ast_error(ast, "compile error: %s", ast_name(reason));
return NULL;
}
default:
ast_error(ast, "not implemented (codegen unknown)");
return NULL;
}
if(has_scope)
{
codegen_popscope(c);
if(has_source)
dwarf_finish(&c->dwarf);
}
return ret;
}
void program_lib_build_args(ast_t* program, pass_opt_t* opt,
const char* path_preamble, const char* rpath_preamble,
const char* global_preamble, const char* global_postamble,
const char* lib_premable, const char* lib_postamble)
{
assert(program != NULL);
assert(ast_id(program) == TK_PROGRAM);
assert(global_preamble != NULL);
assert(global_postamble != NULL);
assert(lib_premable != NULL);
assert(lib_postamble != NULL);
program_t* data = (program_t*)ast_data(program);
assert(data != NULL);
assert(data->lib_args == NULL); // Not yet built args
// Start with an arbitrary amount of space
data->lib_args_alloced = 256;
data->lib_args = (char*)malloc(data->lib_args_alloced);
data->lib_args[0] = '\0';
data->lib_args_size = 0;
// Library paths defined in the source code.
for(strlist_t* p = data->libpaths; p != NULL; p = strlist_next(p))
{
const char* libpath = strlist_data(p);
append_to_args(data, path_preamble);
append_to_args(data, libpath);
append_to_args(data, " ");
if(rpath_preamble != NULL)
{
append_to_args(data, rpath_preamble);
append_to_args(data, libpath);
append_to_args(data, " ");
}
}
// Library paths from the command line and environment variable.
for(strlist_t* p = package_paths(); p != NULL; p = strlist_next(p))
{
const char* libpath = quoted_locator(opt, NULL, strlist_data(p));
if(libpath == NULL)
continue;
append_to_args(data, path_preamble);
append_to_args(data, libpath);
append_to_args(data, " ");
if(rpath_preamble != NULL)
{
append_to_args(data, rpath_preamble);
append_to_args(data, libpath);
append_to_args(data, " ");
}
}
// Library names.
append_to_args(data, global_preamble);
for(strlist_t* p = data->libs; p != NULL; p = strlist_next(p))
{
const char* lib = strlist_data(p);
bool amble = !is_path_absolute(&lib[1]);
if(amble)
append_to_args(data, lib_premable);
append_to_args(data, lib);
if(amble)
append_to_args(data, lib_postamble);
append_to_args(data, " ");
}
append_to_args(data, global_postamble);
}