From a94ba9d90a9fe48a3933f2932b7955b5b248b623 Mon Sep 17 00:00:00 2001
From: David Robillard <d@drobilla.net>
Date: Fri, 31 Dec 2010 04:53:23 +0000
Subject: Define named (and possibly recursive) types for closures and
 functions. Compile type definitions all the way to LLVM IR (including
 recursive types).

git-svn-id: http://svn.drobilla.net/resp/resp@388 ad02d1e2-f140-0410-9f75-f8b11f17cedd
---
 src/lift.cpp | 38 ++++++++++++++++++++++++++++++++------
 1 file changed, 32 insertions(+), 6 deletions(-)

(limited to 'src/lift.cpp')

diff --git a/src/lift.cpp b/src/lift.cpp
index 039eea4..6ae8709 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -96,6 +96,17 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
 	return copy;
 }
 
+static const AST*
+lift_def_type(CEnv& cenv, Code& code, const ATuple* def) throw()
+{
+	const ASymbol* sym = def->frst()->to_symbol();
+	if (!sym)
+		return def;
+
+	const AST* type = def->frrst()->as_tuple()->replace(sym, cenv.penv.sym("__REC"));
+	return tup(def->loc, def->fst(), sym, type, 0);
+}
+
 static const AST*
 lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 {
@@ -145,10 +156,13 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 
 	cenv.pop();
 
+	// Symbol for closure type (defined below)
+	const ASymbol* tsym = cenv.penv.sym(
+		(fnName != "") ? (string("__T") + fnName) : cenv.penv.gensymstr("__Tfn"));
+
 	// Create definition for implementation fn
-	ASymbol* implName = cenv.penv.sym(implNameStr);
-	ATuple*  def      = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL);
-	code.push_back(def);
+	const ASymbol* implName = cenv.penv.sym(implNameStr);
+	const ATuple*  def      = tup(fn->loc, cenv.penv.sym("def"), implName, impl.head, NULL);
 
 	List tupT(fn->loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
 	List consT;
@@ -162,7 +176,8 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 	}
 	cenv.liftStack.pop();
 
-	implProtT.push_front(tupT);
+	// Prepend closure parameter type
+	implProtT.push_front(tsym);
 
 	const ATuple* implT = tup(Cursor(), type->fst(), implProtT.head, implRetT, 0);
 
@@ -170,12 +185,23 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 	consT.push_front(cenv.tenv.Tup);
 
 	cenv.setType(impl, implT);
-	cenv.setType(cons, consT);
+
+	// Create type definition for closure type
+	const AST* tdef = resp_lift(
+		cenv, code, tup(Cursor(), cenv.penv.sym("def-type"), tsym, consT.head, 0));
+	code.push_back(tdef);
+	cenv.tenv.def(tsym, consT);
+
+	code.push_back(def);
+
+	// Set type of closure to type symbol
+	cenv.setType(cons, tsym);
 
 	cenv.def(implName, impl, implT, NULL);
 	if (cenv.name(fn) != "")
 		cenv.def(cenv.penv.sym(cenv.name(fn)), fn, consT, NULL);
 
+
 	return cons;
 }
 
@@ -261,7 +287,7 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
 		else if (form == "def")
 			return lift_def(cenv, code, call);
 		else if (form == "def-type")
-			return call;
+			return lift_def_type(cenv, code, call);
 		else if (form == "do")
 			return lift_args(cenv, code, call);
 		else if (form == "fn")
-- 
cgit v1.2.1