diff --git a/runtime.c b/runtime.c index e80c626..ea63f5d 100644 --- a/runtime.c +++ b/runtime.c @@ -35,6 +35,12 @@ struct node_ind { struct node_parent* next; }; +struct node_data { + char tag; + char ctag; + struct node_parent** array; +}; + void stack_init(struct stack* stack) { stack->size = 16; stack->count = 0; @@ -46,26 +52,31 @@ void stack_free(struct stack* stack) { } void stack_push(struct stack* stack, struct node_parent* node) { + printf("push\n"); assert(stack->count < stack->size); stack->data[stack->count++] = node; } struct node_parent* stack_peek(struct stack* stack, int32_t offset) { + printf("peek %d\n", offset); assert(offset + 1 <= stack->count); return stack->data[stack->count - offset - 1]; } struct node_parent* stack_pop(struct stack* stack) { + printf("pop\n"); assert(stack->count > 0); return stack->data[--stack->count]; } void stack_popn(struct stack* stack, int32_t count) { + printf("popn %d\n", count); assert(stack->count >= count); stack->count -= count; } void stack_update(struct stack* stack, int32_t offset) { + printf("update %d\n", offset); assert(stack->count >= offset + 2); struct node_ind* to_replace = (struct node_ind*) stack->data[stack->count - 1 - 1 - offset]; to_replace->tag = 3; @@ -81,6 +92,7 @@ void stack_alloc(struct stack* stack, int32_t count) { } void stack_slide(struct stack* stack, int32_t count) { + printf("slide %d\n", count); assert(stack->count > count); stack->data[stack->count - 1 - count] = stack->data[stack->count - 1]; stack->count -= count; @@ -96,6 +108,7 @@ int32_t stack_size(struct stack* stack) { } struct node_parent* malloc_node_num(int32_t value) { + printf("alloc int %d\n", value); struct node_num* node = malloc(sizeof(struct node_app)); node->tag = 0; node->value = value; @@ -103,6 +116,7 @@ struct node_parent* malloc_node_num(int32_t value) { } struct node_parent* malloc_node_app(struct node_parent* left, struct node_parent* right) { + printf("alloc app\n"); struct node_app* node = malloc(sizeof(struct node_app)); node->tag = 1; node->left = left; @@ -110,6 +124,7 @@ struct node_parent* malloc_node_app(struct node_parent* left, struct node_parent return (struct node_parent*) node; } struct node_parent* malloc_node_global(int32_t arity, void (*function)(struct stack*)) { + printf("alloc global %d %p\n", arity, function); struct node_global* node = malloc(sizeof(struct node_app)); node->tag = 2; node->arity = arity; @@ -117,23 +132,34 @@ struct node_parent* malloc_node_global(int32_t arity, void (*function)(struct st return (struct node_parent*) node; } struct node_parent* malloc_node_indirect(struct node_parent* target) { + printf("alloc ind\n"); struct node_ind* node = malloc(sizeof(struct node_app)); node->tag = 3; node->next = target; return (struct node_parent*) node; } +struct node_parent* malloc_node_data(char tag, struct node_parent** array) { + printf("alloc data %d\n", tag); + struct node_data* node = malloc(sizeof(struct node_data)); + node->tag = 4; + node->ctag = tag; + node->array = array; + return (struct node_parent*) node; +} void unwind(struct stack* stack) { while(1) { assert(stack_size(stack) != 0); struct node_parent* node = stack_peek(stack, 0); - if(node->tag == 0) { + if(node->tag == 0 || node->tag == 4) { return; } else if(node->tag == 1) { + printf("unwind\n"); stack_push(stack, ((struct node_app*) node)->left); } else if(node->tag == 2) { struct node_global* global = (struct node_global*) node; if(stack->size > global->arity) { + printf("making call\n"); struct node_parent* root = stack_peek(stack, global->arity); stack_popn(stack, global->arity + 1); stack_push(stack, root); @@ -142,12 +168,15 @@ void unwind(struct stack* stack) { stack_push(stack, app->right); root = app->left; } + printf("calling supercomb\n"); global->function(stack); } else { + printf("underflow\n"); stack_popn(stack, stack_size(stack) - 1); return; } } else if(node->tag == 3) { + printf("handling indirection\n"); struct node_ind* ind = (struct node_ind*) node; stack_pop(stack); stack_push(stack, ind->next); @@ -155,9 +184,34 @@ void unwind(struct stack* stack) { } } +struct node_parent* pack(struct stack* stack, char tag, int count) { + printf("pack %d %d\n", tag, count); + assert(stack->count >= count); + struct node_parent** new_array = malloc(sizeof(struct node_parent*) * count); + struct node_parent** current_slot = new_array; + + while(count--) { + *current_slot = stack_pop(stack); + current_slot++; + } + + return malloc_node_data(tag, new_array); +} + +void split(struct stack* stack, struct node_parent* node, int count) { + assert(stack->count > 0); + printf("split %d\n", count); + struct node_data* data = (struct node_data*) node; + while(count > 0) { + stack_push(stack, data->array[count - 1]); + count--; + } +} + struct node_parent* eval(struct node_parent* start) { struct stack new_stack; stack_init(&new_stack); + printf("eval begin\n"); stack_push(&new_stack, start); unwind(&new_stack); struct node_parent* final_node = stack_pop(&new_stack); @@ -169,4 +223,7 @@ extern void main_supercomb(struct stack* stack); int main(int argc, char** argv) { struct node_parent* result = eval(malloc_node_global(0, main_supercomb)); + if(result->tag == 0) { + printf("integer generated! value: %d\n", ((struct node_num*)result)->value); + } } diff --git a/src/ast.cpp b/src/ast.cpp index 2958fbd..96cf25f 100644 --- a/src/ast.cpp +++ b/src/ast.cpp @@ -3,6 +3,10 @@ #include "error.hpp" namespace lily { + type* ast::typecheck(type_manager& mgr, std::shared_ptr env) { + return (ast_type = check(mgr, env)); + } + type* ast_num::check(type_manager& mgr, std::shared_ptr env) { return mgr.require_type("Int"); } @@ -12,8 +16,8 @@ namespace lily { } type* ast_app::check(type_manager& mgr, std::shared_ptr env) { - type* ltype = left->check(mgr, env); - type* rtype = right->check(mgr, env); + type* ltype = left->typecheck(mgr, env); + type* rtype = right->typecheck(mgr, env); // We LHS has to be a function, so unify LHS with that. type_func* f = mgr.create_type(nullptr, nullptr); @@ -31,8 +35,8 @@ namespace lily { } type* ast_op::check(type_manager& mgr, std::shared_ptr env) { - type* ltype = left->check(mgr, env); - type* rtype = right->check(mgr, env); + type* ltype = left->typecheck(mgr, env); + type* rtype = right->typecheck(mgr, env); // We know the thing has to be a nunmber, so we unify with number type. type* inttype = mgr.require_type("Int"); @@ -48,9 +52,9 @@ namespace lily { type* ast_let::check(type_manager& mgr, std::shared_ptr env) { if(env->identifier_exists(name)) throw error("invalid redefinition of variable."); - type* etype = expr->check(mgr, env); + type* etype = expr->typecheck(mgr, env); auto new_env = env->with_type(name, etype); - return in->check(mgr, new_env); + return in->typecheck(mgr, new_env); } type* ast_letrec::check(type_manager& mgr, std::shared_ptr env) { @@ -58,14 +62,14 @@ namespace lily { throw error("invalid redefinition of variable."); type* variable_type = mgr.create_type(); auto new_env = env->with_type(name, variable_type); - type* etype = expr->check(mgr, new_env); + type* etype = expr->typecheck(mgr, new_env); if(!variable_type->unify_with(etype)) throw error("incompatible type for variable"); - return in->check(mgr, new_env); + return in->typecheck(mgr, new_env); } type* ast_case::check(type_manager& mgr, std::shared_ptr env) { - type* ctype = of->check(mgr, env); + type* ctype = of->typecheck(mgr, env); type* pattern_type = nullptr; type* branch_type = nullptr; for(auto& branch : branches) { @@ -82,7 +86,7 @@ namespace lily { if(!pattern_type->unify_with(ctype)) throw error("pattern type doesn't match case value type"); - type* new_branch_type = branch.expr->check(mgr, new_env); + type* new_branch_type = branch.expr->typecheck(mgr, new_env); if(!branch_type) { branch_type = new_branch_type; } else { @@ -91,6 +95,8 @@ namespace lily { } } + case_type = pattern_type; + return branch_type; } @@ -143,6 +149,55 @@ namespace lily { } void ast_case::compile(instruction_manager& mgr, std::vector& into, std::shared_ptr env) { - throw error("case expressions unimplemented"); + type_parameter* param; + type* current_type = case_type; + while((param = dynamic_cast(current_type))) current_type = param->actual_type; + + type_data* data = dynamic_cast(current_type); + if(!data) throw error("case expression must be a data type!"); + + of->compile(mgr, into, env); + into.push_back(mgr.add_instruction()); + + instruction_jump* ijump = mgr.add_instruction(); + int ccount = data->constructors.size(); + bool branched[ccount]; + for(int i = 0; i < ccount; i++) branched[i] = false; + for(auto& branch : branches) { + auto& pattern = branch.pattern; + pattern_var* var_pattern = dynamic_cast(pattern.get()); + if(var_pattern) { + auto new_env = std::make_shared(var_pattern->name); + new_env->set_parent(env); + std::vector new_branch; + branch.expr->compile(mgr, new_branch, new_env); + ijump->instructions.push_back(std::move(new_branch)); + + for(int i = 0; i < ccount; i++) { + if(!branched[i]) ijump->const_instructions[i] = ijump->instructions.size() - 1; + branched[i] = true; + } + } else { + pattern_cons* cons_pattern = dynamic_cast(pattern.get()); + int constructor = std::distance(data->constructors.begin(), data->constructors.find(cons_pattern->name)); + if(branched[constructor]) throw error("cannot branch on the same constructor twice"); + branched[constructor] = true; + + int vcount = cons_pattern->vnames.size(); + for(int i = 0; i < cons_pattern->vnames.size(); i++) { + auto new_env = std::make_shared(cons_pattern->vnames[vcount - i - 1]); + new_env->set_parent(env); + env = new_env; + } + + std::vector into; + into.push_back(mgr.add_instruction(vcount)); + branch.expr->compile(mgr, into, env); + ijump->instructions.push_back(std::move(into)); + ijump->const_instructions[constructor] = ijump->instructions.size() - 1; + } + } + for(int i = 0; i < ccount; i++) if(!branched[i]) throw error("non-total case expression"); + into.push_back(ijump); } } diff --git a/src/ast.hpp b/src/ast.hpp index 60646f5..ead0e20 100644 --- a/src/ast.hpp +++ b/src/ast.hpp @@ -11,9 +11,12 @@ namespace lily { class type_env; struct ast { + type* ast_type = nullptr; + virtual ~ast() = default; virtual type* check(type_manager& mgr, std::shared_ptr env) = 0; virtual void compile(instruction_manager& mgr, std::vector& into, std::shared_ptr env) = 0; + type* typecheck(type_manager& mgr, std::shared_ptr env); }; typedef std::unique_ptr ast_ptr; @@ -86,6 +89,7 @@ namespace lily { ast_ptr expr; }; + type* case_type; ast_ptr of; std::vector branches; diff --git a/src/gmachine.cpp b/src/gmachine.cpp index b989c44..336776d 100644 --- a/src/gmachine.cpp +++ b/src/gmachine.cpp @@ -110,7 +110,6 @@ namespace lily { llvm::Value* stack = ctx.get_current_function()->arg_begin(); llvm::Value* new_node = builder.CreateCall(malloc_node_global_func, { get_int8_constant(ctx.get_supercombinator_arity(name)), ctx.get_supercombinator_function(name) }, "temp"); - // TODO get arity builder.CreateCall(stack_push_func, { stack, new_node }); } @@ -177,14 +176,41 @@ namespace lily { } void instruction_pack::gen_llvm(llvm_context& ctx) { - + llvm::Value* stack = ctx.get_current_function()->arg_begin(); + llvm::Value* packed = builder.CreateCall(pack_func, { stack, get_int8_constant(constructor), get_int32_constant(arity) }, "temp"); + builder.CreateCall(stack_push_func, { stack, packed }); } void instruction_split::gen_llvm(llvm_context& ctx) { - + llvm::Value* stack = ctx.get_current_function()->arg_begin(); + llvm::Value* popped = builder.CreateCall(stack_pop_func, { stack }, "temp"); + builder.CreateCall(split_func, { stack, popped, get_int32_constant(arity) }); } void instruction_jump::gen_llvm(llvm_context& ctx) { - + llvm::Value* stack = ctx.get_current_function()->arg_begin(); + llvm::BasicBlock* safety_block = llvm::BasicBlock::Create(context, "safety", ctx.get_current_function()); + llvm::Value* top = builder.CreateCall(stack_peek_func, { stack, get_int32_constant(0) }, "temp"); + llvm::Value* top_data = builder.CreatePointerCast(top, llvm::PointerType::getUnqual(node_data_type), "temp"); + llvm::Value* top_data_tag_ptr = builder.CreateGEP(top_data, { get_int32_constant(0), get_int32_constant(1) }, "temp"); + llvm::Value* top_data_tag = builder.CreateLoad(top_data_tag_ptr, "temp"); + llvm::SwitchInst* swtch = builder.CreateSwitch(top_data_tag, safety_block); + + std::vector blocks; + for(auto& branch : instructions) { + llvm::BasicBlock* new_block = llvm::BasicBlock::Create(context, "branch", ctx.get_current_function()); + builder.SetInsertPoint(new_block); + for(auto& i : branch) { + i->gen_llvm(ctx); + } + builder.CreateBr(safety_block); + blocks.push_back(new_block); + } + + for(auto& pair : const_instructions) { + swtch->addCase(get_int8_constant(pair.first), blocks[pair.second]); + } + + builder.SetInsertPoint(safety_block); } } diff --git a/src/gmachine.hpp b/src/gmachine.hpp index 4440df5..e37c4d7 100644 --- a/src/gmachine.hpp +++ b/src/gmachine.hpp @@ -129,6 +129,7 @@ namespace lily { struct instruction_jump : instruction { std::vector> instructions; + std::map const_instructions; std::ostream& to_stream(std::ostream& os); void gen_llvm(llvm_context& ctx); }; diff --git a/src/llvm.cpp b/src/llvm.cpp index 1d06d0e..862956a 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -36,7 +36,10 @@ namespace lily { llvm::Function* malloc_node_app_func; llvm::Function* malloc_node_global_func; llvm::Function* malloc_node_ind_func; + llvm::Function* malloc_node_data_func; + llvm::Function* pack_func; + llvm::Function* split_func; llvm::Function* eval_func; llvm::IntegerType* tag_type; @@ -46,20 +49,21 @@ namespace lily { llvm::StructType* node_app_type; llvm::StructType* node_global_type; llvm::StructType* node_indirect_type; + llvm::StructType* node_data_type; static void initialize_llvm() { } - llvm::Value* get_int32_constant(int value) { + llvm::ConstantInt* get_int32_constant(int value) { return llvm::ConstantInt::get(context, llvm::APInt(32, value)); } - llvm::Value* get_int64_constant(long int value) { + llvm::ConstantInt* get_int64_constant(long int value) { return llvm::ConstantInt::get(context, llvm::APInt(64, value)); } - llvm::Value* get_int8_constant(char value) { + llvm::ConstantInt* get_int8_constant(char value) { return llvm::ConstantInt::get(context, llvm::APInt(8, value)); } @@ -137,6 +141,21 @@ namespace lily { llvm::Function::LinkageTypes::ExternalLinkage, "malloc_node_indirect", &module); + malloc_node_data_func = llvm::Function::Create( + llvm::FunctionType::get(node_pointer_type, { tag_type, llvm::IntegerType::get(context, 32) }, false), + llvm::Function::LinkageTypes::ExternalLinkage, + "malloc_node_data", + &module); + pack_func = llvm::Function::Create( + llvm::FunctionType::get(node_pointer_type, { stack_pointer_type, tag_type, llvm::IntegerType::get(context, 32) }, false), + llvm::Function::LinkageTypes::ExternalLinkage, + "pack", + &module); + split_func = llvm::Function::Create( + llvm::FunctionType::get(llvm::Type::getVoidTy(context), { stack_pointer_type, node_pointer_type, llvm::IntegerType::get(context, 32) }, false), + llvm::Function::LinkageTypes::ExternalLinkage, + "split", + &module); eval_func = llvm::Function::Create( llvm::FunctionType::get(node_pointer_type, { node_pointer_type }, false), llvm::Function::LinkageTypes::ExternalLinkage, @@ -155,6 +174,7 @@ namespace lily { node_app_type = llvm::StructType::create(context, "node_app"); node_global_type = llvm::StructType::create(context, "node_global"); node_indirect_type = llvm::StructType::create(context, "node_indirect"); + node_data_type = llvm::StructType::create(context, "node_data"); supercomb_function_type = llvm::FunctionType::get(llvm::Type::getVoidTy(context), { stack_pointer_type }, false); supercomb_function_pointer_type = llvm::PointerType::getUnqual(supercomb_function_type); @@ -165,6 +185,7 @@ namespace lily { node_app_type->setBody(tag_type, node_pointer_type, node_pointer_type); node_global_type->setBody(tag_type, tag_type, supercomb_function_pointer_type); node_indirect_type->setBody(tag_type, node_pointer_type); + node_data_type->setBody(tag_type, tag_type, llvm::PointerType::getUnqual(node_pointer_type)); } void llvm_generate(const std::string& filename) { diff --git a/src/llvm.hpp b/src/llvm.hpp index de47efb..dc7fe6e 100644 --- a/src/llvm.hpp +++ b/src/llvm.hpp @@ -32,7 +32,10 @@ namespace lily { extern llvm::Function* malloc_node_app_func; extern llvm::Function* malloc_node_global_func; extern llvm::Function* malloc_node_ind_func; + extern llvm::Function* malloc_node_data_func; + extern llvm::Function* pack_func; + extern llvm::Function* split_func; extern llvm::Function* eval_func; extern llvm::IntegerType* tag_type; @@ -42,10 +45,11 @@ namespace lily { extern llvm::StructType* node_app_type; extern llvm::StructType* node_global_type; extern llvm::StructType* node_indirect_type; + extern llvm::StructType* node_data_type; - llvm::Value* get_int32_constant(int value); - llvm::Value* get_int64_constant(int value); - llvm::Value* get_int8_constant(char value); + llvm::ConstantInt* get_int32_constant(int value); + llvm::ConstantInt* get_int64_constant(int value); + llvm::ConstantInt* get_int8_constant(char value); void llvm_init(); void llvm_generate(const std::string& filename); diff --git a/src/main.cpp b/src/main.cpp index e4efcf6..abdbc4b 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -8,8 +8,10 @@ int main() { try { lily::program_ptr prog = lily::parse( - "defn magic x = { let z = { x * 2 } in { 326 + z + z } }\n" - "defn main = { magic 1 + magic 0 }" + "data Bool = { False, True }\n" + "defn if c t e = { case not c of { True -> { t } False -> { e } } }\n" + "defn not b = { case b of { True -> { False } False -> { True } } }\n" + "defn main = { if True 3 2 }" ); prog->gen_llvm(); } catch(lily::error& e) { diff --git a/src/parser.cpp b/src/parser.cpp index f60c254..1b975ed 100644 --- a/src/parser.cpp +++ b/src/parser.cpp @@ -287,7 +287,7 @@ namespace lily { // Now that we have collected the functions, check their bodies. for(auto& pair : functions) { type* body_type = - pair.second.body->check(type_mgr, function_envs[pair.first]); + pair.second.body->typecheck(type_mgr, function_envs[pair.first]); if(!function_output_types[pair.first]->unify_with(body_type)) throw error("unable to unify function type"); } @@ -315,6 +315,7 @@ namespace lily { void program::compile(instruction_manager& mgr, std::map>& into) { register_internal(mgr, into); + type_mgr.register_constructor_supercombs(mgr, into); for(auto& pair : functions) { std::shared_ptr fresh_env = std::make_shared(0); size_t count = pair.second.params.size(); @@ -342,7 +343,8 @@ namespace lily { compile(mgr, gcode); for(auto& pair : gcode) { - int arity = functions.count(pair.first) ? functions[pair.first].params.size() : 2; + int arity = functions.count(pair.first) ? functions[pair.first].params.size() : type_mgr.constructor_arity(pair.first); + if(arity == -1) arity = 2; ctx.add_supercombinator(pair.first, arity); } diff --git a/src/type_manager.cpp b/src/type_manager.cpp index a27326a..0d962e2 100644 --- a/src/type_manager.cpp +++ b/src/type_manager.cpp @@ -3,6 +3,7 @@ #include "error.hpp" #include "type.hpp" #include "type_checker.hpp" +#include namespace lily { type_manager::type_manager() { @@ -57,4 +58,31 @@ namespace lily { } } } + + void type_manager::register_constructor_supercombs(instruction_manager& mgr, std::map>& into) { + for(auto& type_ref : types) { + type_data* data_type = dynamic_cast(type_ref.get()); + if(!data_type) continue; + + for(auto& pair : data_type->constructors) { + std::vector is; + is.push_back(mgr.add_instruction(pair.second->id, pair.second->params.size())); + is.push_back(mgr.add_instruction(0)); + into[pair.first] = std::move(is); + } + } + } + + int type_manager::constructor_arity(const std::string& name) { + for(auto& type_ref : types) { + type_data* data_type = dynamic_cast(type_ref.get()); + if(!data_type) continue; + + for(auto& pair : data_type->constructors) { + if(pair.first == name) return pair.second->params.size(); + } + } + return -1; + } + } diff --git a/src/type_manager.hpp b/src/type_manager.hpp index 253525f..b861a4b 100644 --- a/src/type_manager.hpp +++ b/src/type_manager.hpp @@ -3,6 +3,7 @@ #include #include #include "type.hpp" +#include "gmachine.hpp" namespace lily { class type_env; @@ -29,5 +30,7 @@ namespace lily { type* require_type(const std::string& name) const; void register_constructors(std::shared_ptr env); + void register_constructor_supercombs(instruction_manager& mgr, std::map>& into); + int constructor_arity(const std::string& name); }; }