Typing improvements.

More location information.


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

1 files changed, 34 insertions, 23 deletions

diff --git a/llvm.cpp b/llvm.cpp
index a0ec539..1717160 100644
--- a/llvm.cpp
+++ b/llvm.cpp
@@ -67,8 +67,6 @@ lltype(AType* t)
 			for (size_t i = 1; i < t->size(); ++i)
 				types.push_back(lltype(dynamic_cast<AType*>(t->at(i))));
 			return PointerType::get(StructType::get(types, false), 0);
-		} else {
-			throw Error(string("Unknown composite type `") + t->str() + "'");
 		}
 	}
 	return NULL; // not reached
@@ -237,6 +235,29 @@ ASTClosure::lift(CEnv& cenv)
 	cenv.pop();
 }
 
+template<typename T>
+T
+checked_cast(AST* ast)
+{
+	T t = dynamic_cast<T>(ast);
+	if (!t)
+		throw Error((format("internal error: `%1%' should be a `%2%'")
+				% typeid(ast).name() % typeid(T).name()).str(), ast->loc);
+	return t;
+}
+
+static
+AST*
+maybeLookup(CEnv& cenv, AST* ast)
+{
+	ASTSymbol* s = dynamic_cast<ASTSymbol*>(ast);
+	if (s) {
+		AST** val = cenv.code.ref(s);
+		if (val) return *val;
+	}
+	return ast;
+}
+
 CValue
 ASTClosure::compile(CEnv& cenv)
 {
@@ -246,17 +267,13 @@ ASTClosure::compile(CEnv& cenv)
 void
 ASTCall::lift(CEnv& cenv)
 {
-	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
-	if (!c) {
-		AST** val = cenv.code.ref(at(0));
-		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
-	}
-
+	ASTClosure* c = dynamic_cast<ASTClosure*>(maybeLookup(cenv, at(0)));
+	
 	// Lift arguments
 	for (size_t i = 1; i < size(); ++i)
 		at(i)->lift(cenv);
-
-	if (!c) return;
+	
+	if (!c) return; // Primitive
 
 	// Extend environment with bound and typed parameters
 	cenv.push();
@@ -266,7 +283,7 @@ ASTCall::lift(CEnv& cenv)
 		throw Error((format("too few arguments to function `%1%'") % at(0)->str()).str(), exp.loc);
 
 	for (size_t i = 1; i < size(); ++i)
-		cenv.code.def(c->prot()->at(i-1), at(i));
+		cenv.code.def(checked_cast<ASTSymbol*>(c->prot()->at(i-1)), at(i));
 
 	c->lift(cenv); // Lift called closure
 	cenv.pop(); // Restore environment
@@ -275,13 +292,7 @@ ASTCall::lift(CEnv& cenv)
 CValue
 ASTCall::compile(CEnv& cenv)
 {
-	ASTClosure* c = dynamic_cast<ASTClosure*>(at(0));
-	if (!c) {
-		AST** val = cenv.code.ref(at(0));
-		c = (val) ? dynamic_cast<ASTClosure*>(*val) : c;
-	}
-
-	assert(c);
+	AST*      c = maybeLookup(cenv, at(0));
 	Function* f = dynamic_cast<Function*>(LLVal(cenv.compile(c)));
 	if (!f) throw Error("callee failed to compile", exp.loc);
 
@@ -295,7 +306,7 @@ ASTCall::compile(CEnv& cenv)
 void
 ASTDefinition::lift(CEnv& cenv)
 {
-	if (cenv.code.ref((ASTSymbol*)at(1)))
+	if (cenv.code.ref(checked_cast<ASTSymbol*>(at(1))))
 		throw Error(string("`") + at(1)->str() + "' redefined", exp.loc);
 	cenv.code.def((ASTSymbol*)at(1), at(2)); // Define first for recursion
 	at(2)->lift(cenv);
@@ -465,8 +476,8 @@ ASTConsCall::compile(CEnv& cenv)
 CValue
 ASTCarCall::compile(CEnv& cenv)
 {
-	AST**  arg  = cenv.code.ref(at(1));
-	Value* sP   = LLVal(arg ? (*arg)->compile(cenv) : at(1)->compile(cenv));
+	AST*   arg  = maybeLookup(cenv, at(1));
+	Value* sP   = LLVal(cenv.compile(arg));
 	Value* s    = cenv.engine.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
 	Value* carP = cenv.engine.builder.CreateStructGEP(s, 0, "car");
 	return cenv.engine.builder.CreateLoad(carP);
@@ -475,8 +486,8 @@ ASTCarCall::compile(CEnv& cenv)
 CValue
 ASTCdrCall::compile(CEnv& cenv)
 {
-	AST**  arg  = cenv.code.ref(at(1));
-	Value* sP   = LLVal(arg ? (*arg)->compile(cenv) : at(1)->compile(cenv));
+	AST*   arg  = maybeLookup(cenv, at(1));
+	Value* sP   = LLVal(cenv.compile(arg));
 	Value* s    = cenv.engine.builder.CreateGEP(sP, ConstantInt::get(Type::Int32Ty, 0), "pair");
 	Value* cdrP = cenv.engine.builder.CreateStructGEP(s, 1, "cdr");
 	return cenv.engine.builder.CreateLoad(cdrP);