// Check whether the given node is a valid provides type
static bool check_provides_type(ast_t* type)
{
assert(type != NULL);
switch(ast_id(type))
{
case TK_NOMINAL:
{
AST_GET_CHILDREN(type, ignore0, ignore1, ignore2, cap, ephemeral);
if(ast_id(cap) != TK_NONE)
{
ast_error(cap, "can't specify a capability in a provides type");
return false;
}
if(ast_id(ephemeral) != TK_NONE)
{
ast_error(ephemeral, "can't specify ephemeral in a provides type");
return false;
}
return true;
}
case TK_PROVIDES:
case TK_ISECTTYPE:
// Check all our children are also legal
for(ast_t* p = ast_child(type); p != NULL; p = ast_sibling(p))
{
if(!check_provides_type(p))
return false;
}
return true;
default:
ast_error(type, "invalid provides type. Can only provide "
"interfaces, traits and intersects of those.");
return false;
}
}
static void list_doc_params(docgen_t* docgen, ast_t* params)
{
assert(docgen != NULL);
assert(docgen->type_file != NULL);
assert(params != NULL);
ast_t* first = ast_child(params);
for(ast_t* param = first; param != NULL; param = ast_sibling(param))
{
if(param == first)
fprintf(docgen->type_file, "#### Parameters\n\n");
fprintf(docgen->type_file, "* ");
AST_GET_CHILDREN(param, id, type, def_val);
const char* name = ast_name(id);
assert(name != NULL);
fprintf(docgen->type_file, " %s: ", name);
doc_type(docgen, type, true);
// if we have a default value, add it to the documentation
if(ast_id(def_val) != TK_NONE)
{
switch(ast_id(def_val))
{
case TK_STRING:
fprintf(docgen->type_file, "= \"%s\"", ast_get_print(def_val));
break;
default:
fprintf(docgen->type_file, " = %s", ast_get_print(def_val));
break;
}
}
fprintf(docgen->type_file, "\n");
}
fprintf(docgen->type_file, "\n");
}
static ast_t* type_typeexpr(token_id t, ast_t* l_type, ast_t* r_type)
{
bool is_union = t == TK_UNIONTYPE;
if(l_type == NULL)
return r_type;
if(r_type == NULL)
return l_type;
if(is_subtype(l_type, r_type))
{
if(is_union)
return r_type;
else
return l_type;
}
if(is_subtype(r_type, l_type))
{
if(is_union)
return l_type;
else
return r_type;
}
ast_t* type = ast_from(l_type, t);
append_to_typeexpr(type, l_type, is_union);
append_to_typeexpr(type, r_type, is_union);
// If there's only one element, remove the type expression node.
ast_t* child = ast_child(type);
if(ast_sibling(child) == NULL)
{
child = ast_dup(child);
ast_free_unattached(type);
type = child;
}
return type;
}
// A dependency group is a strongly connected component in the dependency graph.
package_group_list_t* package_dependency_groups(ast_t* first_package)
{
package_group_list_t* groups = NULL;
package_stack_t* stack = NULL;
size_t index = 0;
while(first_package != NULL)
{
pony_assert(ast_id(first_package) == TK_PACKAGE);
package_t* package = (package_t*)ast_data(first_package);
if(package->group_index == (size_t)-1)
make_dependency_group(package, &groups, &stack, &index);
first_package = ast_sibling(first_package);
}
pony_assert(stack == NULL);
return package_group_list_reverse(groups);
}
static void show_send(pass_opt_t* opt, ast_t* ast)
{
ast_t* child = ast_child(ast);
while(child != NULL)
{
if(ast_cansend(child) || ast_mightsend(child))
show_send(opt, child);
child = ast_sibling(child);
}
if(ast_id(ast) == TK_CALL)
{
if(ast_cansend(ast))
ast_error(opt->check.errors, ast, "a message can be sent here");
else if(ast_mightsend(ast))
ast_error(opt->check.errors, ast, "a message might be sent here");
}
}
LLVMValueRef gen_seq(compile_t* c, ast_t* ast)
{
ast_t* child = ast_child(ast);
LLVMValueRef value = NULL;
while(child != NULL)
{
if(ast_id(child) == TK_NONE)
break;
value = gen_expr(c, child);
if(value == NULL)
return NULL;
child = ast_sibling(child);
}
return value;
}
static ast_result_t flatten_sendable_params(ast_t* params)
{
ast_t* param = ast_child(params);
ast_result_t r = AST_OK;
while(param != NULL)
{
AST_GET_CHILDREN(param, id, type, def);
if(!sendable(type))
{
ast_error(type, "this parameter must be sendable (iso, val or tag)");
r = AST_ERROR;
}
param = ast_sibling(param);
}
return r;
}
static bool package_access(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
// Left is a packageref, right is an id.
ast_t* left = ast_child(ast);
ast_t* right = ast_sibling(left);
ast_t* type = ast_type(left);
if(is_typecheck_error(type))
return false;
assert(ast_id(left) == TK_PACKAGEREF);
assert(ast_id(right) == TK_ID);
// Must be a type in a package.
const char* package_name = ast_name(ast_child(left));
ast_t* package = ast_get(left, package_name, NULL);
if(package == NULL)
{
ast_error(right, "can't access package '%s'", package_name);
return false;
}
assert(ast_id(package) == TK_PACKAGE);
const char* type_name = ast_name(right);
type = ast_get(package, type_name, NULL);
if(type == NULL)
{
ast_error(right, "can't find type '%s' in package '%s'",
type_name, package_name);
return false;
}
ast_settype(ast, type_sugar(ast, package_name, type_name));
ast_setid(ast, TK_TYPEREF);
return expr_typeref(opt, astp);
}
static ast_result_t syntax_ffi(pass_opt_t* opt, ast_t* ast,
bool return_optional)
{
assert(ast != NULL);
AST_GET_CHILDREN(ast, id, typeargs, args, named_args);
ast_result_t r = AST_OK;
// We don't check FFI names are legal, if the lexer allows it so do we
if((ast_child(typeargs) == NULL && !return_optional) ||
ast_childidx(typeargs, 1) != NULL)
{
ast_error(opt->check.errors, typeargs,
"FFIs must specify a single return type");
r = AST_ERROR;
}
for(ast_t* p = ast_child(args); p != NULL; p = ast_sibling(p))
{
if(ast_id(p) == TK_PARAM)
{
ast_t* def_val = ast_childidx(p, 2);
assert(def_val != NULL);
if(ast_id(def_val) != TK_NONE)
{
ast_error(opt->check.errors, def_val,
"FFIs parameters cannot have default values");
r = AST_ERROR;
}
}
}
if(ast_id(named_args) != TK_NONE)
{
ast_error(opt->check.errors, typeargs, "FFIs cannot take named arguments");
r = AST_ERROR;
}
return r;
}
// Coerce a literal control block to be the specified target type
static bool coerce_control_block(ast_t** astp, ast_t* target_type,
lit_chain_t* chain, pass_opt_t* options, bool report_errors)
{
assert(astp != NULL);
ast_t* literal_expr = *astp;
assert(literal_expr != NULL);
ast_t* lit_type = ast_type(literal_expr);
assert(lit_type != NULL);
assert(ast_id(lit_type) == TK_LITERAL);
ast_t* block_type = ast_type(lit_type);
for(ast_t* p = ast_child(lit_type); p != NULL; p = ast_sibling(p))
{
assert(ast_id(p) == TK_LITERALBRANCH);
ast_t* branch = (ast_t*)ast_data(p);
assert(branch != NULL);
if(!coerce_literal_to_type(&branch, target_type, chain, options,
report_errors))
{
ast_free_unattached(block_type);
return false;
}
block_type = type_union(block_type, ast_type(branch));
}
if(is_typecheck_error(block_type))
return false;
// block_type may be a sub-tree of the current type of literal_expr.
// This means we must copy it before setting it as the type since ast_settype
// will first free the existing type of literal_expr, which may include
// block_type.
if(ast_parent(block_type) != NULL)
block_type = ast_dup(block_type);
ast_settype(literal_expr, block_type);
return true;
}
static bool is_nominal_sub_trait(ast_t* sub, ast_t* super)
{
ast_t* sub_def = (ast_t*)ast_data(sub);
// Get our typeparams and typeargs.
ast_t* typeparams = ast_childidx(sub_def, 1);
ast_t* typeargs = ast_childidx(sub, 2);
// Check traits, depth first.
ast_t* traits = ast_childidx(sub_def, 3);
ast_t* trait = ast_child(traits);
while(trait != NULL)
{
// Reify the trait with our typeargs.
ast_t* r_trait = reify(typeargs, trait, typeparams, typeargs);
if(r_trait == NULL)
return false;
// Use the cap and ephemerality of the subtype.
AST_GET_CHILDREN(sub, pkg, name, typeparams, cap, eph);
ast_t* rr_trait = set_cap_and_ephemeral(r_trait, ast_id(cap), ast_id(eph));
if(rr_trait != r_trait)
{
ast_free_unattached(r_trait);
r_trait = rr_trait;
}
bool is_sub = is_subtype(r_trait, super);
ast_free_unattached(r_trait);
if(is_sub)
return true;
trait = ast_sibling(trait);
}
return false;
}
// Tidy up the method_t structures in the given type
static void tidy_up(ast_t* ast)
{
assert(ast != NULL);
ast_t* members = ast_childidx(ast, 4);
assert(members != NULL);
for(ast_t* p = ast_child(members); p != NULL; p = ast_sibling(p))
{
if(is_method(p))
{
method_t* info = (method_t*)ast_data(p);
assert(info != NULL);
ast_t* body_donor = info->body_donor;
ast_free_unattached(info->reified_default);
POOL_FREE(method_t, info);
ast_setdata(p, body_donor);
}
}
}
static matchtype_t could_subtype_union(ast_t* sub, ast_t* super)
{
// Some component type must be a possible match with the supertype.
ast_t* child = ast_child(sub);
matchtype_t ok = MATCHTYPE_REJECT;
while(child != NULL)
{
matchtype_t sub_ok = could_subtype(child, super);
if(sub_ok != MATCHTYPE_REJECT)
ok = sub_ok;
if(ok == MATCHTYPE_DENY)
return ok;
child = ast_sibling(child);
}
return ok;
}
static reachable_type_t* add_isect_or_union(reachable_method_stack_t** s,
reachable_types_t* r, uint32_t* next_type_id, ast_t* type)
{
reachable_type_t* t = reach_type(r, type);
if(t != NULL)
return t;
t = add_reachable_type(r, type);
t->type_id = ++(*next_type_id);
ast_t* child = ast_child(type);
while(child != NULL)
{
add_type(s, r, next_type_id, child);
child = ast_sibling(child);
}
return t;
}
// Determine the UIF types that the given non-tuple intersection type may be
static int uifset_intersect(pass_opt_t* opt, ast_t* type, lit_chain_t* chain)
{
assert(type != NULL);
assert(ast_id(type) == TK_ISECTTYPE);
int uif_set = UIF_ALL_TYPES;
int constraint = 0;
for(ast_t* p = ast_child(type); p != NULL; p = ast_sibling(p))
{
int r = uifset(opt, p, chain);
if(r == UIF_ERROR) // Propogate errors
return UIF_ERROR;
if((r & UIF_CONSTRAINED) != 0)
{
// We have a formal parameter
constraint = r;
}
else
{
uif_set |= r;
}
}
if(constraint != 0)
{
// We had a formal parameter
int constraint_set = constraint & UIF_ALL_TYPES;
if((constraint_set & uif_set) != constraint_set)
// UIF type limits formal parameter types, no UIF guaranteed
return UIF_NO_TYPES;
return constraint;
}
return uif_set;
}
static bool check_fields_defined(ast_t* ast)
{
assert(ast_id(ast) == TK_NEW);
ast_t* members = ast_parent(ast);
ast_t* member = ast_child(members);
bool result = true;
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
{
sym_status_t status;
ast_t* id = ast_child(member);
ast_t* def = ast_get(ast, ast_name(id), &status);
if((def != member) || (status != SYM_DEFINED))
{
ast_error(def, "field left undefined in constructor");
result = false;
}
break;
}
default: {}
}
member = ast_sibling(member);
}
if(!result)
ast_error(ast, "constructor with undefined fields is here");
return result;
}
static ast_t* get_fun(ast_t* type, const char* name, ast_t* typeargs)
{
ast_t* this_type = set_cap_and_ephemeral(type, TK_REF, TK_NONE);
ast_t* fun = lookup(NULL, NULL, this_type, name);
ast_free_unattached(this_type);
assert(fun != NULL);
if(typeargs != NULL)
{
ast_t* typeparams = ast_childidx(fun, 2);
ast_t* r_fun = reify(fun, typeparams, typeargs);
ast_free_unattached(fun);
fun = r_fun;
assert(fun != NULL);
}
// No signature for any function with a tuple argument or return value, or
// any function that might raise an error.
AST_GET_CHILDREN(fun, cap, id, typeparams, params, result, can_error);
if(ast_id(can_error) == TK_QUESTION)
return NULL;
if(ast_id(result) == TK_TUPLETYPE)
return NULL;
ast_t* param = ast_child(params);
while(param != NULL)
{
AST_GET_CHILDREN(param, p_id, p_type);
if(ast_id(p_type) == TK_TUPLETYPE)
return NULL;
param = ast_sibling(param);
}
return fun;
}
static void init_module(compile_t* c, ast_t* program, pass_opt_t* opt)
{
c->opt = opt;
// Get the first package and the builtin package.
ast_t* package = ast_child(program);
ast_t* builtin = ast_sibling(package);
// If we have only one package, we are compiling builtin itself.
if(builtin == NULL)
builtin = package;
c->reachable = reach_new();
reach_primitives(c->reachable, opt, builtin);
// The name of the first package is the name of the program.
c->filename = package_filename(package);
// LLVM context and machine settings.
c->context = LLVMContextCreate();
c->machine = make_machine(opt);
c->target_data = LLVMGetTargetMachineData(c->machine);
// Create a module.
c->module = LLVMModuleCreateWithNameInContext(c->filename, c->context);
// Set the target triple.
LLVMSetTarget(c->module, opt->triple);
// Set the data layout.
char* layout = LLVMCopyStringRepOfTargetData(c->target_data);
LLVMSetDataLayout(c->module, layout);
LLVMDisposeMessage(layout);
// IR builder.
c->builder = LLVMCreateBuilderInContext(c->context);
// Empty frame stack.
c->frame = NULL;
}
static trace_t trace_type_isect(ast_t* type)
{
trace_t trace = TRACE_DYNAMIC;
for(ast_t* child = ast_child(type);
child != NULL;
child = ast_sibling(child))
{
trace_t t = trace_type(child);
switch(t)
{
case TRACE_NONE:
case TRACE_MAYBE: // Maybe, any refcap.
// Can't be in an isect.
assert(0);
return TRACE_NONE;
case TRACE_PRIMITIVE: // Primitive, any refcap.
case TRACE_ACTOR: // Actor, tag.
case TRACE_KNOWN_VAL:
case TRACE_KNOWN: // Class or struct, not tag.
return t;
case TRACE_UNKNOWN_VAL:
case TRACE_UNKNOWN: // Trait or interface, not tag.
case TRACE_TAG: // Class or struct, tag.
case TRACE_TAG_OR_ACTOR: // Trait or interface, tag.
if(trace > t)
trace = t;
break;
case TRACE_DYNAMIC:
case TRACE_TUPLE:
break;
}
}
return trace;
}
bool is_this_incomplete(typecheck_t* t, ast_t* ast)
{
// If we're in a default argument, we're incomplete by definition.
if(t->frame->method == NULL)
return true;
// If we're not in a constructor, we're complete by definition.
if(ast_id(t->frame->method) != TK_NEW)
return false;
// Check if all fields have been marked as defined.
ast_t* members = ast_childidx(t->frame->type, 4);
ast_t* member = ast_child(members);
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FLET:
case TK_FVAR:
case TK_EMBED:
{
sym_status_t status;
ast_t* id = ast_child(member);
ast_get(ast, ast_name(id), &status);
if(status != SYM_DEFINED)
return true;
break;
}
default: {}
}
member = ast_sibling(member);
}
return false;
}
static bool tuple_contains_embed(ast_t* ast)
{
assert(ast_id(ast) == TK_TUPLE);
ast_t* child = ast_child(ast);
while(child != NULL)
{
if(ast_id(child) != TK_DONTCARE)
{
assert(ast_id(child) == TK_SEQ);
ast_t* member = ast_childlast(child);
if(ast_id(member) == TK_EMBEDREF)
{
return true;
} else if(ast_id(member) == TK_TUPLE) {
if(tuple_contains_embed(member))
return true;
}
}
child = ast_sibling(child);
}
return false;
}
static ast_result_t scope_entity(typecheck_t* t, ast_t* ast)
{
AST_GET_CHILDREN(ast, id, typeparams, cap, provides, members);
if(!set_scope(t, t->frame->package, id, ast))
return AST_ERROR;
// Scope fields and methods immediately, so that the contents of method
// signatures and bodies cannot shadow fields and methods.
ast_t* member = ast_child(members);
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
if(!set_scope(t, member, ast_child(member), member))
return AST_ERROR;
break;
case TK_NEW:
case TK_BE:
case TK_FUN:
if(!scope_method(t, member))
return AST_ERROR;
break;
default:
assert(0);
return AST_FATAL;
}
member = ast_sibling(member);
}
return AST_OK;
}
static void reachable_pattern(reachable_method_stack_t** s,
reachable_types_t* r, uint32_t* next_type_id, ast_t* ast)
{
switch(ast_id(ast))
{
case TK_DONTCARE:
case TK_NONE:
break;
case TK_VAR:
case TK_LET:
{
AST_GET_CHILDREN(ast, idseq, type);
add_type(s, r, next_type_id, type);
break;
}
case TK_TUPLE:
case TK_SEQ:
{
ast_t* child = ast_child(ast);
while(child != NULL)
{
reachable_pattern(s, r, next_type_id, child);
child = ast_sibling(child);
}
break;
}
default:
{
reachable_method(s, r, next_type_id, ast_type(ast), stringtab("eq"),
NULL);
reachable_expr(s, r, next_type_id, ast);
break;
}
}
}
static matchtype_t could_subtype_isect(ast_t* sub, ast_t* super)
{
// If any component is a match, we're a match. Otherwise return the worst
// of reject or deny.
ast_t* child = ast_child(sub);
matchtype_t ok = MATCHTYPE_REJECT;
while(child != NULL)
{
matchtype_t sub_ok = could_subtype(child, super);
if(sub_ok == MATCHTYPE_ACCEPT)
return sub_ok;
if(ok == MATCHTYPE_DENY)
ok = sub_ok;
child = ast_sibling(child);
}
return ok;
}
static ast_result_t syntax_ellipsis(ast_t* ast)
{
assert(ast != NULL);
ast_result_t r = AST_OK;
ast_t* fn = ast_parent(ast_parent(ast));
assert(fn != NULL);
if(ast_id(fn) != TK_FFIDECL)
{
ast_error(ast, "... may only appear in FFI declarations");
r = AST_ERROR;
}
if(ast_sibling(ast) != NULL)
{
ast_error(ast, "... must be the last parameter");
r = AST_ERROR;
}
return r;
}
static void sugar_docstring(ast_t* ast)
{
assert(ast != NULL);
AST_GET_CHILDREN(ast, cap, id, type_params, params, return_type,
error, body, docstring);
if(ast_id(docstring) == TK_NONE)
{
ast_t* first = ast_child(body);
// First expression in body is a docstring if it is a string literal and
// there are any other expressions in the body sequence
if((first != NULL) &&
(ast_id(first) == TK_STRING) &&
(ast_sibling(first) != NULL))
{
ast_pop(body);
ast_replace(&docstring, first);
}
}
}
static ast_result_t sugar_case(ast_t* ast)
{
ast_t* body = ast_childidx(ast, 2);
if(ast_id(body) != TK_NONE)
return AST_OK;
// We have no body, take a copy of the next case with a body
ast_t* next = ast;
ast_t* next_body = body;
while(ast_id(next_body) == TK_NONE)
{
next = ast_sibling(next);
assert(next != NULL);
assert(ast_id(next) == TK_CASE);
next_body = ast_childidx(next, 2);
}
ast_replace(&body, next_body);
return AST_OK;
}
static LLVMValueRef declare_ffi(compile_t* c, const char* f_name,
reach_type_t* t, ast_t* args, bool intrinsic)
{
ast_t* last_arg = ast_childlast(args);
if((last_arg != NULL) && (ast_id(last_arg) == TK_ELLIPSIS))
return declare_ffi_vararg(c, f_name, t);
int count = (int)ast_childcount(args);
size_t buf_size = count * sizeof(LLVMTypeRef);
LLVMTypeRef* f_params = (LLVMTypeRef*)ponyint_pool_alloc_size(buf_size);
count = 0;
ast_t* arg = ast_child(args);
deferred_reification_t* reify = c->frame->reify;
while(arg != NULL)
{
ast_t* p_type = ast_type(arg);
if(p_type == NULL)
p_type = ast_childidx(arg, 1);
p_type = deferred_reify(reify, p_type, c->opt);
reach_type_t* pt = reach_type(c->reach, p_type);
pony_assert(pt != NULL);
f_params[count++] = ((compile_type_t*)pt->c_type)->use_type;
ast_free_unattached(p_type);
arg = ast_sibling(arg);
}
LLVMTypeRef r_type = ffi_return_type(c, t, intrinsic);
LLVMTypeRef f_type = LLVMFunctionType(r_type, f_params, count, false);
LLVMValueRef func = LLVMAddFunction(c->module, f_name, f_type);
ponyint_pool_free_size(buf_size, f_params);
return func;
}
static reach_type_t* add_isect_or_union(reach_t* r, ast_t* type,
pass_opt_t* opt)
{
reach_type_t* t = reach_type(r, type);
if(t != NULL)
return t;
t = add_reach_type(r, type);
t->underlying = ast_id(t->ast);
t->type_id = r->next_type_id++;
ast_t* child = ast_child(type);
while(child != NULL)
{
add_type(r, child, opt);
child = ast_sibling(child);
}
return t;
}
ast_t* type_for_fun(ast_t* ast)
{
AST_GET_CHILDREN(ast, cap, name, typeparams, params, result);
token_id fcap = ast_id(cap);
if(fcap == TK_NONE)
fcap = TK_TAG;
// The params may already have types attached. If we build the function type
// directly from those we'll get nested types which can mess things up. To
// avoid this make a clean version of the params without types.
ast_t* clean_params = ast_dup(params);
for(ast_t* p = ast_child(clean_params); p != NULL; p = ast_sibling(p))
ast_settype(p, NULL);
BUILD(fun, ast,
NODE(TK_FUNTYPE,
NODE(fcap) TREE(typeparams) TREE(clean_params) TREE(result)));
return fun;
}
