From 9ba1ca23fb217c747117c5bbff3fcaac98f5f261 Mon Sep 17 00:00:00 2001
From: David Robillard <d@drobilla.net>
Date: Sat, 27 Jun 2009 00:09:30 +0000
Subject: More CPS conversion work.

git-svn-id: http://svn.drobilla.net/resp/tuplr@151 ad02d1e2-f140-0410-9f75-f8b11f17cedd
---
 cps.cpp   | 13 ++++++-------
 llvm.cpp  |  3 ++-
 tuplr.cpp |  2 +-
 write.cpp | 22 +++++++++++-----------
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/cps.cpp b/cps.cpp
index e1a419f..3d79b9d 100644
--- a/cps.cpp
+++ b/cps.cpp
@@ -59,6 +59,9 @@ ACall::cps(TEnv& tenv, AST* cont)
 	ASymbol* arg = NULL;
 
 	// Make a continuation for each element (operator and arguments)
+	// Argument evaluation continuations are not themselves in CPS.
+	// Each makes a tail call to the next, and the last makes a tail
+	// call to the continuation of this call
 	ssize_t firstFn = -1;
 	ssize_t lastFn = -1;
 	for (size_t i = 0; i < size(); ++i) {
@@ -71,7 +74,7 @@ ACall::cps(TEnv& tenv, AST* cont)
 				firstFn = i;
 
 			AFn* thisFn = tup<AFn>(loc, tenv.penv.sym("fn"),
-					tup<ATuple>(at(i)->loc, arg, tenv.penv.gensym("_k"), 0),
+					tup<ATuple>(at(i)->loc, arg, 0),
 					0);
 
 			if (lastFn != -1)
@@ -84,18 +87,14 @@ ACall::cps(TEnv& tenv, AST* cont)
 	}
 
 	if (firstFn != -1) {
-		// Call our callee in the last argument's evaluation function
+		// Call this call's callee in the last argument evaluator
 		ACall* call = tup<ACall>(loc, 0);
 		assert(funcs.size() == size());
 		for (size_t i = 0; i < funcs.size(); ++i)
 			call->push_back(funcs[i].second);
-		if (!to<APrimitive*>())
-			call->push_back(cont);
-		else
-			call = tup<ACall>(loc, cont, call, 0);
 
 		assert(fn);
-		fn->push_back(call);
+		fn->push_back(call->cps(tenv, cont));
 		return at(firstFn)->cps(tenv, funcs[firstFn].first);
 	} else {
 		assert(at(0)->value());
diff --git a/llvm.cpp b/llvm.cpp
index 1f4c58e..fc369b8 100644
--- a/llvm.cpp
+++ b/llvm.cpp
@@ -239,7 +239,8 @@ AFn::liftCall(CEnv& cenv, const AType& argsT)
 		// Apply substitution to get concrete type for this call
 		thisType = argsSubst.apply(thisType)->as<AType*>();
 		if (!thisType->concrete())
-			throw Error(loc, "unable to resolve concrete type for function");
+			throw Error(loc, string("unable to resolve concrete type for function :: ")
+					+ thisType->str());
 	}
 
 	Object::pool.addRoot(thisType);
diff --git a/tuplr.cpp b/tuplr.cpp
index 52d8b7d..c49cdf8 100644
--- a/tuplr.cpp
+++ b/tuplr.cpp
@@ -269,7 +269,7 @@ eval(CEnv& cenv, const string& name, istream& is)
 		// Print CPS form
 		CValue val = NULL;
 		/*for (list< pair<SExp, AST*> >::const_iterator i = exprs.begin(); i != exprs.end(); ++i) {
-			cout << "CPS: " << endl;
+			cout << "; CPS" << endl;
 			pprint(cout, i->second->cps(cenv.tenv, cenv.penv.sym("cont")));
 		}*/
 
diff --git a/write.cpp b/write.cpp
index ba000f3..04e3401 100644
--- a/write.cpp
+++ b/write.cpp
@@ -65,24 +65,24 @@ pprint_internal(ostream& out, const AST* ast, unsigned indent)
 		ASymbol* headSym = tup->at(0)->to<ASymbol*>();
 		out << "(";
 		pprint_internal(out, tup->at(0), indent);
+		unsigned child_indent = indent;
 		if (tup->size() > 1) {
 			out << " ";
-			if (headSym && headSym->cppstr == "fn")
-				out << tup->at(1) << " ";
-			else
-				pprint_internal(out, tup->at(1), indent + head.length() + 1);
+			if (headSym && headSym->cppstr == "fn") {
+				out << tup->at(1);
+				child_indent = indent + 4;
+			} else {
+				child_indent += head.length() + 1;
+				pprint_internal(out, tup->at(1), child_indent);
+			}
 		}
 		for (size_t i = 2; i < tup->size(); ++i) {
-			//if (!headSym || headSym->cppstr != "def")
-				out << endl;
-			//else
-			//	out << " ";
-			out << string().insert(0, indent, ' ');
-			pprint_internal(out, tup->at(i), indent + head.length() + 2);
+			out << endl << string().insert(0, child_indent, ' ');
+			pprint_internal(out, tup->at(i), child_indent);
 		}
 		out << ")";
 		if (headSym && headSym->cppstr == "fn")
-			out << endl << string().insert(0, indent, ' ');
+			out << endl << string().insert(0, indent + 4, ' ');
 	} else {
 		out << ast;
 	}
-- 
cgit v1.2.1