/* Resp: A programming language
 * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
 *
 * Resp 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.
 *
 * Resp 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 Resp.  If not, see <http://www.gnu.org/licenses/>.
 */

/** @file
 * @brief Interface and type definitions
 */

#ifndef RESP_HPP
#define RESP_HPP

#include <stdarg.h>
#include <stdint.h>
#include <string.h>
#include <iostream>
#include <list>
#include <map>
#include <set>
#include <sstream>
#include <stack>
#include <string>
#include <vector>
#include <boost/format.hpp>

#define FOREACH(IT, i, c)  for (IT i = (c).begin(); i != (c).end(); ++i)
#define FOREACHP(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; }
	const Cursor loc;
	const string msg;
};

/// 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 ~Env() {}
	virtual void push(Frame f=Frame()) { list<Frame>::push_front(f); }
	virtual void pop()                 { 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;
	}
	bool contains(const Frame& frame, const K& key) const {
		for (typename Frame::const_iterator b = frame.begin(); b != frame.end(); ++b)
			if (b->first == key)
				return true;
		return false;
	}
	bool topLevel(const K& key) const { return contains(this->back(), key); }
	bool innermost(const K& key) const { return contains(this->front(), key); }
};

template<typename K, typename V>
ostream& operator<<(ostream& out, const Env<K,V>& env) {
	out << "(Env" << endl;
	for (typename Env<K,V>::const_reverse_iterator f = env.rbegin(); f != env.rend(); ++f) {
		out << "  (" << endl;
		for (typename Env<K,V>::Frame::const_iterator b = f->begin(); b != f->end(); ++b)
			cout << "    " << b->first << " " << b->second << endl;
		out << "  )" << endl;
	}
	out << ")" << endl;
	return out;
}


/***************************************************************************
 * Lexer: Text (istream) -> S-Expressions (SExp)                           *
 ***************************************************************************/

struct AST;
AST* readExpression(Cursor& cur, std::istream& in);


/***************************************************************************
 * Backend Types                                                           *
 ***************************************************************************/

typedef void* CVal;  ///< Compiled value (opaque)
typedef void* CFunc; ///< Compiled function (opaque)


/***************************************************************************
 * Garbage Collection                                                      *
 ***************************************************************************/

struct Object;

/// Garbage collector
struct GC {
	typedef std::list<const Object*> Roots;
	typedef std::list<Object*>       Heap;
	GC(size_t pool_size);
	~GC();
	void* alloc(size_t size);
	void  collect(const Roots& roots);
	void  addRoot(const Object* obj) { assert(obj); _roots.push_back(obj); }
	void  lock() { _roots.insert(_roots.end(), _heap.begin(), _heap.end()); }
	const Roots& roots() const { return _roots; }
private:
	void* _pool;
	Heap  _heap;
	Roots _roots;
};

/// Garbage collected object (including AST and runtime data)
struct Object {
	enum Tag { OBJECT = 123, AST = 456 };

	struct Header {
		uint32_t mark;
		uint32_t tag;
	};

	inline Tag  tag()        const { return (Tag)header()->tag; }
	inline void tag(Tag t)         { header()->tag = t; }
	inline bool marked()     const { return header()->mark != 0; }
	inline void mark(bool b) const { header()->mark = (b ? 1 : 0); }

	static void* operator new(size_t size)  { return pool.alloc(size); }
	static void  operator delete(void* ptr) {}

	// Memory used with placement new MUST always be allocated with pool.alloc!
	static void* operator new(size_t size, void* ptr) { return ptr; }

	static GC pool;

private:
	/// Always allocated with pool.alloc, so this - sizeof(Header) is a valid Header*.
	inline Header* header() const { return (Header*)((char*)this - sizeof(Header)); }
};


/***************************************************************************
 * Abstract Syntax Tree                                                    *
 ***************************************************************************/

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);

typedef list<AST*> Code;

