Literal lists (i.e. list quoting).

Compile type expressions.
Only compile a top-level function if program has code to run (i.e. isn't just definitions).
Cast tuples to Object when necessary to avoid LLVM IR type mismatches (for cons stores and return values).
Fix memory leaks.


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

9 files changed, 231 insertions, 80 deletions

diff --git a/src/c.cpp b/src/c.cpp
index a00c89b..7d5b125 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -43,18 +43,21 @@ struct CEngine : public Engine {
 
 	CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type);
 	void  pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f);
-	void  finishFn(CEnv& cenv, CFunc f, CVal ret);
+	void  finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT);
 	void  eraseFn(CEnv& cenv, CFunc f);
 
-	CVal    compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
-	CVal    compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
-	CVal    compileDot(CEnv& cenv, CVal tup, int32_t index);
-	CVal    compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
-	CVal    compileGlobalGet(CEnv& cenv, const string& s, CVal v);
-	CVal    compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
-	CVal    compileLiteral(CEnv& cenv, const AST* lit);
-	CVal    compilePrimitive(CEnv& cenv, const ATuple* prim);
-	CVal    compileString(CEnv& cenv, const char* str);
+	CVal  compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
+	CVal  compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
+	CVal  compileDot(CEnv& cenv, CVal tup, int32_t index);
+	CVal  compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
+	CVal  compileGlobalGet(CEnv& cenv, const string& s, CVal v);
+	CVal  compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
+	CVal  compileLiteral(CEnv& cenv, const AST* lit);
+	CVal  compilePrimitive(CEnv& cenv, const ATuple* prim);
+	CVal  compileString(CEnv& cenv, const char* str);
+	CType compileType(CEnv& cenv, const char* name, const AST* exp);
+
+	CType objectType(CEnv& cenv);
 
 	void writeModule(CEnv& cenv, std::ostream& os);
 
@@ -159,6 +162,18 @@ CEngine::compileString(CEnv& cenv, const char* str)
 	return new Value(string("\"") + str + "\"");
 }
 
+CType
+CEngine::compileType(CEnv& cenv, const char* name, const AST* expr)
+{
+	return NULL;
+}
+
+CType
+CEngine::objectType(CEnv& cenv)
+{
+	return new string("Object");
+}
+
 CFunc
 CEngine::startFn(CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type)
 {
@@ -212,7 +227,7 @@ CEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f)
 }
 
 void
-CEngine::finishFn(CEnv& cenv, CFunc f, CVal ret)
+CEngine::finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT)
 {
 	out += "return " + *(Value*)ret + ";\n}\n\n";
 }
diff --git a/src/compile.cpp b/src/compile.cpp
index 1de8a78..d2f0530 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -63,6 +63,7 @@ compile_cons(CEnv& cenv, const ATuple* cons) throw()
 	List         tlist(type);
 	vector<CVal> fields;
 	for (ATuple::const_iterator i = cons->iter_at(1); i != cons->end(); ++i) {
+		assert(cenv.type(*i));
 		tlist.push_back(cenv.type(*i));
 		fields.push_back(resp_compile(cenv, *i));
 	}
@@ -97,6 +98,19 @@ compile_def(CEnv& cenv, const ATuple* def) throw()
 }
 
 static CVal
