diff options
| -rw-r--r-- | Makefile | 8 | ||||
| -rw-r--r-- | src/c.cpp | 7 | ||||
| -rw-r--r-- | src/compile.cpp | 10 | ||||
| -rw-r--r-- | src/constrain.cpp | 12 | ||||
| -rw-r--r-- | src/gc.cpp | 19 | ||||
| -rw-r--r-- | src/llvm.cpp | 52 | ||||
| -rw-r--r-- | src/parse.cpp | 7 | ||||
| -rw-r--r-- | src/tuplr.hpp | 31 | ||||
| -rw-r--r-- | src/tuplr_gc.cpp | 8 |
9 files changed, 124 insertions, 30 deletions
@@ -34,12 +34,10 @@ OBJECTS = \ build/repl.o \ build/tlsf.o \ build/tuplr.o \ - build/unify.o + build/unify.o \ + build/tuplr_gc.o -LIBS = \ - build/tuplr_gc.so - -build/tuplr: $(OBJECTS) $(LIBS) +build/tuplr: $(OBJECTS) g++ -o $@ $(OBJECTS) $(LDFLAGS) $(LLVM_LDFLAGS) build/%.o: src/%.cpp src/tuplr.hpp @@ -136,6 +136,7 @@ struct CEngine : public Engine { CFunc compileFunction(CEnv& cenv, AFn* fn, const AType& argsT); + CVal compileTup(CEnv& cenv, const AType* type, const vector<CVal>& fields); CVal compileLiteral(CEnv& cenv, AST* lit); CVal compilePrimitive(CEnv& cenv, APrimitive* prim); CVal compileIf(CEnv& cenv, AIf* aif); @@ -163,6 +164,12 @@ tuplr_new_c_engine() ***************************************************************************/ CVal +CEngine::compileTup(CEnv& cenv, const AType* type, const vector<CVal>& fields) +{ + return NULL; +} + +CVal CEngine::compileLiteral(CEnv& cenv, AST* lit) { return new Value(lit->str()); diff --git a/src/compile.cpp b/src/compile.cpp index d525f57..797ae2e 100644 --- a/src/compile.cpp +++ b/src/compile.cpp @@ -86,6 +86,16 @@ AIf::compile(CEnv& cenv) } CVal +ACons::compile(CEnv& cenv) +{ + const AType* type = cenv.type(this); + vector<CVal> fields; + for (const_iterator i = begin() + 1; i != end(); ++i) + fields.push_back((*i)->compile(cenv)); + return cenv.engine()->compileTup(cenv, type, fields); +} + +CVal APrimitive::compile(CEnv& cenv) { return cenv.engine()->compilePrimitive(cenv, this); diff --git a/src/constrain.cpp b/src/constrain.cpp index 0c9951c..b7d7a0d 100644 --- a/src/constrain.cpp +++ b/src/constrain.cpp @@ -173,6 +173,18 @@ AIf::constrain(TEnv& tenv, Constraints& c) const } void +ACons::constrain(TEnv& tenv, Constraints& c) const +{ + AType* type = tup<AType>(loc, tenv.Tup, 0); + for (const_iterator i = begin() + 1; i != end(); ++i) { + (*i)->constrain(tenv, c); + type->push_back(tenv.var(*i)); + } + + c.constrain(tenv, this, type); +} + +void APrimitive::constrain(TEnv& tenv, Constraints& c) const { const string n = head()->to<const ASymbol*>()->str(); @@ -44,6 +44,7 @@ GC::alloc(size_t size) size += sizeof(Object::Header); void* ret = tlsf_malloc((tlsf_t*)_pool, size); ((Object::Header*)ret)->mark = 0; + ((Object::Header*)ret)->tag = Object::AST; ret = (char*)ret + sizeof(Object::Header); _heap.push_back((Object*)ret); return ret; @@ -56,10 +57,12 @@ mark(const Object* obj) return; obj->mark(true); - const ATuple* tup = dynamic_cast<const ATuple*>((AST*)obj); - if (tup) - FOREACHP(ATuple::const_iterator, i, tup) - mark(*i); + if (obj->tag() == Object::AST) { + const ATuple* tup = ((const AST*)obj)->to<const ATuple*>(); + if (tup) + FOREACHP(ATuple::const_iterator, i, tup) + mark(*i); + } } void @@ -77,14 +80,14 @@ GC::collect(const Roots& roots) if ((*i)->marked()) { (*i)->mark(false); } else { - AST* ast = (AST*)*i; - if (!ast->to<AType*>()) { // FIXME - (ast)->~AST(); + if ((*i)->tag() == Object::AST) + ((AST*)*i)->~AST(); + tlsf_free((tlsf_t*)_pool, ((char*)(*i) - sizeof(Object::Header))); _heap.erase(i); - } } i = next; } + //std::cerr << "[GC] Collect " << oldSize << " => " << _heap.size() << endl; } diff --git a/src/llvm.cpp b/src/llvm.cpp index bb30cbc..bf00778 100644 --- a/src/llvm.cpp +++ b/src/llvm.cpp @@ -45,7 +45,9 @@ static inline Function* llFunc(CFunc f) { return static_cast<Function*>(f); } static const Type* llType(const AType* t) { - if (t->kind == AType::PRIM) { + if (t == NULL) { + return NULL; + } else if (t->kind == AType::PRIM) { if (t->head()->str() == "Nothing") return Type::VoidTy; if (t->head()->str() == "Bool") return Type::Int1Ty; if (t->head()->str() == "Int") return Type::Int32Ty; @@ -60,15 +62,23 @@ llType(const AType* t) vector<const Type*> cprot; FOREACHP(ATuple::const_iterator, i, protT) { - const AType* at = (*i)->to<const AType*>(); - const Type* lt = llType(at); + const Type* lt = llType((*i)->to<const AType*>()); if (!lt) return NULL; cprot.push_back(lt); } - FunctionType* fT = FunctionType::get(llType(retT), cprot, false); - return PointerType::get(fT, 0); + return PointerType::get(FunctionType::get(llType(retT), cprot, false), 0); + } else if (t->kind == AType::EXPR && t->head()->str() == "Tup") { + vector<const Type*> ctypes; + for (AType::const_iterator i = t->begin() + 1; i != t->end(); ++i) { + const Type* lt = llType((*i)->to<const AType*>()); + if (!lt) + return NULL; + ctypes.push_back(lt); + } + + return PointerType::get(StructType::get(ctypes, false), 0); } return NULL; // non-primitive type } @@ -95,7 +105,6 @@ struct LLVMEngine : public Engine { // Declare host provided allocation primitive std::vector<const Type*> argsT(1, Type::Int32Ty); // unsigned size - argsT.push_back(Type::Int8Ty); // char tag FunctionType* funcT = FunctionType::get(PointerType::get(Type::Int8Ty, 0), argsT, false); alloc = Function::Create(funcT, Function::ExternalLinkage, "tuplr_gc_allocate", module); @@ -159,6 +168,7 @@ struct LLVMEngine : public Engine { CFunc compileFunction(CEnv& cenv, AFn* fn, const AType& argsT); + CVal compileTup(CEnv& cenv, const AType* type, const vector<CVal>& fields); CVal compileLiteral(CEnv& cenv, AST* lit); CVal compilePrimitive(CEnv& cenv, APrimitive* prim); CVal compileIf(CEnv& cenv, AIf* aif); @@ -204,6 +214,36 @@ tuplr_new_llvm_engine() * Code Generation * ***************************************************************************/ +/** Convert a size in bits to bytes, rounding up as necessary */ +static inline size_t +bitsToBytes(size_t bits) +{ + return ((bits % 8 == 0) ? bits : (((bits / 8) + 1) * 8)) / 8; +} + +CVal +LLVMEngine::compileTup(CEnv& cenv, const AType* type, const vector<CVal>& fields) +{ + // Find size of memory required + size_t s = 0; + for (AType::const_iterator i = type->begin() + 1; i != type->end(); ++i) + s += llType((*i)->as<AType*>())->getPrimitiveSizeInBits(); + + // Allocate struct + Value* structSize = ConstantInt::get(Type::Int32Ty, bitsToBytes(s)); + Value* mem = builder.CreateCall(alloc, structSize, "tup"); + Value* structPtr = builder.CreateBitCast(mem, llType(type), "tupPtr"); + + // Set struct fields + size_t i = 0; + for (vector<CVal>::const_iterator f = fields.begin(); f != fields.end(); ++f, ++i) { + Value* v = builder.CreateStructGEP(structPtr, i, (format("tup%1%") % i).str().c_str()); + builder.CreateStore(llVal(*f), v); + } + + return structPtr; +} + CVal LLVMEngine::compileLiteral(CEnv& cenv, AST* lit) { diff --git a/src/parse.cpp b/src/parse.cpp index 6271cad..a2dddd2 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -118,9 +118,10 @@ initLang(PEnv& penv, TEnv& tenv) penv.defmac("def", macDef); // Special forms - penv.reg(true, "fn", PEnv::Handler(parseFn)); - penv.reg(true, "if", PEnv::Handler(parseCall<AIf>)); - penv.reg(true, "def", PEnv::Handler(parseCall<ADef>)); + penv.reg(true, "fn", PEnv::Handler(parseFn)); + penv.reg(true, "if", PEnv::Handler(parseCall<AIf>)); + penv.reg(true, "cons", PEnv::Handler(parseCall<ACons>)); + penv.reg(true, "def", PEnv::Handler(parseCall<ADef>)); // Numeric primitives penv.reg(true, "+", PEnv::Handler(parseCall<APrimitive>)); diff --git a/src/tuplr.hpp b/src/tuplr.hpp index dce52b2..31585d2 100644 --- a/src/tuplr.hpp +++ b/src/tuplr.hpp @@ -129,19 +129,29 @@ private: /// Garbage collected object (including AST and runtime data) struct Object { + enum Tag { OBJECT = 123, AST = 456 }; + struct Header { - uint8_t mark; + uint32_t mark; + uint32_t tag; }; - /// Always allocated with pool.alloc, so this - sizeof(Header) is a valid Header*. - inline Header* header() const { return (Header*)((char*)this - sizeof(Header)); } - + inline Tag tag() const { return (Tag)header()->tag; } + inline void tag(Tag t) { header()->tag = t; } inline bool marked() const { return header()->mark != 0; } inline void mark(bool b) const { header()->mark = 1; } - static void* operator new(size_t size) { return pool.alloc(size); } + static void* operator new(size_t size) { return pool.alloc(size); } static void operator delete(void* ptr) {} + + // Memory used with placement new MUST always be allocated with pool.alloc! + static void* operator new(size_t size, void* ptr) { return ptr; } + static GC pool; + +private: + /// Always allocated with pool.alloc, so this - sizeof(Header) is a valid Header*. + inline Header* header() const { return (Header*)((char*)this - sizeof(Header)); } }; @@ -424,6 +434,12 @@ struct AIf : public ACall { CVal compile(CEnv& cenv); }; +struct ACons : public ACall { + ACons(const ATuple* exp) : ACall(exp) {} + void constrain(TEnv& tenv, Constraints& c) const; + CVal compile(CEnv& cenv); +}; + /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)" struct APrimitive : public ACall { APrimitive(const ATuple* exp) : ACall(exp) {} @@ -546,7 +562,8 @@ inline ostream& operator<<(ostream& out, const Constraints& c) { /// Type-Time Environment struct TEnv : public Env<const ASymbol*, AType*> { - TEnv(PEnv& p) : penv(p), varID(1), Fn(new AType(penv.sym("Fn"))) { + TEnv(PEnv& p) : penv(p), varID(1), + Fn(new AType(penv.sym("Fn"))), Tup(new AType(penv.sym("Tup"))) { Object::pool.addRoot(Fn); } AType* fresh(const ASymbol* sym) { @@ -579,6 +596,7 @@ struct TEnv : public Env<const ASymbol*, AType*> { unsigned varID; AType* Fn; + AType* Tup; }; Subst unify(const Constraints& c); @@ -600,6 +618,7 @@ struct Engine { virtual void finishFunction(CEnv& cenv, CFunc f, const AType* retT, CVal ret) = 0; virtual void eraseFunction(CEnv& cenv, CFunc f) = 0; virtual CFunc compileFunction(CEnv& cenv, AFn* fn, const AType& argsT) = 0; + virtual CVal compileTup(CEnv& cenv, const AType* t, const vector<CVal>& f) = 0; virtual CVal compileLiteral(CEnv& cenv, AST* lit) = 0; virtual CVal compileCall(CEnv& cenv, CFunc f, const vector<CVal>& args) = 0; virtual CVal compilePrimitive(CEnv& cenv, APrimitive* prim) = 0; diff --git a/src/tuplr_gc.cpp b/src/tuplr_gc.cpp index d999e44..7bd35a4 100644 --- a/src/tuplr_gc.cpp +++ b/src/tuplr_gc.cpp @@ -27,7 +27,7 @@ extern "C" { void* -tuplr_gc_allocate(unsigned size, uint8_t tag) +tuplr_gc_allocate(unsigned size) { static const size_t COLLECT_SIZE = 8 * 1024 * 1024; // 8 MiB @@ -38,7 +38,11 @@ tuplr_gc_allocate(unsigned size, uint8_t tag) allocated = 0; } - return Object::pool.alloc(size); + void* mem = Object::pool.alloc(size); + Object* obj = new (mem) Object(); + obj->tag(Object::OBJECT); + + return mem; } } |