Fix calling functions that lexically enclose the current function.

In particular this makes it possible to walk lists with match,
since match clauses expand to fns.


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

1 files changed, 48 insertions, 29 deletions

diff --git a/src/lift.cpp b/src/lift.cpp
index c6bcee9..7f236d1 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -145,63 +145,82 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 
 	impl.push_back(implProt);
 
-	// Lift body
-	const AST* implRetT = NULL;
-	for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) {
-		const AST* lifted = resp_lift(cenv, code, *i);
-		impl.push_back(lifted);
-		implRetT = cenv.type(lifted);
-	}
-
-	cenv.pop();
-
 	// Symbol for closure type (defined below)
 	const ASymbol* tsym = cenv.penv.sym(
 		(fnName != "") ? (string("__T") + fnName) : cenv.penv.gensymstr("__Tfn"));
 
+	// Prepend closure parameter type
+	implProtT.push_front(tsym);
+
+	// Variable to represent our return type (for recursive lifting)
+	const AST* retTVar = cenv.tenv.var();
+
 	// Create definition for implementation fn
 	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;
+	// Define types before lifting body with return type as a variable
+	List implT(Cursor(), type->fst(), implProtT.head, retTVar, 0);
+	List closureT(Cursor(), cenv.tenv.Tup, implT.head, NULL);
 	List cons(fn->loc, cenv.penv.sym("Closure"), implName, NULL);
+	cenv.tenv.def(cenv.penv.sym(fnName), closureT);
+	cenv.tenv.def(implName, implT);
+
+	// Lift body
+	const AST* implRetT = NULL;
+	for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) {
+		const AST* lifted = resp_lift(cenv, code, *i);
+		impl.push_back(lifted);
+		implRetT = cenv.type(lifted);
+	}
+
+	cenv.pop();
 
 	const CEnv::FreeVars freeVars = cenv.liftStack.top();
 	cenv.liftStack.pop();
 	for (CEnv::FreeVars::const_iterator i = freeVars.begin(); i != freeVars.end(); ++i) {
 		cons.push_back(resp_lift(cenv, code, *i));
-		tupT.push_back(cenv.type(*i));
-		consT.push_back(cenv.type(*i));
+		closureT.push_back(cenv.type(*i));
 	}
 
-	// Prepend closure parameter type
-	implProtT.push_front(tsym);
-
-	const ATuple* implT = tup(Cursor(), type->fst(), implProtT.head, implRetT, 0);
-
-	consT.push_front(implT);
-	consT.push_front(cenv.tenv.Tup);
-
-	cenv.setType(impl, implT);
+	// Now we know our real lifted return type
+	const ATuple* realImplT = implT.head->replace(retTVar, implRetT);
+	cenv.setType(impl, realImplT);
 
 	// Create type definition for closure type
 	const AST* tdef = resp_lift(
-		cenv, code, tup(Cursor(), cenv.penv.sym("def-type"), tsym, consT.head, 0));
+		cenv, code, tup(Cursor(), cenv.penv.sym("def-type"), tsym, closureT, 0));
 	code.push_back(tdef);
-	cenv.tenv.def(tsym, consT);
+	cenv.tenv.def(tsym, closureT);
 
+	// Put forward declaration for type at start of code
 	List tdecl(Cursor(), cenv.penv.sym("def-type"), tsym, 0);
 	code.push_front(tdecl);
 
-	code.push_back(def);
-
 	// Set type of closure to type symbol
 	cenv.setType(cons, tsym);
 
-	cenv.def(implName, impl, implT, NULL);
+	// Emit implementation definition
+	code.push_back(def);
+	cenv.def(implName, impl, realImplT, NULL);
 	if (cenv.name(fn) != "")
-		cenv.def(cenv.penv.sym(cenv.name(fn)), fn, consT, NULL);
+		cenv.def(cenv.penv.sym(cenv.name(fn)), fn, closureT, NULL);
+
+	// Replace return type variable with actual return type in type environment
+	for (TEnv::iterator i = cenv.tenv.begin(); i != cenv.tenv.end(); ++i) {
+		for (TEnv::Frame::iterator j = i->begin(); j != i->end(); ++j) {
+			if (j->second->to_tuple()) {
+				j->second = j->second->as_tuple()->replace(retTVar, implRetT);
+			}
+		}
+	}
+
+	// Replace return type variable with actual return type in code
+	for (Code::iterator i = code.begin(); i != code.end(); ++i) {
+		if (is_form(*i, "def-type")) {
+			*i = cenv.typedReplace((*i)->as_tuple(), retTVar, implRetT);
+		}
+	}
 
 	return cons;
 }