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

4 files changed, 76 insertions, 44 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;
 }
diff --git a/src/resp.hpp b/src/resp.hpp
index 494241b..e572473 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -739,6 +739,20 @@ struct CEnv {
 			return tenv.named(type->as_symbol()->sym());
 		return type;
 	}
+	const ATuple* typedReplace(const ATuple* in, const AST* from, const AST* to) {
+		List copy;
+		FOREACHP(ATuple::const_iterator, i, in) {
+			if (*i == from) {
+				copy.push_back(to);
+			} else {
+				const ATuple* tup = (*i)->to_tuple();
+				copy.push_back(tup ? typedReplace(tup, from, to) : (*i));
+			}
+		}
+		copy.head->loc = in->loc;
+		setTypeSameAs(copy.head, in);
+		return copy;
+	}
 	const AST* type(const AST* ast, const Subst& subst = Subst(), bool resolve=true) const {
 		const AST*     ret = NULL;
 		const ASymbol* sym = ast->to_symbol();
diff --git a/test/quote.resp b/test/quote.resp
index 741a7a7..638e81b 100644
--- a/test/quote.resp
+++ b/test/quote.resp
@@ -5,21 +5,20 @@
   (Empty))
 
 
-(def l (quote (2 3)))
+(def list (quote (2 a b c)))
 
-(match l
-  (Symbol s)
-  0
+(def (len l)
+  (match l
+    (Symbol s)
+    1
 
-  (Int i)
-  1
+    (Int i)
+    1
 
-  (List h t)
-  2
-  
-  (Empty)
-  3)
+    (List h t)
+    (+ 1 (len t))
+    
+    (Empty)
+    0))
 
-;(def (car l)
-;(. l 0)
-;l
+(len list)
\ No newline at end of file
diff --git a/wscript b/wscript
index 52e2a99..4b2744d 100644
--- a/wscript
+++ b/wscript
@@ -118,4 +118,4 @@ def test(ctx):
     run_test('./test/match.resp',       '12.0000 : Float')
 
     # Quoting
-    run_test('./test/quote.resp',       '2 : Int')
+    run_test('./test/quote.resp',       '4 : Int')