Move code into src directory.

git-svn-id: http://svn.drobilla.net/resp/tuplr@160 ad02d1e2-f140-0410-9f75-f8b11f17cedd

9 files changed, 2361 insertions, 0 deletions

diff --git a/src/cps.cpp b/src/cps.cpp
new file mode 100644
index 0000000..8df11c2
--- /dev/null
+++ b/src/cps.cpp
@@ -0,0 +1,136 @@
+/* Tuplr Type Inferencing
+ * 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 "tuplr.hpp"
+
+/***************************************************************************
+ * CPS Conversion                                                          *
+ ***************************************************************************/
+
+/** (cps x cont) => (cont x) */
+AST*
+AST::cps(TEnv& tenv, AST* cont)
+{
+	return tup<ACall>(loc, cont, this, 0);
+}
+
+/** (cps (fn (a ...) body) cont) => (cont (fn (a ... k) (cps body k))*/
+AST*
+AFn::cps(TEnv& tenv, AST* cont)
+{
+	ATuple*  copyProt = new ATuple(prot()->loc, *prot());
+	ASymbol* contArg  = tenv.penv.gensym("_k");
+	copyProt->push_back(contArg);
+	AFn* copy = tup<AFn>(loc, tenv.penv.sym("fn"), copyProt, 0);
+	const_iterator p = begin();
+	++(++p);
+	for (; p != end(); ++p)
+		copy->push_back((*p)->cps(tenv, contArg));
+	return tup<ACall>(loc, cont, copy, 0);
+}
+
+AST*
+APrimitive::cps(TEnv& tenv, AST* cont)
+{
+	return value() ? tup<ACall>(loc, cont, this, 0) : ACall::cps(tenv, cont);
+}
+
+/** (cps (f a b ...)) => (a (fn (x) (b (fn (y) ... (cont (f x y ...)) */
+AST*
+ACall::cps(TEnv& tenv, AST* cont)
+{
+	std::vector< std::pair<AFn*, AST*> > funcs;
+	AFn*     fn  = NULL;
+	ASymbol* arg = NULL;
+
+	// Make a continuation for each element (operator and arguments)
+	// Argument evaluation continuations are not themselves in CPS.
+	// Each makes a tail call to the next, and the last makes a tail
+	// call to the continuation of this call
+	ssize_t firstFn = -1;
+	for (size_t i = 0; i < size(); ++i) {
+		if (!at(i)->to<ATuple*>()) {
+			funcs.push_back(make_pair((AFn*)NULL, at(i)));
+		} else {
+			arg = tenv.penv.gensym("a");
+
+			if (firstFn == -1)
+				firstFn = i;
+
+			AFn* thisFn = tup<AFn>(loc, tenv.penv.sym("fn"),
+					tup<ATuple>(at(i)->loc, arg, 0),
+					0);
+
+			if (fn)
+				fn->push_back(at(i)->cps(tenv, thisFn));
+
+			funcs.push_back(make_pair(thisFn, arg));
+			fn = thisFn;
+		}
+	}
+
+	if (firstFn != -1) {
+		// Call this call's callee in the last argument evaluator
+		ACall* call = tup<ACall>(loc, 0);
+		assert(funcs.size() == size());
+		for (size_t i = 0; i < funcs.size(); ++i)
+			call->push_back(funcs[i].second);
+
+		assert(fn);
+		fn->push_back(call->cps(tenv, cont));
+		return at(firstFn)->cps(tenv, funcs[firstFn].first);
+	} else {
+		assert(at(0)->value());
+		ACall* ret = tup<ACall>(loc, 0);
+		for (size_t i = 0; i < size(); ++i)
+			ret->push_back(at(i));
+		if (!to<APrimitive*>())
+			ret->push_back(cont);
+		return ret;
+	}
+}
+
+/** (cps (def x y)) => (y (fn (x) (cont))) */
+AST*
+ADef::cps(TEnv& tenv, AST* cont)
+{
+	AST*   val     = at(2)->cps(tenv, cont);
+	ACall* valCall = val->to<ACall*>();
+	assert(valCall);
+	return tup<ADef>(loc, tenv.penv.sym("def"), sym(), valCall->at(1), 0);
+}
+
+/** (cps (if c t ... e)) => */
+AST*
+AIf::cps(TEnv& tenv, AST* cont)
+{
+	ASymbol* argSym = tenv.penv.gensym("c");
+	if (at(1)->value()) {
+		return tup<AIf>(loc, tenv.penv.sym("if"), at(1),
+			at(2)->cps(tenv, cont),
+			at(3)->cps(tenv, cont), 0);
+	} else {
+		AFn* contFn = tup<AFn>(loc, tenv.penv.sym("fn"),
+				tup<ATuple>(at(1)->loc, argSym, tenv.penv.gensym("_k"), 0),
+				tup<AIf>(loc, tenv.penv.sym("if"), argSym,
+					at(2)->cps(tenv, cont),
+					at(3)->cps(tenv, cont), 0));
+		return at(1)->cps(tenv, contFn);
+	}
+}
+
diff --git a/src/gc.cpp b/src/gc.cpp
new file mode 100644
index 0000000..3964324
--- /dev/null
+++ b/src/gc.cpp
@@ -0,0 +1,92 @@
+/* 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 <cassert>
+#include <set>
+#include <iostream>
+#include "tuplr.hpp"
+
+using namespace std;
+
+void*
+GC::alloc(size_t size, GC::Tag tag)
+{
+	size += (4 - (size % 4)); // Align to 32-bits
+	size += sizeof(Object::Header);
+	void* ret = malloc(size);
+	((Object::Header*)ret)->mark = 0;
+	((Object::Header*)ret)->tag  = tag;
+	ret = (char*)ret + sizeof(Object::Header);
+	_heap.push_back((Object*)ret);
+	return ret;
+}
+
+inline void
+mark(const Object* obj)
+{
+	if (!obj || obj->marked())
+		return;
+
+	obj->mark(true);
+	switch (obj->tag()) {
+	case GC::TAG_FRAME:
+		break;
+	case GC::TAG_AST:
+		const ATuple* tup = dynamic_cast<const ATuple*>((AST*)obj);
+		if (tup)
+			FOREACH(ATuple::const_iterator, i, *tup)
+				mark(*i);
+		break;
+	}
+}
+
+void
+GC::collect(const Roots& roots)
+{
+	//const size_t oldSize = _heap.size();
+
+	for (Roots::const_iterator i = roots.begin(); i != roots.end(); ++i)
+		mark(*i);
+
+	for (Heap::iterator i = _heap.begin(); i != _heap.end();) {
+		assert((*i)->tag() == GC::TAG_AST || (*i)->tag() == GC::TAG_FRAME);
+		Heap::iterator next = i;
+		++next;
+
+		if ((*i)->marked()) {
+			(*i)->mark(false);
+		} else {
+			switch ((*i)->tag()) {
+			case GC::TAG_FRAME:
+				free((char*)(*i) - sizeof(Object::Header));
+				_heap.erase(i);
+				break;
+			case GC::TAG_AST:
+				AST* ast = (AST*)*i;
+				if (!ast->to<AType*>()) { // FIXME
+				(ast)->~AST();
+				free((char*)(*i) - sizeof(Object::Header));
+				_heap.erase(i);
+				}
+				break;
+			}
+		}
+		i = next;
+	}
+	//std::cerr << "[GC] Collect " << oldSize << " => " << _heap.size() << endl;
+}
+
diff --git a/src/gclib.cpp b/src/gclib.cpp
new file mode 100644
index 0000000..8c9f140
--- /dev/null
+++ b/src/gclib.cpp
@@ -0,0 +1,41 @@
+/* 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 "tuplr.hpp"
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+extern "C" {
+
+void*
+tuplr_gc_allocate(unsigned size, uint8_t tag)
+{
+	static const size_t COLLECT_SIZE = 8 * 1024 * 1024; // 8 MiB
+
+	static size_t allocated = 0;
+	allocated += size;
+	if (allocated > COLLECT_SIZE) {
+		Object::pool.collect(Object::pool.roots());
+		allocated = 0;
+	}
+
+	return Object::pool.alloc(size, (GC::Tag)tag);
+}
+
+}
+
diff --git a/src/llvm.cpp b/src/llvm.cpp
new file mode 100644
index 0000000..b5e397e
--- /dev/null
+++ b/src/llvm.cpp
@@ -0,0 +1,544 @@
+/* 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 <map>
+#include <sstream>
+#include <boost/format.hpp>
+#include "llvm/Analysis/Verifier.h"
+#include "llvm/Assembly/AsmAnnotationWriter.h"
+#include "llvm/DerivedTypes.h"
+#include "llvm/ExecutionEngine/ExecutionEngine.h"
+#include "llvm/Instructions.h"
+#include "llvm/Module.h"
+#include "llvm/ModuleProvider.h"
+#include "llvm/PassManager.h"
+#include "llvm/Support/IRBuilder.h"
+#include "llvm/Target/TargetData.h"
+#include "llvm/Transforms/Scalar.h"
+#include "tuplr.hpp"
+
+using namespace llvm;
+using namespace std;
+using boost::format;
+
+static inline Value*    llVal(CValue     v) { return static_cast<Value*>(v); }
+static inline Function* llFunc(CFunction f) { return static_cast<Function*>(f); }
+
+static const Type*
+llType(const AType* t)
+{
+	if (t->kind == AType::PRIM) {
+		if (t->at(0)->str() == "Nothing") return Type::VoidTy;
+		if (t->at(0)->str() == "Bool")    return Type::Int1Ty;
+		if (t->at(0)->str() == "Int")     return Type::Int32Ty;
+		if (t->at(0)->str() == "Float")   return Type::FloatTy;
+		throw Error(t->loc, string("Unknown primitive type `") + t->str() + "'");
+	/*} else if (t->kind == AType::EXPR && t->at(0)->str() == "Fn") {
+		AType* retT = t->at(2)->as<AType*>();
+		if (!llType(retT))
+			return NULL;
+
+		vector<const Type*> cprot;
+		const ATuple* prot = t->at(1)->to<ATuple*>();
+		for (size_t i = 0; i < prot->size(); ++i) {
+			AType* at = prot->at(i)->to<AType*>();
+			const Type* lt = llType(at);
+			if (lt)
+				cprot.push_back(lt);
+			else
+				return NULL;
+		}
+
+		FunctionType* fT = FunctionType::get(llType(retT), cprot, false);
+		return PointerType::get(fT, 0);
+		*/
+	}
+	return NULL; // non-primitive type
+}
+
+
+/***************************************************************************
+ * LLVM Engine                                                             *
+ ***************************************************************************/
+
+struct LLVMEngine : public Engine {
+	LLVMEngine()
+		: module(new Module("tuplr"))
+		, engine(ExecutionEngine::create(module))
+		, emp(module)
+		, opt(&emp)
+	{
+		// Set up optimiser pipeline
+		const TargetData* target = engine->getTargetData();
+		opt.add(new TargetData(*target));          // Register target arch
+		opt.add(createInstructionCombiningPass()); // Simple optimizations
+		opt.add(createReassociatePass());          // Reassociate expressions
+		opt.add(createGVNPass());                  // Eliminate Common Subexpressions
+		opt.add(createCFGSimplificationPass());    // Simplify control flow
+
+		// 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);
+	}
+
+	CFunction startFunction(CEnv& cenv,
+			const std::string& name, const AType* retT, const ATuple& argsT,
+			const vector<string> argNames)
+	{
+		Function::LinkageTypes linkage = Function::ExternalLinkage;
+
+		vector<const Type*> cprot;
+		for (size_t i = 0; i < argsT.size(); ++i) {
+			AType* at = argsT.at(i)->as<AType*>();
+			THROW_IF(!llType(at), Cursor(), string("parameter has non-concrete type ")
+				+ at->str())
+			cprot.push_back(llType(at));
+		}
+
+		THROW_IF(!llType(retT), Cursor(), "return has non-concrete type");
+		FunctionType* fT = FunctionType::get(llType(retT), cprot, false);
+		Function*     f  = Function::Create(fT, linkage, name, module);
+
+		// Note f->getName() may be different from name
+		// however LLVM chooses to mangle is fine, we keep a pointer
+
+		// Set argument names in generated code
+		Function::arg_iterator a = f->arg_begin();
+		if (!argNames.empty())
+			for (size_t i = 0; i != argsT.size(); ++a, ++i)
+				a->setName(argNames.at(i));
+
+		BasicBlock* bb = BasicBlock::Create("entry", f);
+		builder.SetInsertPoint(bb);
+
+		return f;
+	}
+
+	void finishFunction(CEnv& cenv, CFunction f, const AType* retT, CValue ret) {
+		if (retT->concrete()) {
+			Value* retVal = llVal(ret);
+			builder.CreateRet(retVal);
+		} else {
+			builder.CreateRetVoid();
+		}
+
+		/*std::cerr << "MODULE {" << endl;
+		module->dump();
+		std::cerr << "}" << endl;*/
+		verifyFunction(*static_cast<Function*>(f));
+		if (cenv.args.find("-g") == cenv.args.end())
+			opt.run(*static_cast<Function*>(f));
+	}
+
+	void eraseFunction(CEnv& cenv, CFunction f) {
+		if (f)
+			llFunc(f)->eraseFromParent();
+	}
+
+	void writeModule(CEnv& cenv, std::ostream& os) {
+		AssemblyAnnotationWriter writer;
+		module->print(os, &writer);
+	}
+
+	const string call(CEnv& cenv, CFunction f, AType* retT) {
+		void*       fp = engine->getPointerToFunction(llFunc(f));
+		const Type* t  = llType(retT);
+		THROW_IF(!fp, Cursor(), "unable to get function pointer");
+		THROW_IF(!t,  Cursor(), "function with non-concrete return type called");
+
+		std::stringstream ss;
+		if (t == Type::Int32Ty)
+			ss << ((int32_t (*)())fp)();
+		else if (t == Type::FloatTy)
+			ss << showpoint << ((float (*)())fp)();
+		else if (t == Type::Int1Ty)
+			ss << (((bool (*)())fp)() ? "#t" : "#f");
+		else
+			ss << ((void* (*)())fp)();
+		return ss.str();
+	}
+
+	Module*                module;
+	ExecutionEngine*       engine;
+	IRBuilder<>            builder;
+	CFunction              alloc;
+	ExistingModuleProvider emp;
+	FunctionPassManager    opt;
+};
+
+static LLVMEngine*
+llEngine(CEnv& cenv)
+{
+	return reinterpret_cast<LLVMEngine*>(cenv.engine());
+}
+
+/// Shared library entry point
+Engine*
+tuplr_new_engine()
+{
+	return new LLVMEngine();
+}
+
+/// Shared library entry point
+void
+tuplr_free_engine(Engine* engine)
+{
+	delete (LLVMEngine*)engine;
+}
+
+
+/***************************************************************************
+ * Code Generation                                                         *
+ ***************************************************************************/
+
+#define LITERAL(CT, NAME, COMPILED) \
+template<> CValue ALiteral<CT>::compile(CEnv& cenv) { return (COMPILED); } \
+template<> void \
+ALiteral<CT>::constrain(TEnv& tenv, Constraints& c) const { \
+	c.constrain(tenv, this, tenv.named(NAME)); \
+}
+
+/// Literal template instantiations
+LITERAL(int32_t, "Int",   ConstantInt::get(Type::Int32Ty, val, true))
+LITERAL(float,   "Float", ConstantFP::get(Type::FloatTy, val))
+LITERAL(bool,    "Bool",  ConstantInt::get(Type::Int1Ty, val, false))
+
+CValue
+ASymbol::compile(CEnv& cenv)
+{
+	return cenv.vals.ref(this);
+}
+
+void
+AFn::lift(CEnv& cenv)
+{
+	cenv.push();
+	for (const_iterator p = prot()->begin(); p != prot()->end(); ++p)
+		cenv.def((*p)->as<ASymbol*>(), *p, NULL, NULL);
+
+	// Lift body
+	for (size_t i = 2; i < size(); ++i)
+		at(i)->lift(cenv);
+
+	cenv.pop();
+
+	AType* type = cenv.type(this);
+	if (impls.find(type) || !type->concrete())
+		return;
+
+	AType* protT = type->at(1)->as<AType*>();
+	liftCall(cenv, *protT);
+}
+
+void
+AFn::liftCall(CEnv& cenv, const 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;
+	Subst  argsSubst;
+
+	if (!genericType->concrete()) {
+		// Build substitution to apply to generic type
+		assert(argsT.size() == prot()->size());
+		ATuple* genericProtT = gt->second->at(1)->as<ATuple*>();
+		for (size_t i = 0; i < argsT.size(); ++i) {
+			const AType* genericArgT = genericProtT->at(i)->to<const AType*>();
+			AType*       callArgT    = argsT.at(i)->to<AType*>();
+			assert(genericArgT);
+			assert(callArgT);
+			if (callArgT->kind == AType::EXPR) {
+				assert(genericArgT->kind == AType::EXPR);
+				assert(callArgT->size() == genericArgT->size());
+				for (size_t i = 0; i < callArgT->size(); ++i) {
+					AType* gT = genericArgT->at(i)->to<AType*>();
+					AType* aT = callArgT->at(i)->to<AType*>();
+					if (gT && aT)
+						argsSubst.add(gT, aT);
+				}
+			} else {
+				argsSubst.add(genericArgT, callArgT);
+			}
+		}
+
+		// Apply substitution to get concrete type for this call
+		thisType = argsSubst.apply(genericType)->as<AType*>();
+		THROW_IF(!thisType->concrete(), loc,
+				string("unable to resolve concrete type for function :: ")
+						+ thisType->str() + "\n" + this->str());
+	}
+
+	Object::pool.addRoot(thisType);
+	if (impls.find(thisType))
+		return;
+
+	ATuple* protT = thisType->at(1)->as<ATuple*>();
+
+	vector<string> argNames;
+	for (size_t i = 0; i < prot()->size(); ++i) {
+		argNames.push_back(prot()->at(i)->str());
+	}
+
+	// Write function declaration
+	const string name = (this->name == "") ? cenv.penv.gensymstr("_fn") : this->name;
+	Function* f = llFunc(cenv.engine()->startFunction(cenv, name,
+			thisType->at(thisType->size()-1)->to<AType*>(),
+			*protT, argNames));
+
+	cenv.push();
+	Subst oldSubst = cenv.tsubst;
+	cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, subst));
+
+//#define EXPLICIT_STACK_FRAMES 1
+
+#ifdef EXPLICIT_STACK_FRAMES
+	vector<const Type*> types;
+	types.push_back(Type::Int8Ty);
+	types.push_back(Type::Int8Ty);
+	size_t s = 16; // stack frame size in bits
+#endif
+
+	// Bind argument values in CEnv
+	vector<Value*> args;
+	const_iterator p = prot()->begin();
+	size_t i = 0;
+	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++i) {
+		AType* t = protT->at(i)->as<AType*>();
+		const Type* lt = llType(t);
+		THROW_IF(!lt, loc, "untyped parameter\n");
+		cenv.def((*p)->as<ASymbol*>(), *p, t, &*a);
+#ifdef EXPLICIT_STACK_FRAMES
+		types.push_back(lt);
+		s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8));
+#endif
+	}
+
+
+#ifdef EXPLICIT_STACK_FRAMES
+	IRBuilder<> builder = llEngine(cenv)->builder;
+
+	// Scan out definitions
+	for (size_t i = 0; i < size(); ++i) {
+		ADef* def = at(i)->to<ADef*>();
+		if (def) {
+			const Type* lt = llType(cenv.type(def->at(2)));
+			THROW_IF(!lt, loc, "untyped definition\n");
+			types.push_back(lt);
+			s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8));
+		}
+	}
+
+	// Create stack frame
+	StructType* frameT    = StructType::get(types, false);
+	Value*      tag       = ConstantInt::get(Type::Int8Ty, GC::TAG_FRAME);
+	Value*      frameSize = ConstantInt::get(Type::Int32Ty, s / 8);
+	Value*      frame     = builder.CreateCall2(llVal(cenv.alloc), frameSize, tag, "frame");
+	Value*      framePtr  = builder.CreateBitCast(frame, PointerType::get(frameT, 0));
+
+	// Bind parameter values in stack frame
+	i = 2;
+	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++i) {
+		Value* v = builder.CreateStructGEP(framePtr, i, "arg");
+		builder.CreateStore(&*a, v);
+	}
+#endif
+
+	// Write function body
+	try {
+		// Define value first for recursion
+		cenv.precompile(this, f);
+		impls.push_back(make_pair(thisType, f));
+		CValue retVal = NULL;
+		for (size_t i = 2; i < size(); ++i)
+			retVal = cenv.compile(at(i));
+		cenv.engine()->finishFunction(cenv, f, cenv.type(at(size()-1)), retVal);
+	} catch (Error& e) {
+		f->eraseFromParent(); // Error reading body, remove function
+		cenv.pop();
+		throw e;
+	}
+	cenv.tsubst = oldSubst;
+	cenv.pop();
+}
+
+CValue
+AFn::compile(CEnv& cenv)
+{
+	return NULL;
+}
+
+void
+ACall::lift(CEnv& cenv)
+{
+	AFn* c = cenv.tenv.resolve(at(0))->to<AFn*>();
+	AType argsT(loc, NULL);
+
+	// Lift arguments
+	for (size_t i = 1; i < size(); ++i) {
+		at(i)->lift(cenv);
+		argsT.push_back(cenv.type(at(i)));
+	}
+
+	if (!c) return; // Primitive
+
+	if (c->prot()->size() < size() - 1)
+		throw Error(loc, (format("too many arguments to function `%1%'") % at(0)->str()).str());
+	if (c->prot()->size() > size() - 1)
+		throw Error(loc, (format("too few arguments to function `%1%'") % at(0)->str()).str());
+
+	c->liftCall(cenv, argsT); // Lift called closure
+}
+
+CValue
+ACall::compile(CEnv& cenv)
+{
+	AFn* c = cenv.tenv.resolve(at(0))->to<AFn*>();
+
+	if (!c) return NULL; // Primitive
+
+	AType protT(loc, NULL);
+	vector<const Type*> types;
+	for (size_t i = 1; i < size(); ++i) {
+		protT.push_back(cenv.type(at(i)));
+		types.push_back(llType(cenv.type(at(i))));
+	}
+
+	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(c);
+	assert(gt != cenv.tenv.genericTypes.end());
+	AType fnT(loc, cenv.penv.sym("Fn"), &protT, cenv.type(this), 0);
+	Function* f = (Function*)c->impls.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 = 0; i < types.size(); ++i)
+		params[i] = llVal(cenv.compile(at(i+1)));
+
+	return llEngine(cenv)->builder.CreateCall(f, params.begin(), params.end());
+}
+
+void
+ADef::lift(CEnv& cenv)
+{
+	// Define stub first for recursion
+	cenv.def(sym(), at(2), cenv.type(at(2)), NULL);
+	AFn* c = at(2)->to<AFn*>();
+	if (c)
+		c->name = sym()->str();
+	at(2)->lift(cenv);
+}
+
+CValue
+ADef::compile(CEnv& cenv)
+{
+	// Define stub first for recursion
+	cenv.def(sym(), at(2), cenv.type(at(2)), NULL);
+	CValue val = cenv.compile(at(size() - 1));
+	cenv.vals.def(sym(), val);
+	return val;
+}
+
+CValue
+AIf::compile(CEnv& cenv)
+{
+	typedef vector< pair<Value*, BasicBlock*> > Branches;
+	Function*   parent  = llEngine(cenv)->builder.GetInsertBlock()->getParent();
+	BasicBlock* mergeBB = BasicBlock::Create("endif");
+	BasicBlock* nextBB  = NULL;
+	Branches    branches;
+	for (size_t i = 1; i < size() - 1; i += 2) {
+		Value*      condV  = llVal(cenv.compile(at(i)));
+		BasicBlock* thenBB = BasicBlock::Create((format("then%1%") % ((i+1)/2)).str());
+
+		nextBB = BasicBlock::Create((format("else%1%") % ((i+1)/2)).str());
+
+		llEngine(cenv)->builder.CreateCondBr(condV, thenBB, nextBB);
+
+		// Emit then block for this condition
+		parent->getBasicBlockList().push_back(thenBB);
+		llEngine(cenv)->builder.SetInsertPoint(thenBB);
+		Value* thenV = llVal(cenv.compile(at(i+1)));
+		llEngine(cenv)->builder.CreateBr(mergeBB);
+		branches.push_back(make_pair(thenV, llEngine(cenv)->builder.GetInsertBlock()));
+
+		parent->getBasicBlockList().push_back(nextBB);
+		llEngine(cenv)->builder.SetInsertPoint(nextBB);
+	}
+
+	// Emit final else block
+	llEngine(cenv)->builder.SetInsertPoint(nextBB);
+	Value* elseV = llVal(cenv.compile(at(size() - 1)));
+	llEngine(cenv)->builder.CreateBr(mergeBB);
+	branches.push_back(make_pair(elseV, llEngine(cenv)->builder.GetInsertBlock()));
+
+	// Emit merge block (Phi node)
+	parent->getBasicBlockList().push_back(mergeBB);
+	llEngine(cenv)->builder.SetInsertPoint(mergeBB);
+	PHINode* pn = llEngine(cenv)->builder.CreatePHI(llType(cenv.type(this)), "ifval");
+
+	FOREACH(Branches::iterator, i, branches)
+		pn->addIncoming(i->first, i->second);
+
+	return pn;
+}
+
+CValue
+APrimitive::compile(CEnv& cenv)
+{
+	Value*       a       = llVal(cenv.compile(at(1)));
+	Value*       b       = llVal(cenv.compile(at(2)));
+	bool         isFloat = cenv.type(at(1))->str() == "Float";
+	const string n       = at(0)->to<ASymbol*>()->str();
+
+	// Binary arithmetic operations
+	Instruction::BinaryOps op = (Instruction::BinaryOps)0;
+	if (n == "+")   op = Instruction::Add;
+	if (n == "-")   op = Instruction::Sub;
+	if (n == "*")   op = Instruction::Mul;
+	if (n == "and") op = Instruction::And;
+	if (n == "or")  op = Instruction::Or;
+	if (n == "xor") op = Instruction::Xor;
+	if (n == "/")   op = isFloat ? Instruction::FDiv : Instruction::SDiv;
+	if (n == "%")   op = isFloat ? Instruction::FRem : Instruction::SRem;
+	if (op != 0) {
+		Value* val = llEngine(cenv)->builder.CreateBinOp(op, a, b);
+		for (size_t i = 3; i < size(); ++i)
+			val = llEngine(cenv)->builder.CreateBinOp(op, val, llVal(cenv.compile(at(i))));
+		return val;
+	}
+
+	// Comparison operations
+	CmpInst::Predicate pred = (CmpInst::Predicate)0;
+	if (n == "=")  pred = isFloat ? CmpInst::FCMP_OEQ : CmpInst::ICMP_EQ ;
+	if (n == "!=") pred = isFloat ? CmpInst::FCMP_ONE : CmpInst::ICMP_NE ;
+	if (n == ">")  pred = isFloat ? CmpInst::FCMP_OGT : CmpInst::ICMP_SGT;
+	if (n == ">=") pred = isFloat ? CmpInst::FCMP_OGE : CmpInst::ICMP_SGE;
+	if (n == "<")  pred = isFloat ? CmpInst::FCMP_OLT : CmpInst::ICMP_SLT;
+	if (n == "<=") pred = isFloat ? CmpInst::FCMP_OLE : CmpInst::ICMP_SLE;
+	if (pred != 0) {
+		if (isFloat)
+			return llEngine(cenv)->builder.CreateFCmp(pred, a, b);
+		else
+			return llEngine(cenv)->builder.CreateICmp(pred, a, b);
+	}
+
+	throw Error(loc, "unknown primitive");
+}
+
diff --git a/src/tuplr.cpp b/src/tuplr.cpp
new file mode 100644
index 0000000..7dd3e9b
--- /dev/null
+++ b/src/tuplr.cpp
@@ -0,0 +1,471 @@
+/* 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 <cerrno>
+#include <cstring>
+#include <fstream>
+#include <set>
+#include <sstream>
+#include <stack>
+#include "tuplr.hpp"
+
+using namespace std;
+using boost::format;
+
+GC Object::pool;
+
+template<typename Atom>
+ostream&
+operator<<(ostream& out, const Exp<Atom>& exp)
+{
+	switch (exp.type) {
+	case Exp<Atom>::ATOM:
+		out << exp.atom;
+		break;
+	case Exp<Atom>::LIST:
+		out << "(";
+		for (size_t i = 0; i != exp.size(); ++i)
+			out << exp.at(i) << ((i != exp.size() - 1) ? " " : "");
+		out << ")";
+		break;
+	}
+	return out;
+}
+
+
+/***************************************************************************
+ * Lexer                                                                   *
+ ***************************************************************************/
+
+inline int
+readChar(Cursor& cur, istream& in)
+{
+	int ch = in.get();
+	switch (ch) {
+	case '\n': ++cur.line; cur.col = 0; break;
+	default:   ++cur.col;
+	}
+	return ch;
+}
+
+SExp
+readExpression(Cursor& cur, istream& in)
+{
+#define PUSH(s, t)  { if (t != "") { s.top().push_back(SExp(loc, t)); t = ""; } }
+#define YIELD(s, t) { if (s.empty()) { return SExp(loc, t); } else PUSH(s, t) }
+	stack<SExp> stk;
+	string      tok;
+	Cursor      loc; // start of tok
+	while (int c = readChar(cur, in)) {
+		switch (c) {
+		case EOF:
+			THROW_IF(!stk.empty(), cur, "unexpected end of file")
+			return SExp(cur);
+		case ';':
+			while ((c = readChar(cur, in)) != '\n') {}
+		case '\n': case ' ': case '\t':
+			if (tok != "") YIELD(stk, tok);
+			break;
+		case '"':
+			loc = cur;
+			do { tok.push_back(c); } while ((c = readChar(cur, in)) != '"');
+			YIELD(stk, tok + '"');
+			break;
+		case '(':
+			stk.push(SExp(cur));
+			break;
+		case ')':
+			switch (stk.size()) {
+			case 0:
+				throw Error(cur, "unexpected `)'");
+			case 1:
+				PUSH(stk, tok);
+				return stk.top();
+			default:
+				PUSH(stk, tok);
+				SExp l = stk.top();
+				stk.pop();
+				stk.top().push_back(l);
+			}
+			break;
+		case '#':
+			if (in.peek() == '|') {
+				while (!(readChar(cur, in) == '|' && readChar(cur, in) == '#')) {}
+				break;
+			}
+		default:
+			if (tok == "") loc = cur;
+			tok += c;
+		}
+	}
+	switch (stk.size()) {
+	case 0:  return SExp(loc, tok);
+	case 1:  return stk.top();
+	default: throw  Error(cur, "missing `)'");
+	}
+	return SExp(cur);
+}
+
+
+/***************************************************************************
+ * Macro Functions                                                         *
+ ***************************************************************************/
+
+inline SExp
+macDef(PEnv& penv, const SExp& exp)
+{
+	THROW_IF(exp.size() < 3, exp.loc, "[MAC] `def' requires at least 2 arguments")
+	if (exp.at(1).type == SExp::ATOM) {
+		return exp;
+	} else {
+		// (def (f x) y) => (def f (fn (x) y))
+		SExp argsExp(exp.loc);
+		for (size_t i = 1; i < exp.at(1).size(); ++i)
+			argsExp.push_back(exp.at(1).at(i));
+		SExp fnExp(exp.at(2).loc);
+		fnExp.push_back(SExp(exp.at(2).loc, "fn"));
+		fnExp.push_back(argsExp);
+		for (size_t i = 2; i < exp.size(); ++i)
+			fnExp.push_back(exp.at(i));
+		SExp ret(exp.loc);
+		ret.push_back(exp.at(0));
+		ret.push_back(exp.at(1).at(0));
+		ret.push_back(fnExp);
+		return ret;
+	}
+}
+
+
+/***************************************************************************
+ * Parser Functions                                                        *
+ ***************************************************************************/
+
+template<typename C>
+inline AST*
+parseCall(PEnv& penv, const SExp& exp, void* arg)
+{
+	return new C(exp, penv.parseTuple(exp));
+}
+
+template<typename T>
+inline AST*
+parseLiteral(PEnv& penv, const SExp& exp, void* arg)
+{
+	return new ALiteral<T>(*reinterpret_cast<T*>(arg), exp.loc);
+}
+
+inline AST*
+parseFn(PEnv& penv, const SExp& exp, void* arg)
+{
+	if (exp.size() < 2)
+		throw Error(exp.loc, "Missing function parameters and body");
+	else if (exp.size() < 3)
+		throw Error(exp.loc, "Missing function body");
+	SExp::const_iterator a = exp.begin(); ++a;
+	AFn* ret = tup<AFn>(exp.loc, penv.sym("fn"), new ATuple(penv.parseTuple(*a++)), 0);
+	while (a != exp.end())
+		ret->push_back(penv.parse(*a++));
+	return ret;
+}
+
+
+/***************************************************************************
+ * Standard Definitions                                                    *
+ ***************************************************************************/
+
+void
+initLang(PEnv& penv, TEnv& tenv)
+{
+	// Types
+	tenv.def(penv.sym("Nothing"), make_pair((AST*)0, new AType(penv.sym("Nothing"))));
+	tenv.def(penv.sym("Bool"),    make_pair((AST*)0, new AType(penv.sym("Bool"))));
+	tenv.def(penv.sym("Int"),     make_pair((AST*)0, new AType(penv.sym("Int"))));
+	tenv.def(penv.sym("Float"),   make_pair((AST*)0, new AType(penv.sym("Float"))));
+
+	// Literals
+	static bool trueVal  = true;
+	static bool falseVal = false;
+	penv.reg(false, "#t", PEnv::Handler(parseLiteral<bool>, &trueVal));
+	penv.reg(false, "#f", PEnv::Handler(parseLiteral<bool>, &falseVal));
+
+	// Macros
+	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>));
+
+	// Numeric primitives
+	penv.reg(true, "+",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "-",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "*",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "/",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "%",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "and", PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "or",  PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "xor", PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "=",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "!=",  PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, ">",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, ">=",  PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "<",   PEnv::Handler(parseCall<APrimitive>));
+	penv.reg(true, "<=",  PEnv::Handler(parseCall<APrimitive>));
+}
+
+
+/***************************************************************************
+ * EVAL/REPL                                                               *
+ ***************************************************************************/
+
+int
+eval(CEnv& cenv, const string& name, istream& is)
+{
+	AST*   result     = NULL;
+	AType* resultType = NULL;
+	list< pair<SExp, AST*> > exprs;
+	Cursor cursor(name);
+	try {
+		while (true) {
+			SExp exp = readExpression(cursor, is);
+			if (exp.type == SExp::LIST && exp.empty())
+				break;
+
+			result = cenv.penv.parse(exp); // Parse input
+			Constraints c;
+			result->constrain(cenv.tenv, c); // Constrain types
+			cenv.tsubst = Subst::compose(cenv.tsubst, TEnv::unify(c)); // Solve type constraints
+			resultType = cenv.type(result);
+			result->lift(cenv); // Lift functions
+			exprs.push_back(make_pair(exp, result));
+
+			// Add definitions as GC roots
+			if (result->to<ADef*>())
+				cenv.lock(result);
+
+			// Add types in type substition as GC roots
+			for (Subst::iterator i = cenv.tsubst.begin(); i != cenv.tsubst.end(); ++i) {
+				Object::pool.addRoot(i->first);
+				Object::pool.addRoot(i->second);
+			}
+		}
+
+		// Print CPS form
+		CValue val = NULL;
+		/*for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i) {
+			cout << "; CPS" << endl;
+			pprint(cout, i->second->cps(cenv.tenv, cenv.penv.sym("cont")));
+		}*/
+
+		if (resultType->concrete()) {
+			// Create function for top-level of program
+			CFunction f = cenv.engine()->startFunction(cenv, "main", resultType, ATuple(cursor));
+
+			// Compile all expressions into it
+			for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
+				val = cenv.compile(i->second);
+
+			// Finish and call it
+			cenv.engine()->finishFunction(cenv, f, resultType, val);
+			cenv.out << cenv.engine()->call(cenv, f, resultType);
+		}
+		cenv.out << " : " << resultType << endl;
+
+		Object::pool.collect(Object::pool.roots());
+
+		if (cenv.args.find("-d") != cenv.args.end())
+			cenv.engine()->writeModule(cenv, cenv.out);
+
+	} catch (Error& e) {
+		cenv.err << e.what() << endl;
+		return 1;
+	}
+	return 0;
+}
+
+int
+repl(CEnv& cenv)
+{
+	while (1) {
+		cenv.out << "() ";
+		cenv.out.flush();
+		Cursor cursor("(stdin)");
+
+		try {
+			SExp exp = readExpression(cursor, std::cin);
+			if (exp.type == SExp::LIST && exp.empty())
+				break;
+
+			AST* body = cenv.penv.parse(exp); // Parse input
+			Constraints c;
+			body->constrain(cenv.tenv, c); // Constrain types
+
+			Subst oldSubst = cenv.tsubst;
+			cenv.tsubst = Subst::compose(cenv.tsubst, TEnv::unify(c)); // Solve type constraints
+
+			AType* bodyT = cenv.type(body);
+			THROW_IF(!bodyT, cursor, "call to untyped body")
+
+			body->lift(cenv);
+
+			CFunction f = NULL;
+			try {
+				// Create anonymous function to insert code into
+				f = cenv.engine()->startFunction(cenv, cenv.penv.gensymstr("_repl"), bodyT, ATuple(cursor));
+				CValue retVal = cenv.compile(body);
+				cenv.engine()->finishFunction(cenv, f, bodyT, retVal);
+				cenv.out << cenv.engine()->call(cenv, f, bodyT);
+			} catch (Error& e) {
+				ADef* def = body->to<ADef*>();
+				if (def)
+					cenv.out << def->sym();
+				else
+					cenv.out << "?";
+				cenv.engine()->eraseFunction(cenv, f);
+			}
+			cenv.out << " : " << cenv.type(body) << endl;
+
+			// Add definitions as GC roots
+			if (body->to<ADef*>())
+				cenv.lock(body);
+
+			Object::pool.collect(Object::pool.roots());
+
+			cenv.tsubst = oldSubst;
+			if (cenv.args.find("-d") != cenv.args.end())
+				cenv.engine()->writeModule(cenv, cenv.out);
+
+		} catch (Error& e) {
+			cenv.err << e.what() << endl;
+		}
+	}
+	return 0;
+}
+
+
+/***************************************************************************
+ * MAIN                                                                    *
+ ***************************************************************************/
+
+int
+print_usage(char* name, bool error)
+{
+	ostream& os = error ? cerr : cout;
+	os << "Usage: " << name << " [OPTION]... [FILE]..."  << endl;
+	os << "Evaluate and/or compile Tuplr code"           << endl;
+	os << endl;
+	os << "  -h               Display this help and exit"        << endl;
+	os << "  -r               Enter REPL after evaluating files" << endl;
+	os << "  -p               Pretty-print input only"           << endl;
+	os << "  -g               Debug (disable optimisation)"      << endl;
+	os << "  -d               Dump assembly output"              << endl;
+	os << "  -e EXPRESSION    Evaluate EXPRESSION"               << endl;
+	os << "  -o FILE          Write output to FILE"              << endl;
+	return error ? 1 : 0;
+}
+
+int
+main(int argc, char** argv)
+{
+	PEnv penv;
+	TEnv tenv(penv);
+	initLang(penv, tenv);
+
+	Engine* engine = tuplr_new_engine();
+	CEnv*   cenv   = new CEnv(penv, tenv, engine);
+
+	cenv->push();
+	Object::pool.lock();
+
+	map<string,string> args;
+	list<string>       files;
+	for (int i = 1; i < argc; ++i) {
+		if (!strncmp(argv[i], "-h", 3)) {
+			return print_usage(argv[0], false);
+		} else if (argv[i][0] != '-') {
+			files.push_back(argv[i]);
+		} else if (!strncmp(argv[i], "-r", 3)
+				|| !strncmp(argv[i], "-p", 3)
+				|| !strncmp(argv[i], "-g", 3)
+				|| !strncmp(argv[i], "-d", 3)) {
+			args.insert(make_pair(argv[i], ""));
+		} else if (i == argc-1 || argv[i+1][0] == '-') {
+			return print_usage(argv[0], true);
+		} else {
+			args.insert(make_pair(argv[i], argv[i+1]));
+			++i;
+		}
+	}
+
+	cenv->args = args;
+
+	int ret = 0;
+
+	string output;
+	map<string,string>::const_iterator a = args.find("-o");
+	if (a != args.end())
+		output = a->second;
+
+	a = args.find("-p");
+	if (a != args.end()) {
+		ifstream is(files.front().c_str());
+		if (is.good()) {
+			Cursor loc;
+			SExp exp = readExpression(loc, is);
+			AST* ast = penv.parse(exp);
+			pprint(cout, ast);
+		}
+		return 0;
+	}
+
+	a = args.find("-e");
+	if (a != args.end()) {
+		istringstream is(a->second);
+		ret = eval(*cenv, "(command line)", is);
+	}
+
+	for (list<string>::iterator f = files.begin(); f != files.end(); ++f) {
+		ifstream is(f->c_str());
+		if (is.good()) {
+			ret = ret | eval(*cenv, *f, is);
+		} else {
+			cerr << argv[0] << ": " << *f << ": " << strerror(errno) << endl;
+			++ret;
+		}
+		is.close();
+	}
+
+	if (args.find("-r") != args.end() || (files.empty() && args.find("-e") == args.end()))
+		ret = repl(*cenv);
+
+	if (output != "") {
+		ofstream os(output.c_str());
+		if (os.good()) {
+			cenv->engine()->writeModule(*cenv, os);
+		} else {
+			cerr << argv[0] << ": " << a->second << ": " << strerror(errno) << endl;
+			++ret;
+		}
+		os.close();
+	}
+
+	delete cenv;
+	tuplr_free_engine(engine);
+
+	return ret;
+}
+
diff --git a/src/tuplr.hpp b/src/tuplr.hpp
new file mode 100644
index 0000000..5275dfd
--- /dev/null
+++ b/src/tuplr.hpp
@@ -0,0 +1,654 @@
+/* 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/>.
+ */
+
+#ifndef TUPLR_HPP
+#define TUPLR_HPP
+
+#include <stdarg.h>
+#include <iostream>
+#include <list>
+#include <map>
+#include <set>
+#include <sstream>
+#include <string>
+#include <vector>
+#include <boost/format.hpp>
+
+#define FOREACH(IT, i, c) for (IT i = (c).begin(); i != (c).end(); ++i)
+#define THROW_IF(cond, error, ...) { if (cond) throw Error(error, __VA_ARGS__); }
+
+using namespace std;
+using boost::format;
+
+
+/***************************************************************************
+ * Basic Utility Classes                                                   *
+ ***************************************************************************/
+
+/// Location in textual code
+struct Cursor {
+	Cursor(const string& n="", unsigned l=1, unsigned c=0) : name(n), line(l), col(c) {}
+	operator bool() const { return !(line == 1 && col == 0); }
+	string str() const { return (format("%1%:%2%:%3%") % name % line % col).str(); }
+	string   name;
+	unsigned line;
+	unsigned col;
+};
+
+/// Compiler error
+struct Error {
+	Error(Cursor c, const string& m) : loc(c), msg(m) {}
+	const string what() const { return (loc ? loc.str() + ": " : "") + "error: " + msg; }
+	Cursor loc;
+	string msg;
+};
+
+/// Expression ::= Atom | (SubExp*)
+template<typename Atom>
+struct Exp : public std::vector< Exp<Atom> > {
+	Exp(Cursor c)                : type(LIST), loc(c)          {}
+	Exp(Cursor c, const Atom& a) : type(ATOM), loc(c), atom(a) {}
+	enum { ATOM, LIST } type;
+	Cursor              loc;
+	Atom                atom;
+};
+
+template<typename Atom>
+extern ostream& operator<<(ostream& out, const Exp<Atom>& exp);
+
+/// Lexical Address
+struct LAddr {
+	LAddr(unsigned u=0, unsigned o=0) : up(u), over(o) {}
+	operator bool() const { return !(up == 0 && over == 0); }
+	unsigned up, over;
+};
+
+/// Generic Lexical Environment
+template<typename K, typename V>
+struct Env : public list< vector< pair<K,V> > > {
+	typedef vector< pair<K,V> > Frame;
+	Env() : list<Frame>(1) {}
+	virtual void push(Frame f=Frame()) { list<Frame>::push_front(f); }
+	virtual void pop() { assert(!this->empty()); list<Frame>::pop_front(); }
+	const V& def(const K& k, const V& v) {
+		for (typename Frame::iterator b = this->begin()->begin(); b != this->begin()->end(); ++b)
+			if (b->first == k)
+				return (b->second = v);
+		this->front().push_back(make_pair(k, v));
+		return v;
+	}
+	V* ref(const K& key) {
+		for (typename Env::iterator f = this->begin(); f != this->end(); ++f)
+			for (typename Frame::iterator b = f->begin(); b != f->end(); ++b)
+				if (b->first == key)
+					return &b->second;
+		return NULL;
+	}
+	LAddr lookup(const K& key) const {
+		unsigned up = 0;
+		for (typename Env::const_iterator f = this->begin(); f != this->end(); ++f, ++up)
+			for (unsigned over = 0; over < f->size(); ++over)
+				if ((*f)[over].first == key)
+					return LAddr(up + 1, over + 1);
+		return LAddr();
+	}
+	V& deref(LAddr addr) {
+		assert(addr);
+		typename Env::iterator f = this->begin();
+		for (unsigned u = 1; u < addr.up; ++u, ++f) { assert(f != this->end()); }
+		assert(f->size() > addr.over - 1);
+		return (*f)[addr.over - 1].second;
+	}
+};
+
+
+/***************************************************************************
+ * Lexer: Text (istream) -> S-Expressions (SExp)                           *
+ ***************************************************************************/
+
+typedef Exp<string> SExp; ///< Textual S-Expression
+
+SExp readExpression(Cursor& cur, std::istream& in);
+
+
+/***************************************************************************
+ * Backend Types                                                           *
+ ***************************************************************************/
+
+typedef void* CValue;    ///< Compiled value (opaque)
+typedef void* CFunction; ///< Compiled function (opaque)
+
+
+/***************************************************************************
+ * Garbage Collector                                                       *
+ ***************************************************************************/
+
+struct Object; ///< Object (AST nodes and runtime data)
+
+struct GC {
+	enum Tag {
+		TAG_AST   = 2, ///< Abstract syntax tree node
+		TAG_FRAME = 4  ///< Stack frame
+	};
+	typedef std::list<const Object*> Roots;
+	typedef std::list<Object*>       Heap;
+	void* alloc(size_t size, Tag tag);
+	void  collect(const Roots& roots);
+	void  addRoot(const Object* obj) { if (obj) _roots.push_back(obj); }
+	void  lock() { _roots.insert(_roots.end(), _heap.begin(), _heap.end()); }
+	const Roots& roots() const { return _roots; }
+private:
+	Heap   _heap;
+	Roots  _roots;
+};
+
+/// Dynamic (garbage-collected) object
+struct Object {
+	struct Header {
+		uint8_t mark;
+		uint8_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 bool    marked()     const { return header()->mark != 0; }
+	inline void    mark(bool b) const { header()->mark = 1; }
+	inline GC::Tag tag()        const { return (GC::Tag)header()->tag; }
+
+	static void* operator new(size_t size) { return pool.alloc(size, GC::TAG_AST); }
+	static void  operator delete(void* ptr) {}
+	static GC pool;
+};
+
+
+/***************************************************************************
+ * Abstract Syntax Tree                                                    *
+ ***************************************************************************/
+
+struct Constraint;  ///< Type Constraint
+struct TEnv;        ///< Type-Time Environment
+struct Constraints; ///< Type Constraints
+struct Subst;       ///< Type substitutions
+struct CEnv;        ///< Compile-Time Environment
+
+struct AST;
+extern ostream& operator<<(ostream& out, const AST* ast);
+
+/// Base class for all AST nodes
+struct AST : public Object {
+	AST(Cursor c=Cursor()) : loc(c) {}
+	virtual ~AST() {}
+	virtual bool   value() const { return true; }
+	virtual bool   operator==(const AST& o) const = 0;
+	virtual bool   contains(const AST* child) const { return false; }
+	virtual void   constrain(TEnv& tenv, Constraints& c) const {}
+	virtual AST*   cps(TEnv& tenv, AST* cont);
+	virtual void   lift(CEnv& cenv) {}
+	virtual CValue compile(CEnv& cenv) = 0;
+	string str() const { ostringstream ss; ss << this; return ss.str(); }
+	template<typename T> T to()       { return dynamic_cast<T>(this); }
+	template<typename T> T to() const { return dynamic_cast<T>(this); }
+	template<typename T> T as() {
+		T t = dynamic_cast<T>(this);
+		if (!t) throw Error(loc, "internal error: bad cast");
+		return t;
+	}
+	Cursor loc;
+};
+
+template<typename T>
+static T* tup(Cursor c, AST* ast, ...)
+{
+	va_list args;
+	va_start(args, ast);
+	T* ret = new T(c, ast, args);
+	va_end(args);
+	return ret;
+}
+
+/// Literal value
+template<typename VT>
+struct ALiteral : public AST {
+	ALiteral(VT v, Cursor c) : AST(c), val(v) {}
+	bool operator==(const AST& rhs) const {
+		const ALiteral<VT>* r = rhs.to<const ALiteral<VT>*>();
+		return (r && (val == r->val));
+	}
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	CValue compile(CEnv& cenv);
+	const VT val;
+};
+
+/// Symbol, e.g. "a"
+struct ASymbol : public AST {
+	bool   operator==(const AST& rhs) const { return this == &rhs; }
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	CValue compile(CEnv& cenv);
+	mutable LAddr  addr;
+	const   string cppstr;
+private:
+	friend class PEnv;
+	ASymbol(const string& s, Cursor c) : AST(c), cppstr(s) {}
+};
+
+/// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)"
+struct ATuple : public AST, public vector<AST*> {
+	ATuple(Cursor c, const vector<AST*>& v=vector<AST*>()) : AST(c), vector<AST*>(v) {}
+	ATuple(Cursor c, AST* ast, va_list args) : AST(c) {
+		if (!ast) return;
+		push_back(ast);
+		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
+			push_back(a);
+	}
+	bool value() const { return false; }
+	bool operator==(const AST& rhs) const {
+		const ATuple* rt = rhs.to<const ATuple*>();
+		if (!rt || rt->size() != size()) return false;
+		const_iterator l = begin();
+		FOREACH(const_iterator, r, *rt)
+			if (!(*(*l++) == *(*r)))
+				return false;
+		return true;
+	}
+	bool contains(AST* child) const {
+		if (*this == *child) return true;
+		FOREACH(const_iterator, p, *this)
+			if (**p == *child || (*p)->contains(child))
+				return true;
+		return false;
+	}
+	void constrain(TEnv& tenv, Constraints& c) const;
+	void lift(CEnv& cenv) { FOREACH(iterator, t, *this) (*t)->lift(cenv); }
+
+	CValue compile(CEnv& cenv) { throw Error(loc, "tuple compiled"); }
+};
+
+/// Type Expression, e.g. "Int", "(Fn (Int Int) Float)"
+struct AType : public ATuple {
+	AType(ASymbol* s) : ATuple(s->loc), kind(PRIM), id(0) { push_back(s); }
+	AType(Cursor c, unsigned i, LAddr a) : ATuple(c), kind(VAR), id(i) {}
+	AType(Cursor c, AST* ast, ...) : ATuple(c), kind(EXPR), id(0) {
+		if (!ast) return;
+		va_list args;
+		va_start(args, ast);
+		push_back(ast);
+		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
+			push_back(a);
+		va_end(args);
+	}
+	AType(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args), kind(EXPR), id(0) {}
+	CValue compile(CEnv& cenv) { return NULL; }
+	bool   var() const { return kind == VAR; }
+	bool concrete() const {
+		switch (kind) {
+		case VAR:  return false;
+		case PRIM: return at(0)->str() != "Nothing";
+		case EXPR:
+			FOREACH(const_iterator, t, *this) {
+				AType* kid = (*t)->to<AType*>();
+				if (kid && !kid->concrete())
+					return false;
+			}
+		}
+		return true;
+	}
+	bool operator==(const AST& rhs) const {
+		const AType* rt = rhs.to<const AType*>();
+		if (!rt || kind != rt->kind)
+			return false;
+		else
+			switch (kind) {
+			case VAR:  return id == rt->id;
+			case PRIM: return at(0)->str() == rt->at(0)->str();
+			case EXPR: return ATuple::operator==(rhs);
+			}
+		return false; // never reached
+	}
+	enum { VAR, PRIM, EXPR } kind;
+	unsigned                 id;
+};
+
+/// Type substitution
+struct Subst : public list< pair<const AType*,AType*> > {
+	Subst(AType* s=0, AType* t=0) { if (s && t) { assert(s != t); push_back(make_pair(s, t)); } }
+	static Subst compose(const Subst& delta, const Subst& gamma);
+	void add(const AType* from, AType* to) { push_back(make_pair(from, to)); }
+	const_iterator find(const AType* t) const {
+		for (const_iterator j = begin(); j != end(); ++j)
+			if (*j->first == *t)
+				return j;
+		return end();
+	}
+	AST* apply(AST* ast) const {
+		AType* in = ast->to<AType*>();
+		if (!in) return ast;
+		if (in->kind == AType::EXPR) {
+			AType* out = tup<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()) {
+				AST*   out  = i->second;
+				AType* outT = out->to<AType*>();
+				if (outT && outT->kind == AType::EXPR && !outT->concrete())
+					out = apply(out);
+				return out;
+			} else {
+				return in;
+			}
+		}
+	}
+};
+
+inline ostream& operator<<(ostream& out, const Subst& s) {
+	for (Subst::const_iterator i = s.begin(); i != s.end(); ++i)
+		out << i->first << " => " << i->second << endl;
+	return out;
+}
+
+/// Fn (first-class function with captured lexical bindings)
+struct AFn : public ATuple {
+	AFn(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {}
+	bool    operator==(const AST& rhs) const { return this == &rhs; }
+	void    constrain(TEnv& tenv, Constraints& c) const;
+	AST*    cps(TEnv& tenv, AST* cont);
+	void    lift(CEnv& cenv);
+	void    liftCall(CEnv& cenv, const AType& argsT);
+	CValue  compile(CEnv& cenv);
+	ATuple* prot() const { return at(1)->to<ATuple*>(); }
+	/// System level implementations of this (polymorphic) fn
+	struct Impls : public list< pair<AType*, CFunction> > {
+		CFunction find(AType* type) const {
+			for (const_iterator f = begin(); f != end(); ++f)
+				if (*f->first == *type)
+					return f->second;
+			return NULL;
+		}
+	};
+	Impls         impls;
+	mutable Subst subst;
+	string        name;
+};
+
+/// Function call/application, e.g. "(func arg1 arg2)"
+struct ACall : public ATuple {
+	ACall(const SExp& e, const ATuple& t) : ATuple(e.loc, t) {}
+	ACall(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {}
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	AST*   cps(TEnv& tenv, AST* cont);
+	void   lift(CEnv& cenv);
+	CValue compile(CEnv& cenv);
+};
+
+/// Definition special form, e.g. "(def x 2)"
+struct ADef : public ACall {
+	ADef(const SExp& e, const ATuple& t) : ACall(e, t) {}
+	ADef(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
+	ASymbol* sym() const {
+		ASymbol* sym = at(1)->to<ASymbol*>();
+		if (!sym) {
+			ATuple* tup = at(1)->to<ATuple*>();
+			if (tup && !tup->empty())
+				return tup->at(0)->to<ASymbol*>();
+		}
+		return sym;
+	}
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	AST*   cps(TEnv& tenv, AST* cont);
+	void   lift(CEnv& cenv);
+	CValue compile(CEnv& cenv);
+};
+
+/// Conditional special form, e.g. "(if cond thenexp elseexp)"
+struct AIf : public ACall {
+	AIf(const SExp& e, const ATuple& t) : ACall(e, t) {}
+	AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	AST*   cps(TEnv& tenv, AST* cont);
+	CValue compile(CEnv& cenv);
+};
+
+/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
+struct APrimitive : public ACall {
+	APrimitive(const SExp& e, const ATuple& t) : ACall(e, t) {}
+	bool value() const {
+		for (size_t i = 1; i < size(); ++i)
+			if (!at(i)->value())
+				return false;;
+		return true;
+	}
+	void   constrain(TEnv& tenv, Constraints& c) const;
+	AST*   cps(TEnv& tenv, AST* cont);
+	CValue compile(CEnv& cenv);
+};
+
+
+/***************************************************************************
+ * Parser: S-Expressions (SExp) -> AST Nodes (AST)                         *
+ ***************************************************************************/
+
+/// Parse Time Environment (really just a symbol table)
+struct PEnv : private map<const string, ASymbol*> {
+	PEnv() : symID(0) {}
+	typedef AST* (*PF)(PEnv&, const SExp&, void*); ///< Parse Function
+	typedef SExp (*MF)(PEnv&, const SExp&); ///< Macro Function
+	struct Handler { Handler(PF f, void* a=0) : func(f), arg(a) {} PF func; void* arg; };
+	map<const string, Handler> aHandlers; ///< Atom parse functions
+	map<const string, Handler> lHandlers; ///< List parse functions
+	map<const string, MF>      macros; ///< Macro functions
+	void reg(bool list, const string& s, const Handler& h) {
+		(list ? lHandlers : aHandlers).insert(make_pair(sym(s)->str(), h));
+	}
+	const Handler* handler(bool list, const string& s) const {
+		const map<const string, Handler>& handlers = list ? lHandlers : aHandlers;
+		map<string, Handler>::const_iterator i = handlers.find(s);
+		return (i != handlers.end()) ? &i->second : NULL;
+	}
+	void defmac(const string& s, const MF f) {
+		macros.insert(make_pair(s, f));
+	}
+	MF mac(const string& s) const {
+		map<string, MF>::const_iterator i = macros.find(s);
+		return (i != macros.end()) ? i->second : NULL;
+	}
+	string gensymstr(const char* s="_") { return (format("%s%d") % s % symID++).str(); }
+	ASymbol* gensym(const char* s="_") { return sym(gensymstr(s)); }
+	ASymbol* sym(const string& s, Cursor c=Cursor()) {
+		const const_iterator i = find(s);
+		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()));
+		size_t n = 0;
+		FOREACH(SExp::const_iterator, i, e)
+			ret[n++] = parse(*i);
+		return ret;
+	}
+	AST* parse(const SExp& exp) {
+		if (exp.type == SExp::LIST) {
+			if (exp.empty()) throw Error(exp.loc, "call to empty list");
+			if (exp.front().type == SExp::ATOM) {
+				MF mf = mac(exp.front().atom);
+				SExp expanded = (mf ? mf(*this, exp) : exp);
+
+				const PEnv::Handler* h = handler(true, expanded.front().atom);
+				if (h)
+					return h->func(*this, expanded, h->arg);
+			}
+			return new ACall(exp, parseTuple(exp)); // Parse as regular call
+		} else if (isdigit(exp.atom[0])) {
+			if (exp.atom.find('.') == string::npos)
+				return new ALiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10), exp.loc);
+			else
+				return new ALiteral<float>(strtod(exp.atom.c_str(), NULL), exp.loc);
+		} else {
+			const PEnv::Handler* h = handler(false, exp.atom);
+			if (h)
+				return h->func(*this, exp, h->arg);
+		}
+		return sym(exp.atom, exp.loc);
+	}
+	unsigned symID;
+};
+
+
+/***************************************************************************
+ * Typing                                                                  *
+ ***************************************************************************/
+
+struct Constraint : public pair<AType*,AType*> {
+	Constraint(AType* a, AType* b, Cursor c) : pair<AType*,AType*>(a, b), loc(c) {}
+	Cursor loc;
+};
+
+struct Constraints : public list<Constraint> {
+	void constrain(TEnv& tenv, const AST* o, AType* t);
+};
+
+inline ostream& operator<<(ostream& out, const Constraints& c) {
+	for (Constraints::const_iterator i = c.begin(); i != c.end(); ++i)
+		out << i->first << " : " << i->second << endl;
+	return out;
+}
+
+/// Type-Time Environment
+struct TEnv : public Env< const ASymbol*, pair<AST*, AType*> > {
+	TEnv(PEnv& p) : penv(p), varID(1) {}
+	AType* fresh(const ASymbol* sym) {
+		assert(sym);
+		AType* ret = new AType(sym->loc, varID++, LAddr());
+		def(sym, make_pair((AST*)NULL, ret));
+		return ret;
+	}
+	AType* var(const AST* ast=0) {
+		const ASymbol* sym = ast->to<const ASymbol*>();
+		if (sym)
+			return deref(lookup(sym)).second;
+
+		Vars::iterator v = vars.find(ast);
+		if (v != vars.end())
+			return v->second;
+
+		AType* ret = new AType(ast ? ast->loc : Cursor(), varID++, LAddr());
+		if (ast)
+			vars[ast] = ret;
+
+		return ret;
+	}
+	AType* named(const string& name) {
+		return ref(penv.sym(name))->second;
+	}
+	AST* resolve(AST* ast) {
+		ASymbol* sym = ast->to<ASymbol*>();
+		return (sym && sym->addr) ? ref(sym)->first : ast;
+	}
+
+	static Subst unify(const Constraints& c);
+
+	typedef map<const AST*, AType*>       Vars;
+	typedef map<const AFn*, const AType*> GenericTypes;
+	Vars         vars;
+	GenericTypes genericTypes;
+	PEnv&        penv;
+	unsigned     varID;
+};
+
+
+/***************************************************************************
+ * Code Generation                                                         *
+ ***************************************************************************/
+
+struct Engine {
+	virtual CFunction startFunction(CEnv& cenv, const std::string& name,
+			const AType* retT, const ATuple& argsT,
+			const vector<string> argNames=vector<string>()) = 0;
+
+	virtual void finishFunction(CEnv& cenv, CFunction f, const AType* retT, CValue ret) = 0;
+	virtual void eraseFunction(CEnv& cenv, CFunction f)                                 = 0;
+	virtual void writeModule(CEnv& cenv, std::ostream& os)                              = 0;
+
+	virtual const string call(CEnv& cenv, CFunction f, AType* retT) = 0;
+};
+
+Engine* tuplr_new_engine();
+void    tuplr_free_engine(Engine* engine);
+
+/// Compile-Time Environment
+struct CEnv {
+	CEnv(PEnv& p, TEnv& t, Engine* e, ostream& os=std::cout, ostream& es=std::cerr)
+		: out(os), err(es), penv(p), tenv(t), _engine(e)
+	{}
+
+	~CEnv() { Object::pool.collect(GC::Roots()); }
+
+	typedef Env<const AST*, CValue> Vals;
+
+	Engine* engine() { return _engine; }
+	void    push() { tenv.push(); vals.push(); }
+	void    pop()  { tenv.pop();  vals.pop();  }
+	void    precompile(AST* obj, CValue value) { vals.def(obj, value); }
+	CValue  compile(AST* obj) {
+		CValue* v = vals.ref(obj);
+		return (v && *v) ? *v : vals.def(obj, obj->compile(*this));
+	}
+	void    lock(AST* ast) { Object::pool.addRoot(ast); Object::pool.addRoot(type(ast)); }
+	AType*  type(AST* ast, const Subst& subst = Subst()) const {
+		ASymbol* sym = ast->to<ASymbol*>();
+		if (sym)
+			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) {
+		tenv.def(sym, make_pair(c, t));
+		vals.def(sym, v);
+	}
+
+	ostream&  out;
+	ostream&  err;
+	PEnv&     penv;
+	TEnv&     tenv;
+	Vals      vals;
+
+	Subst     tsubst;
+
+	map<string,string> args;
+
+private:
+	Engine* _engine;
+};
+
+
+/***************************************************************************
+ * EVAL/REPL/MAIN                                                          *
+ ***************************************************************************/
+
+void  pprint(std::ostream& out, const AST* ast);
+void  initLang(PEnv& penv, TEnv& tenv);
+int   eval(CEnv& cenv, const string& name, istream& is);
+int   repl(CEnv& cenv);
+
+#endif // TUPLR_HPP
+
diff --git a/src/typing.cpp b/src/typing.cpp
new file mode 100644
index 0000000..5791fdc
--- /dev/null
+++ b/src/typing.cpp
@@ -0,0 +1,232 @@
+/* Tuplr Type Inferencing
+ * 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 "tuplr.hpp"
+
+void
+Constraints::constrain(TEnv& tenv, const AST* o, AType* t)
+{
+	assert(!o->to<const AType*>());
+	push_back(Constraint(tenv.var(o), t, o->loc));
+}
+
+
+/***************************************************************************
+ * AST Type Constraints                                                    *
+ ***************************************************************************/
+
+void
+ASymbol::constrain(TEnv& tenv, Constraints& c) const
+{
+	addr = tenv.lookup(this);
+	if (!addr)
+		throw Error(loc, (format("undefined symbol `%1%'") % cppstr).str());
+	c.push_back(Constraint(tenv.var(this), tenv.deref(addr).second, loc));
+}
+
+void
+ATuple::constrain(TEnv& tenv, Constraints& c) const
+{
+	AType* t = tup<AType>(loc, NULL);
+	FOREACH(const_iterator, p, *this) {
+		(*p)->constrain(tenv, c);
+		t->push_back(tenv.var(*p));
+	}
+	c.push_back(Constraint(tenv.var(this), t, loc));
+}
+
+void
+AFn::constrain(TEnv& tenv, Constraints& c) const
+{
+	const AType* genericType;
+	TEnv::GenericTypes::const_iterator gt = tenv.genericTypes.find(this);
+	if (gt != tenv.genericTypes.end()) {
+		genericType = gt->second;
+	} else {
+		set<ASymbol*> defined;
+		TEnv::Frame frame;
+
+		// Add parameters to environment frame
+		for (size_t i = 0; i < prot()->size(); ++i) {
+			ASymbol* sym = prot()->at(i)->to<ASymbol*>();
+			if (!sym)
+				throw Error(prot()->at(i)->loc, "parameter name is not a symbol");
+			if (defined.find(sym) != defined.end())
+				throw Error(sym->loc, (format("duplicate parameter `%1%'") % sym->str()).str());
+			defined.insert(sym);
+			frame.push_back(make_pair(sym, make_pair((AST*)NULL, (AType*)NULL)));
+		}
+
+		// Add internal definitions to environment frame
+		size_t e = 2;
+		for (; e < size(); ++e) {
+			AST*         exp = at(e);
+			ADef* def = exp->to<ADef*>();
+			if (def) {
+				ASymbol* sym = def->sym();
+				if (defined.find(sym) != defined.end())
+					throw Error(def->loc, (format("`%1%' defined twice") % sym->str()).str());
+				defined.insert(def->sym());
+				frame.push_back(make_pair(def->sym(), make_pair(def->at(2), (AType*)NULL)));
+			}
+		}
+
+		tenv.push(frame);
+
+		Constraints cp;
+		cp.push_back(Constraint(tenv.var(this), tenv.var(), loc));
+
+		AType* protT = tup<AType>(loc, NULL);
+		for (size_t i = 0; i < prot()->size(); ++i) {
+			AType* tvar = tenv.fresh(prot()->at(i)->to<ASymbol*>());
+			protT->push_back(tvar);
+			assert(frame[i].first == prot()->at(i));
+			frame[i].second.first = prot()->at(i);
+			frame[i].second.second = tvar;
+		}
+		c.push_back(Constraint(tenv.var(at(1)), protT, at(1)->loc));
+
+		for (size_t i = 2; i < size(); ++i)
+			at(i)->constrain(tenv, cp);
+
+		AType* bodyT = tenv.var(at(e-1));
+		Subst tsubst = TEnv::unify(cp);
+		genericType = tup<AType>(loc, tenv.penv.sym("Fn"),
+				tsubst.apply(protT), tsubst.apply(bodyT), 0);
+		tenv.genericTypes.insert(make_pair(this, genericType));
+		Object::pool.addRoot(genericType);
+
+		tenv.pop();
+		subst = tsubst;
+	}
+
+	AType* t = new AType(*genericType); // FIXME: deep copy
+	c.constrain(tenv, this, t);
+}
+
+void
+ACall::constrain(TEnv& tenv, Constraints& c) const
+{
+	at(0)->constrain(tenv, c);
+	for (size_t i = 1; i < size(); ++i)
+		at(i)->constrain(tenv, c);
+
+	AST* callee  = tenv.resolve(at(0));
+	AFn* closure = callee->to<AFn*>();
+	if (closure) {
+		if (size() - 1 != closure->prot()->size())
+			throw Error(loc, "incorrect number of arguments");
+		TEnv::GenericTypes::iterator gt = tenv.genericTypes.find(closure);
+		if (gt != tenv.genericTypes.end()) {
+			for (size_t i = 1; i < size(); ++i)
+				c.constrain(tenv, at(i), gt->second->at(1)->as<ATuple*>()->at(i-1)->as<AType*>());
+			AType* retT = tenv.var(this);
+			c.constrain(tenv, at(0), tup<AType>(at(0)->loc, tenv.penv.sym("Fn"), tenv.var(), retT, 0));
+			c.constrain(tenv, this, retT);
+			return;
+		}
+	}
+	AType* argsT = tup<AType>(loc, 0);
+	for (size_t i = 1; i < size(); ++i)
+		argsT->push_back(tenv.var(at(i)));
+	AType* retT = tenv.var();
+	c.constrain(tenv, at(0), tup<AType>(at(0)->loc, tenv.penv.sym("Fn"), argsT, retT, 0));
+	c.constrain(tenv, this, retT);
+}
+
+void
+ADef::constrain(TEnv& tenv, Constraints& c) const
+{
+	THROW_IF(size() != 3, loc, "`def' requires exactly 2 arguments");
+	const ASymbol* sym = this->sym();
+	THROW_IF(!sym, loc, "`def' has no symbol")
+
+	AType* tvar = tenv.var(at(2));
+	tenv.def(sym, make_pair(at(2), tvar));
+	at(2)->constrain(tenv, c);
+	c.constrain(tenv, this, tvar);
+}
+
+void
+AIf::constrain(TEnv& tenv, Constraints& c) const
+{
+	THROW_IF(size() < 4, loc, "`if' requires at least 3 arguments");
+	THROW_IF(size() % 2 != 0, loc, "`if' missing final else clause")
+	for (size_t i = 1; i < size(); ++i)
+		at(i)->constrain(tenv, c);
+	AType* retT = tenv.var(this);
+	for (size_t i = 1; i < size(); i += 2) {
+		if (i == size() - 1) {
+			c.constrain(tenv, at(i), retT);
+		} else {
+			c.constrain(tenv, at(i), tenv.named("Bool"));
+			c.constrain(tenv, at(i+1), retT);
+		}
+	}
+}
+
+void
+APrimitive::constrain(TEnv& tenv, Constraints& c) const
+{
+	const string n = at(0)->to<ASymbol*>()->str();
+	enum { ARITHMETIC, BINARY, LOGICAL, COMPARISON } type;
+	if (n == "+" || n == "-" || n == "*" || n == "/")
+		type = ARITHMETIC;
+	else if (n == "%")
+		type = BINARY;
+	else if (n == "and" || n == "or" || n == "xor")
+		type = LOGICAL;
+	else if (n == "=" || n == "!=" || n == ">" || n == ">=" || n == "<" || n == "<=")
+		type = COMPARISON;
+	else
+		throw Error(loc, (format("unknown primitive `%1%'") % n).str());
+
+	for (size_t i = 1; i < size(); ++i)
+		at(i)->constrain(tenv, c);
+
+	switch (type) {
+	case ARITHMETIC:
+		if (size() < 3)
+			throw Error(loc, (format("`%1%' requires at least 2 arguments") % n).str());
+		for (size_t i = 1; i < size(); ++i)
+			c.constrain(tenv, at(i), tenv.var(this));
+		break;
+	case BINARY:
+		if (size() != 3)
+			throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+		c.constrain(tenv, at(1), tenv.var(this));
+		c.constrain(tenv, at(2), tenv.var(this));
+		break;
+	case LOGICAL:
+		if (size() != 3)
+			throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+		c.constrain(tenv, this,  tenv.named("Bool"));
+		c.constrain(tenv, at(1), tenv.named("Bool"));
+		c.constrain(tenv, at(2), tenv.named("Bool"));
+		break;
+	case COMPARISON:
+		if (size() != 3)
+			throw Error(loc, (format("`%1%' requires exactly 2 arguments") % n).str());
+		c.constrain(tenv, this, tenv.named("Bool"));
+		c.constrain(tenv, at(1), tenv.var(at(2)));
+		break;
+	default:
+		throw Error(loc, (format("unknown primitive `%1%'") % n).str());
+	}
+}
+
diff --git a/src/unify.cpp b/src/unify.cpp
new file mode 100644
index 0000000..2a8e6a0
--- /dev/null
+++ b/src/unify.cpp
@@ -0,0 +1,94 @@
+/* Tuplr Unification
+ * 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 "tuplr.hpp"
+
+/***************************************************************************
+ * Type Inference/Substitution                                             *
+ ***************************************************************************/
+
+static void
+substitute(ATuple* tup, const AST* from, AST* to)
+{
+	if (!tup) return;
+	for (size_t i = 0; i < tup->size(); ++i)
+		if (*tup->at(i) == *from)
+			tup->at(i) = to;
+		else if (tup->at(i) != to)
+			substitute(tup->at(i)->to<ATuple*>(), from, to);
+}
+
+Subst
+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);
+		r.add(g->first, ((d != delta.end()) ? d : g)->second);
+	}
+	for (Subst::const_iterator d = delta.begin(); d != delta.end(); ++d) {
+		if (gamma.find(d->first) == gamma.end())
+			r.add(d->first, d->second);
+	}
+	return r;
+}
+
+void
+substConstraints(Constraints& constraints, AType* s, AType* t)
+{
+	for (Constraints::iterator c = constraints.begin(); c != constraints.end();) {
+		Constraints::iterator next = c; ++next;
+		if (*c->first  == *s) c->first  = t;
+		if (*c->second == *s) c->second = t;
+		substitute(c->first, s, t);
+		substitute(c->second, s, t);
+		c = next;
+	}
+}
+
+Subst
+TEnv::unify(const Constraints& constraints) // TAPL 22.4
+{
+	if (constraints.empty()) return Subst();
+	AType*      s  = constraints.begin()->first;
+	AType*      t  = constraints.begin()->second;
+	Constraints cp = constraints;
+	cp.erase(cp.begin());
+
+	if (*s == *t) {
+		return unify(cp);
+	} else if (s->var() && !t->contains(s)) {
+		substConstraints(cp, s, t);
+		return Subst::compose(unify(cp), Subst(s, t));
+	} else if (t->var() && !s->contains(t)) {
+		substConstraints(cp, t, s);
+		return Subst::compose(unify(cp), Subst(t, s));
+	} else if (s->kind == AType::EXPR && s->kind == t->kind && s->size() == t->size()) {
+		for (size_t i = 0; i < s->size(); ++i) {
+			AType* si = s->at(i)->to<AType*>();
+			AType* ti = t->at(i)->to<AType*>();
+			if (si && ti)
+				cp.push_back(Constraint(si, ti, si->loc));
+		}
+		return unify(cp);
+	} else {
+		throw Error(s->loc ? s->loc : t->loc,
+				(format("type is `%1%' but should be `%2%'") % s->str() % t->str()).str());
+	}
+}
+
diff --git a/src/write.cpp b/src/write.cpp
new file mode 100644
index 0000000..04e3401
--- /dev/null
+++ b/src/write.cpp
@@ -0,0 +1,97 @@
+/* Tuplr Serialisation
+ * 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 "tuplr.hpp"
+
+ostream&
+operator<<(ostream& out, const AST* ast)
+{
+	const ALiteral<float>* flit = ast->to<const ALiteral<float>*>();
+	if (flit)
+		return out << showpoint << flit->val;
+
+	const ALiteral<int32_t>* ilit = ast->to<const ALiteral<int32_t>*>();
+	if (ilit)
+		return out << ilit->val;
+
+	const ALiteral<bool>* blit = ast->to<const ALiteral<bool>*>();
+	if (blit)
+		return out << (blit->val ? "#t" : "#f");
+
+	const ASymbol* sym = ast->to<const ASymbol*>();
+	if (sym)
+		return out << sym->cppstr;
+
+	const AType* type = ast->to<const AType*>();
+	if (type) {
+		switch (type->kind) {
+		case AType::VAR:  return out << "?" << type->id;
+		case AType::PRIM: return out << type->at(0);
+		case AType::EXPR: break; // will catch Tuple case below
+		}
+	 }
+
+	const ATuple* tup = ast->to<const ATuple*>();
+	if (tup) {
+		out << "(";
+		for (size_t i = 0; i != tup->size(); ++i)
+			out << tup->at(i) << ((i != tup->size() - 1) ? " " : "");
+		return out << ")";
+	}
+
+	return out << "?";
+}
+
+void
+pprint_internal(ostream& out, const AST* ast, unsigned indent)
+{
+	const ATuple* tup = ast->to<const ATuple*>();
+	if (tup && tup->size() > 0) {
+		const string head = tup->at(0)->str();
+		ASymbol* headSym = tup->at(0)->to<ASymbol*>();
+		out << "(";
+		pprint_internal(out, tup->at(0), indent);
+		unsigned child_indent = indent;
+		if (tup->size() > 1) {
+			out << " ";
+			if (headSym && headSym->cppstr == "fn") {
+				out << tup->at(1);
+				child_indent = indent + 4;
+			} else {
+				child_indent += head.length() + 1;
+				pprint_internal(out, tup->at(1), child_indent);
+			}
+		}
+		for (size_t i = 2; i < tup->size(); ++i) {
+			out << endl << string().insert(0, child_indent, ' ');
+			pprint_internal(out, tup->at(i), child_indent);
+		}
+		out << ")";
+		if (headSym && headSym->cppstr == "fn")
+			out << endl << string().insert(0, indent + 4, ' ');
+	} else {
+		out << ast;
+	}
+}
+
+void
+pprint(ostream& out, const AST* ast)
+{
+	pprint_internal(out, ast, 0);
+	out << endl;
+}
+