Fork off version 13 of the compiler.
This commit is contained in:
parent
bf3c81fe24
commit
5dbf75b5e4
46
code/compiler/13/CMakeLists.txt
Normal file
46
code/compiler/13/CMakeLists.txt
Normal file
|
@ -0,0 +1,46 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
project(compiler)
|
||||
|
||||
# Find all the required packages
|
||||
find_package(BISON)
|
||||
find_package(FLEX)
|
||||
find_package(LLVM REQUIRED CONFIG)
|
||||
|
||||
# Set up the flex and bison targets
|
||||
bison_target(parser
|
||||
${CMAKE_CURRENT_SOURCE_DIR}/parser.y
|
||||
${CMAKE_CURRENT_BINARY_DIR}/parser.cpp
|
||||
COMPILE_FLAGS "-d")
|
||||
flex_target(scanner
|
||||
${CMAKE_CURRENT_SOURCE_DIR}/scanner.l
|
||||
${CMAKE_CURRENT_BINARY_DIR}/scanner.cpp)
|
||||
add_flex_bison_dependency(scanner parser)
|
||||
|
||||
# Find all the relevant LLVM components
|
||||
llvm_map_components_to_libnames(LLVM_LIBS core x86asmparser x86codegen)
|
||||
|
||||
# Create compiler executable
|
||||
add_executable(compiler
|
||||
definition.cpp definition.hpp
|
||||
parsed_type.cpp parsed_type.hpp
|
||||
ast.cpp ast.hpp
|
||||
llvm_context.cpp llvm_context.hpp
|
||||
type_env.cpp type_env.hpp
|
||||
env.cpp env.hpp
|
||||
type.cpp type.hpp
|
||||
error.cpp error.hpp
|
||||
binop.cpp binop.hpp
|
||||
instruction.cpp instruction.hpp
|
||||
graph.cpp graph.hpp
|
||||
global_scope.cpp global_scope.hpp
|
||||
${BISON_parser_OUTPUTS}
|
||||
${FLEX_scanner_OUTPUTS}
|
||||
main.cpp
|
||||
)
|
||||
|
||||
# Configure compiler executable
|
||||
target_include_directories(compiler PUBLIC ${CMAKE_CURRENT_SOURCE_DIR})
|
||||
target_include_directories(compiler PUBLIC ${CMAKE_CURRENT_BINARY_DIR})
|
||||
target_include_directories(compiler PUBLIC ${LLVM_INCLUDE_DIRS})
|
||||
target_compile_definitions(compiler PUBLIC ${LLVM_DEFINITIONS})
|
||||
target_link_libraries(compiler ${LLVM_LIBS})
|
437
code/compiler/13/ast.cpp
Normal file
437
code/compiler/13/ast.cpp
Normal file
|
@ -0,0 +1,437 @@
|
|||
#include "ast.hpp"
|
||||
#include <ostream>
|
||||
#include "binop.hpp"
|
||||
#include "error.hpp"
|
||||
#include "type_env.hpp"
|
||||
#include "env.hpp"
|
||||
|
||||
static void print_indent(int n, std::ostream& to) {
|
||||
while(n--) to << " ";
|
||||
}
|
||||
|
||||
void ast_int::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "INT: " << value << std::endl;
|
||||
}
|
||||
|
||||
void ast_int::find_free(std::set<std::string>& into) {
|
||||
|
||||
}
|
||||
|
||||
type_ptr ast_int::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
return type_ptr(new type_app(env->lookup_type("Int")));
|
||||
}
|
||||
|
||||
void ast_int::translate(global_scope& scope) {
|
||||
|
||||
}
|
||||
|
||||
void ast_int::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
into.push_back(instruction_ptr(new instruction_pushint(value)));
|
||||
}
|
||||
|
||||
void ast_lid::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "LID: " << id << std::endl;
|
||||
}
|
||||
|
||||
void ast_lid::find_free(std::set<std::string>& into) {
|
||||
into.insert(id);
|
||||
}
|
||||
|
||||
type_ptr ast_lid::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
return env->lookup(id)->instantiate(mgr);
|
||||
}
|
||||
|
||||
void ast_lid::translate(global_scope& scope) {
|
||||
|
||||
}
|
||||
|
||||
void ast_lid::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
auto mangled_name = this->env->get_mangled_name(id);
|
||||
into.push_back(instruction_ptr(
|
||||
(env->has_variable(mangled_name) && !this->env->is_global(id)) ?
|
||||
(instruction*) new instruction_push(env->get_offset(mangled_name)) :
|
||||
(instruction*) new instruction_pushglobal(mangled_name)));
|
||||
}
|
||||
|
||||
void ast_uid::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "UID: " << id << std::endl;
|
||||
}
|
||||
|
||||
void ast_uid::find_free(std::set<std::string>& into) {
|
||||
|
||||
}
|
||||
|
||||
type_ptr ast_uid::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
return env->lookup(id)->instantiate(mgr);
|
||||
}
|
||||
|
||||
void ast_uid::translate(global_scope& scope) {
|
||||
|
||||
}
|
||||
|
||||
void ast_uid::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
into.push_back(instruction_ptr(
|
||||
new instruction_pushglobal(this->env->get_mangled_name(id))));
|
||||
}
|
||||
|
||||
void ast_binop::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "BINOP: " << op_name(op) << std::endl;
|
||||
left->print(indent + 1, to);
|
||||
right->print(indent + 1, to);
|
||||
}
|
||||
|
||||
void ast_binop::find_free(std::set<std::string>& into) {
|
||||
left->find_free(into);
|
||||
right->find_free(into);
|
||||
}
|
||||
|
||||
type_ptr ast_binop::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
type_ptr ltype = left->typecheck(mgr, env);
|
||||
type_ptr rtype = right->typecheck(mgr, env);
|
||||
type_ptr ftype = env->lookup(op_name(op))->instantiate(mgr);
|
||||
if(!ftype) throw type_error(std::string("unknown binary operator ") + op_name(op));
|
||||
|
||||
type_ptr return_type = mgr.new_type();
|
||||
type_ptr arrow_one = type_ptr(new type_arr(rtype, return_type));
|
||||
type_ptr arrow_two = type_ptr(new type_arr(ltype, arrow_one));
|
||||
|
||||
mgr.unify(arrow_two, ftype);
|
||||
return return_type;
|
||||
}
|
||||
|
||||
void ast_binop::translate(global_scope& scope) {
|
||||
left->translate(scope);
|
||||
right->translate(scope);
|
||||
}
|
||||
|
||||
void ast_binop::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
right->compile(env, into);
|
||||
left->compile(env_ptr(new env_offset(1, env)), into);
|
||||
|
||||
into.push_back(instruction_ptr(new instruction_pushglobal(op_action(op))));
|
||||
into.push_back(instruction_ptr(new instruction_mkapp()));
|
||||
into.push_back(instruction_ptr(new instruction_mkapp()));
|
||||
}
|
||||
|
||||
void ast_app::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "APP:" << std::endl;
|
||||
left->print(indent + 1, to);
|
||||
right->print(indent + 1, to);
|
||||
}
|
||||
|
||||
void ast_app::find_free(std::set<std::string>& into) {
|
||||
left->find_free(into);
|
||||
right->find_free(into);
|
||||
}
|
||||
|
||||
type_ptr ast_app::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
type_ptr ltype = left->typecheck(mgr, env);
|
||||
type_ptr rtype = right->typecheck(mgr, env);
|
||||
|
||||
type_ptr return_type = mgr.new_type();
|
||||
type_ptr arrow = type_ptr(new type_arr(rtype, return_type));
|
||||
mgr.unify(arrow, ltype);
|
||||
return return_type;
|
||||
}
|
||||
|
||||
void ast_app::translate(global_scope& scope) {
|
||||
left->translate(scope);
|
||||
right->translate(scope);
|
||||
}
|
||||
|
||||
void ast_app::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
right->compile(env, into);
|
||||
left->compile(env_ptr(new env_offset(1, env)), into);
|
||||
into.push_back(instruction_ptr(new instruction_mkapp()));
|
||||
}
|
||||
|
||||
void ast_case::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "CASE: " << std::endl;
|
||||
for(auto& branch : branches) {
|
||||
print_indent(indent + 1, to);
|
||||
branch->pat->print(to);
|
||||
to << std::endl;
|
||||
branch->expr->print(indent + 2, to);
|
||||
}
|
||||
}
|
||||
|
||||
void ast_case::find_free(std::set<std::string>& into) {
|
||||
of->find_free(into);
|
||||
for(auto& branch : branches) {
|
||||
std::set<std::string> free_in_branch;
|
||||
std::set<std::string> pattern_variables;
|
||||
branch->pat->find_variables(pattern_variables);
|
||||
branch->expr->find_free(free_in_branch);
|
||||
for(auto& free : free_in_branch) {
|
||||
if(pattern_variables.find(free) == pattern_variables.end())
|
||||
into.insert(free);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
type_ptr ast_case::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
type_var* var;
|
||||
type_ptr case_type = mgr.resolve(of->typecheck(mgr, env), var);
|
||||
type_ptr branch_type = mgr.new_type();
|
||||
|
||||
for(auto& branch : branches) {
|
||||
type_env_ptr new_env = type_scope(env);
|
||||
branch->pat->typecheck(case_type, mgr, new_env);
|
||||
type_ptr curr_branch_type = branch->expr->typecheck(mgr, new_env);
|
||||
mgr.unify(branch_type, curr_branch_type);
|
||||
}
|
||||
|
||||
input_type = mgr.resolve(case_type, var);
|
||||
type_app* app_type;
|
||||
if(!(app_type = dynamic_cast<type_app*>(input_type.get())) ||
|
||||
!dynamic_cast<type_data*>(app_type->constructor.get())) {
|
||||
throw type_error("attempting case analysis of non-data type");
|
||||
}
|
||||
|
||||
return branch_type;
|
||||
}
|
||||
|
||||
void ast_case::translate(global_scope& scope) {
|
||||
of->translate(scope);
|
||||
for(auto& branch : branches) {
|
||||
branch->expr->translate(scope);
|
||||
}
|
||||
}
|
||||
|
||||
void ast_case::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
type_app* app_type = dynamic_cast<type_app*>(input_type.get());
|
||||
type_data* type = dynamic_cast<type_data*>(app_type->constructor.get());
|
||||
|
||||
of->compile(env, into);
|
||||
into.push_back(instruction_ptr(new instruction_eval()));
|
||||
|
||||
instruction_jump* jump_instruction = new instruction_jump();
|
||||
into.push_back(instruction_ptr(jump_instruction));
|
||||
for(auto& branch : branches) {
|
||||
std::vector<instruction_ptr> branch_instructions;
|
||||
pattern_var* vpat;
|
||||
pattern_constr* cpat;
|
||||
|
||||
if((vpat = dynamic_cast<pattern_var*>(branch->pat.get()))) {
|
||||
branch->expr->compile(env_ptr(new env_offset(1, env)), branch_instructions);
|
||||
|
||||
for(auto& constr_pair : type->constructors) {
|
||||
if(jump_instruction->tag_mappings.find(constr_pair.second.tag) !=
|
||||
jump_instruction->tag_mappings.end())
|
||||
break;
|
||||
|
||||
jump_instruction->tag_mappings[constr_pair.second.tag] =
|
||||
jump_instruction->branches.size();
|
||||
}
|
||||
jump_instruction->branches.push_back(std::move(branch_instructions));
|
||||
} else if((cpat = dynamic_cast<pattern_constr*>(branch->pat.get()))) {
|
||||
env_ptr new_env = env;
|
||||
for(auto it = cpat->params.rbegin(); it != cpat->params.rend(); it++) {
|
||||
new_env = env_ptr(new env_var(branch->expr->env->get_mangled_name(*it), new_env));
|
||||
}
|
||||
|
||||
branch_instructions.push_back(instruction_ptr(new instruction_split(
|
||||
cpat->params.size())));
|
||||
branch->expr->compile(new_env, branch_instructions);
|
||||
branch_instructions.push_back(instruction_ptr(new instruction_slide(
|
||||
cpat->params.size())));
|
||||
|
||||
int new_tag = type->constructors[cpat->constr].tag;
|
||||
if(jump_instruction->tag_mappings.find(new_tag) !=
|
||||
jump_instruction->tag_mappings.end())
|
||||
throw type_error("technically not a type error: duplicate pattern");
|
||||
|
||||
jump_instruction->tag_mappings[new_tag] =
|
||||
jump_instruction->branches.size();
|
||||
jump_instruction->branches.push_back(std::move(branch_instructions));
|
||||
}
|
||||
}
|
||||
|
||||
for(auto& constr_pair : type->constructors) {
|
||||
if(jump_instruction->tag_mappings.find(constr_pair.second.tag) ==
|
||||
jump_instruction->tag_mappings.end())
|
||||
throw type_error("non-total pattern");
|
||||
}
|
||||
}
|
||||
|
||||
void ast_let::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "LET: " << std::endl;
|
||||
in->print(indent + 1, to);
|
||||
}
|
||||
|
||||
void ast_let::find_free(std::set<std::string>& into) {
|
||||
definitions.find_free(into);
|
||||
std::set<std::string> all_free;
|
||||
in->find_free(all_free);
|
||||
for(auto& free_var : all_free) {
|
||||
if(definitions.defs_defn.find(free_var) == definitions.defs_defn.end())
|
||||
into.insert(free_var);
|
||||
}
|
||||
}
|
||||
|
||||
type_ptr ast_let::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
definitions.typecheck(mgr, env);
|
||||
return in->typecheck(mgr, definitions.env);
|
||||
}
|
||||
|
||||
void ast_let::translate(global_scope& scope) {
|
||||
for(auto& def : definitions.defs_data) {
|
||||
def.second->into_globals(scope);
|
||||
}
|
||||
for(auto& def : definitions.defs_defn) {
|
||||
size_t original_params = def.second->params.size();
|
||||
std::string original_name = def.second->name;
|
||||
auto& global_definition = def.second->into_global(scope);
|
||||
size_t captured = global_definition.params.size() - original_params;
|
||||
|
||||
type_env_ptr mangled_env = type_scope(env);
|
||||
mangled_env->bind(def.first, env->lookup(def.first), visibility::global);
|
||||
mangled_env->set_mangled_name(def.first, global_definition.name);
|
||||
|
||||
ast_ptr global_app(new ast_lid(original_name));
|
||||
global_app->env = mangled_env;
|
||||
for(auto& param : global_definition.params) {
|
||||
if(!(captured--)) break;
|
||||
ast_ptr new_arg(new ast_lid(param));
|
||||
new_arg->env = env;
|
||||
global_app = ast_ptr(new ast_app(std::move(global_app), std::move(new_arg)));
|
||||
global_app->env = env;
|
||||
}
|
||||
translated_definitions.push_back({ def.first, std::move(global_app) });
|
||||
}
|
||||
in->translate(scope);
|
||||
}
|
||||
|
||||
void ast_let::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
into.push_back(instruction_ptr(new instruction_alloc(translated_definitions.size())));
|
||||
env_ptr new_env = env;
|
||||
for(auto& def : translated_definitions) {
|
||||
new_env = env_ptr(new env_var(definitions.env->get_mangled_name(def.first), std::move(new_env)));
|
||||
}
|
||||
int offset = translated_definitions.size() - 1;
|
||||
for(auto& def : translated_definitions) {
|
||||
def.second->compile(new_env, into);
|
||||
into.push_back(instruction_ptr(new instruction_update(offset--)));
|
||||
}
|
||||
in->compile(new_env, into);
|
||||
into.push_back(instruction_ptr(new instruction_slide(translated_definitions.size())));
|
||||
}
|
||||
|
||||
void ast_lambda::print(int indent, std::ostream& to) const {
|
||||
print_indent(indent, to);
|
||||
to << "LAMBDA";
|
||||
for(auto& param : params) {
|
||||
to << " " << param;
|
||||
}
|
||||
to << std::endl;
|
||||
body->print(indent+1, to);
|
||||
}
|
||||
|
||||
void ast_lambda::find_free(std::set<std::string>& into) {
|
||||
body->find_free(free_variables);
|
||||
for(auto& param : params) {
|
||||
free_variables.erase(param);
|
||||
}
|
||||
into.insert(free_variables.begin(), free_variables.end());
|
||||
}
|
||||
|
||||
type_ptr ast_lambda::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = env;
|
||||
var_env = type_scope(env);
|
||||
type_ptr return_type = mgr.new_type();
|
||||
type_ptr full_type = return_type;
|
||||
|
||||
for(auto it = params.rbegin(); it != params.rend(); it++) {
|
||||
type_ptr param_type = mgr.new_type();
|
||||
var_env->bind(*it, param_type);
|
||||
full_type = type_ptr(new type_arr(std::move(param_type), full_type));
|
||||
}
|
||||
|
||||
mgr.unify(return_type, body->typecheck(mgr, var_env));
|
||||
return full_type;
|
||||
}
|
||||
|
||||
void ast_lambda::translate(global_scope& scope) {
|
||||
std::vector<std::string> function_params;
|
||||
for(auto& free_variable : free_variables) {
|
||||
if(env->is_global(free_variable)) continue;
|
||||
function_params.push_back(free_variable);
|
||||
}
|
||||
size_t captured_count = function_params.size();
|
||||
function_params.insert(function_params.end(), params.begin(), params.end());
|
||||
|
||||
auto& new_function = scope.add_function("lambda", std::move(function_params), std::move(body));
|
||||
type_env_ptr mangled_env = type_scope(env);
|
||||
mangled_env->bind("lambda", type_scheme_ptr(nullptr), visibility::global);
|
||||
mangled_env->set_mangled_name("lambda", new_function.name);
|
||||
ast_ptr new_application = ast_ptr(new ast_lid("lambda"));
|
||||
new_application->env = mangled_env;
|
||||
|
||||
for(auto& param : new_function.params) {
|
||||
if(!(captured_count--)) break;
|
||||
ast_ptr new_arg = ast_ptr(new ast_lid(param));
|
||||
new_arg->env = env;
|
||||
new_application = ast_ptr(new ast_app(std::move(new_application), std::move(new_arg)));
|
||||
new_application->env = env;
|
||||
}
|
||||
translated = std::move(new_application);
|
||||
}
|
||||
|
||||
void ast_lambda::compile(const env_ptr& env, std::vector<instruction_ptr>& into) const {
|
||||
translated->compile(env, into);
|
||||
}
|
||||
|
||||
void pattern_var::print(std::ostream& to) const {
|
||||
to << var;
|
||||
}
|
||||
|
||||
void pattern_var::find_variables(std::set<std::string>& into) const {
|
||||
into.insert(var);
|
||||
}
|
||||
|
||||
void pattern_var::typecheck(type_ptr t, type_mgr& mgr, type_env_ptr& env) const {
|
||||
env->bind(var, t);
|
||||
}
|
||||
|
||||
void pattern_constr::print(std::ostream& to) const {
|
||||
to << constr;
|
||||
for(auto& param : params) {
|
||||
to << " " << param;
|
||||
}
|
||||
}
|
||||
|
||||
void pattern_constr::find_variables(std::set<std::string>& into) const {
|
||||
into.insert(params.begin(), params.end());
|
||||
}
|
||||
|
||||
void pattern_constr::typecheck(type_ptr t, type_mgr& mgr, type_env_ptr& env) const {
|
||||
type_scheme_ptr constructor_type_scheme = env->lookup(constr);
|
||||
if(!constructor_type_scheme) {
|
||||
throw type_error(std::string("pattern using unknown constructor ") + constr);
|
||||
}
|
||||
type_ptr constructor_type = constructor_type_scheme->instantiate(mgr);
|
||||
|
||||
for(auto& param : params) {
|
||||
type_arr* arr = dynamic_cast<type_arr*>(constructor_type.get());
|
||||
if(!arr) throw type_error("too many parameters in constructor pattern");
|
||||
|
||||
env->bind(param, arr->left);
|
||||
constructor_type = arr->right;
|
||||
}
|
||||
|
||||
mgr.unify(t, constructor_type);
|
||||
}
|
189
code/compiler/13/ast.hpp
Normal file
189
code/compiler/13/ast.hpp
Normal file
|
@ -0,0 +1,189 @@
|
|||
#pragma once
|
||||
#include <memory>
|
||||
#include <vector>
|
||||
#include <set>
|
||||
#include "type.hpp"
|
||||
#include "type_env.hpp"
|
||||
#include "binop.hpp"
|
||||
#include "instruction.hpp"
|
||||
#include "env.hpp"
|
||||
#include "definition.hpp"
|
||||
#include "global_scope.hpp"
|
||||
|
||||
struct ast {
|
||||
type_env_ptr env;
|
||||
|
||||
virtual ~ast() = default;
|
||||
|
||||
virtual void print(int indent, std::ostream& to) const = 0;
|
||||
virtual void find_free(std::set<std::string>& into) = 0;
|
||||
virtual type_ptr typecheck(type_mgr& mgr, type_env_ptr& env) = 0;
|
||||
virtual void translate(global_scope& scope) = 0;
|
||||
virtual void compile(const env_ptr& env,
|
||||
std::vector<instruction_ptr>& into) const = 0;
|
||||
};
|
||||
|
||||
using ast_ptr = std::unique_ptr<ast>;
|
||||
|
||||
struct pattern {
|
||||
virtual ~pattern() = default;
|
||||
|
||||
virtual void print(std::ostream& to) const = 0;
|
||||
virtual void find_variables(std::set<std::string>& into) const = 0;
|
||||
virtual void typecheck(type_ptr t, type_mgr& mgr, type_env_ptr& env) const = 0;
|
||||
};
|
||||
|
||||
using pattern_ptr = std::unique_ptr<pattern>;
|
||||
|
||||
struct branch {
|
||||
pattern_ptr pat;
|
||||
ast_ptr expr;
|
||||
|
||||
branch(pattern_ptr p, ast_ptr a)
|
||||
: pat(std::move(p)), expr(std::move(a)) {}
|
||||
};
|
||||
|
||||
using branch_ptr = std::unique_ptr<branch>;
|
||||
|
||||
struct ast_int : public ast {
|
||||
int value;
|
||||
|
||||
explicit ast_int(int v)
|
||||
: value(v) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_lid : public ast {
|
||||
std::string id;
|
||||
|
||||
explicit ast_lid(std::string i)
|
||||
: id(std::move(i)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_uid : public ast {
|
||||
std::string id;
|
||||
|
||||
explicit ast_uid(std::string i)
|
||||
: id(std::move(i)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_binop : public ast {
|
||||
binop op;
|
||||
ast_ptr left;
|
||||
ast_ptr right;
|
||||
|
||||
ast_binop(binop o, ast_ptr l, ast_ptr r)
|
||||
: op(o), left(std::move(l)), right(std::move(r)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_app : public ast {
|
||||
ast_ptr left;
|
||||
ast_ptr right;
|
||||
|
||||
ast_app(ast_ptr l, ast_ptr r)
|
||||
: left(std::move(l)), right(std::move(r)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_case : public ast {
|
||||
ast_ptr of;
|
||||
type_ptr input_type;
|
||||
std::vector<branch_ptr> branches;
|
||||
|
||||
ast_case(ast_ptr o, std::vector<branch_ptr> b)
|
||||
: of(std::move(o)), branches(std::move(b)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_let : public ast {
|
||||
using basic_definition = std::pair<std::string, ast_ptr>;
|
||||
|
||||
definition_group definitions;
|
||||
ast_ptr in;
|
||||
|
||||
std::vector<basic_definition> translated_definitions;
|
||||
|
||||
ast_let(definition_group g, ast_ptr i)
|
||||
: definitions(std::move(g)), in(std::move(i)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct ast_lambda : public ast {
|
||||
std::vector<std::string> params;
|
||||
ast_ptr body;
|
||||
|
||||
type_env_ptr var_env;
|
||||
|
||||
std::set<std::string> free_variables;
|
||||
ast_ptr translated;
|
||||
|
||||
ast_lambda(std::vector<std::string> ps, ast_ptr b)
|
||||
: params(std::move(ps)), body(std::move(b)) {}
|
||||
|
||||
void print(int indent, std::ostream& to) const;
|
||||
void find_free(std::set<std::string>& into);
|
||||
type_ptr typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
void translate(global_scope& scope);
|
||||
void compile(const env_ptr& env, std::vector<instruction_ptr>& into) const;
|
||||
};
|
||||
|
||||
struct pattern_var : public pattern {
|
||||
std::string var;
|
||||
|
||||
pattern_var(std::string v)
|
||||
: var(std::move(v)) {}
|
||||
|
||||
void print(std::ostream &to) const;
|
||||
void find_variables(std::set<std::string>& into) const;
|
||||
void typecheck(type_ptr t, type_mgr& mgr, type_env_ptr& env) const;
|
||||
};
|
||||
|
||||
struct pattern_constr : public pattern {
|
||||
std::string constr;
|
||||
std::vector<std::string> params;
|
||||
|
||||
pattern_constr(std::string c, std::vector<std::string> p)
|
||||
: constr(std::move(c)), params(std::move(p)) {}
|
||||
|
||||
void print(std::ostream &to) const;
|
||||
void find_variables(std::set<std::string>& into) const;
|
||||
virtual void typecheck(type_ptr t, type_mgr& mgr, type_env_ptr& env) const;
|
||||
};
|
21
code/compiler/13/binop.cpp
Normal file
21
code/compiler/13/binop.cpp
Normal file
|
@ -0,0 +1,21 @@
|
|||
#include "binop.hpp"
|
||||
|
||||
std::string op_name(binop op) {
|
||||
switch(op) {
|
||||
case PLUS: return "+";
|
||||
case MINUS: return "-";
|
||||
case TIMES: return "*";
|
||||
case DIVIDE: return "/";
|
||||
}
|
||||
return "??";
|
||||
}
|
||||
|
||||
std::string op_action(binop op) {
|
||||
switch(op) {
|
||||
case PLUS: return "plus";
|
||||
case MINUS: return "minus";
|
||||
case TIMES: return "times";
|
||||
case DIVIDE: return "divide";
|
||||
}
|
||||
return "??";
|
||||
}
|
12
code/compiler/13/binop.hpp
Normal file
12
code/compiler/13/binop.hpp
Normal file
|
@ -0,0 +1,12 @@
|
|||
#pragma once
|
||||
#include <string>
|
||||
|
||||
enum binop {
|
||||
PLUS,
|
||||
MINUS,
|
||||
TIMES,
|
||||
DIVIDE
|
||||
};
|
||||
|
||||
std::string op_name(binop op);
|
||||
std::string op_action(binop op);
|
145
code/compiler/13/definition.cpp
Normal file
145
code/compiler/13/definition.cpp
Normal file
|
@ -0,0 +1,145 @@
|
|||
#include "definition.hpp"
|
||||
#include "error.hpp"
|
||||
#include "ast.hpp"
|
||||
#include "instruction.hpp"
|
||||
#include "llvm_context.hpp"
|
||||
#include "type.hpp"
|
||||
#include "type_env.hpp"
|
||||
#include "graph.hpp"
|
||||
#include <llvm/IR/DerivedTypes.h>
|
||||
#include <llvm/IR/Function.h>
|
||||
#include <llvm/IR/Type.h>
|
||||
|
||||
void definition_defn::find_free() {
|
||||
body->find_free(free_variables);
|
||||
for(auto& param : params) {
|
||||
free_variables.erase(param);
|
||||
}
|
||||
}
|
||||
|
||||
void definition_defn::insert_types(type_mgr& mgr, type_env_ptr& env, visibility v) {
|
||||
this->env = env;
|
||||
var_env = type_scope(env);
|
||||
return_type = mgr.new_type();
|
||||
full_type = return_type;
|
||||
|
||||
for(auto it = params.rbegin(); it != params.rend(); it++) {
|
||||
type_ptr param_type = mgr.new_type();
|
||||
full_type = type_ptr(new type_arr(param_type, full_type));
|
||||
var_env->bind(*it, param_type);
|
||||
}
|
||||
env->bind(name, full_type, v);
|
||||
}
|
||||
|
||||
void definition_defn::typecheck(type_mgr& mgr) {
|
||||
type_ptr body_type = body->typecheck(mgr, var_env);
|
||||
mgr.unify(return_type, body_type);
|
||||
}
|
||||
|
||||
|
||||
global_function& definition_defn::into_global(global_scope& scope) {
|
||||
std::vector<std::string> all_params;
|
||||
for(auto& free : free_variables) {
|
||||
if(env->is_global(free)) continue;
|
||||
all_params.push_back(free);
|
||||
}
|
||||
all_params.insert(all_params.end(), params.begin(), params.end());
|
||||
body->translate(scope);
|
||||
return scope.add_function(name, std::move(all_params), std::move(body));
|
||||
}
|
||||
|
||||
void definition_data::insert_types(type_env_ptr& env) {
|
||||
this->env = env;
|
||||
env->bind_type(name, type_ptr(new type_data(name, vars.size())));
|
||||
}
|
||||
|
||||
void definition_data::insert_constructors() const {
|
||||
type_ptr this_type_ptr = env->lookup_type(name);
|
||||
type_data* this_type = static_cast<type_data*>(this_type_ptr.get());
|
||||
int next_tag = 0;
|
||||
|
||||
std::set<std::string> var_set;
|
||||
type_app* return_app = new type_app(std::move(this_type_ptr));
|
||||
type_ptr return_type(return_app);
|
||||
for(auto& var : vars) {
|
||||
if(var_set.find(var) != var_set.end()) throw 0;
|
||||
var_set.insert(var);
|
||||
return_app->arguments.push_back(type_ptr(new type_var(var)));
|
||||
}
|
||||
|
||||
for(auto& constructor : constructors) {
|
||||
constructor->tag = next_tag;
|
||||
this_type->constructors[constructor->name] = { next_tag++ };
|
||||
|
||||
type_ptr full_type = return_type;
|
||||
for(auto it = constructor->types.rbegin(); it != constructor->types.rend(); it++) {
|
||||
type_ptr type = (*it)->to_type(var_set, env);
|
||||
full_type = type_ptr(new type_arr(type, full_type));
|
||||
}
|
||||
|
||||
type_scheme_ptr full_scheme(new type_scheme(std::move(full_type)));
|
||||
full_scheme->forall.insert(full_scheme->forall.begin(), vars.begin(), vars.end());
|
||||
env->bind(constructor->name, full_scheme);
|
||||
}
|
||||
}
|
||||
|
||||
void definition_data::into_globals(global_scope& scope) {
|
||||
for(auto& constructor : constructors) {
|
||||
global_constructor& c = scope.add_constructor(
|
||||
constructor->name, constructor->tag, constructor->types.size());
|
||||
env->set_mangled_name(constructor->name, c.name);
|
||||
}
|
||||
}
|
||||
|
||||
void definition_group::find_free(std::set<std::string>& into) {
|
||||
for(auto& def_pair : defs_defn) {
|
||||
def_pair.second->find_free();
|
||||
for(auto& free_var : def_pair.second->free_variables) {
|
||||
if(defs_defn.find(free_var) == defs_defn.end()) {
|
||||
into.insert(free_var);
|
||||
} else {
|
||||
def_pair.second->nearby_variables.insert(free_var);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void definition_group::typecheck(type_mgr& mgr, type_env_ptr& env) {
|
||||
this->env = type_scope(env);
|
||||
|
||||
for(auto& def_data : defs_data) {
|
||||
def_data.second->insert_types(this->env);
|
||||
}
|
||||
for(auto& def_data : defs_data) {
|
||||
def_data.second->insert_constructors();
|
||||
}
|
||||
|
||||
function_graph dependency_graph;
|
||||
|
||||
for(auto& def_defn : defs_defn) {
|
||||
def_defn.second->find_free();
|
||||
dependency_graph.add_function(def_defn.second->name);
|
||||
|
||||
for(auto& dependency : def_defn.second->nearby_variables) {
|
||||
if(defs_defn.find(dependency) == defs_defn.end())
|
||||
throw 0;
|
||||
dependency_graph.add_edge(def_defn.second->name, dependency);
|
||||
}
|
||||
}
|
||||
|
||||
std::vector<group_ptr> groups = dependency_graph.compute_order();
|
||||
for(auto it = groups.rbegin(); it != groups.rend(); it++) {
|
||||
auto& group = *it;
|
||||
for(auto& def_defnn_name : group->members) {
|
||||
auto& def_defn = defs_defn.find(def_defnn_name)->second;
|
||||
def_defn->insert_types(mgr, this->env, vis);
|
||||
}
|
||||
for(auto& def_defnn_name : group->members) {
|
||||
auto& def_defn = defs_defn.find(def_defnn_name)->second;
|
||||
def_defn->typecheck(mgr);
|
||||
}
|
||||
for(auto& def_defnn_name : group->members) {
|
||||
this->env->generalize(def_defnn_name, *group, mgr);
|
||||
}
|
||||
}
|
||||
}
|
83
code/compiler/13/definition.hpp
Normal file
83
code/compiler/13/definition.hpp
Normal file
|
@ -0,0 +1,83 @@
|
|||
#pragma once
|
||||
#include <memory>
|
||||
#include <vector>
|
||||
#include <map>
|
||||
#include <set>
|
||||
#include "instruction.hpp"
|
||||
#include "llvm_context.hpp"
|
||||
#include "parsed_type.hpp"
|
||||
#include "type_env.hpp"
|
||||
#include "global_scope.hpp"
|
||||
|
||||
struct ast;
|
||||
using ast_ptr = std::unique_ptr<ast>;
|
||||
|
||||
struct constructor {
|
||||
std::string name;
|
||||
std::vector<parsed_type_ptr> types;
|
||||
int8_t tag;
|
||||
|
||||
constructor(std::string n, std::vector<parsed_type_ptr> ts)
|
||||
: name(std::move(n)), types(std::move(ts)) {}
|
||||
};
|
||||
|
||||
using constructor_ptr = std::unique_ptr<constructor>;
|
||||
|
||||
struct definition_defn {
|
||||
std::string name;
|
||||
std::vector<std::string> params;
|
||||
ast_ptr body;
|
||||
|
||||
type_env_ptr env;
|
||||
type_env_ptr var_env;
|
||||
std::set<std::string> free_variables;
|
||||
std::set<std::string> nearby_variables;
|
||||
type_ptr full_type;
|
||||
type_ptr return_type;
|
||||
|
||||
definition_defn(std::string n, std::vector<std::string> p, ast_ptr b)
|
||||
: name(std::move(n)), params(std::move(p)), body(std::move(b)) {
|
||||
|
||||
}
|
||||
|
||||
void find_free();
|
||||
void insert_types(type_mgr& mgr, type_env_ptr& env, visibility v);
|
||||
void typecheck(type_mgr& mgr);
|
||||
|
||||
global_function& into_global(global_scope& scope);
|
||||
};
|
||||
|
||||
using definition_defn_ptr = std::unique_ptr<definition_defn>;
|
||||
|
||||
struct definition_data {
|
||||
std::string name;
|
||||
std::vector<std::string> vars;
|
||||
std::vector<constructor_ptr> constructors;
|
||||
|
||||
type_env_ptr env;
|
||||
|
||||
definition_data(
|
||||
std::string n,
|
||||
std::vector<std::string> vs,
|
||||
std::vector<constructor_ptr> cs)
|
||||
: name(std::move(n)), vars(std::move(vs)), constructors(std::move(cs)) {}
|
||||
|
||||
void insert_types(type_env_ptr& env);
|
||||
void insert_constructors() const;
|
||||
|
||||
void into_globals(global_scope& scope);
|
||||
};
|
||||
|
||||
using definition_data_ptr = std::unique_ptr<definition_data>;
|
||||
|
||||
struct definition_group {
|
||||
std::map<std::string, definition_data_ptr> defs_data;
|
||||
std::map<std::string, definition_defn_ptr> defs_defn;
|
||||
visibility vis;
|
||||
type_env_ptr env;
|
||||
|
||||
definition_group(visibility v = visibility::local) : vis(v) {}
|
||||
|
||||
void find_free(std::set<std::string>& into);
|
||||
void typecheck(type_mgr& mgr, type_env_ptr& env);
|
||||
};
|
23
code/compiler/13/env.cpp
Normal file
23
code/compiler/13/env.cpp
Normal file
|
@ -0,0 +1,23 @@
|
|||
#include "env.hpp"
|
||||
|
||||
int env_var::get_offset(const std::string& name) const {
|
||||
if(name == this->name) return 0;
|
||||
if(parent) return parent->get_offset(name) + 1;
|
||||
throw 0;
|
||||
}
|
||||
|
||||
bool env_var::has_variable(const std::string& name) const {
|
||||
if(name == this->name) return true;
|
||||
if(parent) return parent->has_variable(name);
|
||||
return false;
|
||||
}
|
||||
|
||||
int env_offset::get_offset(const std::string& name) const {
|
||||
if(parent) return parent->get_offset(name) + offset;
|
||||
throw 0;
|
||||
}
|
||||
|
||||
bool env_offset::has_variable(const std::string& name) const {
|
||||
if(parent) return parent->has_variable(name);
|
||||
return false;
|
||||
}
|
34
code/compiler/13/env.hpp
Normal file
34
code/compiler/13/env.hpp
Normal file
|
@ -0,0 +1,34 @@
|
|||
#pragma once
|
||||
#include <memory>
|
||||
#include <string>
|
||||
|
||||
struct env {
|
||||
virtual ~env() = default;
|
||||
|
||||
virtual int get_offset(const std::string& name) const = 0;
|
||||
virtual bool has_variable(const std::string& name) const = 0;
|
||||
};
|
||||
|
||||
using env_ptr = std::shared_ptr<env>;
|
||||
|
||||
struct env_var : public env {
|
||||
std::string name;
|
||||
env_ptr parent;
|
||||
|
||||
env_var(std::string n, env_ptr p)
|
||||
: name(std::move(n)), parent(std::move(p)) {}
|
||||
|
||||
int get_offset(const std::string& name) const;
|
||||
bool has_variable(const std::string& name) const;
|
||||
};
|
||||
|
||||
struct env_offset : public env {
|
||||
int offset;
|
||||
env_ptr parent;
|
||||
|
||||
env_offset(int o, env_ptr p)
|
||||
: offset(o), parent(std::move(p)) {}
|
||||
|
||||
int get_offset(const std::string& name) const;
|
||||
bool has_variable(const std::string& name) const;
|
||||
};
|
5
code/compiler/13/error.cpp
Normal file
5
code/compiler/13/error.cpp
Normal file
|
@ -0,0 +1,5 @@
|
|||
#include "error.hpp"
|
||||
|
||||
const char* type_error::what() const noexcept {
|
||||
return "an error occured while checking the types of the program";
|
||||
}
|
21
code/compiler/13/error.hpp
Normal file
21
code/compiler/13/error.hpp
Normal file
|
@ -0,0 +1,21 @@
|
|||
#pragma once
|
||||
#include <exception>
|
||||
#include "type.hpp"
|
||||
|
||||
struct type_error : std::exception {
|
||||
std::string description;
|
||||
|
||||
type_error(std::string d)
|
||||
: description(std::move(d)) {}
|
||||
|
||||
const char* what() const noexcept override;
|
||||
};
|
||||
|
||||
struct unification_error : public type_error {
|
||||
type_ptr left;
|
||||
type_ptr right;
|
||||
|
||||
unification_error(type_ptr l, type_ptr r)
|
||||
: left(std::move(l)), right(std::move(r)),
|
||||
type_error("failed to unify types") {}
|
||||
};
|
2
code/compiler/13/examples/bad1.txt
Normal file
2
code/compiler/13/examples/bad1.txt
Normal file
|
@ -0,0 +1,2 @@
|
|||
data Bool = { True, False }
|
||||
defn main = { 3 + True }
|
1
code/compiler/13/examples/bad2.txt
Normal file
1
code/compiler/13/examples/bad2.txt
Normal file
|
@ -0,0 +1 @@
|
|||
defn main = { 1 2 3 4 5 }
|
8
code/compiler/13/examples/bad3.txt
Normal file
8
code/compiler/13/examples/bad3.txt
Normal file
|
@ -0,0 +1,8 @@
|
|||
data List = { Nil, Cons Int List }
|
||||
|
||||
defn head l = {
|
||||
case l of {
|
||||
Nil -> { 0 }
|
||||
Cons x y z -> { x }
|
||||
}
|
||||
}
|
17
code/compiler/13/examples/fixpoint.txt
Normal file
17
code/compiler/13/examples/fixpoint.txt
Normal file
|
@ -0,0 +1,17 @@
|
|||
data List a = { Nil, Cons a (List a) }
|
||||
|
||||
defn fix f = { let { defn x = { f x } } in { x } }
|
||||
defn fixpointOnes fo = { Cons 1 fo }
|
||||
defn sumTwo l = {
|
||||
case l of {
|
||||
Nil -> { 0 }
|
||||
Cons x xs -> {
|
||||
x + case xs of {
|
||||
Nil -> { 0 }
|
||||
Cons y ys -> { y }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
defn main = { sumTwo (fix fixpointOnes) }
|
8
code/compiler/13/examples/if.txt
Normal file
8
code/compiler/13/examples/if.txt
Normal file
|
@ -0,0 +1,8 @@
|
|||
data Bool = { True, False }
|
||||
defn if c t e = {
|
||||
case c of {
|
||||
True -> { t }
|
||||
False -> { e }
|
||||
}
|
||||
}
|
||||
defn main = { if (if True False True) 11 3 }
|
19
code/compiler/13/examples/lambda.txt
Normal file
19
code/compiler/13/examples/lambda.txt
Normal file
|
@ -0,0 +1,19 @@
|
|||
data List a = { Nil, Cons a (List a) }
|
||||
|
||||
defn sum l = {
|
||||
case l of {
|
||||
Nil -> { 0 }
|
||||
Cons x xs -> { x + sum xs}
|
||||
}
|
||||
}
|
||||
|
||||
defn map f l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { Cons (f x) (map f xs) }
|
||||
}
|
||||
}
|
||||
|
||||
defn main = {
|
||||
sum (map \x -> { x * x } (map (\x -> { x + x }) (Cons 1 (Cons 2 (Cons 3 Nil)))))
|
||||
}
|
47
code/compiler/13/examples/letin.txt
Normal file
47
code/compiler/13/examples/letin.txt
Normal file
|
@ -0,0 +1,47 @@
|
|||
data Bool = { True, False }
|
||||
|
||||
data List a = { Nil, Cons a (List a) }
|
||||
|
||||
defn if c t e = {
|
||||
case c of {
|
||||
True -> { t }
|
||||
False -> { e }
|
||||
}
|
||||
}
|
||||
|
||||
defn mergeUntil l r p = {
|
||||
let {
|
||||
defn mergeLeft nl nr = {
|
||||
case nl of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { if (p x) (Cons x (mergeRight xs nr)) Nil }
|
||||
}
|
||||
}
|
||||
defn mergeRight nl nr = {
|
||||
case nr of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { if (p x) (Cons x (mergeLeft nl xs)) Nil }
|
||||
}
|
||||
}
|
||||
} in {
|
||||
mergeLeft l r
|
||||
}
|
||||
}
|
||||
|
||||
defn const x y = { x }
|
||||
|
||||
defn sum l = {
|
||||
case l of {
|
||||
Nil -> { 0 }
|
||||
Cons x xs -> { x + sum xs }
|
||||
}
|
||||
}
|
||||
|
||||
defn main = {
|
||||
let {
|
||||
defn firstList = { Cons 1 (Cons 3 (Cons 5 Nil)) }
|
||||
defn secondList = { Cons 2 (Cons 4 (Cons 6 Nil)) }
|
||||
} in {
|
||||
sum (mergeUntil firstList secondList (const True))
|
||||
}
|
||||
}
|
32
code/compiler/13/examples/list.txt
Normal file
32
code/compiler/13/examples/list.txt
Normal file
|
@ -0,0 +1,32 @@
|
|||
data List a = { Nil, Cons a (List a) }
|
||||
|
||||
defn map f l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { Cons (f x) (map f xs) }
|
||||
}
|
||||
}
|
||||
|
||||
defn foldl f b l = {
|
||||
case l of {
|
||||
Nil -> { b }
|
||||
Cons x xs -> { foldl f (f b x) xs }
|
||||
}
|
||||
}
|
||||
|
||||
defn foldr f b l = {
|
||||
case l of {
|
||||
Nil -> { b }
|
||||
Cons x xs -> { f x (foldr f b xs) }
|
||||
}
|
||||
}
|
||||
|
||||
defn list = { Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil))) }
|
||||
|
||||
defn add x y = { x + y }
|
||||
defn sum l = { foldr add 0 l }
|
||||
|
||||
defn skipAdd x y = { y + 1 }
|
||||
defn length l = { foldr skipAdd 0 l }
|
||||
|
||||
defn main = { sum list + length list }
|
25
code/compiler/13/examples/mutual_recursion.txt
Normal file
25
code/compiler/13/examples/mutual_recursion.txt
Normal file
|
@ -0,0 +1,25 @@
|
|||
data Bool = { True, False }
|
||||
data List = { Nil, Cons Int List }
|
||||
|
||||
defn if c t e = {
|
||||
case c of {
|
||||
True -> { t }
|
||||
False -> { e }
|
||||
}
|
||||
}
|
||||
|
||||
defn oddEven l e = {
|
||||
case l of {
|
||||
Nil -> { e }
|
||||
Cons x xs -> { evenOdd xs e }
|
||||
}
|
||||
}
|
||||
|
||||
defn evenOdd l e = {
|
||||
case l of {
|
||||
Nil -> { e }
|
||||
Cons x xs -> { oddEven xs e }
|
||||
}
|
||||
}
|
||||
|
||||
defn main = { if (oddEven (Cons 1 (Cons 2 (Cons 3 Nil))) True) (oddEven (Cons 1 (Cons 2 (Cons 3 Nil))) 1) 3 }
|
23
code/compiler/13/examples/packed.txt
Normal file
23
code/compiler/13/examples/packed.txt
Normal file
|
@ -0,0 +1,23 @@
|
|||
data Pair a b = { Pair a b }
|
||||
|
||||
defn packer = {
|
||||
let {
|
||||
data Packed a = { Packed a }
|
||||
defn pack a = { Packed a }
|
||||
defn unpack p = {
|
||||
case p of {
|
||||
Packed a -> { a }
|
||||
}
|
||||
}
|
||||
} in {
|
||||
Pair pack unpack
|
||||
}
|
||||
}
|
||||
|
||||
defn main = {
|
||||
case packer of {
|
||||
Pair pack unpack -> {
|
||||
unpack (pack 3)
|
||||
}
|
||||
}
|
||||
}
|
17
code/compiler/13/examples/pair.txt
Normal file
17
code/compiler/13/examples/pair.txt
Normal file
|
@ -0,0 +1,17 @@
|
|||
data Pair a b = { MkPair a b }
|
||||
|
||||
defn fst p = {
|
||||
case p of {
|
||||
MkPair a b -> { a }
|
||||
}
|
||||
}
|
||||
|
||||
defn snd p = {
|
||||
case p of {
|
||||
MkPair a b -> { b }
|
||||
}
|
||||
}
|
||||
|
||||
defn pair = { MkPair 1 (MkPair 2 3) }
|
||||
|
||||
defn main = { fst pair + snd (snd pair) }
|
122
code/compiler/13/examples/primes.txt
Normal file
122
code/compiler/13/examples/primes.txt
Normal file
|
@ -0,0 +1,122 @@
|
|||
data List = { Nil, Cons Nat List }
|
||||
data Bool = { True, False }
|
||||
data Nat = { O, S Nat }
|
||||
|
||||
defn if c t e = {
|
||||
case c of {
|
||||
True -> { t }
|
||||
False -> { e }
|
||||
}
|
||||
}
|
||||
|
||||
defn toInt n = {
|
||||
case n of {
|
||||
O -> { 0 }
|
||||
S np -> { 1 + toInt np }
|
||||
}
|
||||
}
|
||||
|
||||
defn lte n m = {
|
||||
case m of {
|
||||
O -> {
|
||||
case n of {
|
||||
O -> { True }
|
||||
S np -> { False }
|
||||
}
|
||||
}
|
||||
S mp -> {
|
||||
case n of {
|
||||
O -> { True }
|
||||
S np -> { lte np mp }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
defn minus n m = {
|
||||
case m of {
|
||||
O -> { n }
|
||||
S mp -> {
|
||||
case n of {
|
||||
O -> { O }
|
||||
S np -> {
|
||||
minus np mp
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
defn mod n m = {
|
||||
if (lte m n) (mod (minus n m) m) n
|
||||
}
|
||||
|
||||
defn notDivisibleBy n m = {
|
||||
case (mod m n) of {
|
||||
O -> { False }
|
||||
S mp -> { True }
|
||||
}
|
||||
}
|
||||
|
||||
defn filter f l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { if (f x) (Cons x (filter f xs)) (filter f xs) }
|
||||
}
|
||||
}
|
||||
|
||||
defn map f l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> { Cons (f x) (map f xs) }
|
||||
}
|
||||
}
|
||||
|
||||
defn nats = {
|
||||
Cons (S (S O)) (map S nats)
|
||||
}
|
||||
|
||||
defn primesRec l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons p xs -> { Cons p (primesRec (filter (notDivisibleBy p) xs)) }
|
||||
}
|
||||
}
|
||||
|
||||
defn primes = {
|
||||
primesRec nats
|
||||
}
|
||||
|
||||
defn take n l = {
|
||||
case l of {
|
||||
Nil -> { Nil }
|
||||
Cons x xs -> {
|
||||
case n of {
|
||||
O -> { Nil }
|
||||
S np -> { Cons x (take np xs) }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
defn head l = {
|
||||
case l of {
|
||||
Nil -> { O }
|
||||
Cons x xs -> { x }
|
||||
}
|
||||
}
|
||||
|
||||
defn reverseAcc a l = {
|
||||
case l of {
|
||||
Nil -> { a }
|
||||
Cons x xs -> { reverseAcc (Cons x a) xs }
|
||||
}
|
||||
}
|
||||
|
||||
defn reverse l = {
|
||||
reverseAcc Nil l
|
||||
}
|
||||
|
||||
defn main = {
|
||||
toInt (head (reverse (take ((S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) primes)))
|
||||
}
|
31
code/compiler/13/examples/runtime1.c
Normal file
31
code/compiler/13/examples/runtime1.c
Normal file
|
@ -0,0 +1,31 @@
|
|||
#include "../runtime.h"
|
||||
|
||||
void f_add(struct stack* s) {
|
||||
struct node_num* left = (struct node_num*) eval(stack_peek(s, 0));
|
||||
struct node_num* right = (struct node_num*) eval(stack_peek(s, 1));
|
||||
stack_push(s, (struct node_base*) alloc_num(left->value + right->value));
|
||||
}
|
||||
|
||||
void f_main(struct stack* s) {
|
||||
// PushInt 320
|
||||
stack_push(s, (struct node_base*) alloc_num(320));
|
||||
|
||||
// PushInt 6
|
||||
stack_push(s, (struct node_base*) alloc_num(6));
|
||||
|
||||
// PushGlobal f_add (the function for +)
|
||||
stack_push(s, (struct node_base*) alloc_global(f_add, 2));
|
||||
|
||||
struct node_base* left;
|
||||
struct node_base* right;
|
||||
|
||||
// MkApp
|
||||
left = stack_pop(s);
|
||||
right = stack_pop(s);
|
||||
stack_push(s, ( |