+compile_def_type(CEnv& cenv, const ATuple* def) throw()
+{
+	const ASymbol* name = def->frst()->as_tuple()->fst()->as_symbol();
+	cenv.engine()->compileType(cenv, name->sym(), def->frst());
+	for (ATuple::const_iterator i = def->iter_at(2); i != def->end(); ++i) {
+		const ATuple*  exp = (*i)->as_tuple();
+		const ASymbol* tag = (*exp->begin())->as_symbol();
+		cenv.engine()->compileType(cenv, tag->sym(), exp);
+	}
+	return NULL;
+}
+
+static CVal
 compile_do(CEnv& cenv, const ATuple* ado) throw()
 {
 	CVal retVal = NULL;
@@ -111,7 +125,7 @@ compile_fn(CEnv& cenv, const ATuple* fn) throw()
 {
 	assert(!cenv.currentFn);
 
-	const AST* type = cenv.type(fn);
+	const AST* const type = cenv.type(fn);
 	CFunc f = cenv.findImpl(fn, type);
 	if (f)
 		return f;
@@ -127,7 +141,7 @@ compile_fn(CEnv& cenv, const ATuple* fn) throw()
 		retVal = resp_compile(cenv, *i);
 
 	// Write function conclusion and pop stack frame
-	cenv.engine()->finishFn(cenv, f, retVal);
+	cenv.engine()->finishFn(cenv, f, retVal, type->as_tuple()->frrst());
 	cenv.pop();
 	cenv.currentFn = NULL;
 
@@ -204,7 +218,7 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
 		else if (form == "def")
 			return compile_def(cenv, call);
 		else if (form == "def-type")
-			return NULL; // FIXME
+			return compile_def_type(cenv, call);
 		else if (form == "do")
 			return compile_do(cenv, call);
 		else if (form == "fn")
diff --git a/src/constrain.cpp b/src/constrain.cpp
index 7530f01..a4a1ad3 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -83,6 +83,7 @@ static void
 constrain_def(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 {
 	THROW_IF(call->list_len() != 3, call->loc, "`def' requires exactly 2 arguments");
+	THROW_IF(!call->frst()->to_symbol(), call->frst()->loc, "`def' name is not a symbol");
 	const ASymbol* const sym = call->list_ref(1)->as_symbol();
 	THROW_IF(!sym, call->loc, "`def' has no symbol")
 	const AST* const body = call->list_ref(2);
@@ -111,9 +112,7 @@ constrain_def_type(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 		List           consT;
 		consT.push_back(sym);
 		for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) {
-			const ASymbol* sym = (*i)->to_symbol();
-			THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol");
-			consT.push_back(sym);
+			consT.push_back(*i); // FIXME: ensure symbol, or list of symbol
 		}
 		consT.head->loc = exp->loc;
 		type.push_back(consT);
@@ -260,14 +259,28 @@ constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 }
 
 static void
+resp_constrain_quoted(TEnv& tenv, Constraints& c, const AST* ast) throw(Error)
+{
+	switch (ast->tag()) {
+	case T_SYMBOL:
+		c.constrain(tenv, ast, tenv.named("Symbol"));
+		return;
+	case T_TUPLE:
+		c.constrain(tenv, ast, tenv.named("List"));
+		FOREACHP(ATuple::const_iterator, i, ast->as_tuple())
+			resp_constrain_quoted(tenv, c, *i);
+		return;
+	default:
+		resp_constrain(tenv, c, ast);
+	}
+}
+
+static void
 constrain_quote(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 {
 	THROW_IF(call->list_len() != 2, call->loc, "`quote' requires exactly 1 argument");
-	switch (call->list_ref(1)->tag()) {
-	case T_TUPLE:  c.constrain(tenv, call, tenv.named("List"));   return;
-	case T_SYMBOL: c.constrain(tenv, call, tenv.named("Symbol")); return;
-	default: return;
-	}
+	resp_constrain_quoted(tenv, c, call->frst());
+	c.constrain(tenv, call, tenv.var(call->frst()));
 }
 
 static void
diff --git a/src/expand.cpp b/src/expand.cpp
index 53a415c..e5e3255 100644
--- a/src/expand.cpp
+++ b/src/expand.cpp
@@ -113,7 +113,7 @@ initLang(PEnv& penv, TEnv& tenv)
 {
 	// Types
 	const char* types[] = {
-		"Bool", "Float", "Int",  "Nothing", "String", "Symbol", "List", 0 };
+		"Bool", "Float", "Int",  "Nothing", "String", "Symbol", "List", "Expr", 0 };
 	for (const char** t = types; *t; ++t) {
 		const ASymbol* sym = penv.sym(*t);
 		tenv.def(sym, sym); // FIXME: define to NULL?
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 3f48dec..cc4bf47 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -58,18 +58,21 @@ struct LLVMEngine : public Engine {
 
 	CFunc startFn(CEnv& cenv, const string& name, const ATuple* args, const ATuple* type);
 	void  pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc f);
-	void  finishFn(CEnv& cenv, CFunc f, CVal ret);
+	void  finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT);
 	void  eraseFn(CEnv& cenv, CFunc f);
 
-	CVal compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
-	CVal compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
-	CVal compileDot(CEnv& cenv, CVal tup, int32_t index);
-	CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
-	CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v);
-	CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
-	CVal compileLiteral(CEnv& cenv, const AST* lit);
-	CVal compilePrimitive(CEnv& cenv, const ATuple* prim);
-	CVal compileString(CEnv& cenv, const char* str);
+	CVal  compileCall(CEnv& cenv, CFunc f, const ATuple* funcT, const vector<CVal>& args);
+	CVal  compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<CVal>& fields);
+	CVal  compileDot(CEnv& cenv, CVal tup, int32_t index);
+	CVal  compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
+	CVal  compileGlobalGet(CEnv& cenv, const string& s, CVal v);
+	CVal  compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse);
+	CVal  compileLiteral(CEnv& cenv, const AST* lit);
+	CVal  compilePrimitive(CEnv& cenv, const ATuple* prim);
+	CVal  compileString(CEnv& cenv, const char* str);
+	CType compileType(CEnv& cenv, const char* name, const AST* exp);
+
+	CType objectType(CEnv& cenv);
 
 	void writeModule(CEnv& cenv, std::ostream& os);
 
@@ -91,6 +94,10 @@ private:
 	IRBuilder<>          builder;
 	Function*            alloc;
 	FunctionPassManager* opt;
+	CType                objectT;
+
+	typedef std::map<const std::string, CType> CTypes;
+	CTypes compiledTypes;
 
 	unsigned labelIndex;
 };
