Split LLVM dependent backend from core code.

No more pretty little one filer.  Oh well.


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

6 files changed, 1351 insertions, 1182 deletions

diff --git a/build.sh b/build.sh
index 9009753..66fc830 100755
--- a/build.sh
+++ b/build.sh
@@ -1,5 +1,5 @@
 #!/bin/sh
 CXXFLAGS="-O0 -g -Wall -Wextra -Wno-unused-parameter"
 
-g++ $CXXFLAGS tuplr.cpp `llvm-config --cppflags --ldflags --libs core jit native` -lm -o tuplr
+g++ $CXXFLAGS tuplr.cpp typing.cpp tuplr_llvm.cpp `llvm-config --cppflags --ldflags --libs core jit native` -lm -o tuplr
 
diff --git a/tuplr.cpp b/tuplr.cpp
index fc7b36c..24bfea7 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -1,4 +1,4 @@
-/* Tuplr: A minimalist programming language
+/* 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
@@ -15,70 +15,25 @@
  * along with Tuplr.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <stdarg.h>
-#include <fstream>
-#include <iostream>
-#include <list>
-#include <map>
-#include <sstream>
 #include <stack>
-#include <string>
-#include <vector>
-#include <boost/format.hpp>
-#include "llvm/Analysis/Verifier.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"
 
 #define FOREACH(IT, i, c) for (IT i = (c).begin(); i != (c).end(); ++i)
 
-using namespace llvm;
 using namespace std;
+using namespace llvm;
 using boost::format;
 
+Funcs ASTConsCall::funcs;
+
 std::ostream& err = std::cerr;
 std::ostream& out = std::cout;
 
-struct Cursor {
-	Cursor(const string& n="", unsigned l=1, unsigned c=0) : name(n), line(l), col(c) {}
-	string str() const { return (format("%1%:%2%:%3%") % name % line % col).str(); }
-	string   name;
-	unsigned line;
-	unsigned col;
-};
-
-struct Error {
-	Error(const string& m, Cursor c=Cursor()) : msg(m), loc(c) {}
-	const string what() const throw() { return loc.str() + ": error: " + msg; }
-	string msg;
-	Cursor loc;
-};
-
-template<typename Atom>
-struct Exp { // ::= Atom | (Exp*)
-	Exp(Cursor c)                : type(LIST), loc(c)          {}
-	Exp(Cursor c, const Atom& a) : type(ATOM), loc(c), atom(a) {}
-	typedef std::vector< Exp<Atom> > List;
-	enum { ATOM, LIST } type;
-	Cursor loc;
-	Atom   atom;
-	List   list;
-};
-
-
 /***************************************************************************
  * S-Expression Lexer :: text -> S-Expressions (SExp)                      *
  ***************************************************************************/
 
-typedef Exp<string> SExp;
-
-static SExp
+SExp
 readExpression(Cursor& cur, std::istream& in)
 {
 #define PUSH(s, t)  { if (t != "") { s.top().list.push_back(SExp(loc, t)); t = ""; } }
@@ -134,1133 +89,3 @@ readExpression(Cursor& cur, std::istream& in)
 	return SExp(cur);
 }
 
