diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | gc.cpp | 71 | ||||
| -rw-r--r-- | llvm.cpp | 54 | ||||
| -rw-r--r-- | tuplr.cpp | 5 | ||||
| -rw-r--r-- | tuplr.hpp | 112 | ||||
| -rw-r--r-- | typing.cpp | 5 |
6 files changed, 194 insertions, 55 deletions
@@ -4,7 +4,7 @@ LLVM_LDFLAGS=`llvm-config --ldflags --libs core jit native` CXXFLAGS=-O0 -g -Wall -Wextra -Wno-unused-parameter $(LLVM_CXXFLAGS) LDFLAGS=$(LLVM_LDFLAGS) -lm -build/tuplr: build/tuplr.o build/typing.o build/llvm.o build/write.o +build/tuplr: build/tuplr.o build/typing.o build/llvm.o build/write.o build/gc.o g++ -o $@ $^ $(LDFLAGS) build/%.o: %.cpp tuplr.hpp @@ -0,0 +1,71 @@ +/* Tuplr: A programming language + * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net> + * + * Tuplr is free software: you can redistribute it and/or modify it under + * the terms of the GNU Affero General Public License as published by the + * Free Software Foundation, either version 3 of the License, or (at your + * option) any later version. + * + * Tuplr is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General + * Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with Tuplr. If not, see <http://www.gnu.org/licenses/>. + */ + +#include <set> +#include <iostream> +#include "tuplr.hpp" + +using namespace std; + +void* +GC::alloc(size_t size) +{ + void* ret = malloc(size); + _heap.push_back((AST*)ret); + return ret; +} + +inline void +mark(CEnv& cenv, const AST* ast) +{ + if (!ast || ast->used) + return; + + ast->used = true; + const ATuple* tup = ast->to<const ATuple*>(); + if (tup) { + FOREACH(ATuple::const_iterator, i, *tup) { + mark(cenv, *i); + mark(cenv, cenv.type(*i)); + } + } +} + +void +GC::collect(CEnv& cenv, const Roots& roots) +{ + for (Roots::const_iterator i = roots.begin(); i != roots.end(); ++i) + mark(cenv, *i); + + for (Heap::iterator i = _heap.begin(); i != _heap.end();) { + Heap::iterator next = i; + ++next; + if ((*i)->used) { + (*i)->used = false; + } else { + AType* t = (*i)->to<AType*>(); + // Don't delete types that are keys in the current type substitution + if (!t || cenv.tsubst.find(t) == cenv.tsubst.end()) { + (*i)->~AST(); + free(*i); + _heap.erase(i); + } + } + i = next; + } +} + @@ -165,7 +165,7 @@ compileFunction(CEnv& cenv, const std::string& name, const Type* retT, const ATu if (f->getName() != name) { f->eraseFromParent(); - throw Error(loc, "function redefined"); + throw Error(loc, (format("function `%1%' redefined") % name).str()); } // Set argument names in generated code @@ -211,23 +211,22 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT) { TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(this); assert(gt != cenv.tenv.genericTypes.end()); - AType* genericType = new AType(*gt->second); - - AType* thisType = genericType; + AType* thisType = new AType(*gt->second); Subst argsSubst; if (!thisType->concrete()) { - // Find type and build substitution + // Build substitution to apply to generic type assert(argsT.size() == prot()->size()); - ATuple* genericProtT = genericType->at(1)->as<ATuple*>(); + ATuple* genericProtT = gt->second->at(1)->as<ATuple*>(); for (size_t i = 0; i < argsT.size(); ++i) - argsSubst[*genericProtT->at(i)->to<AType*>()] = argsT.at(i)->to<AType*>(); - thisType = argsSubst.apply(genericType)->as<AType*>(); + argsSubst[genericProtT->at(i)->to<AType*>()] = argsT.at(i)->to<AType*>(); + + // Apply substitution to get concrete type for this call + thisType = argsSubst.apply(thisType)->as<AType*>(); if (!thisType->concrete()) throw Error(loc, "unable to resolve concrete type for function"); - } else { - thisType = genericType; } + AST::pool.addRoot(thisType); if (funcs.find(thisType)) return; @@ -241,7 +240,7 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT) cenv.push(); Subst oldSubst = cenv.tsubst; - cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, *subst)); + cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, subst)); // Bind argument values in CEnv vector<Value*> args; @@ -304,15 +303,15 @@ ACall::compile(CEnv& cenv) if (!c) return NULL; // Primitive - AType* protT = new AType(loc, NULL); + AType protT(loc, NULL); for (size_t i = 1; i < size(); ++i) - protT->push_back(cenv.type(at(i))); + protT.push_back(cenv.type(at(i))); TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(c); assert(gt != cenv.tenv.genericTypes.end()); - AType* fnT = new AType(loc, cenv.penv.sym("Fn"), protT, cenv.type(this), 0); - Function* f = (Function*)c->funcs.find(fnT); - THROW_IF(!f, loc, (format("callee failed to compile for type %1%") % fnT->str()).str()) + AType fnT(loc, cenv.penv.sym("Fn"), &protT, cenv.type(this), 0); + Function* f = (Function*)c->funcs.find(&fnT); + THROW_IF(!f, loc, (format("callee failed to compile for type %1%") % fnT.str()).str()) vector<Value*> params(size() - 1); for (size_t i = 1; i < size(); ++i) @@ -557,6 +556,10 @@ eval(CEnv& cenv, const string& name, istream& is) resultType = cenv.type(result); result->lift(cenv); // Lift functions exprs.push_back(make_pair(exp, result)); + + // Add definitions as GC roots + if (result->to<ADefinition*>()) + cenv.lock(result); } const Type* ctype = lltype(resultType); @@ -576,6 +579,9 @@ eval(CEnv& cenv, const string& name, istream& is) cenv.out << call(resultType, llengine(cenv)->engine->getPointerToFunction(f)) << " : " << resultType << endl; + + AST::pool.collect(cenv, AST::pool.roots()); + } catch (Error& e) { cenv.err << e.what() << endl; return 1; @@ -624,7 +630,15 @@ repl(CEnv& cenv) cenv.out << "; " << cenv.compile(body); } cenv.out << " : " << cenv.type(body) << endl; + + // Add definitions as GC roots + if (body->to<ADefinition*>()) + cenv.lock(body); + + AST::pool.collect(cenv, AST::pool.roots()); + cenv.tsubst = oldSubst; + } catch (Error& e) { cenv.err << e.what() << endl; } @@ -646,3 +660,11 @@ newCenv(PEnv& penv, TEnv& tenv) return cenv; } +void +freeCenv(CEnv* cenv) +{ + AST::pool.collect(*cenv, GC::Roots()); + delete (LLVMEngine*)cenv->engine(); + delete cenv; +} + @@ -27,6 +27,7 @@ using namespace std; using boost::format; Funcs AConsCall::funcs; +GC AST::pool; template<typename Atom> ostream& @@ -228,6 +229,7 @@ initLang(PEnv& penv, TEnv& tenv) } + /*************************************************************************** * EVAL/REPL/MAIN * ***************************************************************************/ @@ -256,6 +258,7 @@ main(int argc, char** argv) CEnv* cenv = newCenv(penv, tenv); cenv->push(); + AST::pool.lock(); map<string,string> args; list<string> files; @@ -326,7 +329,7 @@ main(int argc, char** argv) os.close(); } - delete cenv; + freeCenv(cenv); return ret; } @@ -22,6 +22,7 @@ #include <iostream> #include <list> #include <map> +#include <set> #include <sstream> #include <string> #include <vector> @@ -134,13 +135,33 @@ typedef void* CEngine; ///< Compiler Engine (opaque) /*************************************************************************** + * Garbage Collector * + ***************************************************************************/ + +struct AST; ///< Abstract Syntax Tree node +struct CEnv; ///< Compile-Time Environment + +extern ostream& operator<<(ostream& out, const AST* ast); +struct GC { + typedef std::list<const AST*> Roots; + typedef std::list<AST*> Heap; + void* alloc(size_t size); + void collect(CEnv& cenv, const Roots& roots); + const AST* addRoot(const AST* ast) { if (ast) { cout << "ADD ROOT " << ast << endl; _roots.push_back(ast); } return ast; } + void lock() { _roots.insert(_roots.end(), _heap.begin(), _heap.end()); } + const Roots& roots() const { return _roots; } +private: + Heap _heap; + Roots _roots; +}; + + +/*************************************************************************** * Abstract Syntax Tree * ***************************************************************************/ struct Constraint; ///< Type Constraint struct TEnv; ///< Type-Time Environment -struct CEnv; ///< Compile-Time Environment -struct AST; struct Constraints; struct Subst; @@ -148,7 +169,7 @@ extern ostream& operator<<(ostream& out, const AST* ast); /// Base class for all AST nodes struct AST { - AST(Cursor c=Cursor()) : loc(c) {} + AST(Cursor c=Cursor()) : loc(c), used(false) {} virtual ~AST() {} virtual bool operator==(const AST& o) const = 0; virtual bool contains(const AST* child) const { return false; } @@ -163,7 +184,13 @@ struct AST { if (!t) throw Error(loc, "internal error: bad cast"); return t; } - Cursor loc; + Cursor loc; + mutable bool used; + + static void* operator new(size_t size) { return pool.alloc(size); } + static void operator delete(void* ptr) {} + + static GC pool; }; /// Literal value @@ -202,6 +229,10 @@ struct ATuple : public AST, public vector<AST*> { push_back(a); va_end(args); } + void free() { + FOREACH(const_iterator, p, *this) + delete *p; + } bool operator==(const AST& rhs) const { const ATuple* rt = rhs.to<const ATuple*>(); if (!rt || rt->size() != size()) return false; @@ -283,6 +314,33 @@ struct AType : public ATuple { unsigned id; }; +struct typeLessThan { + inline bool operator()(const AType* a, const AType* b) const { return *a < *b; } +}; + +/// Type substitution +struct Subst : public map<const AType*,AType*,typeLessThan> { + Subst(AType* s=0, AType* t=0) { if (s && t) { assert(s != t); insert(make_pair(s, t)); } } + static Subst compose(const Subst& delta, const Subst& gamma); + AST* apply(AST* ast) const { + AType* in = ast->to<AType*>(); + if (!in) return ast; + if (in->kind == AType::EXPR) { + AType* out = new AType(in->loc, NULL); + for (size_t i = 0; i < in->size(); ++i) + out->push_back(apply(in->at(i))); + return out; + } else { + const_iterator i = find(in); + if (i != end()) { + return i->second; + } else { + return in; + } + } + } +}; + /// Lifted system functions (of various types) for a single Tuplr function struct Funcs : public list< pair<AType*, CFunction> > { CFunction find(AType* type) const { @@ -296,16 +354,16 @@ struct Funcs : public list< pair<AType*, CFunction> > { /// Closure (first-class function with captured lexical bindings) struct AClosure : public ATuple { AClosure(Cursor c, ASymbol* fn, ATuple* p, const string& n="") - : ATuple(c, fn, p, NULL), subst(0), name(n) {} + : ATuple(c, fn, p, NULL), name(n) {} bool operator==(const AST& rhs) const { return this == &rhs; } void constrain(TEnv& tenv, Constraints& c) const; void lift(CEnv& cenv); void liftCall(CEnv& cenv, const vector<AType*>& argsT); CValue compile(CEnv& cenv); ATuple* prot() const { return at(1)->to<ATuple*>(); } - Funcs funcs; - mutable Subst* subst; - string name; + Funcs funcs; + mutable Subst subst; + string name; }; /// Function call/application, e.g. "(func arg1 arg2)" @@ -319,7 +377,7 @@ struct ACall : public ATuple { /// Definition special form, e.g. "(def x 2)" struct ADefinition : public ACall { ADefinition(const SExp& e, const ATuple& t) : ACall(e, t) {} - ASymbol* sym() const { + ASymbol* sym() const { ASymbol* sym = at(1)->to<ASymbol*>(); if (!sym) { ATuple* tup = at(1)->to<ATuple*>(); @@ -401,9 +459,13 @@ struct PEnv : private map<const string, ASymbol*> { } ASymbol* sym(const string& s, Cursor c=Cursor()) { const const_iterator i = find(s); - return ((i != end()) - ? i->second - : insert(make_pair(s, new ASymbol(s, c))).first->second); + if (i != end()) { + return i->second; + } else { + ASymbol* sym = new ASymbol(s, c); + insert(make_pair(s, sym)); + return sym; + } } ATuple parseTuple(const SExp& e) { ATuple ret(e.loc, vector<AST*>(e.size())); @@ -458,28 +520,6 @@ inline ostream& operator<<(ostream& out, const Constraints& c) { return out; } -struct Subst : public map<const AType,AType*> { - Subst(AType* s=0, AType* t=0) { if (s && t) { assert(s != t); insert(make_pair(*s, t)); } } - static Subst compose(const Subst& delta, const Subst& gamma); - AST* apply(AST* ast) const { - AType* in = ast->to<AType*>(); - if (!in) return ast; - if (in->kind == AType::EXPR) { - AType* out = new AType(in->loc, NULL); - for (size_t i = 0; i < in->size(); ++i) - out->push_back(apply(in->at(i))); - return out; - } else { - const_iterator i = find(*in); - if (i != end()) { - return i->second; - } else { - return in; - } - } - } -}; - /// Type-Time Environment struct TEnv : public Env< const ASymbol*, pair<AST*, AType*> > { TEnv(PEnv& p) : penv(p), varID(1) {} @@ -542,10 +582,11 @@ struct CEnv { CValue compile(AST* obj); void optimise(CFunction f); void write(std::ostream& os); + void lock(AST* ast) { AST::pool.addRoot(ast); AST::pool.addRoot(type(ast)); } AType* type(AST* ast, const Subst& subst = Subst()) const { ASymbol* sym = ast->to<ASymbol*>(); if (sym) - return tenv.deref(sym->addr).second; + return sym->addr ? tenv.deref(sym->addr).second : NULL; return tsubst.apply(subst.apply(tenv.vars[ast]))->to<AType*>(); } void def(ASymbol* sym, AST* c, AType* t, CValue v) { @@ -576,6 +617,7 @@ private: void pprint(std::ostream& out, const AST* ast); void initLang(PEnv& penv, TEnv& tenv); CEnv* newCenv(PEnv& penv, TEnv& tenv); +void freeCenv(CEnv* cenv); int eval(CEnv& cenv, const string& name, istream& is); int repl(CEnv& cenv); @@ -108,9 +108,10 @@ AClosure::constrain(TEnv& tenv, Constraints& c) const genericType = new AType(loc, tenv.penv.sym("Fn"), tsubst.apply(protT), tsubst.apply(bodyT), 0); tenv.genericTypes.insert(make_pair(this, genericType)); + AST::pool.addRoot(genericType); tenv.pop(); - subst = new Subst(tsubst); + subst = tsubst; } c.constrain(tenv, this, new AType(*genericType)); @@ -283,7 +284,7 @@ Subst::compose(const Subst& delta, const Subst& gamma) // TAPL 22.1.1 { Subst r; for (Subst::const_iterator g = gamma.begin(); g != gamma.end(); ++g) { - Subst::const_iterator d = delta.find(*g->second); + Subst::const_iterator d = delta.find(g->second); r.insert(make_pair(g->first, ((d != delta.end()) ? d : g)->second)); } for (Subst::const_iterator d = delta.begin(); d != delta.end(); ++d) { |