/// 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 throw(Error) {}
	virtual AST* cps(TEnv& tenv, AST* cont) const;
	virtual AST* lift(CEnv& cenv, Code& code) throw() { return this; }
	virtual AST* depoly(CEnv& cenv, Code& code) throw() { return this; }
	virtual CVal compile(CEnv& env) const throw() = 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 const to() const { return dynamic_cast<T const>(this); }
	template<typename T> T as() {
		T t = dynamic_cast<T>(this);
		return t ? t : throw Error(loc, "internal error: bad cast");
	}
	template<typename T> T const as() const {
		T const t = dynamic_cast<T const>(this);
		return t ? t : throw Error(loc, "internal error: bad cast");
	}
	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 T>
struct ALiteral : public AST {
	ALiteral(T v, Cursor c) : AST(c), val(v) {}
	bool operator==(const AST& rhs) const {
		const ALiteral<T>* r = rhs.to<const ALiteral<T>*>();
		return (r && (val == r->val));
	}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	CVal compile(CEnv& env) const throw();
	const T val;
};

/// Lexeme (any atom in the CST, e.g. "a", "3.4", ""hello"", etc.
struct ALexeme : public AST, public std::string {
	ALexeme(Cursor c, const string& s) : AST(c), std::string(s) {}
	bool operator==(const AST& rhs) const { return this == &rhs; }
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	CVal compile(CEnv& env) const throw();
};

/// String, e.g. ""a""
struct AString : public AST, public std::string {
	AString(Cursor c, const string& s) : AST(c), std::string(s) {}
	bool operator==(const AST& rhs) const { return this == &rhs; }
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	CVal compile(CEnv& env) const throw();
};