-
-/***************************************************************************
- * Abstract Syntax Tree                                                    *
- ***************************************************************************/
-
-struct TEnv;  ///< Type-Time Environment
-struct CEnv;  ///< Compile-Time Environment
-
-/// Constructor user data argument (LLVM opcode)
-struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
-
-/// Base class for all AST nodes
-struct AST {
-	virtual ~AST() {}
-	virtual bool   contains(AST* child)     const { return false; }
-	virtual bool   operator==(const AST& o) const = 0;
-	virtual string str()                    const = 0;
-	virtual void   constrain(TEnv& tenv)    const {}
-	virtual void   lift(CEnv& cenv)               {}
-	virtual Value* compile(CEnv& cenv)            = 0;
-};
-
-/// Literal
-template<typename VT>
-struct ASTLiteral : public AST {
-	ASTLiteral(VT v) : val(v) {}
-	bool operator==(const AST& rhs) const {
-		const ASTLiteral<VT>* r = dynamic_cast<const ASTLiteral<VT>*>(&rhs);
-		return (r && (val == r->val));
-	}
-	string str() const { return (format("%1%") % val).str(); }
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-	const VT val;
-};
-
-/// Symbol, e.g. "a"
-struct ASTSymbol : public AST {
-	ASTSymbol(const string& s, Cursor c=Cursor()) : loc(c), cppstr(s) {}
-	bool   operator==(const AST& rhs) const { return this == &rhs; }
-	string str()                      const { return cppstr; }
-	Value* compile(CEnv& cenv);
-	Cursor       loc;
-private:
-	const string cppstr;
-};
-
-/// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)"
-struct ASTTuple : public AST, public vector<AST*> {
-	ASTTuple(const vector<AST*>& t=vector<AST*>()) : vector<AST*>(t) {}
-	ASTTuple(size_t size) : vector<AST*>(size) {}
-	ASTTuple(AST* ast, ...) {
-		push_back(ast);
-		va_list args;
-		va_start(args, ast);
-		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
-			push_back(a);
-		va_end(args);
-	}
-	string str() const {
-		string ret = "(";
-		for (size_t i = 0; i != size(); ++i)
-			ret += at(i)->str() + ((i != size() - 1) ? " " : "");
-		return ret + ")";
-	}
-	bool operator==(const AST& rhs) const {
-		const ASTTuple* rt = dynamic_cast<const ASTTuple*>(&rhs);
-		if (!rt) return false;
-		if (rt->size() != size()) return false;
-		const_iterator l = begin();
-		FOREACH(const_iterator, r, *rt) {
-			AST* mine = *l++;
-			AST* other = *r;
-			if (!(*mine == *other))
-				return false;
-		}
-		return true;
-	}
-	void lift(CEnv& cenv) {
-		FOREACH(iterator, t, *this)
-			(*t)->lift(cenv);
-	}
-	bool isForm(const string& f) { return !empty() && at(0)->str() == f; }
-	bool   contains(AST* child) const;
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv) { throw Error("tuple compiled"); }
-};
-
-/// Type Expression, e.g. "Int", "(Fn (Int Int) Float)"
-struct AType : public ASTTuple {
-	AType(const ASTTuple& t) : ASTTuple(t), kind(EXPR), ctype(0) {}
-	AType(unsigned i) : kind(VAR), id(i), ctype(0) {}
-	AType(ASTSymbol* n, const Type* t) : kind(PRIM), ctype(t) { push_back(n); }
-	string str() const {
-		switch (kind) {
-		case VAR:  return (format("?%1%") % id).str();
-		case PRIM: return at(0)->str();
-		case EXPR: return ASTTuple::str();
-		}
-		return ""; // never reached
-	}
-	void   constrain(TEnv& tenv) const {}
-	Value* compile(CEnv& cenv) { return NULL; }
-	bool   var() const { return kind == VAR; }
-	bool   concrete() const {
-		switch (kind) {
-		case VAR:  return false;
-		case PRIM: return true;
-		case EXPR:
-			FOREACH(const_iterator, t, *this) {
-				AType* kid = dynamic_cast<AType*>(*t);
-				if (kid && !kid->concrete())
-					return false;
-			}
-		}
-		return true;
-	}
-	bool operator==(const AST& rhs) const {
-		const AType* rt = dynamic_cast<const AType*>(&rhs);
-		if (!rt)
-			return false;
-		else if (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 ASTTuple::operator==(rhs);
-			}
-		return false; // never reached
-	}
-	const Type* type() {
-		if (at(0)->str() == "Pair") {
-			vector<const Type*> types;
-			for (size_t i = 1; i < size(); ++i) {
-				assert(dynamic_cast<AType*>(at(i)));
-				types.push_back(((AType*)at(i))->type());
-			}
-			return PointerType::get(StructType::get(types, false), 0);
-		} else {
-			return ctype;
-		}
-	}
-	enum Kind { VAR, PRIM, EXPR };
-	Kind     kind;
-	unsigned id;
-private:
-	const Type* ctype;
-};
-
-/// Lifted LLVM functions for a single Tuplr function
-struct Funcs : public list< pair<AType*, Function*> > {
-	Function* find(AType* type) const {
-		for (const_iterator f = begin(); f != end(); ++f)
-			if (*f->first == *type)
-				return f->second;
-		return NULL;
-	}
-	void insert(AType* type, Function* func) {
-		push_back(make_pair(type, func));
-	}
-};
-
-/// Closure (first-class function with captured lexical bindings)
-struct ASTClosure : public ASTTuple {
-	ASTClosure(ASTTuple* p, AST* b, const string& n="")
-		: ASTTuple(0, p, b), name(n) {}
-	bool operator==(const AST& rhs) const { return this == &rhs; }
-	string str() const { return (format("%1%") % this).str(); }
-	void   constrain(TEnv& tenv) const;
-	void   lift(CEnv& cenv);
-	Value* compile(CEnv& cenv);
-	ASTTuple* prot() const { return dynamic_cast<ASTTuple*>(at(1)); }
-private:
-	Funcs  funcs;
-	string name;
-};
-
-/// Function call/application, e.g. "(func arg1 arg2)"
-struct ASTCall : public ASTTuple {
-	ASTCall(const SExp& e, const ASTTuple& t) : ASTTuple(t), exp(e) {}
-	void   constrain(TEnv& tenv) const;
-	void   lift(CEnv& cenv);
-	Value* compile(CEnv& cenv);
-	const SExp& exp;
-};
-
-/// Definition special form, e.g. "(def x 2)"
-struct ASTDefinition : public ASTCall {
-	ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
-	void   constrain(TEnv& tenv) const;
-	void   lift(CEnv& cenv);
-	Value* compile(CEnv& cenv);
-};
-
-/// Conditional special form, e.g. "(if cond thenexp elseexp)"
-struct ASTIf : public ASTCall {
-	ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-};
-
-/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
-struct ASTPrimitive : public ASTCall {
-	ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg())
-		: ASTCall(e, t), op(ca.op), arg(ca.arg) {}
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-	unsigned op;
-	unsigned arg;
-};
-
-/// Cons special form, e.g. "(cons 1 2)"
-struct ASTConsCall : public ASTCall {
-	ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
-	AType* functionType(CEnv& cenv);
-	void   constrain(TEnv& tenv) const;
-	void   lift(CEnv& cenv);
-	Value* compile(CEnv& cenv);
-	static Funcs funcs;
-};
-
-Funcs ASTConsCall::funcs;
-
-/// Car special form, e.g. "(car p)"
-struct ASTCarCall : public ASTCall {
-	ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-};
-
-/// Cdr special form, e.g. "(cdr p)"
-struct ASTCdrCall : public ASTCall {
-	ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
-	void   constrain(TEnv& tenv) const;
-	Value* compile(CEnv& cenv);
-};
-
-
-/***************************************************************************
- * Parser - S-Expressions (SExp) -> AST Nodes (AST)                        *
- ***************************************************************************/
-
-// Parse Time Environment (symbol table)
-struct PEnv : private map<const string, ASTSymbol*> {
-	typedef AST* (*PF)(PEnv&, const SExp&, CArg); // Parse Function
-	struct Parser { Parser(PF f, CArg a=CArg()) : func(f), arg(a) {} PF func; CArg arg; };
-	map<string, Parser> parsers;
-	void reg(const string& s, const Parser& p) {
-		parsers.insert(make_pair(sym(s)->str(), p));
-	}
-	const Parser* parser(const string& s) const {
-		map<string, Parser>::const_iterator i = parsers.find(s);
-		return (i != parsers.end()) ? &i->second : NULL;
-	}
-	ASTSymbol* sym(const string& s, Cursor c=Cursor()) {
-		const const_iterator i = find(s);
-		return ((i != end())
-			? i->second
-			: insert(make_pair(s, new ASTSymbol(s, c))).first->second);
-	}
-};
-
-/// The fundamental parser method
-static AST* parseExpression(PEnv& penv, const SExp& exp);
-
-static ASTTuple
-pmap(PEnv& penv, const SExp::List& l)
-{
-	ASTTuple ret(l.size());
-	size_t n = 0;
-	FOREACH(SExp::List::const_iterator, i, l)
-		ret[n++] = parseExpression(penv, *i);
-	return ret;
-}
-
-static AST*
-parseExpression(PEnv& penv, const SExp& exp)
-{
-	if (exp.type == SExp::LIST) {
-		if (exp.list.empty()) throw Error("call to empty list", exp.loc);
-		if (exp.list.front().type == SExp::ATOM) {
-			const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
-			if (handler) // Dispatch to parse function
-				return handler->func(penv, exp, handler->arg);
-		}
-		return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call
-	} else if (isdigit(exp.atom[0])) {
-		if (exp.atom.find('.') == string::npos)
-			return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
-		else
-			return new ASTLiteral<float>(strtod(exp.atom.c_str(), NULL));
-	} else if (exp.atom == "true") {
-		return new ASTLiteral<bool>(true);
-	} else if (exp.atom == "false") {
-		return new ASTLiteral<bool>(false);
-	}
-	return penv.sym(exp.atom, exp.loc);
-}
-
-template<typename C>
-static AST*
-parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg())
-{
-	return new C(exp, pmap(penv, exp.list), arg);
-}
-
-static AST*
-parseFn(PEnv& penv, const SExp& exp, CArg arg)
-{
-	SExp::List::const_iterator a = exp.list.begin(); ++a;
-	return new ASTClosure(
-			new ASTTuple(pmap(penv, (*a++).list)),
-			parseExpression(penv, *a++));
-}
-
-
-/***************************************************************************
- * Generic Lexical Environment                                             *
- ***************************************************************************/
-
-template<typename K, typename V>
-struct Env : public list< map<K,V> > {
-	typedef map<K,V> Frame;
-	Env() : list<Frame>(1) {}
-	void push() { list<Frame>::push_front(Frame()); }
-	void pop()  { list<Frame>::pop_front(); }
-	const V& def(const K& k, const V& v) {
-		typename Frame::iterator existing = this->front().find(k);
-		if (existing != this->front().end() && existing->second != v)
-			throw Error("redefinition");
-		return (this->front()[k] = v);
-	}
-	V* ref(const K& name) {
-		typename Frame::iterator s;
-		for (typename Env::iterator i = this->begin(); i != this->end(); ++i)
-			if ((s = i ->find(name)) != i->end())
-				return &s->second;
-		return 0;
-	}
-};
-
-
-/***************************************************************************
- * Typing                                                                  *
- ***************************************************************************/
-
-struct TSubst : public map<AType*, AType*> {
-	TSubst(AType* s=0, AType* t=0) { if (s && t) insert(make_pair(s, t)); }
-};
-
-/// Type-Time Environment
-struct TEnv : public Env<const AST*,AType*> {
-	TEnv(PEnv& p) : penv(p), varID(1) {}
-	typedef list< pair<AType*, AType*> > Constraints;
-	AType* var() { return new AType(varID++); }
-	AType* type(const AST* ast) {
-		AType** t = ref(ast);
-		return t ? *t : def(ast, var());
-	}
-	AType* named(const string& name) {
-		return *ref(penv.sym(name));
-	}
-	void constrain(const AST* o, AType* t) {
-		assert(!dynamic_cast<const AType*>(o));
-		constraints.push_back(make_pair(type(o), t));
-	}
-	void          solve() { apply(unify(constraints)); }
-	void          apply(const TSubst& substs);
-	static TSubst unify(const Constraints& c);
-	PEnv&       penv;
-	Constraints constraints;
-	unsigned    varID;
-};
-
-#define OP_IS_A(o, t) ((o) >= t ## Begin && (o) < t ## End)
-
-void
-ASTTuple::constrain(TEnv& tenv) const
-{
-	AType* t = new AType(ASTTuple());
-	FOREACH(const_iterator, p, *this) {
-		(*p)->constrain(tenv);
-		t->push_back(tenv.type(*p));
-	}
-	tenv.constrain(this, t);
-}
-
-void
-ASTClosure::constrain(TEnv& tenv) const
-{
-	at(1)->constrain(tenv);
-	at(2)->constrain(tenv);
-	AType* protT = tenv.type(at(1));
-	AType* bodyT = tenv.type(at(2));
-	tenv.constrain(this, new AType(ASTTuple(
-			tenv.penv.sym("Fn"), protT, bodyT, 0)));
-}
-
-void
-ASTCall::constrain(TEnv& tenv) const
-{
-	FOREACH(const_iterator, p, *this)
-		(*p)->constrain(tenv);
-	AType* retT = tenv.type(this);
-	AType* argsT = new AType(ASTTuple());
-	for (size_t i = 1; i < size(); ++i)
-		argsT->push_back(tenv.type(at(i)));
-	tenv.constrain(at(0), new AType(ASTTuple(
-			tenv.penv.sym("Fn"), argsT, retT, NULL)));
-}
-
-void
-ASTDefinition::constrain(TEnv& tenv) const
-{
-	if (size() != 3)
-		throw Error("`def' requires exactly 2 arguments", exp.loc);
-	if (!dynamic_cast<const ASTSymbol*>(at(1)))
-		throw Error("`def' name is not a symbol", exp.loc);
-	FOREACH(const_iterator, p, *this)
-		(*p)->constrain(tenv);
-	AType* tvar = tenv.type(this);
-	tenv.constrain(at(1), tvar);
-	tenv.constrain(at(2), tvar);
-}
-
-void
-ASTIf::constrain(TEnv& tenv) const
-{
-	FOREACH(const_iterator, p, *this)
-		(*p)->constrain(tenv);
-	AType* tvar = tenv.type(this);
-	tenv.constrain(at(1), tenv.named("Bool"));
-	tenv.constrain(at(2), tvar);
-	tenv.constrain(at(3), tvar);
-}
-
-void
-ASTPrimitive::constrain(TEnv& tenv) const
-{
-	FOREACH(const_iterator, p, *this)
-		(*p)->constrain(tenv);
-	if (OP_IS_A(op, Instruction::BinaryOps)) {
-		if (size() <= 2) throw Error((format("`%1%' requires at least 2 arguments")
-				% at(0)->str()).str(), exp.loc);
-		AType* tvar = tenv.type(this);
-		for (size_t i = 1; i < size(); ++i)
-			tenv.constrain(at(i), tvar);
-	} else if (op == Instruction::ICmp) {
-		if (size() != 3) throw Error((format("`%1%' requires exactly 2 arguments")
-			   % at(0)->str()).str(), exp.loc);
-		tenv.constrain(at(1), tenv.type(at(2)));
-		tenv.constrain(this, tenv.named("Bool"));
-	} else {
-		throw Error((format("unknown primitive `%1%'") % at(0)->str()).str(), exp.loc);
-	}
-}
-
-void
-ASTConsCall::constrain(TEnv& tenv) const
-{
-	AType* t = new AType(ASTTuple(tenv.penv.sym("Pair"), 0));
-	for (size_t i = 1; i < size(); ++i) {
-		at(i)->constrain(tenv);
-		t->push_back(tenv.type(at(i)));
-	}
-	tenv.constrain(this, t);
-}
-
-void
-ASTCarCall::constrain(TEnv& tenv) const
-{
-	at(1)->constrain(tenv);
-	AType* ct = tenv.var();
-	AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), ct, tenv.var(), 0));
-	tenv.constrain(at(1), tt);
-	tenv.constrain(this, ct);
-}
-
-void
-ASTCdrCall::constrain(TEnv& tenv) const
-{
-	at(1)->constrain(tenv);
-	AType* ct = tenv.var();
-	AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), tenv.var(), ct, 0));
-	tenv.constrain(at(1), tt);
-	tenv.constrain(this, ct);
-}
-
-static void
-substitute(ASTTuple* tup, 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
-			substitute(dynamic_cast<ASTTuple*>(tup->at(i)), from, to);
-}
-
-bool
-ASTTuple::contains(AST* child) const
-{
-	if (*this == *child) return true;
-	FOREACH(const_iterator, p, *this)
-		if (**p == *child || (*p)->contains(child))
-			return true;
-	return false;
-}
-
-TSubst
-compose(const TSubst& delta, const TSubst& gamma) // TAPL 22.1.1
-{
-	TSubst r;
-	for (TSubst::const_iterator g = gamma.begin(); g != gamma.end(); ++g) {
-		TSubst::const_iterator d = delta.find(g->second);
-		r.insert(make_pair(g->first, ((d != delta.end()) ? d : g)->second));
-	}
-	for (TSubst::const_iterator d = delta.begin(); d != delta.end(); ++d) {
-		if (gamma.find(d->first) == gamma.end())
-			r.insert(*d);
-	}
-	return r;
-}
-
-void
-substConstraints(TEnv::Constraints& constraints, AType* s, AType* t)
-{
-	for (TEnv::Constraints::iterator c = constraints.begin(); c != constraints.end();) {
-		TEnv::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;
-	}
-}
-
-TSubst
-TEnv::unify(const Constraints& constraints) // TAPL 22.4
-{
-	if (constraints.empty()) return TSubst();
-	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 compose(unify(cp), TSubst(s, t));
-	} else if (t->var() && !s->contains(t)) {
-		substConstraints(cp, t, s);
-		return compose(unify(cp), TSubst(t, s));
-	} else if (s->size() == t->size()) {
-		for (size_t i = 0; i < s->size(); ++i) {
-			AType* si = dynamic_cast<AType*>(s->at(i));
-			AType* ti = dynamic_cast<AType*>(t->at(i));
-			if (si && ti)
-				cp.push_back(make_pair(si, ti));
-		}
-		return unify(cp);
-	} else {
-		throw Error("Type unification failed");
-	}
-}
-
-void
-TEnv::apply(const TSubst& substs)
-{
-	FOREACH(TSubst::const_iterator, s, substs)
-		FOREACH(Frame::iterator, t, front())
-			if (*t->second == *s->first)
-				t->second = s->second;
-			else
-				substitute(t->second, s->first, s->second);
-}
-
-
-/***************************************************************************
- * Code Generation                                                         *
- ***************************************************************************/
-
-class PEnv;
-
-/// Compile-Time Environment
-struct CEnv {
-	CEnv(PEnv& p, Module* m, const TargetData* target)
-		: penv(p), tenv(p), module(m), emp(module), opt(&emp), symID(0)
-	{
-		// Set up the optimizer pipeline:
-		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
-	}
-	string gensym(const char* s="_") { return (format("%1%%2%") % s % symID++).str(); }
-	void push() { code.push(); vals.push(); }
-	void pop()  { code.pop();  vals.pop(); }
-	Value* compile(AST* obj) {
-		Value** v = vals.ref(obj);
-		return (v) ? *v : vals.def(obj, obj->compile(*this));
-	}
-	void precompile(AST* obj, Value* value) {
-		assert(!vals.ref(obj));
-		vals.def(obj, value);
-	}
-	void optimise(Function& f) { return; verifyFunction(f); opt.run(f); }
-	typedef Env<const AST*, AST*>   Code;
-	typedef Env<const AST*, Value*> Vals;
-	PEnv&                  penv;
-	TEnv                   tenv;
-	IRBuilder<>            builder;
-	Module*                module;
-	ExistingModuleProvider emp;
-	FunctionPassManager    opt;
-	unsigned               symID;
-	Code                   code;
-	Vals                   vals;
-	Function*              alloc;
-};
-
-#define LITERAL(CT, NAME, COMPILED) \
-template<> Value* \
-ASTLiteral<CT>::compile(CEnv& cenv) { return (COMPILED); } \
-template<> void \
-ASTLiteral<CT>::constrain(TEnv& tenv) const { tenv.constrain(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))
-
-static Function*
-compileFunction(CEnv& cenv, const std::string& name, const Type* retT, const ASTTuple& prot,
-		const vector<string> argNames=vector<string>())
-{
-	Function::LinkageTypes linkage = Function::ExternalLinkage;
-
-	vector<const Type*> cprot;
-	for (size_t i = 0; i < prot.size(); ++i) {
-		AType* at = cenv.tenv.type(prot.at(i));
-		if (!at->type() || at->var()) throw Error("function parameter is untyped");
-		cprot.push_back(at->type());
-	}
-
-	if (!retT) throw Error("function return is untyped");
-	FunctionType* fT = FunctionType::get(retT, cprot, false);
-	Function*     f  = Function::Create(fT, linkage, name, cenv.module);
-
-	if (f->getName() != name) {
-		f->eraseFromParent();
-		throw Error("function redefined");
-	}
-
-	// Set argument names in generated code
-	Function::arg_iterator a = f->arg_begin();
-	if (!argNames.empty())
-		for (size_t i = 0; i != prot.size(); ++a, ++i)
-			a->setName(argNames.at(i));
-	else
-		for (size_t i = 0; i != prot.size(); ++a, ++i)
-			a->setName(prot.at(i)->str());
-	
-	BasicBlock* bb = BasicBlock::Create("entry", f);
-	cenv.builder.SetInsertPoint(bb);
-
-	return f;
-}
-
-Value*
-ASTSymbol::compile(CEnv& cenv)
-{
-	AST** c = cenv.code.ref(this);
-	if (!c) throw Error((string("undefined symbol `") + cppstr + "'").c_str(), loc);
-	return cenv.compile(*c);
-}
-
-void
-ASTClosure::lift(CEnv& cenv)
-{
-	AType* type = cenv.tenv.type(this);
-	if (!type->concrete()) {
-		err << "closure is untyped, not lifting" << endl;
-		return;
-	}
-	
-	if (funcs.find(type))
-		return;
-
-	cenv.push();
-
-	// Write function declaration
-	string name = this->name == "" ? cenv.gensym("_fn") : this->name;
-	Function* f = compileFunction(cenv, name, cenv.tenv.type(at(2))->type(), *prot());
-
-	// Bind argument values in CEnv
-	vector<Value*> args;
-	const_iterator p = prot()->begin();
-	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p)
-		cenv.vals.def(dynamic_cast<ASTSymbol*>(*p), &*a);
-
-	// Write function body
-	try {
-		cenv.precompile(this, f); // Define our value first for recursion
-		Value* retVal = cenv.compile(at(2));
-		cenv.builder.CreateRet(retVal); // Finish function
-		cenv.optimise(*f);
-		funcs.insert(type, f);
-	} catch (Error& e) {
-		f->eraseFromParent(); // Error reading body, remove function
-		throw e;
-	}
-
-	cenv.pop();
-}
-
-Value*
-ASTClosure::compile(CEnv& cenv)
-{
-	return funcs.find(cenv.tenv.type(this));
-}
-
-void
-ASTCall::lift(CEnv& cenv)
-{
-	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
-	if (!c) {
-		AST** val = cenv.code.ref(at(0));
-		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
-	}
-
-	// Lift arguments
-	for (size_t i = 1; i < size(); ++i)
-		at(i)->lift(cenv);
-
-	if (!c) return;
-
-	// Extend environment with bound and typed parameters
-	cenv.push();
-	if (c->prot()->size() < size() - 1)
-		throw Error((format("too many arguments to function `%1%'") % at(0)->str()).str(), exp.loc);
-	if (c->prot()->size() > size() - 1)
-		throw Error((format("too few arguments to function `%1%'") % at(0)->str()).str(), exp.loc);
-
-	for (size_t i = 1; i < size(); ++i)
-		cenv.code.def(c->prot()->at(i-1), at(i));
-
-	c->lift(cenv); // Lift called closure
-	cenv.pop(); // Restore environment
-}
-
-Value*
-ASTCall::compile(CEnv& cenv)
-{
-	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
-	if (!c) {
-		AST** val = cenv.code.ref(at(0));
-		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
-	}
-
-	assert(c);
-	Function* f = dynamic_cast<Function*>(cenv.compile(c));
-	if (!f) throw Error("callee failed to compile", exp.loc);
-
-	vector<Value*> params(size() - 1);
-	for (size_t i = 1; i < size(); ++i)
-		params[i-1] = cenv.compile(at(i));
-
-	return cenv.builder.CreateCall(f, params.begin(), params.end(), "calltmp");
-}
-
-void
-ASTDefinition::lift(CEnv& cenv)
-{
-	if (cenv.code.ref((ASTSymbol*)at(1)))
-		throw Error(string("`") + at(1)->str() + "' redefined", exp.loc);
-	cenv.code.def((ASTSymbol*)at(1), at(2)); // Define first for recursion
-	at(2)->lift(cenv);
-}
-
-Value*
-ASTDefinition::compile(CEnv& cenv)
-{
-	return cenv.compile(at(2));
-}
-
-Value*
-ASTIf::compile(CEnv& cenv)
-{
-	typedef vector< pair<Value*, BasicBlock*> > Branches;
-	Function*     parent  = cenv.builder.GetInsertBlock()->getParent();
-	BasicBlock*   mergeBB = BasicBlock::Create("endif");
-	BasicBlock*   nextBB  = NULL;
-	Branches      branches;
-	ostringstream ss;
-	for (size_t i = 1; i < size() - 1; i += 2) {
-		Value* condV = cenv.compile(at(i));
-
-		ss.str(""); ss << "then" << ((i + 1) / 2);
-		BasicBlock* thenBB = BasicBlock::Create(ss.str());
-
-		ss.str(""); ss << "else" << ((i + 1) / 2);
-		nextBB = BasicBlock::Create(ss.str());
-
-		cenv.builder.CreateCondBr(condV, thenBB, nextBB);
-
-		// Emit then block for this condition
-		parent->getBasicBlockList().push_back(thenBB);
-		cenv.builder.SetInsertPoint(thenBB);
-		Value* thenV = cenv.compile(at(i + 1));
-		cenv.builder.CreateBr(mergeBB);
-		branches.push_back(make_pair(thenV, cenv.builder.GetInsertBlock()));
-
-		parent->getBasicBlockList().push_back(nextBB);
-		cenv.builder.SetInsertPoint(nextBB);
-	}
-
-	// Emit else block
-	cenv.builder.SetInsertPoint(nextBB);
-	Value* elseV = cenv.compile(at(size() - 1));
-	cenv.builder.CreateBr(mergeBB);
-	branches.push_back(make_pair(elseV, cenv.builder.GetInsertBlock()));
-
-	// Emit merge block (Phi node)
-	parent->getBasicBlockList().push_back(mergeBB);
-	cenv.builder.SetInsertPoint(mergeBB);
-	PHINode* pn = cenv.builder.CreatePHI(cenv.tenv.type(this)->type(), "ifval");
-
-	for (Branches::iterator i = branches.begin(); i != branches.end(); ++i)
-		pn->addIncoming(i->first, i->second);
-
-	return pn;
-}
-
-Value*
-ASTPrimitive::compile(CEnv& cenv)
-{
-	Value* a = cenv.compile(at(1));
-	Value* b = cenv.compile(at(2));
-
-	if (OP_IS_A(op, Instruction::BinaryOps)) {
-		const Instruction::BinaryOps bo = (Instruction::BinaryOps)op;
-		if (size() == 2)
-			return cenv.compile(at(1));
-		Value* val = cenv.builder.CreateBinOp(bo, a, b);
-		for (size_t i = 3; i < size(); ++i)
-			val = cenv.builder.CreateBinOp(bo, val, cenv.compile(at(i)));
-		return val;
-	} else if (op == Instruction::ICmp) {
-		bool isInt = cenv.tenv.type(at(1))->str() == "Int";
-		if (isInt) {
-			return cenv.builder.CreateICmp((CmpInst::Predicate)arg, a, b);
-		} else {
-			// Translate to floating point operation
-			switch (arg) {
-			case CmpInst::ICMP_EQ:  arg = CmpInst::FCMP_OEQ; break;
-			case CmpInst::ICMP_NE:  arg = CmpInst::FCMP_ONE; break;
-			case CmpInst::ICMP_SGT: arg = CmpInst::FCMP_OGT; break;
-			case CmpInst::ICMP_SGE: arg = CmpInst::FCMP_OGE; break;
-			case CmpInst::ICMP_SLT: arg = CmpInst::FCMP_OLT; break;
-			case CmpInst::ICMP_SLE: arg = CmpInst::FCMP_OLE; break;
-			default: throw Error("Unknown primitive", exp.loc);
-			}
-			return cenv.builder.CreateFCmp((CmpInst::Predicate)arg, a, b);
-		}
-	}
-	throw Error("Unknown primitive", exp.loc);
-}
-
-AType*
-ASTConsCall::functionType(CEnv& cenv)
-{
-	ASTTuple* protTypes = new ASTTuple(cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL);
-	AType* cellType = new AType(ASTTuple(cenv.penv.sym("Pair"),
-				cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL));
-	return new AType(ASTTuple(cenv.penv.sym("Fn"), protTypes, cellType, NULL));
-}
-
-void
-ASTConsCall::lift(CEnv& cenv)
-{
-	AType* funcType = functionType(cenv);
-	if (funcs.find(functionType(cenv)))
-		return;
-	
-	ASTCall::lift(cenv);
-	
-	ASTTuple* prot = new ASTTuple(at(1), at(2), NULL);
-
-	vector<const Type*> types;
-	size_t sz = 0;
-	for (size_t i = 1; i < size(); ++i) {
-		const Type* t = cenv.tenv.type(at(i))->type();
-		types.push_back(t);
-		sz += t->getPrimitiveSizeInBits();
-	}
-	sz = (sz % 8 == 0) ? sz / 8 : sz / 8 + 1;
-
-	StructType* sT = StructType::get(types, false);
-	Type* pT = PointerType::get(sT, 0);
-	
-	// Write function declaration
-	vector<string> argNames;
-	argNames.push_back("car");
-	argNames.push_back("cdr");
-	Function* func = compileFunction(cenv, cenv.gensym("cons"), pT, *prot, argNames);
-
-	Value* mem = cenv.builder.CreateCall(cenv.alloc, ConstantInt::get(Type::Int32Ty, sz), "mem");
-	Value* cell = cenv.builder.CreateBitCast(mem, pT, "cell");
-	Value* s = cenv.builder.CreateGEP(cell, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* carP = cenv.builder.CreateStructGEP(s, 0, "car");
-	Value* cdrP = cenv.builder.CreateStructGEP(s, 1, "cdr");
-	Function::arg_iterator ai = func->arg_begin();
-	Value& carArg = *ai++;
-	Value& cdrArg = *ai++;
-	cenv.builder.CreateStore(&carArg, carP);
-	cenv.builder.CreateStore(&cdrArg, cdrP);
-	cenv.builder.CreateRet(cell);
-	cenv.optimise(*func);
-
-	funcs.insert(funcType, func);
-}
-
-Value*
-ASTConsCall::compile(CEnv& cenv)
-{
-	vector<Value*> params(size() - 1);
-	for (size_t i = 1; i < size(); ++i)
-		params[i-1] = cenv.compile(at(i));
-
-	return cenv.builder.CreateCall(funcs.find(functionType(cenv)), params.begin(), params.end());
-}
-
-Value*
-ASTCarCall::compile(CEnv& cenv)
-{
-	AST**  arg  = cenv.code.ref(at(1));
-	Value* sP   = arg ? (*arg)->compile(cenv) : at(1)->compile(cenv);
-	Value* s    = cenv.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* carP = cenv.builder.CreateStructGEP(s, 0, "car");
-	return cenv.builder.CreateLoad(carP);
-}
-
-Value*
-ASTCdrCall::compile(CEnv& cenv)
-{
-	AST**  arg  = cenv.code.ref(at(1));
-	Value* sP   = arg ? (*arg)->compile(cenv) : at(1)->compile(cenv);
-	Value* s    = cenv.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
-	Value* cdrP = cenv.builder.CreateStructGEP(s, 1, "cdr");
-	return cenv.builder.CreateLoad(cdrP);
-}
-
-
-/***************************************************************************
- * EVAL/REPL/MAIN                                                          *
- ***************************************************************************/
-
-std::string
-call(AType* retT, void* fp)
-{
-	std::stringstream ss;
-	if (retT->type() == Type::Int32Ty)
-		ss << ((int32_t (*)())fp)();
-	else if (retT->type() == Type::FloatTy)
-		ss << ((float (*)())fp)();
-	else if (retT->type() == Type::Int1Ty)
-		ss << ((bool (*)())fp)();
-	else
-		ss << ((void* (*)())fp)();
-	return ss.str();
-}
-
-int
-eval(CEnv& cenv, ExecutionEngine* engine, 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.list.empty())
-				break;
-
-			result = parseExpression(cenv.penv, exp); // Parse input
-			result->constrain(cenv.tenv); // Constrain types
-			cenv.tenv.solve(); // Solve and apply type constraints
-			resultType = cenv.tenv.type(result);
-			result->lift(cenv); // Lift functions
-			exprs.push_back(make_pair(exp, result));
-		}
-
-		if (!resultType || resultType->var()) throw Error("body is undefined/untyped", cursor);
-		
-		const Type* ctype = resultType->type();
-		if (!ctype) throw Error("body has no system type", cursor);
-
-		// Create function for top-level of program
-		Function* f = compileFunction(cenv, cenv.gensym("input"), ctype, ASTTuple());
-
-		// Compile all expressions into it
-		Value* val  = NULL;
-		for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
-			val = cenv.compile(i->second);
-
-		// Finish function
-		cenv.builder.CreateRet(val);
-		cenv.optimise(*f);
-
-		string resultStr = call(resultType, engine->getPointerToFunction(f));
-		out << resultStr << " : " << resultType->str() << endl;
-
-	} catch (Error& e) {
-		err << e.what() << endl;
-		return 1;
-	}
-
-	return 0;
-}
-
-int
-repl(CEnv& cenv, ExecutionEngine* engine)
-{
-	while (1) {
-		out << "() ";
-		out.flush();
-		Cursor cursor("(stdin)");
-		SExp exp = readExpression(cursor, std::cin);
-		if (exp.type == SExp::LIST && exp.list.empty())
-			break;
-
-		try {
-			AST* body = parseExpression(cenv.penv, exp); // Parse input
-			body->constrain(cenv.tenv); // Constrain types
-			cenv.tenv.solve(); // Solve and apply type constraints
-
-			AType* bodyT = cenv.tenv.type(body);
-			if (!bodyT)             throw Error("call to untyped body", cursor);
-			if (!bodyT->concrete()) throw Error("call to variable typed body", cursor);
-
-			body->lift(cenv);
-			
-			if (bodyT->type()) {
-				// Create anonymous function to insert code into
-				Function* f = compileFunction(cenv, cenv.gensym("_repl"), bodyT->type(), ASTTuple());
-				try {
-					Value* retVal = cenv.compile(body);
-					cenv.builder.CreateRet(retVal); // Finish function
-					cenv.optimise(*f);
-				} catch (Error& e) {
-					f->eraseFromParent(); // Error reading body, remove function
-					throw e;
-				}
-				out << call(bodyT, engine->getPointerToFunction(f));
-			} else {
-				Value* val = cenv.compile(body);
-				out << ";   " << val;
-			}
-			out << " : " << cenv.tenv.type(body)->str() << endl;
-
-		} catch (Error& e) {
-			err << e.what() << endl;
-		}
-	}
-
-	return 0;
-}
-
-int
-main(int argc, char** argv)
-{
-#define PRIM(O, A) PEnv::Parser(parseAST<ASTPrimitive>, CArg(Instruction:: O, A))
-	PEnv penv;
-	penv.reg("fn",   PEnv::Parser(parseFn));
-	penv.reg("if",   PEnv::Parser(parseAST<ASTIf>));
-	penv.reg("def",  PEnv::Parser(parseAST<ASTDefinition>));
-	penv.reg("cons", PEnv::Parser(parseAST<ASTConsCall>));
-	penv.reg("car",  PEnv::Parser(parseAST<ASTCarCall>));
-	penv.reg("cdr",  PEnv::Parser(parseAST<ASTCdrCall>));
-	penv.reg("+",    PRIM(Add,  0));
-	penv.reg("-",    PRIM(Sub,  0));
-	penv.reg("*",    PRIM(Mul,  0));
-	penv.reg("/",    PRIM(FDiv, 0));
-	penv.reg("%",    PRIM(FRem, 0));
-	penv.reg("&",    PRIM(And,  0));
-	penv.reg("|",    PRIM(Or,   0));
-	penv.reg("^",    PRIM(Xor,  0));
-	penv.reg("=",    PRIM(ICmp, CmpInst::ICMP_EQ));
-	penv.reg("!=",   PRIM(ICmp, CmpInst::ICMP_NE));
-	penv.reg(">",    PRIM(ICmp, CmpInst::ICMP_SGT));
-	penv.reg(">=",   PRIM(ICmp, CmpInst::ICMP_SGE));
-	penv.reg("<",    PRIM(ICmp, CmpInst::ICMP_SLT));
-	penv.reg("<=",   PRIM(ICmp, CmpInst::ICMP_SLE));
-
-	Module*          module = new Module("interactive");
-	ExecutionEngine* engine = ExecutionEngine::create(module);
-	CEnv             cenv(penv, module, engine->getTargetData());
-
-	cenv.tenv.def(penv.sym("Bool"),  new AType(penv.sym("Bool"),  Type::Int1Ty));
-	cenv.tenv.def(penv.sym("Int"),   new AType(penv.sym("Int"),   Type::Int32Ty));
-	cenv.tenv.def(penv.sym("Float"), new AType(penv.sym("Float"), Type::FloatTy));
-	
-	// Host provided allocation primitive prototypes
-	std::vector<const Type*> argsT(1, Type::Int32Ty);
-	FunctionType* funcT = FunctionType::get(PointerType::get(Type::Int8Ty, 0), argsT, false);
-	cenv.alloc = Function::Create(funcT, Function::ExternalLinkage, "malloc", module);
-	
-	int ret;
-	if (argc > 2 && !strncmp(argv[1], "-e", 3)) {
-		std::istringstream is(argv[2]);
-		ret = eval(cenv, engine, "(command line)", is);
-	} else if (argc > 2 && !strncmp(argv[1], "-f", 3)) {
-		std::ifstream is(argv[2]);
-		ret = eval(cenv, engine, argv[2], is);
-		is.close();
-	} else {
-		ret = repl(cenv, engine);
-	}
-	
-	//out << endl << "*** Generated Code ***" << endl;
-	//cenv.module->dump();
-
-	return ret;
-}
-
diff --git a/tuplr.hpp b/tuplr.hpp
new file mode 100644
index 0000000..1d3eb0d
--- /dev/null
+++ b/tuplr.hpp
@@ -0,0 +1,464 @@
+/* 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 <string>
+#include <vector>
+#include <boost/format.hpp>
+#include "tuplr_llvm.hpp"
+
+#define FOREACH(IT, i, c) for (IT i = (c).begin(); i != (c).end(); ++i)
+
+using namespace std;
+using boost::format;
+
+extern std::ostream& err;
+extern std::ostream& out;
+
+struct Cursor {
+	Cursor(const string& n="", unsigned l=1, unsigned c=0) : name(n), line(l), col(c) {}
+	string str() const { return (format("%1%:%2%:%3%") % name % line % col).str(); }
+	string   name;
+	unsigned line;
+	unsigned col;
+};
+
+struct Error {
+	Error(const string& m, Cursor c=Cursor()) : msg(m), loc(c) {}
+	const string what() const throw() { return loc.str() + ": error: " + msg; }
+	string msg;
+	Cursor loc;
+};
+
+template<typename Atom>
+struct Exp { // ::= Atom | (Exp*)
+	Exp(Cursor c)                : type(LIST), loc(c)          {}
+	Exp(Cursor c, const Atom& a) : type(ATOM), loc(c), atom(a) {}
+	typedef std::vector< Exp<Atom> > List;
+	enum { ATOM, LIST } type;
+	Cursor loc;
+	Atom   atom;
+	List   list;
+};
+
+
+/***************************************************************************
+ * S-Expression Lexer :: text -> S-Expressions (SExp)                      *
+ ***************************************************************************/
+
+typedef Exp<string> SExp; ///< Textual S-Expression
+
+SExp readExpression(Cursor& cur, std::istream& in);
+
+
+/***************************************************************************
+ * Abstract Syntax Tree                                                    *
+ ***************************************************************************/
+
+struct TEnv;  ///< Type-Time Environment
+struct CEnv;  ///< Compile-Time Environment
+
+/// Base class for all AST nodes
+struct AST {
+	virtual ~AST() {}
+	virtual string  str()                    const = 0;
+	virtual bool    operator==(const AST& o) const = 0;
+	virtual bool    contains(AST* child)     const { return false; }
+	virtual void    constrain(TEnv& tenv)    const {}
+	virtual void    lift(CEnv& cenv)               {}
+	virtual CValue* compile(CEnv& cenv)            = 0;
+};
+
+/// Literal value
+template<typename VT>
+struct ASTLiteral : public AST {
+	ASTLiteral(VT v) : val(v) {}
+	bool operator==(const AST& rhs) const {
+		const ASTLiteral<VT>* r = dynamic_cast<const ASTLiteral<VT>*>(&rhs);
+		return (r && (val == r->val));
+	}
+	string  str() const { return (format("%1%") % val).str(); }
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv);
+	const VT val;
+};
+
+/// Symbol, e.g. "a"
+struct ASTSymbol : public AST {
+	ASTSymbol(const string& s, Cursor c=Cursor()) : loc(c), cppstr(s) {}
+	bool    operator==(const AST& rhs) const { return this == &rhs; }
+	string  str()                      const { return cppstr; }
+	CValue* compile(CEnv& cenv);
+private:
+	Cursor       loc;
+	const string cppstr;
+};
+
+/// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)"
+struct ASTTuple : public AST, public vector<AST*> {
+	ASTTuple(const vector<AST*>& t=vector<AST*>()) : vector<AST*>(t) {}
+	ASTTuple(size_t size) : vector<AST*>(size) {}
+	ASTTuple(AST* ast, ...) {
+		push_back(ast);
+		va_list args;
+		va_start(args, ast);
+		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
+			push_back(a);
+		va_end(args);
+	}
+	string str() const {
+		string ret = "(";
+		for (size_t i = 0; i != size(); ++i)
+			ret += at(i)->str() + ((i != size() - 1) ? " " : "");
+		return ret + ")";
+	}
+	bool operator==(const AST& rhs) const {
+		const ASTTuple* rt = dynamic_cast<const ASTTuple*>(&rhs);
+		if (!rt) return false;
+		if (rt->size() != size()) return false;
+		const_iterator l = begin();
+		FOREACH(const_iterator, r, *rt) {
+			AST* mine = *l++;
+			AST* other = *r;
+			if (!(*mine == *other))
+				return false;
+		}
+		return true;
+	}
+	void lift(CEnv& cenv) {
+		FOREACH(iterator, t, *this)
+			(*t)->lift(cenv);
+	}
+	bool    contains(AST* child) const;
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv) { throw Error("tuple compiled"); }
+};
+
+/// Type Expression, e.g. "Int", "(Fn (Int Int) Float)"
+struct AType : public ASTTuple {
+	AType(const ASTTuple& t) : ASTTuple(t), kind(EXPR), ctype(0) {}
+	AType(unsigned i) : kind(VAR), id(i), ctype(0) {}
+	AType(ASTSymbol* n, const CType* t) : kind(PRIM), ctype(t) { push_back(n); }
+	string str() const {
+		switch (kind) {
+		case VAR:  return (format("?%1%") % id).str();
+		case PRIM: return at(0)->str();
+		case EXPR: return ASTTuple::str();
+		}
+		return ""; // never reached
+	}
+	void    constrain(TEnv& tenv) const {}
+	CValue* compile(CEnv& cenv) { return NULL; }
+	bool    var() const { return kind == VAR; }
+	bool concrete() const {
+		switch (kind) {
+		case VAR:  return false;
+		case PRIM: return true;
+		case EXPR:
+			FOREACH(const_iterator, t, *this) {
+				AType* kid = dynamic_cast<AType*>(*t);
+				if (kid && !kid->concrete())
+					return false;
+			}
+		}
+		return true;
+	}
+	bool operator==(const AST& rhs) const {
+		const AType* rt = dynamic_cast<const AType*>(&rhs);
+		if (!rt)
+			return false;
+		else if (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 ASTTuple::operator==(rhs);
+			}
+		return false; // never reached
+	}
+	const CType* type();
+	enum Kind { VAR, PRIM, EXPR };
+	Kind     kind;
+	unsigned id;
+private:
+	const CType* ctype;
+};
+
+/// Lifted system functions (of various types) for a single Tuplr function
+struct Funcs : 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;
+	}
+	void insert(AType* type, CFunction* func) {
+		push_back(make_pair(type, func));
+	}
+};
+
+/// Closure (first-class function with captured lexical bindings)
+struct ASTClosure : public ASTTuple {
+	ASTClosure(ASTTuple* p, AST* b, const string& n="")
+		: ASTTuple(0, p, b, NULL), name(n) {}
+	bool      operator==(const AST& rhs) const { return this == &rhs; }
+	string    str() const { return (format("%1%") % this).str(); }
+	void      constrain(TEnv& tenv) const;
+	void      lift(CEnv& cenv);
+	CValue*   compile(CEnv& cenv);
+	ASTTuple* prot() const { return dynamic_cast<ASTTuple*>(at(1)); }
+private:
+	Funcs  funcs;
+	string name;
+};
+
+/// Function call/application, e.g. "(func arg1 arg2)"
+struct ASTCall : public ASTTuple {
+	ASTCall(const SExp& e, const ASTTuple& t) : ASTTuple(t), exp(e) {}
+	void    constrain(TEnv& tenv) const;
+	void    lift(CEnv& cenv);
+	CValue* compile(CEnv& cenv);
+	const SExp& exp;
+};
+
+/// Definition special form, e.g. "(def x 2)"
+struct ASTDefinition : public ASTCall {
+	ASTDefinition(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	void    constrain(TEnv& tenv) const;
+	void    lift(CEnv& cenv);
+	CValue* compile(CEnv& cenv);
+};
+
+/// Conditional special form, e.g. "(if cond thenexp elseexp)"
+struct ASTIf : public ASTCall {
+	ASTIf(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv);
+};
+
+/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
+struct ASTPrimitive : public ASTCall {
+	ASTPrimitive(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t), arg(ca) {}
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv);
+	CArg arg;
+};
+
+/// Cons special form, e.g. "(cons 1 2)"
+struct ASTConsCall : public ASTCall {
+	ASTConsCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	AType*  functionType(CEnv& cenv);
+	void    constrain(TEnv& tenv) const;
+	void    lift(CEnv& cenv);
+	CValue* compile(CEnv& cenv);
+	static Funcs funcs;
+};
+
+/// Car special form, e.g. "(car p)"
+struct ASTCarCall : public ASTCall {
+	ASTCarCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv);
+};
+
+/// Cdr special form, e.g. "(cdr p)"
+struct ASTCdrCall : public ASTCall {
+	ASTCdrCall(const SExp& e, const ASTTuple& t, CArg ca=CArg()) : ASTCall(e, t) {}
+	void    constrain(TEnv& tenv) const;
+	CValue* compile(CEnv& cenv);
+};
+
+
+/***************************************************************************
+ * Parser - S-Expressions (SExp) -> AST Nodes (AST)                        *
+ ***************************************************************************/
+
+// Parse Time Environment (symbol table)
+struct PEnv : private map<const string, ASTSymbol*> {
+	typedef AST* (*PF)(PEnv&, const SExp&, CArg); // Parse Function
+	struct Parser { Parser(PF f, CArg a=CArg()) : func(f), arg(a) {} PF func; CArg arg; };
+	map<string, Parser> parsers;
+	void reg(const string& s, const Parser& p) {
+		parsers.insert(make_pair(sym(s)->str(), p));
+	}
+	const Parser* parser(const string& s) const {
+		map<string, Parser>::const_iterator i = parsers.find(s);
+		return (i != parsers.end()) ? &i->second : NULL;
+	}
+	ASTSymbol* sym(const string& s, Cursor c=Cursor()) {
+		const const_iterator i = find(s);
+		return ((i != end())
+			? i->second
+			: insert(make_pair(s, new ASTSymbol(s, c))).first->second);
+	}
+};
+
+/// The fundamental parser method
+static AST* parseExpression(PEnv& penv, const SExp& exp);
+
+static ASTTuple
+pmap(PEnv& penv, const SExp::List& l)
+{
+	ASTTuple ret(l.size());
+	size_t n = 0;
+	FOREACH(SExp::List::const_iterator, i, l)
+		ret[n++] = parseExpression(penv, *i);
+	return ret;
+}
+
+static AST*
+parseExpression(PEnv& penv, const SExp& exp)
+{
+	if (exp.type == SExp::LIST) {
+		if (exp.list.empty()) throw Error("call to empty list", exp.loc);
+		if (exp.list.front().type == SExp::ATOM) {
+			const PEnv::Parser* handler = penv.parser(exp.list.front().atom);
+			if (handler) // Dispatch to parse function
+				return handler->func(penv, exp, handler->arg);
+		}
+		return new ASTCall(exp, pmap(penv, exp.list)); // Parse as regular call
+	} else if (isdigit(exp.atom[0])) {
+		if (exp.atom.find('.') == string::npos)
+			return new ASTLiteral<int32_t>(strtol(exp.atom.c_str(), NULL, 10));
+		else
+			return new ASTLiteral<float>(strtod(exp.atom.c_str(), NULL));
+	} else if (exp.atom == "true") {
+		return new ASTLiteral<bool>(true);
+	} else if (exp.atom == "false") {
+		return new ASTLiteral<bool>(false);
+	}
+	return penv.sym(exp.atom, exp.loc);
+}
+
+template<typename C>
+inline AST*
+parseAST(PEnv& penv, const SExp& exp, CArg arg=CArg())
+{
+	return new C(exp, pmap(penv, exp.list), arg);
+}
+
+inline AST*
+parseFn(PEnv& penv, const SExp& exp, CArg arg)
+{
+	SExp::List::const_iterator a = exp.list.begin(); ++a;
+	return new ASTClosure(
+			new ASTTuple(pmap(penv, (*a++).list)),
+			parseExpression(penv, *a++));
+}
+
+
+/***************************************************************************
+ * Generic Lexical Environment                                             *
+ ***************************************************************************/
+
+template<typename K, typename V>
+struct Env : public list< map<K,V> > {
+	typedef map<K,V> Frame;
+	Env() : list<Frame>(1) {}
+	void push() { list<Frame>::push_front(Frame()); }
+	void pop()  { assert(!this->empty()); list<Frame>::pop_front(); }
+	const V& def(const K& k, const V& v) {
+		typename Frame::iterator existing = this->front().find(k);
+		if (existing != this->front().end() && existing->second != v)
+			throw Error("redefinition");
+		return (this->front()[k] = v);
+	}
+	V* ref(const K& name) {
+		typename Frame::iterator s;
+		for (typename Env::iterator i = this->begin(); i != this->end(); ++i)
+			if ((s = i ->find(name)) != i->end())
+				return &s->second;
+		return 0;
+	}
+};
+
+
+/***************************************************************************
+ * Typing                                                                  *
+ ***************************************************************************/
+
+struct TSubst : public map<AType*, AType*> {
+	TSubst(AType* s=0, AType* t=0) { if (s && t) insert(make_pair(s, t)); }
+};
+
+/// Type-Time Environment
+struct TEnv : public Env<const AST*,AType*> {
+	TEnv(PEnv& p) : penv(p), varID(1) {}
+	typedef list< pair<AType*, AType*> > Constraints;
+	AType* var() { return new AType(varID++); }
+	AType* type(const AST* ast) {
+		AType** t = ref(ast);
+		return t ? *t : def(ast, var());
+	}
+	AType* named(const string& name) {
+		return *ref(penv.sym(name));
+	}
+	void constrain(const AST* o, AType* t) {
+		assert(!dynamic_cast<const AType*>(o));
+		constraints.push_back(make_pair(type(o), t));
+	}
+	void          solve() { apply(unify(constraints)); }
+	void          apply(const TSubst& substs);
+	static TSubst unify(const Constraints& c);
+	PEnv&       penv;
+	Constraints constraints;
+	unsigned    varID;
+};
+
+
+/***************************************************************************
+ * Code Generation                                                         *
+ ***************************************************************************/
+
+struct CEnvPimpl;
+
+/// Compile-Time Environment
+struct CEnv {
+	CEnv(PEnv& p, CEngine& engine);
+	~CEnv();
+	
+	typedef Env<const AST*, AST*>    Code;
+	typedef Env<const AST*, CValue*> Vals;
+	
+	string  gensym(const char* s="_") { return (format("%s%d") % s % symID++).str(); }
+	void    push() { code.push(); vals.push(); }
+	void    pop()  { code.pop();  vals.pop();  }
+	void    precompile(AST* obj, CValue* value) { vals.def(obj, value); }
+	CValue* compile(AST* obj);
+	void    optimise(CFunction& f);
+	
+	CEngine&   engine;
+	PEnv&      penv;
+	TEnv       tenv;
+	Code       code;
+	Vals       vals;
+	unsigned   symID;
+	CFunction* alloc;
+
+private:
+	CEnvPimpl* _pimpl;
+};
+
+#endif // TUPLR_HPP
+
diff --git a/tuplr_llvm.cpp b/tuplr_llvm.cpp
new file mode 100644
index 0000000..a807f75
--- /dev/null
+++ b/tuplr_llvm.cpp
@@ -0,0 +1,635 @@
+/* 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 <sstream>
+#include <fstream>
+#include "tuplr.hpp"
+#include "tuplr_llvm.hpp"
+
+using namespace llvm;
+using namespace std;
+using boost::format;
+
+
+/***************************************************************************
+ * Abstract Syntax Tree                                                    *
+ ***************************************************************************/
+
+const CType*
+AType::type()
+{
+	if (at(0)->str() == "Pair") {
+		vector<const CType*> types;
+		for (size_t i = 1; i < size(); ++i) {
+			assert(dynamic_cast<AType*>(at(i)));
+			types.push_back(((AType*)at(i))->type());
+		}
+		return PointerType::get(StructType::get(types, false), 0);
+	} else {
+		return ctype;
+	}
+}
+
+
+/***************************************************************************
+ * Typing                                                                  *
+ ***************************************************************************/
+
+#define OP_IS_A(o, t) ((o) >= t ## Begin && (o) < t ## End)
+
+void
+ASTPrimitive::constrain(TEnv& tenv) const
+{
+	FOREACH(const_iterator, p, *this)
+		(*p)->constrain(tenv);
+	if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
+		if (size() <= 2) throw Error((format("`%1%' requires at least 2 arguments")
+				% at(0)->str()).str(), exp.loc);
+		AType* tvar = tenv.type(this);
+		for (size_t i = 1; i < size(); ++i)
+			tenv.constrain(at(i), tvar);
+	} else if (arg.op == Instruction::ICmp) {
+		if (size() != 3) throw Error((format("`%1%' requires exactly 2 arguments")
+			   % at(0)->str()).str(), exp.loc);
+		tenv.constrain(at(1), tenv.type(at(2)));
+		tenv.constrain(this, tenv.named("Bool"));
+	} else {
+		throw Error((format("unknown primitive `%1%'") % at(0)->str()).str(), exp.loc);
+	}
+}
+
+
+/***************************************************************************
+ * Code Generation                                                         *
+ ***************************************************************************/
+
+// Compile-Time Environment
+
+CEngine::CEngine()
+	: module(new Module("tuplr"))
+	, engine(ExecutionEngine::create(module))
+{
+}
+
+struct CEnvPimpl {
+	CEnvPimpl(CEngine& engine)
+		: module(engine.module), emp(module), opt(&emp)
+	{
+		// Set up the optimizer pipeline:
+		const TargetData* target = engine.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
+	}
+
+	Module*                module;
+	ExistingModuleProvider emp;
+	FunctionPassManager    opt;
+	Function*              alloc;
+};
+
+CEnv::CEnv(PEnv& p, CEngine& eng)
+	: engine(eng), penv(p), tenv(p), symID(0), _pimpl(new CEnvPimpl(eng))
+{
+}
+
+CEnv::~CEnv()
+{
+	delete _pimpl;
+}
+
+CValue*
+CEnv::compile(AST* obj)
+{
+	CValue** v = vals.ref(obj);
+	return (v) ? *v : vals.def(obj, obj->compile(*this));
+}
+
+void
+CEnv::optimise(Function& f)
+{
+	verifyFunction(f);
+	_pimpl->opt.run(f);
+}
+
+#define LITERAL(CT, NAME, COMPILED) \
+template<> CValue* \
+ASTLiteral<CT>::compile(CEnv& cenv) { return (COMPILED); } \
+template<> void \
+ASTLiteral<CT>::constrain(TEnv& tenv) const { tenv.constrain(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))
+
+static Function*
+compileFunction(CEnv& cenv, const std::string& name, const CType* retT, const ASTTuple& prot,
+		const vector<string> argNames=vector<string>())
+{
+	Function::LinkageTypes linkage = Function::ExternalLinkage;
+
+	vector<const CType*> cprot;
+	for (size_t i = 0; i < prot.size(); ++i) {
+		AType* at = cenv.tenv.type(prot.at(i));
+		if (!at->type() || at->var()) throw Error("function parameter is untyped");
+		cprot.push_back(at->type());
+	}
+
+	if (!retT) throw Error("function return is untyped");
+	FunctionType* fT = FunctionType::get(retT, cprot, false);
+	Function*     f  = Function::Create(fT, linkage, name, cenv.engine.module);
+
+	if (f->getName() != name) {
+		f->eraseFromParent();
+		throw Error("function redefined");
+	}
+
+	// Set argument names in generated code
+	Function::arg_iterator a = f->arg_begin();
+	if (!argNames.empty())
+		for (size_t i = 0; i != prot.size(); ++a, ++i)
+			a->setName(argNames.at(i));
+	else
+		for (size_t i = 0; i != prot.size(); ++a, ++i)
+			a->setName(prot.at(i)->str());
+	
+	BasicBlock* bb = BasicBlock::Create("entry", f);
+	cenv.engine.builder.SetInsertPoint(bb);
+
+	return f;
+}
+
+CValue*
+ASTSymbol::compile(CEnv& cenv)
+{
+	AST** c = cenv.code.ref(this);
+	if (!c) throw Error((string("undefined symbol `") + cppstr + "'").c_str(), loc);
+	return cenv.compile(*c);
+}
+
+void
+ASTClosure::lift(CEnv& cenv)
+{
+	AType* type = cenv.tenv.type(this);
+	if (!type->concrete()) {
+		err << "closure is untyped, not lifting" << endl;
+		return;
+	}
+	
+	if (funcs.find(type))
+		return;
+
+	cenv.push();
+
+	// Write function declaration
+	string name = this->name == "" ? cenv.gensym("_fn") : this->name;
+	Function* f = compileFunction(cenv, name, cenv.tenv.type(at(2))->type(), *prot());
+
+	// Bind argument values in CEnv
+	vector<CValue*> args;
+	const_iterator p = prot()->begin();
+	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p)
+		cenv.vals.def(dynamic_cast<ASTSymbol*>(*p), &*a);
+
+	// Write function body
+	try {
+		cenv.precompile(this, f); // Define our value first for recursion
+		CValue* retVal = cenv.compile(at(2));
+		cenv.engine.builder.CreateRet(retVal); // Finish function
+		cenv.optimise(*f);
+		funcs.insert(type, f);
+	} catch (Error& e) {
+		f->eraseFromParent(); // Error reading body, remove function
+		throw e;
+	}
+
+	cenv.pop();
+}
+
+CValue*
+ASTClosure::compile(CEnv& cenv)
+{
+	return funcs.find(cenv.tenv.type(this));
+}
+
+void
+ASTCall::lift(CEnv& cenv)
+{
+	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
+	if (!c) {
+		AST** val = cenv.code.ref(at(0));
+		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
+	}
+
+	// Lift arguments
+	for (size_t i = 1; i < size(); ++i)
+		at(i)->lift(cenv);
+
+	if (!c) return;
+
+	// Extend environment with bound and typed parameters
+	cenv.push();
+	if (c->prot()->size() < size() - 1)
+		throw Error((format("too many arguments to function `%1%'") % at(0)->str()).str(), exp.loc);
+	if (c->prot()->size() > size() - 1)
+		throw Error((format("too few arguments to function `%1%'") % at(0)->str()).str(), exp.loc);
+
+	for (size_t i = 1; i < size(); ++i)
+		cenv.code.def(c->prot()->at(i-1), at(i));
+
+	c->lift(cenv); // Lift called closure
+	cenv.pop(); // Restore environment
+}
+
+CValue*
+ASTCall::compile(CEnv& cenv)
+{
+	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
+	if (!c) {
+		AST** val = cenv.code.ref(at(0));
+		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
+	}
+
+	assert(c);
+	Function* f = dynamic_cast<Function*>(cenv.compile(c));
+	if (!f) throw Error("callee failed to compile", exp.loc);
+
+	vector<CValue*> params(size() - 1);
+	for (size_t i = 1; i < size(); ++i)
+		params[i-1] = cenv.compile(at(i));
+
+	return cenv.engine.builder.CreateCall(f, params.begin(), params.end(), "calltmp");
+}
+
+void
+ASTDefinition::lift(CEnv& cenv)
+{
+	if (cenv.code.ref((ASTSymbol*)at(1)))
+		throw Error(string("`") + at(1)->str() + "' redefined", exp.loc);
+	cenv.code.def((ASTSymbol*)at(1), at(2)); // Define first for recursion
+	at(2)->lift(cenv);
+}
+
+CValue*
+ASTDefinition::compile(CEnv& cenv)
+{
+	return cenv.compile(at(2));
+}
+
+CValue*
+ASTIf::compile(CEnv& cenv)
+{
+	typedef vector< pair<CValue*, BasicBlock*> > Branches;
+	Function*     parent  = cenv.engine.builder.GetInsertBlock()->getParent();
+	BasicBlock*   mergeBB = BasicBlock::Create("endif");
+	BasicBlock*   nextBB  = NULL;
+	Branches      branches;
+	ostringstream ss;
+	for (size_t i = 1; i < size() - 1; i += 2) {
+		CValue* condV = cenv.compile(at(i));
+
+		ss.str(""); ss << "then" << ((i + 1) / 2);
+		BasicBlock* thenBB = BasicBlock::Create(ss.str());
+
+		ss.str(""); ss << "else" << ((i + 1) / 2);
+		nextBB = BasicBlock::Create(ss.str());
+
+		cenv.engine.builder.CreateCondBr(condV, thenBB, nextBB);
+
+		// Emit then block for this condition
+		parent->getBasicBlockList().push_back(thenBB);
+		cenv.engine.builder.SetInsertPoint(thenBB);
+		CValue* thenV = cenv.compile(at(i + 1));
+		cenv.engine.builder.CreateBr(mergeBB);
+		branches.push_back(make_pair(thenV, cenv.engine.builder.GetInsertBlock()));
+
+		parent->getBasicBlockList().push_back(nextBB);
+		cenv.engine.builder.SetInsertPoint(nextBB);
+	}
+
+	// Emit else block
+	cenv.engine.builder.SetInsertPoint(nextBB);
+	CValue* elseV = cenv.compile(at(size() - 1));
+	cenv.engine.builder.CreateBr(mergeBB);
+	branches.push_back(make_pair(elseV, cenv.engine.builder.GetInsertBlock()));
+
+	// Emit merge block (Phi node)
+	parent->getBasicBlockList().push_back(mergeBB);
+	cenv.engine.builder.SetInsertPoint(mergeBB);
+	PHINode* pn = cenv.engine.builder.CreatePHI(cenv.tenv.type(this)->type(), "ifval");
+
+	for (Branches::iterator i = branches.begin(); i != branches.end(); ++i)
+		pn->addIncoming(i->first, i->second);
+
+	return pn;
+}
+
+CValue*
+ASTPrimitive::compile(CEnv& cenv)
+{
+	CValue* a = cenv.compile(at(1));
+	CValue* b = cenv.compile(at(2));
+
+	if (OP_IS_A(arg.op, Instruction::BinaryOps)) {
+		const Instruction::BinaryOps bo = (Instruction::BinaryOps)arg.op;
+		if (size() == 2)
+			return cenv.compile(at(1));
+		CValue* val = cenv.engine.builder.CreateBinOp(bo, a, b);
+		for (size_t i = 3; i < size(); ++i)
+			val = cenv.engine.builder.CreateBinOp(bo, val, cenv.compile(at(i)));
+		return val;
+	} else if (arg.op == Instruction::ICmp) {
+		bool isInt = cenv.tenv.type(at(1))->str() == "Int";
+		if (isInt) {
+			return cenv.engine.builder.CreateICmp((CmpInst::Predicate)arg.arg, a, b);
+		} else {
+			// Translate to floating point operation
+			switch (arg.arg) {
+			case CmpInst::ICMP_EQ:  arg.arg = CmpInst::FCMP_OEQ; break;
+			case CmpInst::ICMP_NE:  arg.arg = CmpInst::FCMP_ONE; break;
+			case CmpInst::ICMP_SGT: arg.arg = CmpInst::FCMP_OGT; break;
+			case CmpInst::ICMP_SGE: arg.arg = CmpInst::FCMP_OGE; break;
+			case CmpInst::ICMP_SLT: arg.arg = CmpInst::FCMP_OLT; break;
+			case CmpInst::ICMP_SLE: arg.arg = CmpInst::FCMP_OLE; break;
+			default: throw Error("Unknown primitive", exp.loc);
+			}
+			return cenv.engine.builder.CreateFCmp((CmpInst::Predicate)arg.arg, a, b);
+		}
+	}
+	throw Error("Unknown primitive", exp.loc);
+}
+
+AType*
+ASTConsCall::functionType(CEnv& cenv)
+{
+	ASTTuple* protTypes = new ASTTuple(cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL);
+	AType* cellType = new AType(ASTTuple(cenv.penv.sym("Pair"),
+				cenv.tenv.type(at(1)), cenv.tenv.type(at(2)), NULL));
+	return new AType(ASTTuple(cenv.penv.sym("Fn"), protTypes, cellType, NULL));
+}
+
+void
+ASTConsCall::lift(CEnv& cenv)
+{
+	AType* funcType = functionType(cenv);
+	if (funcs.find(functionType(cenv)))
+		return;
+	
+	ASTCall::lift(cenv);
+	
+	ASTTuple* prot = new ASTTuple(at(1), at(2), NULL);
+
+	vector<const CType*> types;
+	size_t sz = 0;
+	for (size_t i = 1; i < size(); ++i) {
+		const CType* t = cenv.tenv.type(at(i))->type();
+		types.push_back(t);
+		sz += t->getPrimitiveSizeInBits();
+	}
+	sz = (sz % 8 == 0) ? sz / 8 : sz / 8 + 1;
+
+	StructType* sT = StructType::get(types, false);
+	CType* pT = PointerType::get(sT, 0);
+	
+	// Write function declaration
+	vector<string> argNames;
+	argNames.push_back("car");
+	argNames.push_back("cdr");
+	Function* func = compileFunction(cenv, cenv.gensym("cons"), pT, *prot, argNames);
+
+	CValue* mem = cenv.engine.builder.CreateCall(cenv.alloc, ConstantInt::get(Type::Int32Ty, sz), "mem");
+	CValue* cell = cenv.engine.builder.CreateBitCast(mem, pT, "cell");
+	CValue* s = cenv.engine.builder.CreateGEP(cell, ConstantInt::get(Type::Int32Ty, 0), "pair");
+	CValue* carP = cenv.engine.builder.CreateStructGEP(s, 0, "car");
+	CValue* cdrP = cenv.engine.builder.CreateStructGEP(s, 1, "cdr");
+	Function::arg_iterator ai = func->arg_begin();
+	Value& carArg = *ai++;
+	Value& cdrArg = *ai++;
+	cenv.engine.builder.CreateStore(&carArg, carP);
+	cenv.engine.builder.CreateStore(&cdrArg, cdrP);
+	cenv.engine.builder.CreateRet(cell);
+	cenv.optimise(*func);
+
+	funcs.insert(funcType, func);
+}
+
+CValue*
+ASTConsCall::compile(CEnv& cenv)
+{
+	vector<CValue*> params(size() - 1);
+	for (size_t i = 1; i < size(); ++i)
+		params[i-1] = cenv.compile(at(i));
+
+	return cenv.engine.builder.CreateCall(funcs.find(functionType(cenv)), params.begin(), params.end());
+}
+
+CValue*
+ASTCarCall::compile(CEnv& cenv)
+{
+	AST**  arg  = cenv.code.ref(at(1));
+	CValue* sP   = arg ? (*arg)->compile(cenv) : at(1)->compile(cenv);
+	CValue* s    = cenv.engine.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
+	CValue* carP = cenv.engine.builder.CreateStructGEP(s, 0, "car");
+	return cenv.engine.builder.CreateLoad(carP);
+}
+
+CValue*
+ASTCdrCall::compile(CEnv& cenv)
+{
+	AST**  arg  = cenv.code.ref(at(1));
+	CValue* sP   = arg ? (*arg)->compile(cenv) : at(1)->compile(cenv);
+	CValue* s    = cenv.engine.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
+	CValue* cdrP = cenv.engine.builder.CreateStructGEP(s, 1, "cdr");
+	return cenv.engine.builder.CreateLoad(cdrP);
+}
+
+
+/***************************************************************************
+ * EVAL/REPL/MAIN                                                          *
+ ***************************************************************************/
+
+std::string
+call(AType* retT, void* fp)
+{
+	std::stringstream ss;
+	if (retT->type() == Type::Int32Ty)
+		ss << ((int32_t (*)())fp)();
+	else if (retT->type() == Type::FloatTy)
+		ss << ((float (*)())fp)();
+	else if (retT->type() == Type::Int1Ty)
+		ss << ((bool (*)())fp)();
+	else
+		ss << ((void* (*)())fp)();
+	return ss.str();
+}
+
+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.list.empty())
+				break;
+
+			result = parseExpression(cenv.penv, exp); // Parse input
+			result->constrain(cenv.tenv); // Constrain types
+			cenv.tenv.solve(); // Solve and apply type constraints
+			resultType = cenv.tenv.type(result);
+			result->lift(cenv); // Lift functions
+			exprs.push_back(make_pair(exp, result));
+		}
+
+		if (!resultType || resultType->var()) throw Error("body is undefined/untyped", cursor);
+		
+		const CType* ctype = resultType->type();
+		if (!ctype) throw Error("body has no system type", cursor);
+
+		// Create function for top-level of program
+		Function* f = compileFunction(cenv, cenv.gensym("input"), ctype, ASTTuple());
+
+		// Compile all expressions into it
+		CValue* val  = NULL;
+		for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
+			val = cenv.compile(i->second);
+
+		// Finish function
+		cenv.engine.builder.CreateRet(val);
+		cenv.optimise(*f);
+
+		string resultStr = call(resultType, cenv.engine.engine->getPointerToFunction(f));
+		out << resultStr << " : " << resultType->str() << endl;
+
+	} catch (Error& e) {
+		err << e.what() << endl;
+		return 1;
+	}
+
+	return 0;
+}
+
+int
+repl(CEnv& cenv)
+{
+	while (1) {
+		out << "() ";
+		out.flush();
+		Cursor cursor("(stdin)");
+		SExp exp = readExpression(cursor, std::cin);
+		if (exp.type == SExp::LIST && exp.list.empty())
+			break;
+
+		try {
+			AST* body = parseExpression(cenv.penv, exp); // Parse input
+			body->constrain(cenv.tenv); // Constrain types
+			cenv.tenv.solve(); // Solve and apply type constraints
+
+			AType* bodyT = cenv.tenv.type(body);
+			if (!bodyT)             throw Error("call to untyped body", cursor);
+			if (!bodyT->concrete()) throw Error("call to variable typed body", cursor);
+
+			body->lift(cenv);
+			
+			if (bodyT->type()) {
+				// Create anonymous function to insert code into
+				Function* f = compileFunction(cenv, cenv.gensym("_repl"), bodyT->type(), ASTTuple());
+				try {
+					CValue* retVal = cenv.compile(body);
+					cenv.engine.builder.CreateRet(retVal); // Finish function
+					cenv.optimise(*f);
+				} catch (Error& e) {
+					f->eraseFromParent(); // Error reading body, remove function
+					throw e;
+				}
+				out << call(bodyT, cenv.engine.engine->getPointerToFunction(f));
+			} else {
+				CValue* val = cenv.compile(body);
+				out << ";   " << val;
+			}
+			out << " : " << cenv.tenv.type(body)->str() << endl;
+
+		} catch (Error& e) {
+			err << e.what() << endl;
+		}
+	}
+
+	return 0;
+}
+
+int
+main(int argc, char** argv)
+{
+#define PRIM(O, A) PEnv::Parser(parseAST<ASTPrimitive>, CArg(Instruction:: O, A))
+	PEnv penv;
+	penv.reg("fn",   PEnv::Parser(parseFn));
+	penv.reg("if",   PEnv::Parser(parseAST<ASTIf>));
+	penv.reg("def",  PEnv::Parser(parseAST<ASTDefinition>));
+	penv.reg("cons", PEnv::Parser(parseAST<ASTConsCall>));
+	penv.reg("car",  PEnv::Parser(parseAST<ASTCarCall>));
+	penv.reg("cdr",  PEnv::Parser(parseAST<ASTCdrCall>));
+	penv.reg("+",    PRIM(Add,  0));
+	penv.reg("-",    PRIM(Sub,  0));
+	penv.reg("*",    PRIM(Mul,  0));
+	penv.reg("/",    PRIM(FDiv, 0));
+	penv.reg("%",    PRIM(FRem, 0));
+	penv.reg("&",    PRIM(And,  0));
+	penv.reg("|",    PRIM(Or,   0));
+	penv.reg("^",    PRIM(Xor,  0));
+	penv.reg("=",    PRIM(ICmp, CmpInst::ICMP_EQ));
+	penv.reg("!=",   PRIM(ICmp, CmpInst::ICMP_NE));
+	penv.reg(">",    PRIM(ICmp, CmpInst::ICMP_SGT));
+	penv.reg(">=",   PRIM(ICmp, CmpInst::ICMP_SGE));
+	penv.reg("<",    PRIM(ICmp, CmpInst::ICMP_SLT));
+	penv.reg("<=",   PRIM(ICmp, CmpInst::ICMP_SLE));
+
+	CEngine engine;
+	CEnv cenv(penv, engine);
+
+	cenv.tenv.def(penv.sym("Bool"),  new AType(penv.sym("Bool"),  Type::Int1Ty));
+	cenv.tenv.def(penv.sym("Int"),   new AType(penv.sym("Int"),   Type::Int32Ty));
+	cenv.tenv.def(penv.sym("Float"), new AType(penv.sym("Float"), Type::FloatTy));
+	
+	// Host provided allocation primitive prototypes
+	std::vector<const CType*> argsT(1, Type::Int32Ty);
+	FunctionType* funcT = FunctionType::get(PointerType::get(Type::Int8Ty, 0), argsT, false);
+	cenv.alloc = Function::Create(funcT, Function::ExternalLinkage, "malloc", engine.module);
+	
+	int ret;
+	if (argc > 2 && !strncmp(argv[1], "-e", 3)) {
+		std::istringstream is(argv[2]);
+		ret = eval(cenv, "(command line)", is);
+	} else if (argc > 2 && !strncmp(argv[1], "-f", 3)) {
+		std::ifstream is(argv[2]);
+		ret = eval(cenv, argv[2], is);
+		is.close();
+	} else {
+		ret = repl(cenv);
+	}
+	
+	//out << endl << "*** Generated Code ***" << endl;
+	//cenv.module->dump();
+
+	return ret;
+}
+
diff --git a/tuplr_llvm.hpp b/tuplr_llvm.hpp
new file mode 100644
index 0000000..99be041
--- /dev/null
+++ b/tuplr_llvm.hpp
@@ -0,0 +1,47 @@
+/* Tuplr LLVM Backend Definitions
+ * 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_LLVM_HPP
+#define TUPLR_LLVM_HPP
+
+#include "tuplr.hpp"
+#include "llvm/Analysis/Verifier.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"
+
+typedef llvm::Value    CValue;
+typedef llvm::Type     CType;
+typedef llvm::Function CFunction;
+
+struct CArg { CArg(int o=0, int a=0) : op(o), arg(a) {} int op; int arg; };
+
+struct CEngine {
+	CEngine();
+	llvm::Module*          module;
+	llvm::ExecutionEngine* engine;
+	llvm::IRBuilder<>      builder;
+};
+
+#endif // TUPLR_LLVM_HPP
+
diff --git a/typing.cpp b/typing.cpp
new file mode 100644
index 0000000..eeba8dc
--- /dev/null
+++ b/typing.cpp
@@ -0,0 +1,198 @@
+/* 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 "tuplr.hpp"
+void
+ASTTuple::constrain(TEnv& tenv) const
+{
+	AType* t = new AType(ASTTuple());
+	FOREACH(const_iterator, p, *this) {
+		(*p)->constrain(tenv);
+		t->push_back(tenv.type(*p));
+	}
+	tenv.constrain(this, t);
+}
+
+void
+ASTClosure::constrain(TEnv& tenv) const
+{
+	at(1)->constrain(tenv);
+	at(2)->constrain(tenv);
+	AType* protT = tenv.type(at(1));
+	AType* bodyT = tenv.type(at(2));
+	tenv.constrain(this, new AType(ASTTuple(
+			tenv.penv.sym("Fn"), protT, bodyT, 0)));
+}
+
+void
+ASTCall::constrain(TEnv& tenv) const
+{
+	FOREACH(const_iterator, p, *this)
+		(*p)->constrain(tenv);
+	AType* retT = tenv.type(this);
+	AType* argsT = new AType(ASTTuple());
+	for (size_t i = 1; i < size(); ++i)
+		argsT->push_back(tenv.type(at(i)));
+	tenv.constrain(at(0), new AType(ASTTuple(
+			tenv.penv.sym("Fn"), argsT, retT, NULL)));
+}
+
+void
+ASTDefinition::constrain(TEnv& tenv) const
+{
+	if (size() != 3)
+		throw Error("`def' requires exactly 2 arguments", exp.loc);
+	if (!dynamic_cast<const ASTSymbol*>(at(1)))
+		throw Error("`def' name is not a symbol", exp.loc);
+	FOREACH(const_iterator, p, *this)
+		(*p)->constrain(tenv);
+	AType* tvar = tenv.type(this);
+	tenv.constrain(at(1), tvar);
+	tenv.constrain(at(2), tvar);
+}
+
+void
+ASTIf::constrain(TEnv& tenv) const
+{
+	FOREACH(const_iterator, p, *this)
+		(*p)->constrain(tenv);
+	AType* tvar = tenv.type(this);
+	tenv.constrain(at(1), tenv.named("Bool"));
+	tenv.constrain(at(2), tvar);
+	tenv.constrain(at(3), tvar);
+}
+
+void
+ASTConsCall::constrain(TEnv& tenv) const
+{
+	AType* t = new AType(ASTTuple(tenv.penv.sym("Pair"), 0));
+	for (size_t i = 1; i < size(); ++i) {
+		at(i)->constrain(tenv);
+		t->push_back(tenv.type(at(i)));
+	}
+	tenv.constrain(this, t);
+}
+
+void
+ASTCarCall::constrain(TEnv& tenv) const
+{
+	at(1)->constrain(tenv);
+	AType* ct = tenv.var();
+	AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), ct, tenv.var(), 0));
+	tenv.constrain(at(1), tt);
+	tenv.constrain(this, ct);
+}
+
+void
+ASTCdrCall::constrain(TEnv& tenv) const
+{
+	at(1)->constrain(tenv);
+	AType* ct = tenv.var();
+	AType* tt = new AType(ASTTuple(tenv.penv.sym("Pair"), tenv.var(), ct, 0));
+	tenv.constrain(at(1), tt);
+	tenv.constrain(this, ct);
+}
+
+static void
+substitute(ASTTuple* tup, 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
+			substitute(dynamic_cast<ASTTuple*>(tup->at(i)), from, to);
+}
+
+bool
+ASTTuple::contains(AST* child) const
+{
+	if (*this == *child) return true;
+	FOREACH(const_iterator, p, *this)
+		if (**p == *child || (*p)->contains(child))
+			return true;
+	return false;
+}
+
+TSubst
+compose(const TSubst& delta, const TSubst& gamma) // TAPL 22.1.1
+{
+	TSubst r;
+	for (TSubst::const_iterator g = gamma.begin(); g != gamma.end(); ++g) {
+		TSubst::const_iterator d = delta.find(g->second);
+		r.insert(make_pair(g->first, ((d != delta.end()) ? d : g)->second));
+	}
+	for (TSubst::const_iterator d = delta.begin(); d != delta.end(); ++d) {
+		if (gamma.find(d->first) == gamma.end())
+			r.insert(*d);
+	}
+	return r;
+}
+
+void
+substConstraints(TEnv::Constraints& constraints, AType* s, AType* t)
+{
+	for (TEnv::Constraints::iterator c = constraints.begin(); c != constraints.end();) {
+		TEnv::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;
+	}
+}
+
+TSubst
+TEnv::unify(const Constraints& constraints) // TAPL 22.4
+{
+	if (constraints.empty()) return TSubst();
+	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 compose(unify(cp), TSubst(s, t));
+	} else if (t->var() && !s->contains(t)) {
+		substConstraints(cp, t, s);
+		return compose(unify(cp), TSubst(t, s));
+	} else if (s->size() == t->size()) {
+		for (size_t i = 0; i < s->size(); ++i) {
+			AType* si = dynamic_cast<AType*>(s->at(i));
+			AType* ti = dynamic_cast<AType*>(t->at(i));
+			if (si && ti)
+				cp.push_back(make_pair(si, ti));
+		}
+		return unify(cp);
+	} else {
+		throw Error("Type unification failed");
+	}
+}
+
+void
+TEnv::apply(const TSubst& substs)
+{
+	FOREACH(TSubst::const_iterator, s, substs)
+		FOREACH(Frame::iterator, t, front())
+			if (*t->second == *s->first)
+				t->second = s->second;
+			else
+				substitute(t->second, s->first, s->second);
+}