parent
bf3c81fe24
commit
5dbf75b5e4
@ -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}) |
@ -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); |
||||
} |
@ -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; |
||||
}; |
@ -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 "??"; |
||||
} |
@ -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); |
@ -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); |
||||
} |
||||
} |
||||
} |
@ -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); |
||||
}; |
@ -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; |
||||
} |
@ -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; |
||||
}; |
@ -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"; |
||||
} |
@ -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") {} |
||||
}; |
@ -0,0 +1,2 @@ |
||||
data Bool = { True, False } |
||||
defn main = { 3 + True } |
@ -0,0 +1 @@ |
||||
defn main = { 1 2 3 4 5 } |
@ -0,0 +1,8 @@ |
||||
data List = { Nil, Cons Int List } |
||||
|
||||
defn head l = { |
||||
case l of { |
||||
Nil -> { 0 } |
||||
Cons x y z -> { x } |
||||
} |
||||
} |
@ -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) } |
@ -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 } |
@ -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))))) |
||||
} |
@ -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)) |
||||
} |
||||
} |
@ -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 } |
@ -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 } |
@ -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) |
||||
} |
||||
} |
||||
} |
@ -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) } |
@ -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) } |
||||
} |
||||