// Sugar for partial application, which we convert to a lambda.
static bool partial_application(pass_opt_t* opt, ast_t** astp)
{
/* Example that we refer to throughout this function.
* ```pony
* class C
* fun f[T](a: A, b: B = b_default): R
*
* let recv: T = ...
* recv~f[T2](foo)
* ```
*
* Partial call is converted to:
* ```pony
* lambda(b: B = b_default)($0 = recv, a = foo): R => $0.f[T2](a, consume b)
* ```
*/
ast_t* ast = *astp;
typecheck_t* t = &opt->check;
if(!method_application(opt, ast, true))
return false;
AST_GET_CHILDREN(ast, positional, namedargs, lhs);
assert(ast_id(lhs) == TK_FUNAPP || ast_id(lhs) == TK_BEAPP ||
ast_id(lhs) == TK_NEWAPP);
// LHS must be a TK_TILDE, possibly contained in a TK_QUALIFY.
AST_GET_CHILDREN(lhs, receiver, method);
ast_t* type_args = NULL;
switch(ast_id(receiver))
{
case TK_NEWAPP:
case TK_BEAPP:
case TK_FUNAPP:
type_args = method;
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(opt, type, receiver,
positional);
AST_GET_CHILDREN(type, cap, type_params, target_params, result);
token_id can_error = ast_canerror(lhs) ? TK_QUESTION : TK_NONE;
const char* recv_name = package_hygienic_id(t);
// Build captures. We always have at least one capture, for receiver.
// Capture: `$0 = recv`
BUILD(captures, receiver,
NODE(TK_LAMBDACAPTURES,
NODE(TK_LAMBDACAPTURE,
ID(recv_name)
NONE // Infer type.
TREE(receiver))));
// Process arguments.
ast_t* given_arg = ast_child(positional);
ast_t* target_param = ast_child(target_params);
ast_t* lambda_params = ast_from(target_params, TK_NONE);
ast_t* lambda_call_args = ast_from(positional, TK_NONE);
while(given_arg != NULL)
{
assert(target_param != NULL);
const char* target_p_name = ast_name(ast_child(target_param));
if(ast_id(given_arg) == TK_NONE)
{
// This argument is not supplied already, must be a lambda parameter.
// Like `b` in example above.
// Build a new a new TK_PARAM node rather than copying the target one,
// since the target has already been processed to expr pass, and we need
// a clean one.
AST_GET_CHILDREN(target_param, p_id, p_type, p_default);
// Parameter: `b: B = b_default`
BUILD(lambda_param, target_param,
NODE(TK_PARAM,
TREE(p_id)
TREE(sanitise_type(p_type))
TREE(p_default)));
ast_append(lambda_params, lambda_param);
ast_setid(lambda_params, TK_PARAMS);
// Argument: `consume b`
BUILD(target_arg, lambda_param,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NONE
NODE(TK_REFERENCE, ID(target_p_name)))));
ast_append(lambda_call_args, target_arg);
ast_setid(lambda_call_args, TK_POSITIONALARGS);
}
else
{
// This argument is supplied to the partial, capture it.
// Like `a` in example above.
// Capture: `a = foo`
BUILD(capture, given_arg,
NODE(TK_LAMBDACAPTURE,
ID(target_p_name)
NONE
TREE(given_arg)));
ast_append(captures, capture);
// Argument: `a`
BUILD(target_arg, given_arg,
NODE(TK_SEQ,
NODE(TK_REFERENCE, ID(target_p_name))));
ast_append(lambda_call_args, target_arg);
ast_setid(lambda_call_args, TK_POSITIONALARGS);
}
given_arg = ast_sibling(given_arg);
target_param = ast_sibling(target_param);
}
assert(target_param == NULL);
// Build lambda expression.
// `$0.f`
BUILD(call_receiver, ast,
NODE(TK_DOT,
NODE(TK_REFERENCE, ID(recv_name))
TREE(method)));
if(type_args != NULL)
{
// The partial call has type args, add them to the actual call in apply().
// `$0.f[T2]`
BUILD(qualified, type_args,
NODE(TK_QUALIFY,
TREE(call_receiver)
TREE(type_args)));
call_receiver = qualified;
}
REPLACE(astp,
NODE(TK_LAMBDA,
NODE(apply_cap)
NONE // Lambda function name.
NONE // Lambda type params.
TREE(lambda_params)
TREE(captures)
TREE(sanitise_type(result))
NODE(can_error)
NODE(TK_SEQ,
NODE(TK_CALL,
TREE(lambda_call_args)
NONE // Named args.
TREE(call_receiver)))));
// Need to preserve various lambda children.
ast_setflag(ast_childidx(*astp, 2), AST_FLAG_PRESERVE); // Type params.
ast_setflag(ast_childidx(*astp, 3), AST_FLAG_PRESERVE); // Parameters.
ast_setflag(ast_childidx(*astp, 5), AST_FLAG_PRESERVE); // Return type.
ast_setflag(ast_childidx(*astp, 7), AST_FLAG_PRESERVE); // Body.
// Catch up to this pass.
return ast_passes_subtree(astp, opt, PASS_EXPR);
}
// Add eq() and ne() functions to the given entity.
static bool add_comparable(ast_t* ast, pass_opt_t* options)
{
assert(ast != NULL);
AST_GET_CHILDREN(ast, id, typeparams, defcap, traits, members);
ast_t* typeargs = ast_from(typeparams, TK_NONE);
bool r = true;
for(ast_t* p = ast_child(typeparams); p != NULL; p = ast_sibling(p))
{
ast_t* p_id = ast_child(p);
BUILD_NO_DEBUG(type, p_id,
NODE(TK_NOMINAL, NONE TREE(p_id) NONE NONE NONE));
ast_append(typeargs, type);
ast_setid(typeargs, TK_TYPEARGS);
}
if(!has_member(members, "eq"))
{
BUILD_NO_DEBUG(eq, members,
NODE(TK_FUN, AST_SCOPE
NODE(TK_BOX)
ID("eq")
NONE
NODE(TK_PARAMS,
NODE(TK_PARAM,
ID("that")
NODE(TK_NOMINAL, NONE TREE(id) TREE(typeargs) NONE NONE)
NONE))
NODE(TK_NOMINAL, NONE ID("Bool") NONE NONE NONE)
NONE
NODE(TK_SEQ,
NODE(TK_IS,
NODE(TK_THIS)
NODE(TK_REFERENCE, ID("that"))))
NONE
NONE));
// Need to set function data field to point to originating type, ie ast.
// This won't be done when we catch up the passes since we've already
// processed that type.
ast_setdata(eq, ast);
ast_append(members, eq);
ast_set(ast, stringtab("eq"), eq, SYM_DEFINED);
if(!ast_passes_subtree(&eq, options, PASS_TRAITS))
r = false;
}
if(!has_member(members, "ne"))
{
BUILD_NO_DEBUG(ne, members,
NODE(TK_FUN, AST_SCOPE
NODE(TK_BOX)
ID("ne")
NONE
NODE(TK_PARAMS,
NODE(TK_PARAM,
ID("that")
NODE(TK_NOMINAL, NONE TREE(id) TREE(typeargs) NONE NONE)
NONE))
NODE(TK_NOMINAL, NONE ID("Bool") NONE NONE NONE)
NONE
NODE(TK_SEQ,
NODE(TK_ISNT,
NODE(TK_THIS)
NODE(TK_REFERENCE, ID("that"))))
NONE
NONE));
// Need to set function data field to point to originating type, ie ast.
// This won't be done when we catch up the passes since we've already
// processed that type.
ast_setdata(ne, ast);
ast_append(members, ne);
ast_set(ast, stringtab("ne"), ne, SYM_DEFINED);
if(!ast_passes_subtree(&ne, options, PASS_TRAITS))
r = false;
}
ast_free_unattached(typeargs);
return r;
}
// Resolve the field delegate body to use for the given method, if any.
// Return the body to use, NULL if none found or BODY_ERROR on error.
static ast_t* resolve_delegate_body(ast_t* entity, ast_t* method,
method_t* info, const char* name)
{
assert(entity != NULL);
assert(method != NULL);
assert(info != NULL);
assert(name != NULL);
if(info->delegate_field_2 != NULL)
{
// Ambiguous delegate
assert(info->delegate_field_1 != NULL);
assert(info->delegate_target_1 != NULL);
assert(info->delegate_target_2 != NULL);
ast_error(entity,
"clashing delegates for method %s, local disambiguation required", name);
ast_error(info->delegate_field_1, "field %s delegates to %s via %s",
ast_name(ast_child(info->delegate_field_1)), name,
ast_name(ast_child(info->delegate_target_1)));
ast_error(info->delegate_field_2, "field %s delegates to %s via %s",
ast_name(ast_child(info->delegate_field_2)), name,
ast_name(ast_child(info->delegate_target_2)));
return BODY_ERROR;
}
if(info->delegate_field_1 == NULL) // No delegation needed
return NULL;
// We have a delegation, make a redirection body
const char* field_name = ast_name(ast_child(info->delegate_field_1));
ast_t* args = ast_from(info->delegate_field_1, TK_NONE);
ast_t* last_arg = NULL;
AST_GET_CHILDREN(method, cap, id, t_params, params, result, error, old_body);
for(ast_t* p = ast_child(params); p != NULL; p = ast_sibling(p))
{
const char* param_name = ast_name(ast_child(p));
BUILD(arg, info->delegate_field_1,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NONE
NODE(TK_REFERENCE, ID(param_name)))));
ast_list_append(args, &last_arg, arg);
ast_setid(args, TK_POSITIONALARGS);
}
BUILD(body, info->delegate_field_1,
NODE(TK_SEQ,
NODE(TK_CALL,
TREE(args) // Positional args
NODE(TK_NONE) // Named args
NODE(TK_DOT, // Receiver
NODE(TK_REFERENCE, ID(field_name))
ID(name)))));
if(is_none(result))
{
// Add None to end of body. Whilst the call generated above will return
// None anyway in this case, without this extra None testing is very hard
// since a directly written version of this body will have the None.
BUILD(none, info->delegate_field_1,
NODE(TK_REFERENCE, ID("None")));
ast_append(body, none);
}
info->body_donor = entity;
return body;
}
// Sugar for partial application, which we convert to a lambda.
static bool partial_application(pass_opt_t* opt, ast_t** astp)
{
/* Example that we refer to throughout this function.
* ```pony
* class C
* fun f[T](a: A, b: B = b_default): R
*
* let recv: T = ...
* recv~f[T2](foo)
* ```
*
* Partial call is converted to:
* ```pony
* {(b: B = b_default)($0 = recv, a = foo): R => $0.f[T2](a, consume b) }
* ```
*/
ast_t* ast = *astp;
typecheck_t* t = &opt->check;
if(!method_application(opt, ast, true))
return false;
AST_GET_CHILDREN(ast, positional, namedargs, question, lhs);
// LHS must be an application, possibly wrapped in another application
// if the method had type parameters for qualification.
pony_assert(ast_id(lhs) == TK_FUNAPP || ast_id(lhs) == TK_BEAPP ||
ast_id(lhs) == TK_NEWAPP);
AST_GET_CHILDREN(lhs, receiver, method);
ast_t* type_args = NULL;
if(ast_id(receiver) == ast_id(lhs))
{
type_args = method;
AST_GET_CHILDREN_NO_DECL(receiver, receiver, method);
}
// Look up the original method definition for this method call.
ast_t* method_def = lookup(opt, lhs, ast_type(receiver), ast_name(method));
pony_assert(ast_id(method_def) == TK_FUN || ast_id(method_def) == TK_BE ||
ast_id(method_def) == TK_NEW);
// The TK_FUNTYPE of the LHS.
ast_t* type = ast_type(lhs);
pony_assert(ast_id(type) == TK_FUNTYPE);
if(is_typecheck_error(type))
return false;
AST_GET_CHILDREN(type, cap, type_params, target_params, result);
bool bare = ast_id(cap) == TK_AT;
token_id apply_cap = TK_AT;
if(!bare)
apply_cap = partial_application_cap(opt, type, receiver, positional);
token_id can_error = ast_id(ast_childidx(method_def, 5));
const char* recv_name = package_hygienic_id(t);
// Build lambda expression.
ast_t* call_receiver = NULL;
if(bare)
{
ast_t* arg = ast_child(positional);
while(arg != NULL)
{
if(ast_id(arg) != TK_NONE)
{
ast_error(opt->check.errors, arg, "the partial application of a bare "
"method cannot take arguments");
return false;
}
arg = ast_sibling(arg);
}
ast_t* receiver_type = ast_type(receiver);
if(is_bare(receiver_type))
{
// Partial application on a bare object, simply return the object itself.
ast_replace(astp, receiver);
return true;
}
AST_GET_CHILDREN(receiver_type, recv_type_package, recv_type_name);
const char* recv_package_str = ast_name(recv_type_package);
const char* recv_name_str = ast_name(recv_type_name);
ast_t* module = ast_nearest(ast, TK_MODULE);
ast_t* package = ast_parent(module);
ast_t* pkg_id = package_id(package);
const char* pkg_str = ast_name(pkg_id);
const char* pkg_alias = NULL;
if(recv_package_str != pkg_str)
pkg_alias = package_alias_from_id(module, recv_package_str);
ast_free_unattached(pkg_id);
if(pkg_alias != NULL)
{
// `package.Type.f`
BUILD_NO_DECL(call_receiver, ast,
NODE(TK_DOT,
NODE(TK_DOT,
NODE(TK_REFERENCE, ID(pkg_alias))
ID(recv_name_str))
TREE(method)));
} else {
// `Type.f`
BUILD_NO_DECL(call_receiver, ast,
NODE(TK_DOT,
NODE(TK_REFERENCE, ID(recv_name_str))
TREE(method)));
}
} else {
// `$0.f`
BUILD_NO_DECL(call_receiver, ast,
NODE(TK_DOT,
NODE(TK_REFERENCE, ID(recv_name))
TREE(method)));
}
ast_t* captures = NULL;
if(bare)
{
captures = ast_from(receiver, TK_NONE);
} else {
// Build captures. We always have at least one capture, for receiver.
// Capture: `$0 = recv`
BUILD_NO_DECL(captures, receiver,
NODE(TK_LAMBDACAPTURES,
NODE(TK_LAMBDACAPTURE,
ID(recv_name)
NONE // Infer type.
TREE(receiver))));
}
// Process arguments.
ast_t* target_param = ast_child(target_params);
ast_t* lambda_params = ast_from(target_params, TK_NONE);
ast_t* lambda_call_args = ast_from(positional, TK_NONE);
ast_t* given_arg = ast_child(positional);
while(given_arg != NULL)
{
pony_assert(target_param != NULL);
const char* target_p_name = ast_name(ast_child(target_param));
if(ast_id(given_arg) == TK_NONE)
{
// This argument is not supplied already, must be a lambda parameter.
// Like `b` in example above.
// Build a new a new TK_PARAM node rather than copying the target one,
// since the target has already been processed to expr pass, and we need
// a clean one.
AST_GET_CHILDREN(target_param, p_id, p_type, p_default);
// Parameter: `b: B = b_default`
BUILD(lambda_param, target_param,
NODE(TK_PARAM,
TREE(p_id)
TREE(sanitise_type(p_type))
TREE(p_default)));
ast_append(lambda_params, lambda_param);
ast_setid(lambda_params, TK_PARAMS);
// Argument: `consume b`
BUILD(target_arg, lambda_param,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NONE
NODE(TK_REFERENCE, ID(target_p_name)))));
ast_append(lambda_call_args, target_arg);
ast_setid(lambda_call_args, TK_POSITIONALARGS);
}
else
{
// This argument is supplied to the partial, capture it.
// Like `a` in example above.
// Capture: `a = foo`
BUILD(capture, given_arg,
NODE(TK_LAMBDACAPTURE,
ID(target_p_name)
NONE
TREE(given_arg)));
ast_append(captures, capture);
// Argument: `a`
BUILD(target_arg, given_arg,
NODE(TK_SEQ,
NODE(TK_REFERENCE, ID(target_p_name))));
ast_append(lambda_call_args, target_arg);
ast_setid(lambda_call_args, TK_POSITIONALARGS);
}
given_arg = ast_sibling(given_arg);
target_param = ast_sibling(target_param);
}
pony_assert(target_param == NULL);
if(type_args != NULL)
{
// The partial call has type args, add them to the actual call in apply().
// `$0.f[T2]`
BUILD(qualified, type_args,
NODE(TK_QUALIFY,
TREE(call_receiver)
TREE(type_args)));
call_receiver = qualified;
}
REPLACE(astp,
NODE((bare ? TK_BARELAMBDA : TK_LAMBDA),
NODE(apply_cap)
NONE // Lambda function name.
NONE // Lambda type params.
TREE(lambda_params)
TREE(captures)
TREE(sanitise_type(result))
NODE(can_error)
NODE(TK_SEQ,
NODE(TK_CALL,
TREE(lambda_call_args)
NONE // Named args.
NODE(can_error)
TREE(call_receiver)))
NONE)); // Lambda reference capability.
// Need to preserve various lambda children.
ast_setflag(ast_childidx(*astp, 2), AST_FLAG_PRESERVE); // Type params.
ast_setflag(ast_childidx(*astp, 3), AST_FLAG_PRESERVE); // Parameters.
ast_setflag(ast_childidx(*astp, 5), AST_FLAG_PRESERVE); // Return type.
ast_setflag(ast_childidx(*astp, 7), AST_FLAG_PRESERVE); // Body.
// Catch up to this pass.
return ast_passes_subtree(astp, opt, PASS_EXPR);
}
// Add a new method to the given entity, based on the specified method from
// the specified type.
// The trait_ref is the entry in the provides / delegates list that causes this
// method inclusion. Needed for error reporting.
// The basis_method is the reified method in the trait to add.
// The adjective parameter is used for error reporting and should be "provided"
// or similar.
// Return the newly added method or NULL on error.
static ast_t* add_method(ast_t* entity, ast_t* trait_ref, ast_t* basis_method,
const char* adjective, pass_opt_t* opt)
{
assert(entity != NULL);
assert(trait_ref != NULL);
assert(basis_method != NULL);
assert(adjective != NULL);
const char* name = ast_name(ast_childidx(basis_method, 1));
// Check behaviour compatability.
if(ast_id(basis_method) == TK_BE)
{
switch(ast_id(entity))
{
case TK_PRIMITIVE:
ast_error(opt->check.errors, trait_ref,
"cannot add a behaviour (%s) to a primitive", name);
return NULL;
case TK_STRUCT:
ast_error(opt->check.errors, trait_ref,
"cannot add a behaviour (%s) to a struct", name);
return NULL;
case TK_CLASS:
ast_error(opt->check.errors, trait_ref,
"cannot add a behaviour (%s) to a class", name);
return NULL;
default:
break;
}
}
// Check for existing method of the same name.
ast_t* existing = ast_get(entity, name, NULL);
if(existing != NULL)
{
assert(is_field(existing)); // Should already have checked for methods.
ast_error(opt->check.errors, trait_ref,
"%s method '%s' clashes with field", adjective, name);
ast_error_continue(opt->check.errors, basis_method,
"method is defined here");
return NULL;
}
// Check for clash with existing method.
ast_t* case_clash = ast_get_case(entity, name, NULL);
if(case_clash != NULL)
{
const char* clash_name = "";
switch(ast_id(case_clash))
{
case TK_FUN:
case TK_BE:
case TK_NEW:
clash_name = ast_name(ast_childidx(case_clash, 1));
break;
case TK_LET:
case TK_VAR:
case TK_EMBED:
clash_name = ast_name(ast_child(case_clash));
break;
default:
assert(0);
break;
}
ast_error(opt->check.errors, trait_ref,
"%s method '%s' differs only in case from '%s'",
adjective, name, clash_name);
ast_error_continue(opt->check.errors, basis_method,
"clashing method is defined here");
return NULL;
}
AST_GET_CHILDREN(basis_method, cap, id, typeparams, params, result,
can_error, body, doc);
// Ignore docstring.
if(ast_id(doc) == TK_STRING)
{
ast_set_name(doc, "");
ast_setid(doc, TK_NONE);
}
ast_t* local = ast_append(ast_childidx(entity, 4), basis_method);
ast_set(entity, name, local, SYM_DEFINED, false);
ast_t* body_donor = (ast_t*)ast_data(basis_method);
method_t* info = attach_method_t(local);
info->trait_ref = trait_ref;
if(ast_id(body) != TK_NONE)
info->body_donor = body_donor;
return local;
}
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;
}
bool expr_object(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
bool ok = true;
AST_GET_CHILDREN(ast, cap, provides, members);
ast_clearflag(cap, AST_FLAG_PRESERVE);
ast_clearflag(provides, AST_FLAG_PRESERVE);
ast_clearflag(members, AST_FLAG_PRESERVE);
ast_t* annotation = ast_consumeannotation(ast);
const char* c_id = package_hygienic_id(&opt->check);
ast_t* t_params;
ast_t* t_args;
collect_type_params(ast, &t_params, &t_args);
const char* nice_id = (const char*)ast_data(ast);
if(nice_id == NULL)
nice_id = "object literal";
// Create a new anonymous type.
BUILD(def, ast,
NODE(TK_CLASS, AST_SCOPE
ANNOTATE(annotation)
NICE_ID(c_id, nice_id)
TREE(t_params)
NONE
TREE(provides)
NODE(TK_MEMBERS)
NONE
NONE));
// We will have a create method in the type.
BUILD(create, members,
NODE(TK_NEW, AST_SCOPE
NONE
ID("create")
NONE
NODE(TK_PARAMS)
NONE
NONE
NODE(TK_SEQ,
NODE(TK_TRUE))
NONE
NONE));
BUILD(type_ref, ast, NODE(TK_REFERENCE, ID(c_id)));
if(ast_id(t_args) != TK_NONE)
{
// Need to add type args to our type reference
BUILD(t, ast, NODE(TK_QUALIFY, TREE(type_ref) TREE(t_args)));
type_ref = t;
}
ast_free_unattached(t_args);
// We will replace object..end with $0.create(...)
BUILD(call, ast,
NODE(TK_CALL,
NODE(TK_POSITIONALARGS)
NONE
NONE
NODE(TK_DOT,
TREE(type_ref)
ID("create"))));
ast_t* create_params = ast_childidx(create, 3);
ast_t* create_body = ast_childidx(create, 6);
ast_t* call_args = ast_child(call);
ast_t* class_members = ast_childidx(def, 4);
ast_t* member = ast_child(members);
bool has_fields = false;
bool has_behaviours = false;
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
{
add_field_to_object(opt, member, class_members, create_params,
create_body, call_args);
has_fields = true;
break;
}
case TK_BE:
// If we have behaviours, we must be an actor.
ast_append(class_members, member);
has_behaviours = true;
break;
default:
// Keep all the methods as they are.
ast_append(class_members, member);
break;
}
member = ast_sibling(member);
}
// Add the create function at the end.
ast_append(class_members, create);
// Add new type to current module and bring it up to date with passes.
ast_t* module = ast_nearest(ast, TK_MODULE);
ast_append(module, def);
// Turn any free variables into fields.
ast_t* captures = ast_from(ast, TK_MEMBERS);
ast_t* last_capture = NULL;
if(!capture_from_type(opt, *astp, &def, captures, &last_capture))
ok = false;
for(ast_t* p = ast_child(captures); p != NULL; p = ast_sibling(p))
{
add_field_to_object(opt, p, class_members, create_params, create_body,
call_args);
has_fields = true;
}
ast_free_unattached(captures);
ast_resetpass(def, PASS_SUGAR);
// Handle capability and whether the anonymous type is a class, primitive or
// actor.
token_id cap_id = ast_id(cap);
if(has_behaviours)
{
// Change the type to an actor.
ast_setid(def, TK_ACTOR);
if(cap_id != TK_NONE && cap_id != TK_TAG)
{
ast_error(opt->check.errors, cap, "object literals with behaviours are "
"actors and so must have tag capability");
ok = false;
}
cap_id = TK_TAG;
}
else if(!has_fields && (cap_id == TK_NONE || cap_id == TK_TAG ||
cap_id == TK_BOX || cap_id == TK_VAL))
{
// Change the type from a class to a primitive.
ast_setid(def, TK_PRIMITIVE);
cap_id = TK_VAL;
}
if(ast_id(def) != TK_PRIMITIVE)
pony_assert(!ast_has_annotation(def, "ponyint_bare"));
// Reset constructor to pick up the correct defaults.
ast_setid(ast_child(create), cap_id);
ast_t* result = ast_childidx(create, 4);
ast_replace(&result,
type_for_class(opt, def, result, cap_id, TK_EPHEMERAL, false));
// Catch up provides before catching up the entire type.
if(!catch_up_provides(opt, provides))
return false;
// Type check the anonymous type.
if(!ast_passes_type(&def, opt, PASS_EXPR))
return false;
// Replace object..end with $0.create(...)
ast_replace(astp, call);
if(ast_visit(astp, pass_syntax, NULL, opt, PASS_SYNTAX) != AST_OK)
return false;
if(!ast_passes_subtree(astp, opt, PASS_EXPR))
return false;
return ok;
}
// Handle the given case method parameter, which does have a type specified.
// Combine and check the case parameter against the existing match parameter
// and generate the pattern element.
// Returns: true on success, false on error.
static bool param_with_type(ast_t* case_param, ast_t* match_param,
ast_t* pattern)
{
assert(case_param != NULL);
assert(match_param != NULL);
assert(pattern != NULL);
AST_GET_CHILDREN(case_param, case_id, case_type, case_def_arg);
assert(ast_id(case_type) != TK_NONE);
if(ast_id(case_id) != TK_ID)
{
ast_error(case_id, "expected parameter name for case method. If this is "
"meant to be a value to match on, do not specify parameter type");
return false;
}
AST_GET_CHILDREN(match_param, match_id, match_type, match_def_arg);
assert(ast_id(match_id) == TK_ID || ast_id(match_id) == TK_NONE);
if(ast_id(match_id) == TK_NONE)
{
// This is the first case method to give this parameter, just use it as
// given by this case.
ast_replace(&match_id, case_id);
ast_replace(&match_type, case_type);
ast_replace(&match_def_arg, case_def_arg);
}
else
{
// Combine new case param with existing match param.
if(ast_name(case_id) != ast_name(match_id))
{
ast_error(case_id, "parameter name differs between case methods");
ast_error(match_id, "clashing name here");
return false;
}
if(ast_id(case_def_arg) != TK_NONE)
{
// This case provides a default argument.
if(ast_id(match_def_arg) != TK_NONE)
{
ast_error(case_def_arg,
"multiple defaults provided for case method parameter");
ast_error(match_def_arg, "another default defined here");
return false;
}
// Move default arg to match parameter.
ast_replace(&match_def_arg, case_def_arg);
}
// Union param types.
REPLACE(&match_type,
NODE(TK_UNIONTYPE,
TREE(match_type)
TREE(case_type)));
}
// Add parameter to match pattern.
BUILD(pattern_elem, case_param,
NODE(TK_SEQ,
NODE(TK_LET, TREE(case_id) TREE(case_type))));
ast_append(pattern, pattern_elem);
return true;
}
// Check parameters and build the all parameter structures for a complete set
// of case methods with the given name.
// Generate match operand, worker parameters and worker call arguments.
// Returns: match operand, NULL on failure.
static ast_t* build_params(ast_t* match_params, ast_t* worker_params,
ast_t* call_args, const char* name, typecheck_t* t)
{
assert(match_params != NULL);
assert(worker_params != NULL);
assert(call_args != NULL);
assert(name != NULL);
assert(t != NULL);
ast_t* match_operand = ast_from(match_params, TK_TUPLE);
size_t count = 0;
bool ok = true;
for(ast_t* p = ast_child(match_params); p != NULL; p = ast_sibling(p))
{
AST_GET_CHILDREN(p, id, type, def_arg);
count++;
if(ast_id(id) == TK_NONE)
{
assert(ast_id(type) == TK_NONE);
ast_error(p,
"name and type not specified for parameter " __zu
" of case function %s",
count, name);
ok = false;
}
else
{
const char* worker_param_name = package_hygienic_id(t);
// Add parameter to match operand.
BUILD(element, p,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NONE
NODE(TK_REFERENCE, ID(worker_param_name)))));
ast_append(match_operand, element);
// Add parameter to worker function.
BUILD(param, p,
NODE(TK_PARAM,
ID(worker_param_name)
TREE(type)
NONE)); // Default argument.
ast_append(worker_params, param);
// Add argument to worker call.
BUILD(arg, p,
NODE(TK_SEQ,
NODE(TK_CONSUME,
NONE
NODE(TK_REFERENCE, TREE(id)))));
ast_append(call_args, arg);
}
}
if(!ok)
{
ast_free(match_operand);
return NULL;
}
assert(count > 0);
if(count == 1)
{
// Only one parameter, don't need tuple in operand.
ast_t* tmp = ast_pop(ast_child(match_operand));
ast_free(match_operand);
match_operand = tmp;
}
return match_operand;
}
static bool is_fun_sub_fun(ast_t* sub, ast_t* super,
ast_t* isub, ast_t* isuper)
{
token_id tsub = ast_id(sub);
token_id tsuper = ast_id(super);
switch(tsub)
{
case TK_NEW:
case TK_BE:
case TK_FUN:
break;
default:
return false;
}
switch(tsuper)
{
case TK_NEW:
case TK_BE:
case TK_FUN:
break;
default:
return false;
}
// A constructor can only be a subtype of a constructor.
if(((tsub == TK_NEW) || (tsuper == TK_NEW)) && (tsub != tsuper))
return false;
AST_GET_CHILDREN(sub, sub_cap, sub_id, sub_typeparams, sub_params);
AST_GET_CHILDREN(super, super_cap, super_id, super_typeparams, super_params);
// Must have the same name.
if(ast_name(sub_id) != ast_name(super_id))
return false;
// Must have the same number of type parameters and parameters.
if((ast_childcount(sub_typeparams) != ast_childcount(super_typeparams)) ||
(ast_childcount(sub_params) != ast_childcount(super_params)))
return false;
ast_t* r_sub = sub;
if(ast_id(super_typeparams) != TK_NONE)
{
// Reify sub with the type parameters of super.
BUILD(typeargs, super_typeparams, NODE(TK_TYPEARGS));
ast_t* super_typeparam = ast_child(super_typeparams);
while(super_typeparam != NULL)
{
AST_GET_CHILDREN(super_typeparam, super_id, super_constraint);
token_id cap = cap_from_constraint(super_constraint);
BUILD(typearg, super_typeparam,
NODE(TK_TYPEPARAMREF, TREE(super_id) NODE(cap) NONE));
ast_t* def = ast_get(super_typeparam, ast_name(super_id), NULL);
ast_setdata(typearg, def);
ast_append(typeargs, typearg);
super_typeparam = ast_sibling(super_typeparam);
}
r_sub = reify(sub, sub, sub_typeparams, typeargs);
ast_free_unattached(typeargs);
}
bool ok = is_reified_fun_sub_fun(r_sub, super, isub, isuper);
if(r_sub != sub)
ast_free_unattached(r_sub);
return ok;
}
static bool is_fun_sub_fun(ast_t* sub, ast_t* super, errorframe_t* errors)
{
token_id tsub = ast_id(sub);
token_id tsuper = ast_id(super);
switch(tsub)
{
case TK_NEW:
case TK_BE:
case TK_FUN:
break;
default:
return false;
}
switch(tsuper)
{
case TK_NEW:
case TK_BE:
case TK_FUN:
break;
default:
return false;
}
AST_GET_CHILDREN(sub, sub_cap, sub_id, sub_typeparams, sub_params);
AST_GET_CHILDREN(super, super_cap, super_id, super_typeparams, super_params);
// Must have the same name.
if(ast_name(sub_id) != ast_name(super_id))
{
if(errors != NULL)
{
ast_error_frame(errors, sub,
"method %s is not a subtype of method %s: they have different names",
ast_name(sub_id), ast_name(super_id));
}
return false;
}
// A constructor can only be a subtype of a constructor.
if(((tsub == TK_NEW) || (tsuper == TK_NEW)) && (tsub != tsuper))
{
if(errors != NULL)
ast_error_frame(errors, sub,
"only a constructor can be a subtype of a constructor");
return false;
}
// Must have the same number of type parameters.
if(ast_childcount(sub_typeparams) != ast_childcount(super_typeparams))
{
if(errors != NULL)
ast_error_frame(errors, sub,
"methods have a different number of type parameters");
return false;
}
// Must have the same number of parameters.
if(ast_childcount(sub_params) != ast_childcount(super_params))
{
if(errors != NULL)
ast_error_frame(errors, sub,
"methods have a different number of parameters");
return false;
}
ast_t* r_sub = sub;
if(ast_id(super_typeparams) != TK_NONE)
{
// Reify sub with the type parameters of super.
BUILD(typeargs, super_typeparams, NODE(TK_TYPEARGS));
ast_t* super_typeparam = ast_child(super_typeparams);
while(super_typeparam != NULL)
{
AST_GET_CHILDREN(super_typeparam, super_id, super_constraint);
BUILD(typearg, super_typeparam,
NODE(TK_TYPEPARAMREF, TREE(super_id) NONE NONE));
ast_t* def = ast_get(super_typeparam, ast_name(super_id), NULL);
ast_setdata(typearg, def);
typeparam_set_cap(typearg);
ast_append(typeargs, typearg);
super_typeparam = ast_sibling(super_typeparam);
}
r_sub = reify(sub, sub_typeparams, typeargs);
ast_free_unattached(typeargs);
}
bool ok = is_reified_fun_sub_fun(r_sub, super, errors);
if(r_sub != sub)
ast_free_unattached(r_sub);
return ok;
}
static ast_result_t sugar_object(pass_opt_t* opt, ast_t** astp)
{
typecheck_t* t = &opt->check;
ast_t* ast = *astp;
ast_result_t r = AST_OK;
AST_GET_CHILDREN(ast, cap, provides, members);
ast_t* c_id = ast_from_string(ast, package_hygienic_id(t));
ast_t* t_params;
ast_t* t_args;
collect_type_params(ast, &t_params, &t_args);
// Create a new anonymous type.
BUILD(def, ast,
NODE(TK_CLASS, AST_SCOPE
TREE(c_id)
TREE(t_params)
NONE
TREE(provides)
NODE(TK_MEMBERS)
NONE
NONE));
// We will have a create method in the type.
BUILD_NO_DEBUG(create, members,
NODE(TK_NEW, AST_SCOPE
NONE
ID("create")
NONE
NONE
NONE
NONE
NODE(TK_SEQ)
NONE
NONE));
BUILD(type_ref, ast, NODE(TK_REFERENCE, TREE(c_id)));
if(ast_id(t_args) != TK_NONE)
{
// Need to add type args to our type reference
BUILD(t, ast, NODE(TK_QUALIFY, TREE(type_ref) TREE(t_args)));
type_ref = t;
}
ast_free_unattached(t_args);
// We will replace object..end with $0.create(...)
BUILD(call, ast,
NODE(TK_CALL,
NONE
NONE
NODE(TK_DOT,
TREE(type_ref)
ID("create"))));
ast_t* create_params = ast_childidx(create, 3);
ast_t* create_body = ast_childidx(create, 6);
ast_t* call_args = ast_child(call);
ast_t* class_members = ast_childidx(def, 4);
ast_t* member = ast_child(members);
bool has_fields = false;
bool has_behaviours = false;
while(member != NULL)
{
switch(ast_id(member))
{
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
{
AST_GET_CHILDREN(member, id, type, init);
ast_t* p_id = ast_from_string(id, package_hygienic_id(t));
// The field is: var/let/embed id: type
BUILD(field, member,
NODE(ast_id(member),
TREE(id)
TREE(type)
NONE
NONE));
// The param is: $0: type
BUILD(param, member,
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_NO_DEBUG(assign, init,
NODE(TK_ASSIGN,
NODE(TK_CONSUME, NODE(TK_NONE) NODE(TK_REFERENCE, TREE(p_id)))
NODE(TK_REFERENCE, TREE(id))));
ast_setid(create_params, TK_PARAMS);
ast_setid(call_args, TK_POSITIONALARGS);
ast_append(class_members, field);
ast_append(create_params, param);
ast_append(create_body, assign);
ast_append(call_args, arg);
has_fields = true;
break;
}
case TK_BE:
// If we have behaviours, we must be an actor.
ast_append(class_members, member);
has_behaviours = true;
break;
default:
// Keep all the methods as they are.
ast_append(class_members, member);
break;
}
member = ast_sibling(member);
}
if(!has_fields)
{
// End the constructor with 'true', since it has no parameters.
BUILD_NO_DEBUG(true_node, ast, NODE(TK_TRUE));
ast_append(create_body, true_node);
}
// Handle capability and whether the anonymous type is a class, primitive or
// actor.
token_id cap_id = ast_id(cap);
if(has_behaviours)
{
// Change the type to an actor.
ast_setid(def, TK_ACTOR);
if(cap_id != TK_NONE && cap_id != TK_TAG)
{
ast_error(cap, "object literals with behaviours are actors and so must "
"have tag capability");
r = AST_ERROR;
}
}
else if(!has_fields && (cap_id == TK_NONE || cap_id == TK_TAG ||
cap_id == TK_BOX || cap_id == TK_VAL))
{
// Change the type from a class to a primitive.
ast_setid(def, TK_PRIMITIVE);
}
else
{
// Type is a class, set the create capability as specified
ast_setid(ast_child(create), cap_id);
}
// Add the create function at the end.
ast_append(class_members, create);
// Replace object..end with $0.create(...)
ast_replace(astp, call);
// Add new type to current module and bring it up to date with passes.
ast_t* module = ast_nearest(ast, TK_MODULE);
ast_append(module, def);
if(!ast_passes_type(&def, opt))
return AST_FATAL;
// Sugar the call.
if(!ast_passes_subtree(astp, opt, PASS_SUGAR))
return AST_FATAL;
return r;
}
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_NOMINAL:
case TK_TYPEPARAMREF:
{
ast_t* cap = cap_fetch(r_type);
switch(ast_id(cap))
{
case TK_ISO:
case TK_TRN:
case TK_REF:
case TK_BOX:
case TK_ISO_BIND:
case TK_TRN_BIND:
case TK_REF_BIND:
case TK_BOX_BIND:
// A known refcap on the right can be compacted.
upper = VIEW_UPPER_YES;
break;
case TK_VAL:
case TK_TAG:
case TK_CAP_SHARE:
case TK_VAL_BIND:
case TK_TAG_BIND:
case TK_CAP_SHARE_BIND:
// No refcap on the left modifies these.
upper = VIEW_UPPER_FORCE;
break;
default: {}
}
break;
}
case TK_ARROW:
break;
default:
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:
case TK_REF_BIND:
// 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:
case TK_CAP_SEND_BIND:
case TK_CAP_SHARE_BIND:
case TK_CAP_READ_BIND:
case TK_CAP_ALIAS_BIND:
case TK_CAP_ANY_BIND:
// 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:
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;
}
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;
}
static void trace_dynamic_tuple(compile_t* c, LLVMValueRef ctx,
LLVMValueRef ptr, LLVMValueRef desc, ast_t* type, ast_t* orig, ast_t* tuple)
{
// Build a "don't care" type of our cardinality.
size_t cardinality = ast_childcount(type);
ast_t* dontcare = ast_from(type, TK_TUPLETYPE);
for(size_t i = 0; i < cardinality; i++)
ast_append(dontcare, ast_from(type, TK_DONTCARE));
// Replace our type in the tuple type with the "don't care" type.
bool in_tuple = (tuple != NULL);
if(in_tuple)
ast_swap(type, dontcare);
else
tuple = dontcare;
// If the original type is a subtype of the test type, then we are always
// the correct cardinality. Otherwise, we need to dynamically check
// cardinality.
LLVMBasicBlockRef is_true = codegen_block(c, "");
LLVMBasicBlockRef is_false = codegen_block(c, "");
if(!is_subtype(orig, tuple, NULL))
{
LLVMValueRef dynamic_count = gendesc_fieldcount(c, desc);
LLVMValueRef static_count = LLVMConstInt(c->i32, cardinality, false);
LLVMValueRef test = LLVMBuildICmp(c->builder, LLVMIntEQ, static_count,
dynamic_count, "");
// Skip if not the right cardinality.
LLVMBuildCondBr(c->builder, test, is_true, is_false);
} else {
LLVMBuildBr(c->builder, is_true);
}
LLVMPositionBuilderAtEnd(c->builder, is_true);
size_t index = 0;
ast_t* child = ast_child(type);
ast_t* dc_child = ast_child(dontcare);
while(child != NULL)
{
switch(trace_type(child))
{
case TRACE_PRIMITIVE:
// Skip this element.
break;
case TRACE_ACTOR:
case TRACE_KNOWN:
case TRACE_UNKNOWN:
case TRACE_KNOWN_VAL:
case TRACE_UNKNOWN_VAL:
case TRACE_TAG:
case TRACE_TAG_OR_ACTOR:
case TRACE_DYNAMIC:
{
// If we are (A, B), turn (_, _) into (A, _).
ast_t* swap = ast_dup(child);
ast_swap(dc_child, swap);
// Create a next block.
LLVMBasicBlockRef next_block = codegen_block(c, "");
// Load the object from the tuple field.
LLVMValueRef field_info = gendesc_fieldinfo(c, desc, index);
LLVMValueRef object = gendesc_fieldload(c, ptr, field_info);
// Trace dynamic, even if the tuple thinks the field isn't dynamic.
trace_dynamic(c, ctx, object, swap, orig, tuple, next_block);
// Continue into the next block.
LLVMBuildBr(c->builder, next_block);
LLVMPositionBuilderAtEnd(c->builder, next_block);
// Restore (A, _) to (_, _).
ast_swap(swap, dc_child);
ast_free_unattached(swap);
break;
}
case TRACE_TUPLE:
{
// If we are (A, B), turn (_, _) into (A, _).
ast_t* swap = ast_dup(child);
ast_swap(dc_child, swap);
// Get a pointer to the unboxed tuple and it's descriptor.
LLVMValueRef field_info = gendesc_fieldinfo(c, desc, index);
LLVMValueRef field_ptr = gendesc_fieldptr(c, ptr, field_info);
LLVMValueRef field_desc = gendesc_fielddesc(c, field_info);
// Trace the tuple dynamically.
trace_dynamic_tuple(c, ctx, field_ptr, field_desc, swap, orig, tuple);
// Restore (A, _) to (_, _).
ast_swap(swap, dc_child);
ast_free_unattached(swap);
break;
}
default: {}
}
index++;
child = ast_sibling(child);
dc_child = ast_sibling(dc_child);
}
// Restore the tuple type.
if(in_tuple)
ast_swap(dontcare, type);
ast_free_unattached(dontcare);
// Continue with other possible tracings.
LLVMBuildBr(c->builder, is_false);
LLVMPositionBuilderAtEnd(c->builder, is_false);
}
// Handle a set of case methods, starting at the given method.
// Generate wrapper and worker methods and append them to the given list.
// Returns: true on success, false on failure.
static bool sugar_case_method(ast_t* first_case_method, ast_t* members,
const char* name, typecheck_t* t)
{
assert(first_case_method != NULL);
assert(members != NULL);
assert(name != NULL);
assert(t != NULL);
ast_t* wrapper = make_match_wrapper(first_case_method);
if(wrapper == NULL)
return false;
ast_t* match_cases = ast_from(first_case_method, TK_CASES);
ast_scope(match_cases);
// Process all methods with the same name.
// We need to remove processed methods. However, removing nodes from a list
// we're iterating over gets rather complex. Instead we mark nodes and remove
// them all in one sweep later.
for(ast_t* p = first_case_method; p != NULL; p = ast_sibling(p))
{
const char* p_name = ast_name(ast_childidx(p, 1));
if(p_name == name)
{
// This method is in the case set.
ast_t* case_ast = add_case_method(wrapper, p);
if(case_ast == NULL)
{
ast_free(wrapper);
ast_free(match_cases);
return false;
}
ast_append(match_cases, case_ast);
ast_setid(p, TK_NONE); // Mark for removal.
}
}
// Check params and build match operand, worker parameters and worker call
// arguments.
ast_t* match_params = ast_childidx(wrapper, 3);
ast_t* worker_params = ast_from(match_params, TK_PARAMS);
ast_t* call_args = ast_from(match_params, TK_POSITIONALARGS);
ast_t* match_operand = build_params(match_params, worker_params, call_args,
name, t);
if(match_operand == NULL)
{
ast_free(wrapper);
ast_free(match_cases);
ast_free(worker_params);
ast_free(call_args);
return false;
}
// Complete wrapper function and add to containing entity.
const char* worker_name = package_hygienic_id(t);
ast_t* wrapper_body = ast_childidx(wrapper, 6);
ast_t* wrapper_call;
ast_t* call_t_args = ast_from(wrapper, TK_NONE);
assert(ast_id(wrapper_body) == TK_SEQ);
assert(ast_childcount(wrapper_body) == 0);
build_t_params(ast_childidx(wrapper, 2), call_t_args);
if(ast_id(call_t_args) == TK_NONE)
{
// No type args needed.
ast_free(call_t_args);
BUILD(tmp, wrapper_body,
NODE(TK_CALL,
TREE(call_args)
NONE
NODE(TK_REFERENCE, ID(worker_name))));
wrapper_call = tmp;
}
else
{
// Type args needed on call.
BUILD(tmp, wrapper_body,
NODE(TK_CALL,
TREE(call_args)
NONE
NODE(TK_QUALIFY,
NODE(TK_REFERENCE, ID(worker_name))
TREE(call_t_args))));
wrapper_call = tmp;
}
ast_append(wrapper_body, wrapper_call);
ast_append(members, wrapper);
// Make worker function and add to containing entity.
AST_GET_CHILDREN(wrapper, cap, wrapper_id, t_params, wrapper_params,
ret_type, error);
if(ast_id(wrapper) == TK_BE)
cap = ast_from(cap, TK_REF);
BUILD(worker, wrapper,
NODE(TK_FUN, AST_SCOPE
TREE(cap)
ID(worker_name)
TREE(t_params)
TREE(worker_params)
TREE(ret_type)
TREE(error)
NODE(TK_SEQ,
NODE(TK_MATCH, AST_SCOPE
NODE(TK_SEQ, TREE(match_operand))
TREE(match_cases)
NONE)) // Else clause.
NONE // Doc string.
NONE)); // Guard.
ast_append(members, worker);
return true;
}
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 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(opt->check.errors, pattern, "not a matchable pattern");
return false;
}
switch(ast_id(pattern))
{
case TK_MATCH_CAPTURE:
// Captures are always OK.
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:
if(ast_childcount(pattern) == 1) // This may be a just a capture.
return is_valid_pattern(opt, ast_child(pattern));
// Treat this like other nodes.
break;
case TK_DONTCARE:
// It's always ok not to care.
return true;
default:
break;
}
// Structural equality, pattern.eq(match).
ast_t* fun = lookup(opt, pattern, pattern_type, stringtab("eq"));
if(fun == NULL)
{
ast_error(opt->check.errors, pattern,
"this pattern element doesn't support structural equality");
return false;
}
if(ast_id(fun) != TK_FUN)
{
ast_error(opt->check.errors, pattern,
"eq is not a function on this pattern element");
ast_error_continue(opt->check.errors, 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(opt->check.errors, pattern,
"polymorphic eq not supported in pattern matching");
ok = false;
}
if(!is_bool(result))
{
ast_error(opt->check.errors, pattern,
"eq must return Bool when pattern matching");
ok = false;
}
if(ast_id(partial) != TK_NONE)
{
ast_error(opt->check.errors, pattern,
"eq cannot be partial when pattern matching");
ok = false;
}
ast_t* r_type = set_cap_and_ephemeral(pattern_type, ast_id(cap), TK_NONE);
ast_t* a_type = alias(pattern_type);
errorframe_t info = NULL;
if(!is_subtype(a_type, r_type, &info, opt))
{
errorframe_t frame = NULL;
ast_error_frame(&frame, pattern, "eq cannot be called on this pattern");
errorframe_append(&frame, &info);
errorframe_report(&frame, opt->check.errors);
ok = false;
}
ast_t* param = ast_child(params);
if(param == NULL || ast_sibling(param) != NULL)
{
ast_error(opt->check.errors, 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(r_type);
ast_free_unattached(a_type);
ast_free_unattached(fun);
return ok;
}