int function_decl(ParserState* ps) { Ast *func = ps->curr, *t0 = 0; if (stepifis(ps, RFunction)) { if (stepifis(ps, TkId)) { ast_swap(func, func->next); t0 = func; func = func->next; } if (parameter_list(ps)) { if (statement_block(ps)) { ast_next_to_last_child(func); ast_next_to_last_child(func); if (t0 != 0) { Ast* t2 = ast_insert_after(t0); t2->t = OpAsgn; Ast* t1 = ast_insert_after(t0); t1->t = RVar; ast_swap(t0, t1); ast_swap(t1, t2); ast_next_to_last_child(t1); ast_next_to_last_child(t1); ast_next_to_last_child(t0); } } else parerr(ps, "expecting '{'"); } else parerr(ps, "expecting '('"); return 1; } else return 0; }
ast_t* reify_method_def(ast_t* ast, ast_t* typeparams, ast_t* typeargs, pass_opt_t* opt) { (void)opt; switch(ast_id(ast)) { case TK_FUN: case TK_BE: case TK_NEW: break; default: pony_assert(false); } // Remove the body AST to avoid duplicating it. ast_t* body = ast_childidx(ast, 6); ast_t* temp_body = ast_blank(TK_NONE); ast_swap(body, temp_body); ast_t* r_ast = reify(ast, typeparams, typeargs, opt, true); ast_swap(temp_body, body); ast_free_unattached(temp_body); return r_ast; }
int statement(ParserState* ps) { Ast *start = ps->curr, *expr = 0; if (stepifis(ps, PSemi)) { parwrn(ps, "empty statement"); } else if (stepifis(ps, RBreak)) { if (stepifis(ps, PSemi)) {} else { parerr(ps, "expecting ';' after break"); } } else if (stepifis(ps, RReturn)) { if (expression(ps, &expr)) { ast_next_to_first_child(start); } if (stepifis(ps, PSemi)) {} else { parerr(ps, "expecting ';'"); } } else if (if_statement(ps)) {} else if (while_statement(ps)) {} else if (variable_decl(ps)) {} else if (statement_block(ps)) {} else if (expression(ps, &expr)) { Ast* lhs = expr; Ast* op = ps->curr; if (curris(ps, OpAsgn)) { step(ps); if (expression(ps, &expr)) { if (lhs->t == AstGetIdx || lhs->t == AstGetKey) { lhs->t++; free(ast_rmnext(lhs)); ast_next_to_last_child(lhs); } else { ast_swap(lhs, op); ast_next_to_first_child(lhs); ast_next_to_last_child(lhs); } } else { parerr(ps, "invalid assignment"); } } else if (stepifis(ps, OpInc) || stepifis(ps, OpDec)) { ast_swap(lhs, op); ast_next_to_first_child(lhs); } if (stepifis(ps, PSemi)) {} else { parerr(ps, "invalid syntax, missing ';'?"); } } else return 0; return 1; }
static int binary_expr(ParserState* ps, int p, Ast** expr) { Ast *left, *right; if (unary_expr(ps, &left)) { *expr = left; int r = 0xffff; while (ps->curr != 0 && ps->curr->t < TkOpEnd && OpPrec[ps->curr->t] >= p && OpPrec[ps->curr->t] <= r) { Ast* op = ps->curr; step(ps); if (binary_expr(ps, OpPrec[op->t] + 1, &right)) { r = OpPrec[op->t]; ast_swap(left, op); ast_next_to_first_child(left); ast_next_to_last_child(left); *expr = left; } else { parerr(ps, "invalid syntax"); } } return 1; } else return 0; }
int if_statement(ParserState* ps) { Ast* rif = ps->curr, *expr, *relse; if (stepifis(ps, RIf)) { if (expression(ps, &expr)) { if (statement_block(ps)) { ast_next_to_first_child(rif); ast_next_to_last_child(rif); } else { parerr(ps, "expecting '{'"); } } else { parerr(ps, "expecting test expression"); } relse = ps->curr; if (stepifis(ps, RElse)) { if (if_statement(ps) || statement_block(ps)) { ast_swap(relse, relse->next); ast_rmnext(relse); ast_next_to_last_child(rif); } else { parerr(ps, "expecting '{' or 'if' after 'else'"); } } return 1; } else return 0; }
int parameter_list(ParserState* ps) { if (curris(ps, PLParen)) { enterblk(); while (ps->curr != 0) { VVar id; if (!declarator(ps, &id)) parerr(ps, "invalid parameter syntax"); if (curris(ps, PComma)) { Ast* comma = ps->curr; if (comma->next != 0) { ast_swap(comma, comma->next); ast_rmnext(comma); } } else if (ps->curr != 0) { parerr(ps, "expecting \',\' in parameter list"); } } exitblk(); return 1; } else return 0; }
static int primary_expr(ParserState* ps, Ast** expr) { Ast* base = ps->curr; if (literal_expr(ps, &base)) { *expr = base; } else if (curris(ps, PLParen)) { enterblk(); if (expression(ps, expr) && ps->curr == 0) { exitblk(); ast_swap(base, *expr); free(*expr); *expr = base; return 1; } else { exitblk(); parerr(ps, "invlaid syntax"); } } else if (obj_literal_expr(ps, expr)) {} else if (array_literal_expr(ps, expr)) {} else if (curris(ps, TkId)) { *expr = base; step(ps); } // else if (stepifis(ps, RNew)) {} else return 0; while (indexing(ps, expr, base) || dot_id(ps, expr, base) || arg_list(ps, base)) { } return 1; }
static int dot_id(ParserState* ps, Ast** expr, Ast* obj) { Ast* op = ps->curr; if (stepifis(ps, OpDot) && stepifis(ps, TkId)) { ast_swap(obj, op); ast_next_to_first_child(obj); ast_next_to_last_child(obj); obj->t = AstGetKey; *expr = obj; return 1; } return 0; }
void ast_replace(ast_t** prev, ast_t* next) { if(*prev == next) return; if(hasparent(next)) next = ast_dup(next); if(hasparent(*prev)) ast_swap(*prev, next); ast_free(*prev); *prev = next; }
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); }
static int obj_literal_expr(ParserState* ps, Ast** expr) { if (curris(ps, PLBrace)) { *expr = ps->curr; enterblk(); Ast* start = ps->curr, *value; while (ps->curr != 0) { Ast *key, *op; if (curris(ps, TkId) || curris(ps, TkVar) && ps->curr->v.type == T_VString) { key = ps->curr; step(ps); op = ps->curr; if (stepifis(ps, PColon)) { if (expression(ps, &value)) { ast_swap(key, op); ast_next_to_last_child(key); ast_next_to_last_child(key); } else { parerr(ps, "invalid initialization in object literal"); break; } } else { parerr(ps, "expecting ':'"); break; } } else { parerr(ps, "invalid key in object literal"); break; } if (ps->curr != 0 && !stepifis(ps, PComma)) { parerr(ps, "expecting ','"); break; } } while (start != 0 && start->next != 0) { if (start->next->t == PComma) ast_rmnext(start); else start = start->next; } exitblk(); (*expr)->t = AstObjLiteral; return 1; } else return 0; }
static int indexing(ParserState* ps, Ast** expr, Ast* obj) { if (curris(ps, PLBracket) && ps->curr->child != 0) { Ast* idx = ps->curr; enterblk(); if (!expression(ps, expr)) parerr(ps, "invalid index"); exitblk(); ast_swap(obj, idx); ast_next_to_first_child(obj); obj->t = AstGetIdx; *expr = obj; return 1; } else return 0; }
static int declarator(ParserState* ps, VVar* id) { Ast* start = ps->curr; if (curris(ps, TkId)) { *id = ps->curr->v; step(ps); Ast* op = ps->curr; if (stepifis(ps, OpAsgn)) { Ast* expr; if (expression(ps, &expr)) { ast_swap(start, op); ast_next_to_first_child(start); ast_next_to_last_child(start); } else { parerr(ps, "invalid initialization syntax"); } } return 1; } else return 0; }
static int arg_list(ParserState* ps, Ast* base) { Ast* args = ps->curr; if (curris(ps, PLParen)) { enterblk(); while (ps->curr != 0) { Ast* expr; if (!expression(ps, &expr)) parerr(ps, "invalid argument"); if (stepifis(ps, PComma)) free(ast_rmnext(expr)); else if (ps->curr != 0) parerr(ps, "expecting \',\' in parameter list"); } exitblk(); ast_swap(base, args); ast_next_to_first_child(base); base->t = AstInvoke; return 1; } else return 0; }
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 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); }
// Add the given case method into the given match method wrapper and check the // are compatible. // Returns: match case for worker method or NULL on error. static ast_t* add_case_method(ast_t* match_method, ast_t* case_method) { assert(match_method != NULL); assert(case_method != NULL); // We need default capabality and return value if not provided explicitly. if(ast_id(case_method) == TK_FUN) fun_defaults(case_method); AST_GET_CHILDREN(match_method, match_cap, match_id, match_t_params, match_params, match_ret_type, match_question); AST_GET_CHILDREN(case_method, case_cap, case_id, case_t_params, case_params, case_ret_type, case_question, case_body, case_docstring, case_guard); bool ok = true; if(ast_id(case_method) != ast_id(match_method)) { ast_error(case_method, "cannot mix fun and be cases in a single match method"); ast_error(match_method, "clashing method here"); ok = false; } if(ast_id(case_method) == TK_FUN) { if(ast_id(case_cap) != ast_id(match_cap)) { ast_error(case_cap, "differing receiver capabilities on case methods"); ast_error(match_cap, "clashing capability here"); ok = false; } if(ast_id(match_ret_type) == TK_NONE) { // Use case method return type. ast_replace(&match_ret_type, case_ret_type); } else { // Union this case method's return type with the existing match one. REPLACE(&match_ret_type, NODE(TK_UNIONTYPE, TREE(match_ret_type) TREE(case_ret_type))); } } if(ast_id(case_question) == TK_QUESTION) // If any case throws the match does too. ast_setid(match_question, TK_QUESTION); if(!process_t_params(match_t_params, case_t_params)) ok = false; ast_t* pattern = process_params(match_params, case_params); if(!ok || pattern == NULL) { ast_free(pattern); return NULL; } // Extract case body and guard condition (if any) to avoid copying. ast_t* body = ast_from(case_body, TK_NONE); ast_swap(case_body, body); ast_t* guard = ast_from(case_guard, TK_NONE); ast_swap(case_guard, guard); // Make match case. BUILD(match_case, pattern, NODE(TK_CASE, AST_SCOPE TREE(pattern) TREE(case_guard) TREE(case_body))); return match_case; }
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_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 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); }