aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/compile.cpp18
-rw-r--r--src/lift.cpp38
-rw-r--r--src/llvm.cpp90
-rw-r--r--src/pprint.cpp2
-rw-r--r--src/resp.hpp19
-rw-r--r--test/closure.resp3
6 files changed, 133 insertions, 37 deletions
diff --git a/src/compile.cpp b/src/compile.cpp
index 90e31ba..53fd9ad 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -109,12 +109,18 @@ compile_def(CEnv& cenv, const ATuple* def) throw()
static CVal
compile_def_type(CEnv& cenv, const ATuple* def) throw()
{
- const ASymbol* name = def->frst()->as_tuple()->fst()->as_symbol();
- cenv.engine()->compileType(cenv, name->sym(), def->frst());
- for (ATuple::const_iterator i = def->iter_at(2); i != def->end(); ++i) {
- const ATuple* exp = (*i)->as_tuple();
- const ASymbol* tag = (*exp->begin())->as_symbol();
- cenv.engine()->compileType(cenv, tag->sym(), exp);
+ const ASymbol* name = def->frst()->to_symbol();
+ if (name) {
+ cenv.engine()->compileType(cenv, name->sym(), def->frrst());
+ cenv.tenv.def(name, def->frrst());
+ } else {
+ name = def->frst()->as_tuple()->fst()->as_symbol();
+ cenv.engine()->compileType(cenv, name->sym(), def->frst());
+ for (ATuple::const_iterator i = def->iter_at(2); i != def->end(); ++i) {
+ const ATuple* exp = (*i)->as_tuple();
+ const ASymbol* tag = (*exp->begin())->as_symbol();
+ cenv.engine()->compileType(cenv, tag->sym(), exp);
+ }
}
return NULL;
}
diff --git a/src/lift.cpp b/src/lift.cpp
index 039eea4..6ae8709 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -97,6 +97,17 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
}
static const AST*
+lift_def_type(CEnv& cenv, Code& code, const ATuple* def) throw()
+{
+ const ASymbol* sym = def->frst()->to_symbol();
+ if (!sym)
+ return def;
+
+ const AST* type = def->frrst()->as_tuple()->replace(sym, cenv.penv.sym("__REC"));
+ return tup(def->loc, def->fst(), sym, type, 0);
+}
+
+static const AST*
lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
{
List impl;
@@ -145,10 +156,13 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
cenv.pop();
+ // Symbol for closure type (defined below)
+ const ASymbol* tsym = cenv.penv.sym(
+ (fnName != "") ? (string("__T") + fnName) : cenv.penv.gensymstr("__Tfn"));
+
// Create definition for implementation fn
- ASymbol* implName = cenv.penv.sym(implNameStr);
- ATuple* def = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL);
- code.push_back(def);
+ const ASymbol* implName = cenv.penv.sym(implNameStr);
+ const ATuple* def = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL);
List tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
List consT;
@@ -162,7 +176,8 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
}
cenv.liftStack.pop();
- implProtT.push_front(tupT);
+ // Prepend closure parameter type
+ implProtT.push_front(tsym);
const ATuple* implT = tup(Cursor(), type->fst(), implProtT.head, implRetT, 0);
@@ -170,12 +185,23 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
consT.push_front(cenv.tenv.Tup);
cenv.setType(impl, implT);
- cenv.setType(cons, consT);
+
+ // Create type definition for closure type
+ const AST* tdef = resp_lift(
+ cenv, code, tup(Cursor(), cenv.penv.sym("def-type"), tsym, consT.head, 0));
+ code.push_back(tdef);
+ cenv.tenv.def(tsym, consT);
+
+ code.push_back(def);
+
+ // Set type of closure to type symbol
+ cenv.setType(cons, tsym);
cenv.def(implName, impl, implT, NULL);
if (cenv.name(fn) != "")
cenv.def(cenv.penv.sym(cenv.name(fn)), fn, consT, NULL);
+
return cons;
}
@@ -261,7 +287,7 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
else if (form == "def")
return lift_def(cenv, code, call);
else if (form == "def-type")
- return call;
+ return lift_def_type(cenv, code, call);
else if (form == "do")
return lift_args(cenv, code, call);
else if (form == "fn")
diff --git a/src/llvm.cpp b/src/llvm.cpp
index a3882c8..e445650 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -85,7 +85,7 @@ private:
inline Value* llVal(CVal v) { return static_cast<Value*>(v); }
inline Function* llFunc(CFunc f) { return static_cast<Function*>(f); }
- const Type* llType(const AST* t);
+ const Type* llType(const AST* t, const char* name=NULL);
LLVMContext context;
Module* module;
@@ -95,7 +95,9 @@ private:
FunctionPassManager* opt;
CType objectT;
- typedef std::map<const std::string, CType> CTypes;
+ PATypeHolder* opaqueT;
+
+ typedef std::map<const std::string, const Type*> CTypes;
CTypes compiledTypes;
unsigned labelIndex;
@@ -103,6 +105,7 @@ private:
LLVMEngine::LLVMEngine()
: builder(context)
+ , opaqueT(NULL)
, labelIndex(1)
{
InitializeNativeTarget();
@@ -140,7 +143,7 @@ LLVMEngine::~LLVMEngine()
}
const Type*
-LLVMEngine::llType(const AST* t)
+LLVMEngine::llType(const AST* t, const char* name)
{
if (t == NULL) {
return NULL;
@@ -156,7 +159,26 @@ LLVMEngine::llType(const AST* t)
if (sym == "String") return PointerType::get(Type::getInt8Ty(context), NULL);
if (sym == "Symbol") return PointerType::get(Type::getInt8Ty(context), NULL);
if (sym == "Expr") return PointerType::get(Type::getInt8Ty(context), NULL);
- } else if (is_form(t, "Fn")) {
+ if (sym == "__REC") { if (!opaqueT) throw; return *opaqueT;}
+
+ CTypes::const_iterator i = compiledTypes.find(sym);
+ if (i != compiledTypes.end())
+ return i->second;
+
+ }
+
+ if (!AType::is_expr(t))
+ return NULL;
+
+ // Define opaque type to stand for name in recursive type body
+ if (name) {
+ THROW_IF(opaqueT, t->loc, "Nested recursive types");
+ opaqueT = new PATypeHolder(OpaqueType::get(context));
+ }
+
+ const Type* ret;
+
+ if (is_form(t, "Fn")) {
ATuple::const_iterator i = t->as_tuple()->begin();
const ATuple* protT = (*++i)->to_tuple();
const AST* retT = (*++i);
@@ -171,8 +193,9 @@ LLVMEngine::llType(const AST* t)
cprot.push_back(lt);
}
- return PointerType::get(FunctionType::get(llType(retT), cprot, false), 0);
- } else if (AType::is_expr(t) && isupper(t->as_tuple()->fst()->str()[0])) {
+ ret = FunctionType::get(llType(retT), cprot, false);
+
+ } else if (isupper(t->as_tuple()->fst()->str()[0])) {
vector<const Type*> ctypes;
ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI
for (ATuple::const_iterator i = t->as_tuple()->iter_at(1); i != t->as_tuple()->end(); ++i) {
@@ -182,9 +205,26 @@ LLVMEngine::llType(const AST* t)
ctypes.push_back(lt);
}
- return PointerType::get(StructType::get(context, ctypes, false), 0);
+ ret = StructType::get(context, ctypes, false);
}
- return NULL;
+
+ if (!ret) {
+ cerr << "WARNING: No low-level type for " << t << endl;
+ return NULL;
+ }
+
+ // Tell LLVM opaqueT is actually ret* (for recursive types)
+ const PointerType* ptrT(PointerType::get(ret, 0));
+
+ if (name) {
+ PATypeHolder retT(ret);
+ ((OpaqueType*)opaqueT->get())->refineAbstractTypeTo(ptrT);
+ ptrT = cast<PointerType>(opaqueT->get()); // update potentially invalidated type
+ opaqueT = NULL;
+ module->addTypeName(name, retT.get());
+ }
+
+ return ptrT;
}
/** Convert a size in bits to bytes, rounding up as necessary */
@@ -198,17 +238,13 @@ CVal
LLVMEngine::compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args)
{
vector<Value*> llArgs(*reinterpret_cast<const vector<Value*>*>(&args));
- Value* closure = builder.CreateBitCast(llArgs[0],
- llType(funcT->prot()->fst()),
- cenv.penv.gensymstr("you"));
- llArgs[0] = closure;
return builder.CreateCall(llFunc(f), llArgs.begin(), llArgs.end());
}
CVal
LLVMEngine::compileCast(CEnv& cenv, CVal v, const AST* t)
{
- return builder.CreateBitCast(llVal(v), llType(t), "cast");
+ return builder.CreateBitCast(llVal(v), (const Type*)compileType(cenv, NULL, t), "cast");
}
CVal
@@ -219,7 +255,8 @@ LLVMEngine::compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<
PointerType::get(Type::getInt8Ty(context), NULL));
assert(type->begin() != type->end());
for (ATuple::const_iterator i = type->iter_at(1); i != type->end(); ++i)
- s += engine->getTargetData()->getTypeSizeInBits(llType(*i));
+ s += engine->getTargetData()->getTypeSizeInBits(
+ (const Type*)compileType(cenv, NULL, *i));
// Allocate struct
const std::string name = type->fst()->str();
@@ -277,13 +314,17 @@ LLVMEngine::compileString(CEnv& cenv, const char* str)
CType
LLVMEngine::compileType(CEnv& cenv, const char* name, const AST* expr)
{
- CTypes::const_iterator i = compiledTypes.find(name);
- if (i != compiledTypes.end())
- return i->second;
+ if (name) {
+ CTypes::const_iterator i = compiledTypes.find(name);
+ if (i != compiledTypes.end())
+ return i->second;
+ }
+
+ const Type* const type = llType(expr, name);
+
+ if (name)
+ compiledTypes.insert(make_pair(name, type));
- const Type* type = llType(expr);
- module->addTypeName(name, type);
- compiledTypes.insert(make_pair(name, type));
return type;
}
@@ -298,9 +339,10 @@ LLVMEngine::startFn(
vector<const Type*> cprot;
FOREACHP(ATuple::const_iterator, i, argsT) {
- THROW_IF(!llType(*i), Cursor(), string("non-concrete parameter :: ")
- + (*i)->str())
- cprot.push_back(llType(*i));
+ const char* name = (*i)->to_symbol() ? (*i)->as_symbol()->sym() : NULL;
+ CType iT = compileType(cenv, name, cenv.resolveType(*i));
+ THROW_IF(!iT, Cursor(), string("non-concrete parameter :: ") + (*i)->str());
+ cprot.push_back((const Type*)iT);
}
THROW_IF(!llType(retT), Cursor(),
@@ -340,7 +382,7 @@ LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc
assert(prot->size() == f->num_args());
for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++pT) {
const AST* t = cenv.resolveType(*pT);
- THROW_IF(!llType(t), (*p)->loc, "untyped parameter\n");
+// THROW_IF(!llType(t), (*p)->loc, "untyped parameter\n");
cenv.def((*p)->as_symbol(), *p, t, &*a);
}
}
diff --git a/src/pprint.cpp b/src/pprint.cpp
index 718e43b..56f1f91 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -143,6 +143,8 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types)
const ATuple* const fn = tup->frrst()->as_tuple();
const ATuple* const prot = fn->frst()->as_tuple();
print_list_one_line(out, prot, prot->begin(), indent + 7, cenv, types, types);
+ print_annotation(out, fn, indent + head_width + 1, cenv, true);
+
newline(out, indent + 2);
print_list(out, fn, fn->iter_at(2), indent + 2, cenv, types, false);
} else {
diff --git a/src/resp.hpp b/src/resp.hpp
index a5bf99d..2ae556c 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -26,6 +26,7 @@
#include <stdint.h>
#include <string.h>
+#include <cassert>
#include <iostream>
#include <list>
#include <map>
@@ -270,6 +271,8 @@ struct ATuple : public AST {
const AST* list_ref(unsigned index) const { return *iter_at(index); }
+ const ATuple* replace(const AST* from, const AST* to) const;
+
const ATuple* prot() const { return list_ref(1)->as_tuple(); }
private:
@@ -375,6 +378,22 @@ struct List {
ATuple* tail;
};
+inline const ATuple*
+ATuple::replace(const AST* from, const AST* to) const
+{
+ List copy;
+ FOREACHP(const_iterator, i, this) {
+ if (*i == from) {
+ copy.push_back(to);
+ } else {
+ const ATuple* tup = (*i)->to_tuple();
+ copy.push_back(tup ? tup->replace(from, to) : (*i));
+ }
+ }
+ copy.head->loc = loc;
+ return copy;
+}
+
template<typename T>
inline bool
literal_equals(const ALiteral<T>* lhs, const ALiteral<T>* rhs)
diff --git a/test/closure.resp b/test/closure.resp
index fb5a41d..8dad1c1 100644
--- a/test/closure.resp
+++ b/test/closure.resp
@@ -1,4 +1,5 @@
-(def (multiplier factor) (fn (x) (* (+ x 0) factor)))
+(def (multiplier factor)
+ (fn (x) (* (+ x 0) factor)))
(def doubler (multiplier 2))
generated by cgit v1.2.1 (git 2.18.0) at 2024-06-30 19:17:38 +0000