static bool apply_named_args(pass_opt_t* opt, ast_t* params, ast_t* positional,
ast_t* namedargs)
{
ast_t* namedarg = ast_pop(namedargs);
while(namedarg != NULL)
{
AST_GET_CHILDREN(namedarg, arg_id, arg);
ast_t* param = ast_child(params);
size_t param_index = 0;
while(param != NULL)
{
AST_GET_CHILDREN(param, param_id);
if(ast_name(arg_id) == ast_name(param_id))
break;
param = ast_sibling(param);
param_index++;
}
if(param == NULL)
{
if(ast_id(namedarg) == TK_UPDATEARG)
{
ast_error(opt->check.errors, arg_id,
"cannot use sugar, update() has no parameter named \"value\"");
return false;
}
ast_error(opt->check.errors, arg_id, "not a parameter name");
return false;
}
ast_t* arg_replace = ast_childidx(positional, param_index);
if(ast_id(arg_replace) != TK_NONE)
{
ast_error(opt->check.errors, arg_id,
"named argument is already supplied");
ast_error_continue(opt->check.errors, arg_replace,
"supplied argument is here");
return false;
}
// Extract named argument expression to avoid copying it
ast_free(ast_pop(namedarg)); // ID
arg = ast_pop(namedarg); // Expression
ast_replace(&arg_replace, arg);
namedarg = ast_pop(namedargs);
}
ast_setid(namedargs, TK_NONE);
return true;
}
ast_t* program_load(const char* path, pass_opt_t* options)
{
ast_t* program = ast_blank(TK_PROGRAM);
ast_scope(program);
options->program_pass = PASS_PARSE;
// Always load builtin package first, then the specified one.
if(package_load(program, stringtab("builtin"), options) == NULL ||
package_load(program, path, options) == NULL)
{
ast_free(program);
return NULL;
}
// Reorder packages so specified package is first.
ast_t* builtin = ast_pop(program);
ast_append(program, builtin);
if(!ast_passes_program(program, options))
{
ast_free(program);
return NULL;
}
return program;
}
// Handle the given case method parameter, which does not have a type
// specified.
// Check the case parameter and generate the pattern element.
// Returns: true on success, false on error.
static bool param_without_type(ast_t* case_param, ast_t* pattern)
{
assert(case_param != NULL);
assert(pattern != NULL);
AST_GET_CHILDREN(case_param, value, type, def_arg);
assert(ast_id(type) == TK_NONE);
if(ast_id(def_arg) != TK_NONE)
{
ast_error(type,
"cannot specify default argument for match value parameter");
return false;
}
// Add value to match pattern. Pop it first to avoid pointless copy.
ast_t* popped_value = ast_pop(case_param);
if(ast_id(popped_value) == TK_DONTCARE)
{
// Value is just `don't care`.
ast_append(pattern, popped_value);
}
else
{
// Value in an expression, need a containing sequence.
BUILD(value_ast, value, NODE(TK_SEQ, TREE(popped_value)));
ast_append(pattern, value_ast);
}
return true;
}
void default_builder(rule_state_t* state, ast_t* new_ast)
{
assert(state != NULL);
assert(new_ast != NULL);
// Existing AST goes at the top
if(ast_id(new_ast) == TK_FLATTEN)
{
// Add the children of the new node, not the node itself
ast_t* new_child;
while((new_child = ast_pop(new_ast)) != NULL)
default_builder(state, new_child);
ast_free(new_ast);
return;
}
if(state->last_child == NULL) // No valid last pointer
ast_append(state->ast, new_ast);
else // Add new AST to end of children
ast_add_sibling(state->last_child, new_ast);
state->last_child = new_ast;
}
// Sugar any case methods in the given entity.
ast_result_t sugar_case_methods(typecheck_t* t, ast_t* entity)
{
assert(entity != NULL);
ast_result_t result = AST_OK;
ast_t* members = ast_childidx(entity, 4);
bool cases_found = false;
// Check each method to see if its name is repeated, which indicates a case
// method.
for(ast_t* p = ast_child(members); p != NULL; p = ast_sibling(p))
{
if(ast_id(p) == TK_FUN || ast_id(p) == TK_BE)
{
const char* p_name = ast_name(ast_childidx(p, 1));
// Check if any subsequent methods share p's name.
for(ast_t* q = ast_sibling(p); q != NULL; q = ast_sibling(q))
{
if(ast_id(q) == TK_FUN || ast_id(q) == TK_BE)
{
const char* q_name = ast_name(ast_childidx(q, 1));
if(q_name == p_name)
{
// p's name is repeated, it's a case method, get a match method.
if(!sugar_case_method(p, members, p_name, t))
result = AST_ERROR;
cases_found = true;
break;
}
}
}
}
}
if(cases_found)
{
// Remove nodes marked during processing.
ast_t* filtered_members = ast_from(members, TK_MEMBERS);
ast_t* list = NULL;
ast_t* member;
while((member = ast_pop(members)) != NULL)
{
if(ast_id(member) == TK_NONE) // Marked for removal.
ast_free(member);
else // Put back in filtered list.
ast_list_append(filtered_members, &list, member);
}
ast_replace(&members, filtered_members);
}
return result;
}
// Handle the given case method parameter list.
// Combine and check the case parameters against the existing match parameters
// and generate the match pattern to go in the worker method.
// Returns: match pattern, NULL on error.
static ast_t* process_params(ast_t* match_params, ast_t* case_params)
{
assert(match_params != NULL);
assert(case_params != NULL);
bool ok = true;
size_t count = 0;
ast_t* pattern = ast_from(case_params, TK_TUPLE);
ast_t* case_param = ast_child(case_params);
ast_t* match_param = ast_child(match_params);
while(case_param != NULL && match_param != NULL)
{
AST_GET_CHILDREN(case_param, id, type, def_arg);
if(ast_id(type) != TK_NONE)
{
// We have a parameter.
if(!param_with_type(case_param, match_param, pattern))
ok = false;
}
else
{
// We have a value to match.
if(!param_without_type(case_param, pattern))
ok = false;
}
case_param = ast_sibling(case_param);
match_param = ast_sibling(match_param);
count++;
}
if(case_param != NULL || match_param != NULL)
{
ast_error(case_params, "differing number of parameters to case methods");
ast_error(match_params, "clashing parameter count here");
ok = false;
}
if(!ok)
{
ast_free(pattern);
return NULL;
}
assert(count > 0);
if(count == 1)
{
// Only one parameter, don't need a tuple pattern.
ast_t* tmp = ast_pop(ast_child(pattern));
ast_free(pattern);
pattern = tmp;
}
return pattern;
}
static void pop_assume()
{
ast_t* assumption = ast_pop(subtype_assume);
ast_free_unattached(assumption);
if(ast_child(subtype_assume) == NULL)
{
ast_free_unattached(subtype_assume);
subtype_assume = NULL;
}
}
static void add_as_type(typecheck_t* t, ast_t* type, ast_t* pattern,
ast_t* body)
{
assert(type != NULL);
switch(ast_id(type))
{
case TK_TUPLETYPE:
{
BUILD(tuple_pattern, pattern, NODE(TK_SEQ, NODE(TK_TUPLE)));
ast_append(pattern, tuple_pattern);
ast_t* pattern_child = ast_child(tuple_pattern);
BUILD(tuple_body, body, NODE(TK_SEQ, NODE(TK_TUPLE)));
ast_t* body_child = ast_child(tuple_body);
for(ast_t* p = ast_child(type); p != NULL; p = ast_sibling(p))
add_as_type(t, p, pattern_child, body_child);
if(ast_childcount(body_child) == 1)
{
// Only one child, not actually a tuple
ast_t* t = ast_pop(body_child);
ast_free(tuple_body);
tuple_body = t;
}
ast_append(body, tuple_body);
break;
}
case TK_DONTCARE:
ast_append(pattern, type);
break;
default:
{
const char* name = package_hygienic_id(t);
ast_t* a_type = alias(type);
BUILD(pattern_elem, pattern,
NODE(TK_SEQ,
NODE(TK_LET, ID(name) TREE(a_type))));
BUILD(body_elem, body,
NODE(TK_SEQ,
NODE(TK_CONSUME, NODE(TK_BORROWED) NODE(TK_REFERENCE, ID(name)))));
ast_append(pattern, pattern_elem);
ast_append(body, body_elem);
break;
}
}
}
static ast_result_t sugar_as(pass_opt_t* opt, ast_t** astp)
{
typecheck_t* t = &opt->check;
ast_t* ast = *astp;
AST_GET_CHILDREN(ast, expr, type);
ast_t* pattern_root = ast_from(type, TK_LEX_ERROR);
ast_t* body_root = ast_from(type, TK_LEX_ERROR);
add_as_type(t, type, pattern_root, body_root);
ast_t* body = ast_pop(body_root);
ast_free(body_root);
if(body == NULL)
{
// No body implies all types are "don't care"
ast_error(ast, "Cannot treat value as \"don't care\"");
ast_free(pattern_root);
return AST_ERROR;
}
// Don't need top sequence in pattern
assert(ast_id(ast_child(pattern_root)) == TK_SEQ);
ast_t* pattern = ast_pop(ast_child(pattern_root));
ast_free(pattern_root);
REPLACE(astp,
NODE(TK_MATCH, AST_SCOPE
NODE(TK_SEQ, TREE(expr))
NODE(TK_CASES, AST_SCOPE
NODE(TK_CASE, AST_SCOPE
TREE(pattern)
NONE
TREE(body)))
NODE(TK_SEQ, AST_SCOPE NODE(TK_ERROR, NONE))));
return ast_visit(astp, pass_sugar, NULL, opt, PASS_SUGAR);
}
void ast_reorder_children(ast_t* ast, const size_t* new_order,
ast_t** shuffle_space)
{
assert(ast != NULL);
assert(new_order != NULL);
assert(shuffle_space != NULL);
size_t count = ast_childcount(ast);
for(size_t i = 0; i < count; i++)
shuffle_space[i] = ast_pop(ast);
for(size_t i = 0; i < count; i++)
{
size_t index = new_order[i];
assert(index < count);
ast_t* t = shuffle_space[index];
assert(t != NULL);
ast_append(ast, t);
shuffle_space[index] = NULL;
}
}
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);
}
}
}
// Normalise the given ifdef condition.
static void cond_normalise(ast_t** astp)
{
pony_assert(astp != NULL);
ast_t* ast = *astp;
pony_assert(ast != NULL);
switch(ast_id(ast))
{
case TK_AND:
{
ast_setid(ast, TK_IFDEFAND);
AST_GET_CHILDREN(ast, left, right, question);
pony_assert(ast_id(question) == TK_NONE);
ast_remove(question);
cond_normalise(&left);
cond_normalise(&right);
break;
}
case TK_OR:
{
ast_setid(ast, TK_IFDEFOR);
AST_GET_CHILDREN(ast, left, right, question);
pony_assert(ast_id(question) == TK_NONE);
ast_remove(question);
cond_normalise(&left);
cond_normalise(&right);
break;
}
case TK_NOT:
{
ast_setid(ast, TK_IFDEFNOT);
AST_GET_CHILDREN(ast, child);
cond_normalise(&child);
break;
}
case TK_STRING:
{
ast_setid(ast, TK_ID);
REPLACE(astp,
NODE(TK_IFDEFFLAG,
TREE(*astp)));
break;
}
case TK_REFERENCE:
{
const char* name = ast_name(ast_child(ast));
if(strcmp(name, OS_POSIX_NAME) == 0)
{
REPLACE(astp,
NODE(TK_IFDEFOR,
NODE(TK_IFDEFOR,
NODE(TK_IFDEFFLAG, ID(OS_LINUX_NAME))
NODE(TK_IFDEFFLAG, ID(OS_MACOSX_NAME)))
NODE(TK_IFDEFFLAG, ID(OS_BSD_NAME))));
break;
}
ast_setid(ast, TK_IFDEFFLAG);
break;
}
case TK_SEQ:
{
// Remove the sequence node.
pony_assert(ast_childcount(ast) == 1);
ast_t* child = ast_pop(ast);
pony_assert(child != NULL);
cond_normalise(&child);
ast_replace(astp, child);
break;
}
case TK_IFDEFAND:
case TK_IFDEFOR:
case TK_IFDEFNOT:
case TK_IFDEFFLAG:
// Already normalised.
break;
default:
pony_assert(0);
break;
}
}
// 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;
}
