static ast_result_t flatten_isect(pass_opt_t* opt, ast_t* ast)
{
// Flatten intersections without testing subtyping. This is to preserve any
// type guarantees that an element in the intersection might make.
// If there are more than 2 children, this has already been flattened.
if(ast_childcount(ast) > 2)
return AST_OK;
AST_EXTRACT_CHILDREN(ast, left, right);
if((opt->check.frame->constraint == NULL) &&
(opt->check.frame->iftype_constraint == NULL) &&
(opt->check.frame->provides == NULL) &&
!is_compat_type(left, right))
{
ast_add(ast, right);
ast_add(ast, left);
ast_error(opt->check.errors, ast,
"intersection types cannot include reference capabilities that are not "
"locally compatible");
return AST_ERROR;
}
flatten_typeexpr_element(ast, left, TK_ISECTTYPE);
flatten_typeexpr_element(ast, right, TK_ISECTTYPE);
return AST_OK;
}
static bool apply_default_arg(pass_opt_t* opt, ast_t* param, ast_t* arg)
{
// Pick up a default argument.
AST_GET_CHILDREN(param, id, type, def_arg);
if(ast_id(def_arg) == TK_NONE)
{
ast_error(opt->check.errors, arg, "not enough arguments");
return false;
}
if(ast_id(def_arg) == TK_LOCATION)
{
// Default argument is __loc. Expand call location.
ast_t* location = expand_location(arg);
ast_add(arg, location);
if(!ast_passes_subtree(&location, opt, PASS_EXPR))
return false;
}
else
{
// Just use default argument.
ast_add(arg, def_arg);
}
ast_setid(arg, TK_SEQ);
if(!expr_seq(opt, arg))
return false;
return true;
}
static ast_t* make_single_arrow(ast_t* left, ast_t* right)
{
switch(ast_id(left))
{
case TK_ARROW:
{
ast_t* arrow = ast_dup(left);
ast_t* child = ast_childidx(arrow, 1);
// Arrow is right associative.
while(ast_id(child) == TK_ARROW)
child = ast_childidx(child, 1);
ast_t* view = viewpoint_type(child, right);
if(view == NULL)
{
ast_free_unattached(arrow);
return NULL;
}
ast_replace(&child, view);
return arrow;
}
default: {}
}
ast_t* arrow = ast_from(left, TK_ARROW);
ast_add(arrow, right);
ast_add(arrow, left);
return arrow;
}
static ast_result_t sugar_with(typecheck_t* t, ast_t** astp)
{
AST_EXTRACT_CHILDREN(*astp, withexpr, body, else_clause);
token_id try_token;
if(ast_id(else_clause) == TK_NONE)
try_token = TK_TRY_NO_CHECK;
else
try_token = TK_TRY;
expand_none(else_clause, false);
// First build a skeleton try block without the "with" variables
BUILD(replace, *astp,
NODE(TK_SEQ,
NODE(try_token,
NODE(TK_SEQ, AST_SCOPE
TREE(body))
NODE(TK_SEQ, AST_SCOPE
TREE(else_clause))
NODE(TK_SEQ, AST_SCOPE))));
ast_t* tryexpr = ast_child(replace);
AST_GET_CHILDREN(tryexpr, try_body, try_else, try_then);
// Add the "with" variables from each with element
for(ast_t* p = ast_child(withexpr); p != NULL; p = ast_sibling(p))
{
assert(ast_id(p) == TK_SEQ);
AST_GET_CHILDREN(p, idseq, init);
const char* init_name = package_hygienic_id(t);
BUILD(assign, idseq,
NODE(TK_ASSIGN, AST_NODEBUG
TREE(init)
NODE(TK_LET, ID(init_name) NONE)));
BUILD(local, idseq,
NODE(TK_ASSIGN, AST_NODEBUG
NODE(TK_REFERENCE, ID(init_name))
TREE(idseq)));
ast_add(replace, assign);
ast_add(try_body, local);
ast_add(try_else, local);
build_with_dispose(try_then, idseq);
ast_add(try_then, local);
}
ast_replace(astp, replace);
return AST_OK;
}
static void build_with_dispose(ast_t* dispose_clause, ast_t* idseq)
{
assert(dispose_clause != NULL);
assert(idseq != NULL);
if(ast_id(idseq) == TK_LET)
{
// Just a single variable
ast_t* id = ast_child(idseq);
assert(id != NULL);
// Don't call dispose() on don't cares
if(ast_id(id) == TK_DONTCARE)
return;
assert(ast_id(id) == TK_ID);
BUILD(dispose, idseq,
NODE(TK_CALL,
NONE NONE
NODE(TK_DOT, NODE(TK_REFERENCE, TREE(id)) ID("dispose"))));
ast_add(dispose_clause, dispose);
return;
}
// We have a list of variables
assert(ast_id(idseq) == TK_TUPLE);
for(ast_t* p = ast_child(idseq); p != NULL; p = ast_sibling(p))
build_with_dispose(dispose_clause, p);
}
static bool apply_default_arg(pass_opt_t* opt, ast_t* param, ast_t* arg)
{
// Pick up a default argument.
ast_t* def_arg = ast_childidx(param, 2);
if(ast_id(def_arg) == TK_NONE)
{
ast_error(arg, "not enough arguments");
return false;
}
ast_setid(arg, TK_SEQ);
ast_add(arg, def_arg);
// Type check the arg.
if(ast_type(def_arg) == NULL)
{
if(ast_visit(&arg, NULL, pass_expr, opt) != AST_OK)
return false;
ast_visit(&arg, NULL, pass_nodebug, opt);
} else {
if(!expr_seq(arg))
return false;
}
return true;
}
static bool insert_apply(pass_opt_t* opt, ast_t** astp)
{
// Sugar .apply()
ast_t* ast = *astp;
AST_GET_CHILDREN(ast, positional, namedargs, lhs);
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_from_string(ast, "apply"));
ast_swap(lhs, dot);
ast_add(dot, lhs);
if(!expr_dot(opt, &dot))
return false;
return expr_call(opt, astp);
}
ast_t* builder_add(builder_t* builder, const char* add_point,
const char* description)
{
assert(add_point != NULL);
assert(description != NULL);
if(builder == NULL)
return NULL;
ast_t* add_parent = builder_find_sub_tree(builder, add_point);
if(add_parent == NULL)
{
error(NULL, 0, 0, "Node with attribute {def %s} not found", add_point);
return NULL;
}
ast_t* ast = builder_add_ast(builder, description);
if(ast == NULL)
return NULL;
// Success, add new tree to builder
ast_add(add_parent, ast);
return ast;
}
static void add_field_to_object(pass_opt_t* opt, ast_t* field,
ast_t* class_members, ast_t* create_params, ast_t* create_body,
ast_t* call_args)
{
AST_GET_CHILDREN(field, id, type, init);
ast_t* p_id = ast_from_string(id, package_hygienic_id(&opt->check));
// The param is: $0: type
BUILD(param, field,
NODE(TK_PARAM,
TREE(p_id)
TREE(type)
NONE));
// The arg is: $seq init
BUILD(arg, init,
NODE(TK_SEQ,
TREE(init)));
// The body of create contains: id = consume $0
BUILD(assign, init,
NODE(TK_ASSIGN,
NODE(TK_CONSUME, NODE(TK_NONE) NODE(TK_REFERENCE, TREE(p_id)))
NODE(TK_REFERENCE, TREE(id))));
// Remove the initialiser from the field
ast_replace(&init, ast_from(init, TK_NONE));
ast_add(class_members, field);
ast_append(create_params, param);
ast_append(create_body, assign);
ast_append(call_args, arg);
}
static bool push_assume(ast_t* sub, ast_t* super)
{
// Returns true if we have already assumed sub is a subtype of super.
if(subtype_assume != NULL)
{
ast_t* assumption = ast_child(subtype_assume);
while(assumption != NULL)
{
AST_GET_CHILDREN(assumption, assume_sub, assume_super);
if(exact_nominal(sub, assume_sub) &&
exact_nominal(super, assume_super))
return true;
assumption = ast_sibling(assumption);
}
} else {
subtype_assume = ast_from(sub, TK_NONE);
}
BUILD(assume, sub, NODE(TK_NONE, TREE(ast_dup(sub)) TREE(ast_dup(super))));
ast_add(subtype_assume, assume);
return false;
}
static ast_result_t sugar_binop(ast_t** astp, const char* fn_name)
{
AST_GET_CHILDREN(*astp, left, right);
ast_t* positional = ast_from(right, TK_POSITIONALARGS);
if(ast_id(right) == TK_TUPLE)
{
ast_t* value = ast_child(right);
while(value != NULL)
{
BUILD(arg, right, NODE(TK_SEQ, TREE(value)));
ast_append(positional, arg);
value = ast_sibling(value);
}
} else {
BUILD(arg, right, NODE(TK_SEQ, TREE(right)));
ast_add(positional, arg);
}
REPLACE(astp,
NODE(TK_CALL,
TREE(positional)
NONE
NODE(TK_DOT, TREE(left) ID(fn_name))
));
return AST_OK;
}
builder_t* builder_create(const char* description)
{
if(description == NULL)
return NULL;
source_t* source = source_open_string(description);
symtab_t* symtab = symtab_new();
ast_t* ast = build_ast(source, symtab);
if(ast == NULL)
{
// Error, tidy up
source_close(source);
symtab_free(symtab);
return NULL;
}
// Success, create builder
builder_t* builder = POOL_ALLOC(builder_t);
builder->sources = NULL;
builder->defs = symtab;
builder->dummy_root = ast_blank(TK_TEST);
ast_add(builder->dummy_root, ast);
add_source(builder, source);
return builder;
}
bool parse(ast_t* package, source_t* source, rule_t start,
const char* expected)
{
assert(package != NULL);
assert(source != NULL);
assert(expected != NULL);
// Open the lexer
lexer_t* lexer = lexer_open(source);
if(lexer == NULL)
return false;
// Create a parser and attach the lexer
parser_t* parser = POOL_ALLOC(parser_t);
parser->source = source;
parser->lexer = lexer;
parser->token = lexer_next(lexer);
parser->last_matched = NULL;
parser->last_token_line = 0;
parser->next_flags = 0;
parser->failed = false;
// Parse given start rule
builder_fn_t build_fn;
ast_t* ast = start(parser, &build_fn, expected);
if(ast == PARSE_ERROR)
ast = NULL;
if(ast == RULE_NOT_FOUND)
{
syntax_error(parser, expected, NULL, NULL);
ast = NULL;
}
if(parser->failed)
{
ast_free(ast);
ast = NULL;
}
lexer_close(lexer);
token_free(parser->token);
POOL_FREE(parser_t, parser);
if(ast == NULL)
{
source_close(source);
return false;
}
assert(ast_id(ast) == TK_MODULE);
assert(ast_data(ast) == NULL);
ast_setdata(ast, source);
ast_add(package, ast);
return true;
}
// Add the given method to the relevant name list in the given symbol table
static bool add_method_to_list(ast_t* method, methods_t* method_info,
const char *entity_name)
{
assert(method != NULL);
assert(method_info != NULL);
assert(entity_name != NULL);
const char* name = ast_name(ast_childidx(method, 1));
assert(name != NULL);
symtab_t* symtab = method_info->symtab;
assert(symtab != NULL);
// Entity doesn't yet have method, add it to our list for later
ast_t* list = (ast_t*)symtab_find(symtab, name, NULL);
if(list == NULL)
{
ast_t* case_clash = (ast_t*)symtab_find_case(symtab, name, NULL);
if(case_clash != NULL)
{
ast_error(case_clash, "in %s method name differs only in case",
entity_name);
ast_error(method, "previous definition is here");
return false;
}
// First instance of this name
list = ast_blank(TK_ID);
ast_set_name(list, name);
symtab_add(symtab, name, (void*)list, SYM_NONE);
if(method_info->last_list == NULL)
ast_add(method_info->name_lists, list);
else
ast_add_sibling(method_info->last_list, list);
method_info->last_list = list;
}
ast_add(list, method);
return true;
}
void infix_builder(rule_state_t* state, ast_t* new_ast)
{
assert(state != NULL);
assert(new_ast != NULL);
// New AST goes at the top
ast_add(new_ast, state->ast);
state->ast = new_ast;
state->last_child = NULL;
}
// If the given tree is a TK_NONE expand it to a source None
static void expand_none(ast_t* ast, bool is_scope)
{
if(ast_id(ast) != TK_NONE)
return;
if(is_scope)
ast_scope(ast);
ast_setid(ast, TK_SEQ);
BUILD_NO_DEBUG(ref, ast, NODE(TK_REFERENCE, ID("None")));
ast_add(ast, ref);
}
static bool apply_default_arg(pass_opt_t* opt, ast_t* param, ast_t* arg)
{
// Pick up a default argument.
ast_t* def_arg = ast_childidx(param, 2);
if(ast_id(def_arg) == TK_NONE)
{
ast_error(arg, "not enough arguments");
return false;
}
ast_setid(arg, TK_SEQ);
ast_add(arg, def_arg);
if(!expr_seq(opt, arg))
return false;
return true;
}
ast_t* ast_list_append(ast_t* parent, ast_t** last_pointer, ast_t* new_child)
{
assert(parent != NULL);
assert(last_pointer != NULL);
assert(new_child != NULL);
if(*last_pointer == NULL)
{
// This is the first child for the parent
assert(parent->child == NULL);
*last_pointer = ast_add(parent, new_child);
}
else
{
// This is not the first child, append to list
assert(parent->child != NULL);
assert((*last_pointer)->sibling == NULL);
*last_pointer = ast_add_sibling(*last_pointer, new_child);
}
return *last_pointer;
}
static ast_result_t sugar_module(ast_t* ast)
{
ast_t* docstring = ast_child(ast);
ast_t* package = ast_parent(ast);
assert(ast_id(package) == TK_PACKAGE);
if(strcmp(package_name(package), "$0") != 0)
{
// Every module not in builtin has an implicit use builtin command.
// Since builtin is always the first package processed it is $0.
BUILD(builtin, ast,
NODE(TK_USE,
NONE
STRING(stringtab("builtin"))
NONE));
ast_add(ast, builtin);
}
if((docstring == NULL) || (ast_id(docstring) != TK_STRING))
return AST_OK;
ast_t* package_docstring = ast_childlast(package);
if(ast_id(package_docstring) == TK_STRING)
{
ast_error(docstring, "the package already has a docstring");
ast_error(package_docstring, "the existing docstring is here");
return AST_ERROR;
}
ast_append(package, docstring);
ast_remove(docstring);
return AST_OK;
}
static void reify_reference(ast_t** astp, ast_t* typeparam, ast_t* typearg)
{
ast_t* ast = *astp;
pony_assert(ast_id(ast) == TK_REFERENCE);
const char* name = ast_name(ast_child(ast));
sym_status_t status;
ast_t* ref_def = ast_get(ast, name, &status);
if(ref_def == NULL)
return;
ast_t* param_def = (ast_t*)ast_data(typeparam);
pony_assert(param_def != NULL);
if(ref_def != param_def)
return;
ast_setid(ast, TK_TYPEREF);
ast_add(ast, ast_from(ast, TK_NONE)); // 1st child: package reference
ast_append(ast, ast_from(ast, TK_NONE)); // 3rd child: type args
ast_settype(ast, typearg);
}
bool expr_qualify(pass_opt_t* opt, ast_t** astp)
{
// Left is a postfix expression, right is a typeargs.
ast_t* ast = *astp;
AST_GET_CHILDREN(ast, left, right);
ast_t* type = ast_type(left);
assert(ast_id(right) == TK_TYPEARGS);
if(is_typecheck_error(type))
return false;
switch(ast_id(left))
{
case TK_TYPEREF:
{
// Qualify the type.
assert(ast_id(type) == TK_NOMINAL);
// If the type isn't polymorphic or the type is already qualified,
// sugar .apply().
ast_t* def = names_def(opt, type);
ast_t* typeparams = ast_childidx(def, 1);
if((ast_id(typeparams) == TK_NONE) ||
(ast_id(ast_childidx(type, 2)) != TK_NONE))
{
if(!expr_nominal(opt, &type))
return false;
break;
}
type = ast_dup(type);
ast_t* typeargs = ast_childidx(type, 2);
ast_replace(&typeargs, right);
ast_settype(ast, type);
ast_setid(ast, TK_TYPEREF);
return expr_typeref(opt, astp);
}
case TK_NEWREF:
case TK_NEWBEREF:
case TK_BEREF:
case TK_FUNREF:
case TK_NEWAPP:
case TK_BEAPP:
case TK_FUNAPP:
{
// Qualify the function.
assert(ast_id(type) == TK_FUNTYPE);
ast_t* typeparams = ast_childidx(type, 1);
if(!reify_defaults(typeparams, right, true, opt))
return false;
if(!check_constraints(left, typeparams, right, true, opt))
return false;
type = reify(type, typeparams, right, opt);
typeparams = ast_childidx(type, 1);
ast_replace(&typeparams, ast_from(typeparams, TK_NONE));
ast_settype(ast, type);
ast_setid(ast, ast_id(left));
ast_inheritflags(ast);
return true;
}
default: {}
}
// Sugar .apply()
ast_t* dot = ast_from(left, TK_DOT);
ast_add(dot, ast_from_string(left, "apply"));
ast_swap(left, dot);
ast_add(dot, left);
if(!expr_dot(opt, &dot))
return false;
return expr_qualify(opt, astp);
}
static bool type_access(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
// Left is a typeref, 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_TYPEREF);
assert(ast_id(right) == TK_ID);
ast_t* find = lookup(opt, ast, type, ast_name(right));
if(find == NULL)
return false;
bool ret = true;
switch(ast_id(find))
{
case TK_TYPEPARAM:
ast_error(opt->check.errors, right,
"can't look up a typeparam on a type");
ret = false;
break;
case TK_NEW:
ret = method_access(opt, ast, find);
break;
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
case TK_BE:
case TK_FUN:
{
// Make this a lookup on a default constructed object.
ast_free_unattached(find);
if(!strcmp(ast_name(right), "create"))
{
ast_error(opt->check.errors, right,
"create is not a constructor on this type");
return false;
}
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_from_string(ast, "create"));
ast_swap(left, dot);
ast_add(dot, left);
ast_t* call = ast_from(ast, TK_CALL);
ast_swap(dot, call);
ast_add(call, dot); // the LHS goes at the end, not the beginning
ast_add(call, ast_from(ast, TK_NONE)); // named
ast_add(call, ast_from(ast, TK_NONE)); // positional
if(!expr_dot(opt, &dot))
return false;
if(!expr_call(opt, &call))
return false;
return expr_dot(opt, astp);
}
default:
assert(0);
ret = false;
break;
}
ast_free_unattached(find);
return ret;
}
bool expr_reference(pass_opt_t* opt, ast_t** astp)
{
typecheck_t* t = &opt->check;
ast_t* ast = *astp;
// Everything we reference must be in scope.
const char* name = ast_name(ast_child(ast));
sym_status_t status;
ast_t* def = ast_get(ast, name, &status);
if(def == NULL)
{
const char* alt_name = suggest_alt_name(ast, name);
if(alt_name == NULL)
ast_error(ast, "can't find declaration of '%s'", name);
else
ast_error(ast, "can't find declaration of '%s', did you mean '%s'?",
name, alt_name);
return false;
}
switch(ast_id(def))
{
case TK_PACKAGE:
{
// Only allowed if in a TK_DOT with a type.
if(ast_id(ast_parent(ast)) != TK_DOT)
{
ast_error(ast, "a package can only appear as a prefix to a type");
return false;
}
ast_setid(ast, TK_PACKAGEREF);
return true;
}
case TK_INTERFACE:
case TK_TRAIT:
case TK_TYPE:
case TK_TYPEPARAM:
case TK_PRIMITIVE:
case TK_STRUCT:
case TK_CLASS:
case TK_ACTOR:
{
// It's a type name. This may not be a valid type, since it may need
// type arguments.
ast_t* id = ast_child(def);
const char* name = ast_name(id);
ast_t* type = type_sugar(ast, NULL, name);
ast_settype(ast, type);
ast_setid(ast, TK_TYPEREF);
return expr_typeref(opt, astp);
}
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
{
// Transform to "this.f".
if(!def_before_use(def, ast, name))
return false;
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_child(ast));
ast_t* self = ast_from(ast, TK_THIS);
ast_add(dot, self);
ast_replace(astp, dot);
if(!expr_this(opt, self))
return false;
return expr_dot(opt, astp);
}
case TK_PARAM:
{
if(t->frame->def_arg != NULL)
{
ast_error(ast, "can't reference a parameter in a default argument");
return false;
}
if(!def_before_use(def, ast, name))
return false;
ast_t* type = ast_type(def);
if(is_typecheck_error(type))
return false;
if(!valid_reference(opt, ast, type, status))
return false;
if(!sendable(type) && (t->frame->recover != NULL))
{
ast_error(ast,
"can't access a non-sendable parameter from inside a recover "
"expression");
return false;
}
// Get the type of the parameter and attach it to our reference.
// Automatically consume a parameter if the function is done.
ast_t* r_type = type;
if(is_method_return(t, ast))
r_type = consume_type(type, TK_NONE);
ast_settype(ast, r_type);
ast_setid(ast, TK_PARAMREF);
return true;
}
case TK_NEW:
case TK_BE:
case TK_FUN:
{
// Transform to "this.f".
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_child(ast));
ast_t* self = ast_from(ast, TK_THIS);
ast_add(dot, self);
ast_replace(astp, dot);
if(!expr_this(opt, self))
return false;
return expr_dot(opt, astp);
}
case TK_ID:
{
if(!def_before_use(def, ast, name))
return false;
ast_t* type = ast_type(def);
if(type != NULL && ast_id(type) == TK_INFERTYPE)
{
ast_error(ast, "cannot infer type of %s\n", ast_nice_name(def));
ast_settype(def, ast_from(def, TK_ERRORTYPE));
ast_settype(ast, ast_from(ast, TK_ERRORTYPE));
return false;
}
if(is_typecheck_error(type))
return false;
if(!valid_reference(opt, ast, type, status))
return false;
ast_t* var = ast_parent(def);
switch(ast_id(var))
{
case TK_VAR:
ast_setid(ast, TK_VARREF);
break;
case TK_LET:
case TK_MATCH_CAPTURE:
ast_setid(ast, TK_LETREF);
break;
default:
assert(0);
return false;
}
if(!sendable(type))
{
if(t->frame->recover != NULL)
{
ast_t* def_recover = ast_nearest(def, TK_RECOVER);
if(t->frame->recover != def_recover)
{
ast_error(ast, "can't access a non-sendable local defined outside "
"of a recover expression from within that recover expression");
return false;
}
}
}
// Get the type of the local and attach it to our reference.
// Automatically consume a local if the function is done.
ast_t* r_type = type;
if(is_method_return(t, ast))
r_type = consume_type(type, TK_NONE);
ast_settype(ast, r_type);
return true;
}
default: {}
}
assert(0);
return false;
}
bool expr_typeref(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
assert(ast_id(ast) == TK_TYPEREF);
ast_t* type = ast_type(ast);
if(is_typecheck_error(type))
return false;
switch(ast_id(ast_parent(ast)))
{
case TK_QUALIFY:
// Doesn't have to be valid yet.
break;
case TK_DOT:
// Has to be valid.
if(!expr_nominal(opt, &type))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
break;
case TK_CALL:
{
// Has to be valid.
if(!expr_nominal(opt, &type))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
// Transform to a default constructor.
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_from_string(ast, "create"));
ast_swap(ast, dot);
*astp = dot;
ast_add(dot, ast);
if(!expr_dot(opt, astp))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
ast_t* ast = *astp;
// If the default constructor has no parameters, transform to an apply
// call.
if((ast_id(ast) == TK_NEWREF) || (ast_id(ast) == TK_NEWBEREF))
{
type = ast_type(ast);
if(is_typecheck_error(type))
return false;
assert(ast_id(type) == TK_FUNTYPE);
AST_GET_CHILDREN(type, cap, typeparams, params, result);
if(ast_id(params) == TK_NONE)
{
// Add a call node.
ast_t* call = ast_from(ast, TK_CALL);
ast_add(call, ast_from(call, TK_NONE)); // Named
ast_add(call, ast_from(call, TK_NONE)); // Positional
ast_swap(ast, call);
ast_append(call, ast);
if(!expr_call(opt, &call))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
// Add a dot node.
ast_t* apply = ast_from(call, TK_DOT);
ast_add(apply, ast_from_string(call, "apply"));
ast_swap(call, apply);
ast_add(apply, call);
if(!expr_dot(opt, &apply))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
}
}
return true;
}
default:
{
// Has to be valid.
if(!expr_nominal(opt, &type))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
// Transform to a default constructor.
ast_t* dot = ast_from(ast, TK_DOT);
ast_add(dot, ast_from_string(ast, "create"));
ast_swap(ast, dot);
ast_add(dot, ast);
// Call the default constructor with no arguments.
ast_t* call = ast_from(ast, TK_CALL);
ast_swap(dot, call);
ast_add(call, dot); // Receiver comes last.
ast_add(call, ast_from(ast, TK_NONE)); // Named args.
ast_add(call, ast_from(ast, TK_NONE)); // Positional args.
*astp = call;
if(!expr_dot(opt, &dot))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
if(!expr_call(opt, astp))
{
ast_settype(ast, ast_from(type, TK_ERRORTYPE));
ast_free_unattached(type);
return false;
}
break;
}
}
return true;
}
static ast_result_t sugar_entity(typecheck_t* t, ast_t* ast, bool add_create,
token_id def_def_cap)
{
AST_GET_CHILDREN(ast, id, typeparams, defcap, traits, members);
if(add_create)
add_default_constructor(ast);
if(ast_id(defcap) == TK_NONE)
ast_setid(defcap, def_def_cap);
// Build a reverse sequence of all field initialisers.
BUILD(init_seq, members, NODE(TK_SEQ));
ast_t* member = ast_child(members);
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FLET:
case TK_FVAR:
case TK_EMBED:
{
AST_GET_CHILDREN(member, f_id, f_type, f_init);
if(ast_id(f_init) != TK_NONE)
{
// Replace the initialiser with TK_NONE.
ast_swap(f_init, ast_from(f_init, TK_NONE));
// id = init
BUILD(init, member,
NODE(TK_ASSIGN,
TREE(f_init)
NODE(TK_REFERENCE, TREE(f_id))));
ast_add(init_seq, init);
}
break;
}
default: {}
}
member = ast_sibling(member);
}
// Add field initialisers to all constructors.
if(ast_child(init_seq) != NULL)
{
member = ast_child(members);
while(member != NULL)
{
switch(ast_id(member))
{
case TK_NEW:
{
AST_GET_CHILDREN(member, n_cap, n_id, n_typeparam, n_params,
n_result, n_partial, n_body);
assert(ast_id(n_body) == TK_SEQ);
ast_t* init = ast_child(init_seq);
while(init != NULL)
{
ast_add(n_body, init);
init = ast_sibling(init);
}
break;
}
default: {}
}
member = ast_sibling(member);
}
}
ast_free_unattached(init_seq);
return sugar_case_methods(t, ast);
}
static bool partial_application(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
typecheck_t* t = &opt->check;
if(!method_application(opt, ast, true))
return false;
AST_GET_CHILDREN(ast, positional, namedargs, lhs);
// LHS must be a TK_TILDE, possibly contained in a TK_QUALIFY.
AST_GET_CHILDREN(lhs, receiver, method);
switch(ast_id(receiver))
{
case TK_NEWAPP:
case TK_BEAPP:
case TK_FUNAPP:
AST_GET_CHILDREN_NO_DECL(receiver, receiver, method);
break;
default: {}
}
// The TK_FUNTYPE of the LHS.
ast_t* type = ast_type(lhs);
if(is_typecheck_error(type))
return false;
token_id apply_cap = partial_application_cap(type, receiver, positional);
AST_GET_CHILDREN(type, cap, typeparams, params, result);
// Create a new anonymous type.
ast_t* c_id = ast_from_string(ast, package_hygienic_id(t));
BUILD(def, ast,
NODE(TK_CLASS, AST_SCOPE
TREE(c_id)
NONE
NONE
NONE
NODE(TK_MEMBERS)
NONE
NONE));
// We will have a create method in the type.
BUILD(create, ast,
NODE(TK_NEW, AST_SCOPE
NONE
ID("create")
NONE
NODE(TK_PARAMS)
NONE
NONE
NODE(TK_SEQ)
NONE));
// We will have an apply method in the type.
token_id can_error = ast_canerror(lhs) ? TK_QUESTION : TK_NONE;
BUILD(apply, ast,
NODE(TK_FUN, AST_SCOPE
NODE(apply_cap)
ID("apply")
NONE
NODE(TK_PARAMS)
TREE(result)
NODE(can_error)
NODE(TK_SEQ)
NONE));
// We will replace partial application with $0.create(...)
BUILD(call_receiver, ast, NODE(TK_REFERENCE, TREE(c_id)));
BUILD(call_dot, ast, NODE(TK_DOT, TREE(call_receiver) ID("create")));
BUILD(call, ast,
NODE(TK_CALL,
NONE
NODE(TK_NAMEDARGS)
TREE(call_dot)));
ast_t* class_members = ast_childidx(def, 4);
ast_t* create_params = ast_childidx(create, 3);
ast_t* create_body = ast_childidx(create, 6);
ast_t* apply_params = ast_childidx(apply, 3);
ast_t* apply_body = ast_childidx(apply, 6);
ast_t* call_namedargs = ast_childidx(call, 1);
// Add the receiver to the anonymous type.
ast_t* r_id = ast_from_string(receiver, package_hygienic_id(t));
ast_t* r_field_id = ast_from_string(receiver, package_hygienic_id(t));
ast_t* r_type = ast_type(receiver);
if(is_typecheck_error(r_type))
return false;
// A field in the type.
BUILD(r_field, receiver, NODE(TK_FLET, TREE(r_field_id) TREE(r_type) NONE));
// A parameter of the constructor.
BUILD(r_ctor_param, receiver, NODE(TK_PARAM, TREE(r_id) TREE(r_type) NONE));
// An assignment in the constructor body.
BUILD(r_assign, receiver,
NODE(TK_ASSIGN,
NODE(TK_CONSUME, NODE(TK_NONE) NODE(TK_REFERENCE, TREE(r_id)))
NODE(TK_REFERENCE, TREE(r_field_id))));
// A named argument at the call site.
BUILD(r_call_seq, receiver, NODE(TK_SEQ, TREE(receiver)));
BUILD(r_call_arg, receiver, NODE(TK_NAMEDARG, TREE(r_id) TREE(r_call_seq)));
ast_settype(r_call_seq, r_type);
ast_append(class_members, r_field);
ast_append(create_params, r_ctor_param);
ast_append(create_body, r_assign);
ast_append(call_namedargs, r_call_arg);
// Add a call to the original method to the apply body.
BUILD(apply_call, ast,
NODE(TK_CALL,
NODE(TK_POSITIONALARGS)
NONE
NODE(TK_DOT, NODE(TK_REFERENCE, TREE(r_field_id)) TREE(method))));
ast_append(apply_body, apply_call);
ast_t* apply_args = ast_child(apply_call);
// Add the arguments to the anonymous type.
ast_t* arg = ast_child(positional);
ast_t* param = ast_child(params);
while(arg != NULL)
{
AST_GET_CHILDREN(param, id, p_type);
if(ast_id(arg) == TK_NONE)
{
// A parameter of the apply method, using the same name, type and default
// argument.
ast_append(apply_params, param);
// An arg in the call to the original method.
BUILD(apply_arg, param,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NODE(TK_NONE)
NODE(TK_REFERENCE, TREE(id)))));
ast_append(apply_args, apply_arg);
} else {
ast_t* p_id = ast_from_string(id, package_hygienic_id(t));
// A field in the type.
BUILD(field, arg, NODE(TK_FLET, TREE(id) TREE(p_type) NONE));
// A parameter of the constructor.
BUILD(ctor_param, arg, NODE(TK_PARAM, TREE(p_id) TREE(p_type) NONE));
// An assignment in the constructor body.
BUILD(assign, arg,
NODE(TK_ASSIGN,
NODE(TK_CONSUME, NODE(TK_NONE) NODE(TK_REFERENCE, TREE(p_id)))
NODE(TK_REFERENCE, TREE(id))));
// A named argument at the call site.
BUILD(call_arg, arg, NODE(TK_NAMEDARG, TREE(p_id) TREE(arg)));
// An arg in the call to the original method.
BUILD(apply_arg, arg, NODE(TK_SEQ, NODE(TK_REFERENCE, TREE(id))));
ast_append(class_members, field);
ast_append(create_params, ctor_param);
ast_append(create_body, assign);
ast_append(call_namedargs, call_arg);
ast_append(apply_args, apply_arg);
}
arg = ast_sibling(arg);
param = ast_sibling(param);
}
// Add create and apply to the anonymous type.
ast_append(class_members, create);
ast_append(class_members, apply);
// Typecheck the anonymous type.
ast_add(t->frame->module, def);
if(!type_passes(def, opt))
return false;
// Typecheck the create call.
if(!expr_reference(opt, &call_receiver))
return false;
if(!expr_dot(opt, &call_dot))
return false;
if(!expr_call(opt, &call))
return false;
// Replace the partial application with the create call.
ast_replace(astp, call);
return true;
}
// Load a sequence of nodes until the specified terminator is found
static ast_t* get_nodes(build_parser_t* builder, ast_token_id terminator)
{
assert(builder != NULL);
ast_t* ast = NULL;
ast_t* last_child = NULL;
while(true)
{
ast_token_id id = get_token(builder);
ast_t* child = NULL;
bool is_type = false;
if(id == terminator)
{
if(ast == NULL)
build_error(builder, "Syntax error");
if(ast_id(ast) == TK_MINUS && ast_childcount(ast) == 1)
ast_setid(ast, TK_UNARY_MINUS);
return ast;
}
if(id == AT_ID)
id = keyword_replace(builder);
switch(id)
{
case AT_LPAREN:
child = get_nodes(builder, AT_RPAREN);
break;
case AT_LSQUARE:
child = get_type(builder, ast);
is_type = true;
break;
case AT_ERROR: // Propogate
break;
case AT_STRING:
case AT_TOKEN:
child = ast_token(builder->token);
save_token(builder);
get_attributes(builder, child);
break;
case AT_ID:
if(strcmp("id", token_string(builder->token)) == 0)
return get_id(builder, ast);
build_error(builder, "Unrecognised identifier \"%s\"",
token_string(builder->token));
break;
default:
build_error(builder, "Syntax error");
break;
}
if(child == NULL)
{
// An error occurred and should already have been reported
ast_free(ast);
return NULL;
}
if(ast == NULL)
{
ast = child;
last_child = NULL;
}
else if(is_type)
{
ast_settype(ast, child);
}
else
{
if(last_child == NULL)
ast_add(ast, child);
else
ast_add_sibling(last_child, child);
last_child = child;
}
}
}