@@ -114,9 +121,17 @@ LLVMEngine::LLVMEngine()
 
 	// Declare host provided allocation primitive
 	std::vector<const Type*> argsT(1, Type::getInt32Ty(context)); // unsigned size
-	FunctionType* funcT = FunctionType::get(PointerType::get(Type::getInt8Ty(context), 0), argsT, false);
-	alloc = Function::Create(funcT, Function::ExternalLinkage,
-	                         "resp_gc_allocate", module);
+	FunctionType* funcT = FunctionType::get(
+		PointerType::get(Type::getInt8Ty(context), 0), argsT, false);
+	alloc = Function::Create(
+		funcT, Function::ExternalLinkage, "resp_gc_allocate", module);
+
+	// Build Object type (tag only, binary compatible with any constructed thing)
+	vector<const Type*> ctypes;
+	ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI
+	StructType* cObjectT = StructType::get(context, ctypes, false);
+	module->addTypeName("Object", cObjectT);
+	objectT = cObjectT;
 }
 
 LLVMEngine::~LLVMEngine()
@@ -141,6 +156,7 @@ LLVMEngine::llType(const AST* t)
 		if (sym == "Float")   return Type::getFloatTy(context);
 		if (sym == "String")  return PointerType::get(Type::getInt8Ty(context), NULL);
 		if (sym == "Symbol")  return PointerType::get(Type::getInt8Ty(context), NULL);
