Better (but still not correct...) computation of lifted function implementation type.

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

8 files changed, 44 insertions, 32 deletions

diff --git a/Makefile b/Makefile
index bdec095..69c58b7 100644
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@ LLVM_LDFLAGS=`llvm-config --ldflags --libs core jit native`
 #LLVM_LDFLAGS=`llvm-config --ldflags --libs all`
 
 COMMON_FLAGS=-fPIC
-COMMON_FLAGS+=-Wextra -Wno-unused-parameter
+COMMON_FLAGS+=-Wall -Wextra -Wno-unused-parameter
 COMMON_FLAGS+=-O0 -g
 #COMMON_FLAGS+=-O2 -march=nocona -fomit-frame-pointer
 
diff --git a/src/c.cpp b/src/c.cpp
index c456132..ecf7d92 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -154,8 +154,8 @@ struct CEngine : public Engine {
 	CVal compileLiteral(CEnv& cenv, AST* lit);
 	CVal compilePrimitive(CEnv& cenv, APrimitive* prim);
 	CVal compileIf(CEnv& cenv, AIf* aif);
-	CVal compileGlobal(CEnv& cenv, const AType* type, const string& name, CVal val);
-	CVal getGlobal(CEnv& cenv, CVal val);
+	CVal compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val);
+	CVal getGlobal(CEnv& cenv, const string& sym, CVal val);
 
 	void writeModule(CEnv& cenv, std::ostream& os) {
 		os << out;
@@ -202,7 +202,6 @@ CEngine::compileFunction(CEnv& cenv, AFn* fn, const AType* type)
 {
 	assert(type->concrete());
 
-	CEngine*     engine    = reinterpret_cast<CEngine*>(cenv.engine());
 	const AType* argsT     = type->prot()->as<const AType*>();
 	const AType* retT      = type->last()->as<const AType*>();
 	Subst        argsSubst = cenv.tenv.buildSubst(type, *argsT);
@@ -248,8 +247,7 @@ CEngine::compileFunction(CEnv& cenv, AFn* fn, const AType* type)
 CVal
 CEngine::compileIf(CEnv& cenv, AIf* aif)
 {
-	CEngine* engine  = reinterpret_cast<CEngine*>(cenv.engine());
-	Value*   varname = new string(cenv.penv.gensymstr("if"));
+	Value* varname = new string(cenv.penv.gensymstr("if"));
 	out += (format("%s %s;\n") % *llType(cenv.type(aif)) % *varname).str();
 	size_t idx = 1;
 	for (AIf::iterator i = aif->begin() + 1; ; ++i, idx += 2) {
@@ -284,11 +282,10 @@ CEngine::compilePrimitive(CEnv& cenv, APrimitive* prim)
 	APrimitive::iterator i = prim->begin();
 	++i;
 
-	CEngine*     engine = reinterpret_cast<CEngine*>(cenv.engine());
-	Value*       a      = llVal((*i++)->compile(cenv));
-	Value*       b      = llVal((*i++)->compile(cenv));
-	const string n      = prim->head()->to<ASymbol*>()->str();
-	string       op     = n;
+	Value*       a  = llVal((*i++)->compile(cenv));
+	Value*       b  = llVal((*i++)->compile(cenv));
+	const string n  = prim->head()->to<ASymbol*>()->str();
+	string       op = n;
 
 	// Convert operator to C operator if they don't match
 	if (n == "=")        op = "==";
@@ -310,13 +307,13 @@ CEngine::compilePrimitive(CEnv& cenv, APrimitive* prim)
 }
 
 CVal
-CEngine::compileGlobal(CEnv& cenv, const AType* type, const string& name, CVal val)
+CEngine::compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val)
 {
 	return NULL;
 }
 
 CVal
-CEngine::getGlobal(CEnv& cenv, CVal val)
+CEngine::getGlobal(CEnv& cenv, const string& sym, CVal val)
 {
 	return NULL;
 }
diff --git a/src/compile.cpp b/src/compile.cpp
index ee92dbd..70056db 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -34,10 +34,11 @@ COMPILE_LITERAL(bool);
 CVal
 ASymbol::compile(CEnv& cenv) throw()
 {
-	if (cenv.vals.topLevel(this) && cenv.type(this)->head()->str() != "Fn")
-		return cenv.engine()->getGlobal(cenv, *cenv.vals.ref(this));
-	else
+	if (cenv.vals.topLevel(this) && cenv.type(this)->head()->str() != "Fn") {
+		return cenv.engine()->getGlobal(cenv, cppstr, *cenv.vals.ref(this));
+	} else {
 		return *cenv.vals.ref(this);
+	}
 }
 
 CVal
diff --git a/src/lift.cpp b/src/lift.cpp
index 7e7ec57..2c20aa8 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -70,9 +70,20 @@ AFn::lift(CEnv& cenv, Code& code) throw()
 
 	// Create a new stub environment frame for parameters
 	cenv.push();
-	AType::const_iterator tp = cenv.type(this)->prot()->begin();
-	for (const_iterator p = prot()->begin(); p != prot()->end(); ++p)
-		cenv.def((*p)->as<ASymbol*>(), *p, (*tp++)->as<AType*>(), NULL);
+	const AType*          type      = cenv.type(this);
+	AType::const_iterator tp        = type->prot()->begin();
+	AType*                implProtT = new AType(*type->prot()->as<const AType*>());
+	ATuple::iterator      ip        = implProtT->begin();
+	for (const_iterator p = prot()->begin(); p != prot()->end(); ++p) {
+		const AType* paramType = (*tp++)->as<const AType*>();
+		if (paramType->kind == AType::EXPR && *paramType->head() == *cenv.tenv.Fn) {
+			AType* fnType = new AType(*paramType);
+			fnType->prot()->push_front(const_cast<AType*>(cenv.tenv.var()));
+			paramType = tup<const AType>((*p)->loc, cenv.tenv.Tup, fnType, NULL);
+		}
+		cenv.def((*p)->as<ASymbol*>(), *p, paramType, NULL);
+		*ip++ = new AType(*paramType);
+	}
 
 	/* Add closure parameter with dummy name (undefined symbol).
 	 * The name of this parameter will be changed to the name of this
@@ -91,7 +102,7 @@ AFn::lift(CEnv& cenv, Code& code) throw()
 
 	cenv.pop();
 
-	// Set name of closure parameter to actual name of this function
+	// Set name of closure parameter to "me"
 	*impl->prot()->begin() = cenv.penv.sym("me");
 
 	// Create definition for implementation fn
@@ -99,11 +110,13 @@ AFn::lift(CEnv& cenv, Code& code) throw()
 	ADef*    def       = tup<ADef>(loc, cenv.penv.sym("def"), implName, impl, NULL);
 	code.push_back(def);
 
-	AType* implT = new AType(*cenv.type(this)); // Type of the implementation function
+	AType* implT = new AType(*type); // Type of the implementation function
 	AType* tupT  = tup<AType>(loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
 	AType* consT = tup<AType>(loc, cenv.tenv.Tup, implT, NULL);
 	ACons* cons  = tup<ACons>(loc, cenv.penv.sym("cons"), implName, NULL); // Closure
 
+	*(implT->begin() + 1) = implProtT;
+
 	const CEnv::FreeVars& freeVars = cenv.liftStack.top();
 	for (CEnv::FreeVars::const_iterator i = freeVars.begin(); i != freeVars.end(); ++i) {
 		cons->push_back(*i);
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 6243919..e606062 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -192,8 +192,8 @@ struct LLVMEngine : public Engine {
 	CVal compileLiteral(CEnv& cenv, AST* lit);
 	CVal compilePrimitive(CEnv& cenv, APrimitive* prim);
 	CVal compileIf(CEnv& cenv, AIf* aif);
-	CVal compileGlobal(CEnv& cenv, const AType* type, const string& name, CVal val);
-	CVal getGlobal(CEnv& cenv, CVal val);
+	CVal compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val);
+	CVal getGlobal(CEnv& cenv, const string& sym, CVal val);
 
 	void writeModule(CEnv& cenv, std::ostream& os) {
 		AssemblyAnnotationWriter writer;
@@ -300,9 +300,8 @@ LLVMEngine::compileFunction(CEnv& cenv, AFn* fn, const AType* type)
 {
 	assert(type->concrete());
 
-	LLVMEngine*  engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	const AType* argsT  = type->prot()->as<const AType*>();
-	const AType* retT   = type->last()->as<const AType*>();
+	const AType* argsT = type->prot()->as<const AType*>();
+	const AType* retT  = type->last()->as<const AType*>();
 
 	vector<string> argNames;
 	for (ATuple::const_iterator i = fn->prot()->begin(); i != fn->prot()->end(); ++i)
@@ -449,7 +448,6 @@ CVal
 LLVMEngine::compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal val)
 {
 	LLVMEngine*     engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	Constant*       init   = Constant::getNullValue(llType(type));
 	GlobalVariable* global = new GlobalVariable(*module, llType(type), false,
 			GlobalValue::ExternalLinkage, Constant::getNullValue(llType(type)), sym);
 
@@ -458,8 +456,8 @@ LLVMEngine::compileGlobal(CEnv& cenv, const AType* type, const string& sym, CVal
 }
 
 CVal
-LLVMEngine::getGlobal(CEnv& cenv, CVal val)
+LLVMEngine::getGlobal(CEnv& cenv, const string& sym, CVal val)
 {
 	LLVMEngine* engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	return engine->builder.CreateLoad(llVal(val), "globalPtr");
+	return engine->builder.CreateLoad(llVal(val), sym + "Ptr");
 }
diff --git a/src/resp.cpp b/src/resp.cpp
index 89b77ef..1f2c5c3 100644
--- a/src/resp.cpp
+++ b/src/resp.cpp
@@ -110,6 +110,7 @@ main(int argc, char** argv)
 			AST* ast = penv.parse(exp);
 			pprint(cout, ast);
 		}
+		delete cenv;
 		return 0;
 	}
 
diff --git a/src/resp.hpp b/src/resp.hpp
index 1edf9e6..34106f4 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -353,6 +353,7 @@ struct AType : public ATuple {
 				if (kid && !kid->concrete())
 					return false;
 			}
+		case DOTS: return false;
 		}
 		return true;
 	}
@@ -365,6 +366,7 @@ struct AType : public ATuple {
 			case VAR:  return id == rt->id;
 			case PRIM: return head()->str() == rt->head()->str();
 			case EXPR: return ATuple::operator==(rhs);
+			case DOTS: return true;
 			}
 		return false; // never reached
 	}
@@ -697,7 +699,7 @@ struct Engine {
 	virtual CVal  compilePrimitive(CEnv& cenv, APrimitive* prim)                         = 0;
 	virtual CVal  compileIf(CEnv& cenv, AIf* aif)                                        = 0;
 	virtual CVal  compileGlobal(CEnv& cenv, const AType* t, const string& sym, CVal val) = 0;
-	virtual CVal  getGlobal(CEnv& cenv, CVal val)                                        = 0;
+	virtual CVal  getGlobal(CEnv& cenv, const string& sym, CVal val)                     = 0;
 	virtual void  writeModule(CEnv& cenv, std::ostream& os)                              = 0;
 
 	virtual const string call(CEnv& cenv, CFunc f, const AType* retT) = 0;
diff --git a/src/unify.cpp b/src/unify.cpp
index aadc032..1d3af81 100644
--- a/src/unify.cpp
+++ b/src/unify.cpp
@@ -157,8 +157,8 @@ unify(const Constraints& constraints)
 			else
 				cp.push_back(Constraint(st, tt));
 		}
-		if (si == s->end() && (ti == t->end() || (*ti)->as<AType*>()->kind == AType::DOTS)
-				|| ti == t->end() && (*si)->as<AType*>()->kind == AType::DOTS)
+		if (   (si == s->end() && (ti == t->end() || (*ti)->as<AType*>()->kind == AType::DOTS))
+		    || (ti == t->end() && (*si)->as<AType*>()->kind == AType::DOTS))
 			return unify(cp);
 	}
 	throw Error(s->loc,