/// Symbol, e.g. "a"
struct ASymbol : public AST {
	bool operator==(const AST& rhs) const { return this == &rhs; }
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* lift(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
	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 {
	ATuple(Cursor c) : AST(c), _len(0), _vec(0) {}
	ATuple(const ATuple& exp) : AST(exp.loc), _len(exp._len) {
		_vec = (AST**)malloc(sizeof(AST*) * _len);
		memcpy(_vec, exp._vec, sizeof(AST*) * _len);
	}
	ATuple(Cursor c, AST* ast, va_list args) : AST(c), _len(0), _vec(0) {
		if (!ast) return;
		push_back(ast);
		for (AST* a = va_arg(args, AST*); a; a = va_arg(args, AST*))
			push_back(a);
	}
	~ATuple() { free(_vec); }
	void push_back(AST* ast) {
		AST** newvec = (AST**)realloc(_vec, sizeof(AST*) * (_len + 1));
		newvec[_len++] = ast;
		_vec = newvec;
	}
	void push_front(AST* ast) {
		AST** newvec = (AST**)malloc(sizeof(AST*) * (_len + 1));
		newvec[0] = ast;
		memcpy(newvec + 1, _vec, sizeof(AST*) * _len++);
		_vec = newvec;
	}
	const AST* head()  const { assert(_len > 0); return _vec[0]; }
	AST*       head()        { assert(_len > 0); return _vec[0]; }
	const AST* last()  const { return _vec[_len - 1]; }
	AST*       last()        { return _vec[_len - 1]; }
	size_t     size()  const { return _len; }
	bool       empty() const { return _len == 0; }

	typedef AST**       iterator;
	typedef AST* const* const_iterator;
	const_iterator begin() const { return _vec; }
	iterator       begin()       { return _vec; }
	const_iterator end()   const { return _vec + _len; }
	iterator       end()         { return _vec + _len; }

	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();
		FOREACHP(const_iterator, r, rt)
			if (!(*(*l++) == *(*r)))
				return false;
		return true;
	}
	bool contains(const AST* child) const {
		if (*this == *child) return true;
		FOREACHP(const_iterator, p, this)
			if (**p == *child || (*p)->contains(child))
				return true;
		return false;
	}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();

	CVal compile(CEnv& env) const throw();

private:
	size_t _len;
	AST**  _vec;
};

/// Type Expression, e.g. "Int", "(Fn (Int Int) Float)"
struct AType : public ATuple {
	enum Kind { VAR, NAME, PRIM, EXPR, DOTS };
	AType(ASymbol* s, Kind k) : ATuple(s->loc), kind(k), id(0) { push_back(s); }
	AType(Cursor c, unsigned i) : ATuple(c), kind(VAR), id(i) {}
	AType(Cursor c, Kind k=EXPR) : ATuple(c), kind(k), id(0) {}
	AType(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args), kind(EXPR), id(0) {}
	AType(const AType& copy) : ATuple(copy), kind(copy.kind), id(copy.id) { }
	CVal compile(CEnv& cenv) const throw();
	const ATuple* prot() const { assert(kind == EXPR); return (*(begin() + 1))->to<const ATuple*>(); }
	ATuple*       prot()       { assert(kind == EXPR); return (*(begin() + 1))->to<ATuple*>(); }
	bool concrete() const {
		switch (kind) {
		case VAR:  return false;
		case NAME: return false;
		case PRIM: return head()->str() != "Nothing";
		case EXPR:
			FOREACHP(const_iterator, t, this) {
				AType* kid = (*t)->to<AType*>();
				if (kid && !kid->concrete())
					return false;
			}
		case DOTS: return false;
		}
		return true;
	}
	bool operator==(const AST& rhs) const {
		const AType* rt = rhs.to<const AType*>();
		if (!rt || kind != rt->kind) {
			assert(str() != rt->str());
			return false;
		} else
			switch (kind) {
			case VAR:   return id == rt->id;
			case NAME:  return head()->str() == rt->head()->str();
			case PRIM:  return head()->str() == rt->head()->str();
			case EXPR:  return ATuple::operator==(rhs);
			case DOTS:  return true;
			}
		return false; // never reached
	}
	Kind     kind;
	unsigned id;
};

/// Fn (first-class function with captured lexical bindings)
struct AFn : public ATuple {
	AFn(const ATuple* exp) : ATuple(*exp) {}
	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 throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
	const ATuple* prot() const { return (*(begin() + 1))->to<const ATuple*>(); }
	ATuple*       prot()       { return (*(begin() + 1))->to<ATuple*>(); }
	string name;
};

/// Function call/application, e.g. "(func arg1 arg2)"
struct ACall : public ATuple {
	ACall(const ATuple* exp) : ATuple(*exp) {}
	ACall(Cursor c, AST* ast, va_list args) : ATuple(c, ast, args) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

/// Definition special form, e.g. "(def x 2)"
struct ADef : public ACall {
	ADef(const ATuple* exp) : ACall(exp) {}
	ADef(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	const ASymbol* sym() const {
		const AST*     name = *(begin() + 1);
		const ASymbol* sym  = name->to<const ASymbol*>();
		if (!sym) {
			const ATuple* tup = name->to<const ATuple*>();
			if (tup && !tup->empty())
				return tup->head()->to<const ASymbol*>();
		}
		return sym;
	}
	const AST* body() const { return *(begin() + 2); }
	AST*       body()       { return *(begin() + 2); }
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

struct ADefType : public ACall {
	ADefType(const ATuple* exp) : ACall(exp) {}
	ADefType(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	const ASymbol* sym() const { return (*(begin() + 1))->as<const ASymbol*>(); }
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw() { return this; }
	AST* depoly(CEnv& cenv, Code& code) throw() { return this; }
	CVal compile(CEnv& env) const throw() { return NULL; }
};

struct AMatch : public ACall {
	AMatch(const ATuple* exp) : ACall(exp) {}
	AMatch(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw() { return this; }
	AST* depoly(CEnv& cenv, Code& code) throw() { return this; }
	CVal compile(CEnv& env) const throw();
};

/// Conditional special form, e.g. "(if cond thenexp elseexp)"
struct AIf : public ACall {
	AIf(const ATuple* exp) : ACall(exp) {}
	AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

struct ACons : public ACall {
	ACons(const ATuple* exp) : ACall(exp) {}
	ACons(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

struct ADot : public ACall {
	ADot(const ATuple* exp) : ACall(exp) {}
	ADot(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

/// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
struct APrimitive : public ACall {
	APrimitive(const ATuple* exp) : ACall(exp) {}
	bool value() const {
		ATuple::const_iterator i = begin();
		for (++i; i != end(); ++i)
			if (!(*i)->value())
				return false;;
		return true;
	}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* cps(TEnv& tenv, AST* cont) const;
	AST* lift(CEnv& cenv, Code& code) throw();
	AST* depoly(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};

struct AQuote : public ACall {
	AQuote(const ATuple* exp) : ACall(exp) {}
	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
	AST* lift(CEnv& cenv, Code& code) throw();
	CVal compile(CEnv& env) const throw();
};
	

/***************************************************************************
 * 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 AST*, void*); ///< Parse Function
	typedef AST* (*MF)(PEnv&, const AST*); ///< 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 ALexeme& 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;
		}
	}
	AST* parse(const AST* exp);
	unsigned symID;
};


/***************************************************************************
 * Typing                                                                  *
 ***************************************************************************/

/// Type constraint
struct Constraint : public pair<const AType*,const AType*> {
	Constraint(const AType* a, const AType* b)
		: pair<const AType*, const AType*>(a, b) {}
};

/// Type substitution
struct Subst : public list<Constraint> {
	Subst(const AType* s=0, const AType* t=0) {
		if (s && t) { assert(s != t); push_back(Constraint(s, t)); }
	}
	static Subst compose(const Subst& delta, const Subst& gamma);
	void add(const AType* from, const AType* to) { push_back(Constraint(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();
	}
	const AType* apply(const AType* in) const {
		if (in->kind == AType::EXPR) {
			AType* out = tup<AType>(in->loc, NULL);
			for (ATuple::const_iterator i = in->begin(); i != in->end(); ++i)
				out->push_back(const_cast<AType*>(apply((*i)->as<AType*>())));
			return out;
		} else {
			const_iterator i = find(in);
			if (i != end()) {
				const AType* out = i->second->as<const AType*>();
				if (out->kind == AType::EXPR && !out->concrete())
					out = const_cast<AType*>(apply(out->as<const AType*>()));
				return out;
			} else {
				return new AType(*in);
			}
		}
	}
	bool contains(const AType* type) const {
		if (find(type) != end())
			return true;
		FOREACHP(const_iterator, j, this)
			if (*j->second == *type || j->second->contains(type))
				return true;
		return false;
	}
};

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;
}

/// Type constraint set
struct Constraints : public list<Constraint> {
	Constraints() : list<Constraint>() {}
	Constraints(const Subst& subst) : list<Constraint>() {
		FOREACH(Subst::const_iterator, i, subst)
			push_back(Constraint(new AType(*i->first), new AType(*i->second)));
	}
	Constraints(const_iterator begin, const_iterator end) : list<Constraint>(begin, end) {}
	void constrain(TEnv& tenv, const AST* o, const AType* t);
	Constraints& replace(const AType* s, const 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*, const AType*> {
	TEnv(PEnv& p)
		: penv(p)
		, varID(1)
		, Fn(new AType(penv.sym("Fn"), AType::PRIM))
		, Tup(new AType(penv.sym("Tup"), AType::NAME))
		, U(new AType(penv.sym("U"), AType::PRIM))
	{
		Object::pool.addRoot(Fn);
	}
	const AType* fresh(const ASymbol* sym) {
		return def(sym, new AType(sym->loc, varID++));
	}
	const AType* var(const AST* ast=0) {
		if (!ast)
			return new AType(Cursor(), varID++);

		const ASymbol* sym = ast->to<const ASymbol*>();
		if (sym)
			return *ref(sym);

		Vars::iterator v = vars.find(ast);
		if (v != vars.end())
			return v->second;

		return (vars[ast] = new AType(ast->loc, varID++));
	}
	const AType* named(const string& name) {
		return *ref(penv.sym(name));
	}
	static Subst buildSubst(const AType* fnT, const AType& argsT);

	typedef map<const AST*, const AType*> Vars;

	Vars     vars;
	PEnv&    penv;
	unsigned varID;

	AType* Fn;
	AType* Tup;
	AType* U;
};

Subst unify(const Constraints& c);


/***************************************************************************
 * Code Generation                                                         *
 ***************************************************************************/

/// Compiler backend
struct Engine {
	virtual ~Engine() {}

	typedef const vector<CVal> ValVec;

	virtual CFunc startFunction(
			CEnv&                cenv,
			const std::string&   name,
			const ATuple*        args,
			const AType*         type) = 0;

	virtual void pushFunctionArgs(CEnv& cenv, const AFn* fn, const AType* type, CFunc f) = 0;

	virtual void  finishFunction(CEnv& cenv, CFunc f, CVal ret)                          = 0;
	virtual void  eraseFunction(CEnv& cenv, CFunc f)                                     = 0;
	virtual CVal  compileTup(CEnv& cenv, const AType* t, CVal rtti, ValVec& f)           = 0;
	virtual CVal  compileDot(CEnv& cenv, CVal tup, int32_t index)                        = 0;
	virtual CVal  compileLiteral(CEnv& cenv, const AST* lit)                             = 0;
	virtual CVal  compileString(CEnv& cenv, const char* str)                             = 0;
	virtual CVal  compileCall(CEnv& cenv, CFunc f, const AType* fT, ValVec& args)        = 0;
	virtual CVal  compilePrimitive(CEnv& cenv, const APrimitive* prim)                   = 0;
	virtual CVal  compileIf(CEnv& cenv, const AIf* aif)                                  = 0;
	virtual CVal  compileMatch(CEnv& cenv, const AMatch* match)                          = 0;
	virtual CVal  compileGlobal(CEnv& cenv, const AType* t, const string& sym, CVal val) = 0;
	virtual CVal  getGlobal(CEnv& cenv, const string& sym, CVal val)                     = 0;
	virtual void  writeModule(CEnv& cenv, std::ostream& os)                              = 0;

	virtual const string call(CEnv& cenv, CFunc f, const AType* retT) = 0;
};

Engine* resp_new_llvm_engine();
Engine* resp_new_c_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 ASymbol*, CVal> Vals;

	Engine* engine() { return _engine; }
	void    push() { code.push(); tenv.push(); vals.push(); }
	void    pop()  { code.pop(); tenv.pop();  vals.pop();  }
	void    lock(const AST* ast) {
		Object::pool.addRoot(ast);
		if (type(ast))
				Object::pool.addRoot(type(ast));
	}
	const AType* type(const AST* ast, const Subst& subst = Subst()) const {
		const ASymbol* sym = ast->to<const ASymbol*>();
		if (sym) {
			const AType** rec = tenv.ref(sym);
			return rec ? *rec : NULL;
		}
		const AType* var = tenv.vars[ast];
		if (var) {
			return tsubst.apply(subst.apply(var))->to<const AType*>();
		}
		return NULL;
	}
	void def(const ASymbol* sym, const AST* c, const AType* t, CVal v) {
		code.def(sym, c);
		tenv.def(sym, t);
		vals.def(sym, v);
	}
	const AST* resolve(const AST* ast) {
		const ASymbol* sym = ast->to<const ASymbol*>();
		const AST**          rec = code.ref(sym);
		return rec ? *rec : ast;
	}
	void setType(AST* ast, const AType* type) {
		const AType* tvar = tenv.var();
		tenv.vars.insert(make_pair(ast, tvar));
		tsubst.add(tvar, type);
	}
	void setTypeSameAs(AST* ast, AST* typedAst) {
		tenv.vars.insert(make_pair(ast, tenv.vars[typedAst]));
	}

	ostream& out;
	ostream& err;
	PEnv&    penv;
	TEnv&    tenv;
	Vals     vals;
	Subst    tsubst;

	Env<const ASymbol*, const AST*> code;

	typedef map<const AFn*, CFunc> Impls;
	Impls impls;

	CFunc findImpl(const AFn* fn, const AType* type) {
		Impls::const_iterator i = impls.find(fn);
		return (i != impls.end()) ? i->second : NULL;
	}

	void addImpl(const AFn* fn, CFunc impl) {
		impls.insert(make_pair(fn, impl));
	}

	map<string,string> args;

	CFunc currentFn; ///< Currently compiling function

	struct FreeVars : public std::vector<ASymbol*> {
		FreeVars(AFn* f, const std::string& n) : fn(f), implName(n) {}
		AFn* const        fn;
		const std::string implName;
		int32_t index(ASymbol* sym) {
			const_iterator i = find(begin(), end(), sym);
			if (i != end()) {
				return i - begin() + 1;
			} else {
				push_back(sym);
				return size();
			}
		}
	};
	typedef std::stack<FreeVars> LiftStack;
	LiftStack liftStack;

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, bool execute);
int  repl(CEnv& cenv);

#endif // RESP_HPP