+		if (sym == "Expr")    return PointerType::get(Type::getInt8Ty(context), NULL);
 	} else if (is_form(t, "Fn")) {
 		ATuple::const_iterator i     = t->as_tuple()->begin();
 		const ATuple*          protT = (*++i)->to_tuple();
@@ -209,9 +225,16 @@ LLVMEngine::compileCons(CEnv& cenv, const ATuple* type, CVal rtti, const vector<
 	if (rtti)
 		builder.CreateStore((Value*)rtti, builder.CreateStructGEP(structPtr, 0, "rtti"));
 	size_t i = 1;
-	for (vector<CVal>::const_iterator f = fields.begin(); f != fields.end(); ++f, ++i) {
-		builder.CreateStore(llVal(*f),
-				builder.CreateStructGEP(structPtr, i, (format("tup%1%") % i).str().c_str()));
+	ATuple::const_iterator t = type->iter_at(1);
+	for (vector<CVal>::const_iterator f = fields.begin(); f != fields.end(); ++f, ++i, ++t) {
+		Value* val = llVal(*f);
+		Value* field = builder.CreateStructGEP(
+			structPtr, i, (format("tup%1%") % i).str().c_str());
+
+		if ((*t)->to_tuple())
+			val = builder.CreateBitCast(val, llType(*t), "objPtr");
+
+		builder.CreateStore(val, field);
 	}
 
 	return structPtr;
@@ -245,6 +268,47 @@ LLVMEngine::compileString(CEnv& cenv, const char* str)
 	return builder.CreateGlobalStringPtr(str);
 }
 
+CType
+LLVMEngine::compileType(CEnv& cenv, const char* name, const AST* expr)
+{
+	CTypes::const_iterator i = compiledTypes.find(name);
+	if (i != compiledTypes.end())
+		return i->second;
+
+	const ATuple* const tup = expr->as_tuple();
+	vector<const Type*> ctypes;
+	ctypes.push_back(PointerType::get(Type::getInt8Ty(context), NULL)); // RTTI
+	for (ATuple::const_iterator i = tup->iter_at(1); i != tup->end(); ++i) {
+		const ATuple* tup = (*i)->to_tuple();
+		const Type*   lt  = (tup)
+			? (const Type*)compileType(cenv, tup->fst()->as_symbol()->sym(), *i)
+			: llType(*i);
+		if (!lt)
+			return NULL;
+		ctypes.push_back(lt);
+	}
+	
+	Type* structT = StructType::get(context, ctypes, false);
+
+	// Tell LLVM opaqueT and structT are the same (for recursive types)
+	//PATypeHolder opaqueT = OpaqueType::get(context);
+	//((OpaqueType*)opaqueT.get())->refineAbstractTypeTo(structT);
+	//structT = cast<StructType>(opaqueT.get()); // updated potentially invalidated structT
+
+	Type* ret = PointerType::get(structT, 0);
+	module->addTypeName(name, structT);
+
+	compiledTypes.insert(make_pair(name, ret));
+
+	return ret;
+}
+
+CType
+LLVMEngine::objectType(CEnv& cenv)
+{
+	return objectT;
+}
+
 CFunc
 LLVMEngine::startFn(
 	CEnv& cenv, const std::string& name, const ATuple* args, const ATuple* type)
@@ -304,9 +368,13 @@ LLVMEngine::pushFnArgs(CEnv& cenv, const ATuple* prot, const ATuple* type, CFunc
 }
 
 void
-LLVMEngine::finishFn(CEnv& cenv, CFunc f, CVal ret)
+LLVMEngine::finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT)
 {
-	builder.CreateRet(llVal(ret));
+	if (retT->str() == "Nothing")
+		builder.CreateRetVoid();
+	else
+		builder.CreateRet(builder.CreateBitCast(llVal(ret), llType(retT), "ret"));
+
 	if (verifyFunction(*static_cast<Function*>(f), llvm::PrintMessageAction)) {
 		module->dump();
 		throw Error(Cursor(), "Broken module");
diff --git a/src/pprint.cpp b/src/pprint.cpp
index 15e9f54..4e0d036 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -37,8 +37,11 @@ newline(ostream& out, unsigned indent)
 static inline void
 print_annotation(ostream& out, CEnv* cenv, const AST* ast, bool print)
 {
-	if (print)
-		out << " :" << cenv->tsubst.apply(cenv->tenv.var(ast));
+	if (print) {
+		const AST* var = cenv->tenv.var(ast);
+		if (var)
+			out << " :" << cenv->tsubst.apply(var);
+	}
 }
 
 ostream&
diff --git a/src/repl.cpp b/src/repl.cpp
index 81035bb..6c9b3cf 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -136,7 +136,8 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 		Code exprs;
 		for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) {
 			const ATuple* call = (*i)->to_tuple();
-			if (call && is_form(call, "def") && is_form(call->list_ref(2), "fn")) {
+			if (call && (   (is_form(call, "def-type"))
+			             || (is_form(call, "def") && is_form(call->frrst(), "fn")))) {
 				val = resp_compile(cenv, call);
 			} else {
 				const ATuple* tup = (*i)->to_tuple();
@@ -146,27 +147,25 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 			}
 		}
 
-		const AST*    type = cenv.type(exprs.back());
-		const ATuple* fnT  = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0);
-
-		// Create function for top-level of program
-		f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+		if (!exprs.empty()) {
+			const AST*    type = cenv.type(exprs.back());
+			const ATuple* fnT  = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0);
 
-		// Compile expressions (other than function definitions) into it
-		for (Code::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
-			val = resp_compile(cenv, *i);
+			// Create function for program containing all expressions except definitions
+			f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+			for (Code::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
+				val = resp_compile(cenv, *i);
+			cenv.engine()->finishFn(cenv, f, val, type);
 
-		// Finish compilation
-		cenv.engine()->finishFn(cenv, f, val);
+			// Call and print result
+			callPrintCollect(cenv, f, ast, type, execute);
+		}
 
 		if (cenv.args.find("-S") != cenv.args.end()) {
 			cenv.engine()->writeModule(cenv, cenv.out);
 			return 0;
 		}
 
-		// Call and print result
-		callPrintCollect(cenv, f, ast, type, execute);
-
 	} catch (Error& e) {
 		cenv.err << e.what() << endl;
 		return 1;
@@ -200,7 +199,7 @@ repl(CEnv& cenv)
 			try {
 				// Create function for this repl loop
 				f = cenv.engine()->startFn(cenv, replFnName, new ATuple(cursor), fnT);
-				cenv.engine()->finishFn(cenv, f, resp_compile(cenv, ast));
+				cenv.engine()->finishFn(cenv, f, resp_compile(cenv, ast), type);
 				callPrintCollect(cenv, f, ast, type, true);
 				if (cenv.args.find("-d") != cenv.args.end())
 					cenv.engine()->writeModule(cenv, cenv.out);
diff --git a/src/resp.hpp b/src/resp.hpp
index acf7725..57880f5 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -71,8 +71,9 @@ struct Error {
  * Backend Types                                                           *
  ***************************************************************************/
 
-typedef void* CVal;  ///< Compiled value (opaque)
-typedef void* CFunc; ///< Compiled function (opaque)
+typedef const void* CType; ///< Compiled type (opaque)
+typedef void*       CVal;  ///< Compiled value (opaque)
+typedef void*       CFunc; ///< Compiled function (opaque)
 
 
 /***************************************************************************
@@ -205,9 +206,12 @@ struct ATuple : public AST {
 	ATuple(const AST* fst, const ATuple* rst, Cursor c=Cursor())
 		: AST(T_TUPLE, c), _fst(fst), _rst(rst) {}
 
-	const AST*    fst()   const { return _fst; }
-	const ATuple* rst()   const { return _rst; }
-	bool          empty() const { return _fst == 0 && _rst ==0; }
+	inline const AST*    fst()   const { return _fst; }
+	inline const ATuple* rst()   const { return _rst; }
+	inline const AST*    frst()  const { return _rst->_fst; }
+	inline const AST*    frrst() const { return _rst->_rst->_fst; }
+
+	bool empty() const { return _fst == 0 && _rst ==0; }
 
 	size_t list_len() const {
 		size_t ret = 0;
@@ -272,7 +276,7 @@ private:
 	const ATuple* _rst;
 };
 
-inline ATuple* tup(Cursor c, AST* ast, ...) {
+inline ATuple* tup(Cursor c, const AST* ast, ...) {
 	ATuple* const head = new ATuple(ast, 0, c);
 	if (!ast)
 		return head;
@@ -468,6 +472,7 @@ ostream& operator<<(ostream& out, const Env<V>& env) {
 /// Parse Time Environment (really just a symbol table)
 struct PEnv : private map<const string, const char*> {
 	PEnv() : symID(0) {}
+	~PEnv() { FOREACHP(const_iterator, i, this) free(const_cast<char*>(i->second)); }
 	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()) {
@@ -580,6 +585,8 @@ struct TEnv : public Env<const AST*> {
 		, Closure(penv.sym("Closure"))
 		, Dots(penv.sym("..."))
 		, Fn(penv.sym("Fn"))
+		, List(penv.sym("List"))
+		, Empty(penv.sym("Empty"))
 		, Tup(penv.sym("Tup"))
 		, U(penv.sym("U"))
 	{
@@ -616,6 +623,8 @@ struct TEnv : public Env<const AST*> {
 	ASymbol* Closure;
 	ASymbol* Dots;
 	ASymbol* Fn;
+	ASymbol* List;
+	ASymbol* Empty;
 	ASymbol* Tup;
 	ASymbol* U;
 };
@@ -643,18 +652,21 @@ struct Engine {
 	                         const ATuple* type,
 	                         CFunc         f) = 0;
 
-	virtual void  finishFn(CEnv& cenv, CFunc f, CVal ret) = 0;
-	virtual void  eraseFn(CEnv& cenv, CFunc f)            = 0;
-
-	virtual CVal compileCall(CEnv& cenv, CFunc f, const ATuple* fT, CVals& args)           = 0;
-	virtual CVal compileCons(CEnv& cenv, const ATuple* t, CVal rtti, CVals& f)             = 0;
-	virtual CVal compileDot(CEnv& cenv, CVal tup, int32_t index)                           = 0;
-	virtual CVal compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t)       = 0;
-	virtual CVal compileGlobalGet(CEnv& cenv, const string& s, CVal v)                     = 0;
-	virtual CVal compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) = 0;
-	virtual CVal compileLiteral(CEnv& cenv, const AST* lit)                                = 0;
-	virtual CVal compilePrimitive(CEnv& cenv, const ATuple* prim)                          = 0;
-	virtual CVal compileString(CEnv& cenv, const char* str)                                = 0;
+	virtual void  finishFn(CEnv& cenv, CFunc f, CVal ret, const AST* retT) = 0;
+	virtual void  eraseFn(CEnv& cenv, CFunc f)                             = 0;
+
+	virtual CVal  compileCall(CEnv& cenv, CFunc f, const ATuple* fT, CVals& args)           = 0;
+	virtual CVal  compileCons(CEnv& cenv, const ATuple* t, CVal rtti, CVals& f)             = 0;
+	virtual CVal  compileDot(CEnv& cenv, CVal tup, int32_t index)                           = 0;
+	virtual CVal  compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t)       = 0;
+	virtual CVal  compileGlobalGet(CEnv& cenv, const string& s, CVal v)                     = 0;
+	virtual CVal  compileIf(CEnv& cenv, const AST* cond, const AST* then, const AST* aelse) = 0;
+	virtual CVal  compileLiteral(CEnv& cenv, const AST* lit)                                = 0;
+	virtual CVal  compilePrimitive(CEnv& cenv, const ATuple* prim)                          = 0;
+	virtual CVal  compileString(CEnv& cenv, const char* str)                                = 0;
+	virtual CType compileType(CEnv& cenv, const char* name, const AST* exp)                 = 0;
+
+	virtual CType objectType(CEnv& cenv) = 0;
 
 	virtual void writeModule(CEnv& cenv, std::ostream& os) = 0;
 
diff --git a/src/simplify.cpp b/src/simplify.cpp
index 0c839f7..e27049a 100644
--- a/src/simplify.cpp
+++ b/src/simplify.cpp
@@ -145,17 +145,44 @@ simplify_let(CEnv& cenv, const ATuple* call) throw()
 	return copy;
 }
 
+static inline const AST*
+simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type)
+{
+	if (!node) {
+		const AST* empty = new ATuple(cenv.tenv.Empty, 0, Cursor());
+		cenv.setType(empty, type);
+		return empty;
+	}
+
+	assert(cenv.type(node->fst()));
+	
+	const AST* const fst = tup(Cursor(), cenv.type(node->fst()), node->fst(), 0);
+	const AST* const rst = simplify_list_elem(cenv, node->rst(), type);
+	assert(node->fst());
+	assert(rst);
+	List cons(node->loc, cenv.tenv.List, fst, rst, 0);
+	cenv.setType(fst, tup(Cursor(), cenv.penv.sym("Expr"), 0));
+	cenv.setType(cons, type);
+	return cons;
+}
+
 static const AST*
 simplify_quote(CEnv& cenv, const ATuple* call) throw()
 {
-	switch (call->list_ref(1)->tag()) {
-	case T_SYMBOL: case T_TUPLE:
-		// Symbols and lists remain quoted (because semantics differ)
+	switch (call->frst()->tag()) {
+	case T_SYMBOL:
+		// Symbols remain quoted so they are not interpreted as variables
 		return call;
+	case T_TUPLE: {
+		// Lists are transformed into nested conses
+		const ATuple* const list = call->frst()->as_tuple();
+		return simplify_list_elem(cenv, list,
+		                          tup(Cursor(), cenv.tenv.List, cenv.penv.sym("Expr"), 0));
+	}
 	default:
 		// Other literals (e.g. numbers, strings) are self-evaluating, so the
 		// quote can be removed, e.g. (quote 3) => 3
-		return call->list_ref(1);
+		return call->frst();
 	}
 }