Fully shared library safe backend interface.

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

3 files changed, 71 insertions, 52 deletions

diff --git a/src/compile.cpp b/src/compile.cpp
index 8862f73..8c83e15 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -51,7 +51,28 @@ AFn::lift(CEnv& cenv)
 		return;
 
 	AType* protT = type->at(1)->as<AType*>();
-	liftCall(cenv, *protT);
+	cenv.engine()->liftCall(cenv, this, *protT);
+}
+
+CValue
+AFn::compile(CEnv& cenv)
+{
+	AType* aFnT = cenv.type(this);
+	/*const Type* fnT = llType(aFnT);
+	return fnT ? static_cast<Function*>(impls.find(aFnT)) : NULL;*/
+	return impls.find(aFnT);
+
+	/*vector<const Type*> types;
+	types.push_back(PointerType::get(fnT, 0));
+	types.push_back(PointerType::get(Type::VoidTy, 0));
+	LLVMEngine* engine  = reinterpret_cast<LLVMEngine*>(cenv.engine());
+	IRBuilder<> builder = engine->builder;
+	Value*      tag     = ConstantInt::get(Type::Int8Ty, GC::TAG_FRAME);
+	StructType* tupT    = StructType::get(types, false);
+	Value*      tupSize = ConstantInt::get(Type::Int32Ty, sizeof(void*) * 2);
+	Value*      tup     = builder.CreateCall2(engine->alloc, tupSize, tag, "fn");
+	Value*      tupPtr  = builder.CreateBitCast(tup, PointerType::get(tupT, 0));
+	return tupPtr;*/
 }
 
 void
@@ -73,7 +94,7 @@ ACall::lift(CEnv& cenv)
 	if (c->prot()->size() > size() - 1)
 		throw Error(loc, (format("too few arguments to function `%1%'") % at(0)->str()).str());
 
-	c->liftCall(cenv, argsT); // Lift called closure
+	cenv.engine()->liftCall(cenv, c, argsT); // Lift called closure
 }
 
 CValue
@@ -124,3 +145,15 @@ ADef::compile(CEnv& cenv)
 	cenv.vals.def(sym(), val);
 	return val;
 }
+
+CValue
+AIf::compile(CEnv& cenv)
+{
+	return cenv.engine()->compileIf(cenv, this);
+}
+
+CValue
+APrimitive::compile(CEnv& cenv)
+{
+	return cenv.engine()->compilePrimitive(cenv, this);
+}
diff --git a/src/tuplr.hpp b/src/tuplr.hpp
index 4302584..925deec 100644
--- a/src/tuplr.hpp
+++ b/src/tuplr.hpp
@@ -394,7 +394,6 @@ struct AFn : public ATuple {
 	void    constrain(TEnv& tenv, Constraints& c) const;
 	AST*    cps(TEnv& tenv, AST* cont);
 	void    lift(CEnv& cenv);
-	void    liftCall(CEnv& cenv, const AType& argsT);
 	CValue  compile(CEnv& cenv);
 	const ATuple* prot() const { return at(1)->to<const ATuple*>(); }
 	ATuple* prot() { return at(1)->to<ATuple*>(); }
@@ -630,7 +629,10 @@ struct Engine {
 
 	virtual void   finishFunction(CEnv& cenv, CFunction f, const AType* retT, CValue ret) = 0;
 	virtual void   eraseFunction(CEnv& cenv, CFunction f)                                 = 0;
+	virtual void   liftCall(CEnv& cenv, AFn* fn, const AType& argsT)                      = 0;
 	virtual CValue compileCall(CEnv& cenv, CFunction f, const vector<CValue>& args)       = 0;
+	virtual CValue compilePrimitive(CEnv& cenv, APrimitive* prim)                         = 0;
+	virtual CValue compileIf(CEnv& cenv, AIf* aif)                                        = 0;
 	virtual void   writeModule(CEnv& cenv, std::ostream& os)                              = 0;
 
 	virtual const string call(CEnv& cenv, CFunction f, AType* retT) = 0;
diff --git a/src/tuplr_llvm.cpp b/src/tuplr_llvm.cpp
index d4f8055..dfd4c9d 100644
--- a/src/tuplr_llvm.cpp
+++ b/src/tuplr_llvm.cpp
@@ -165,6 +165,10 @@ struct LLVMEngine : public Engine {
 		return builder.CreateCall(llFunc(f), llArgs.begin(), llArgs.end());
 	}
 
+	void   liftCall(CEnv& cenv, AFn* fn, const AType& argsT);
+	CValue compilePrimitive(CEnv& cenv, APrimitive* prim);
+	CValue compileIf(CEnv& cenv, AIf* aif);
+
 	void writeModule(CEnv& cenv, std::ostream& os) {
 		AssemblyAnnotationWriter writer;
 		module->print(os, &writer);
@@ -228,9 +232,9 @@ COMPILE_LITERAL(float,   ConstantFP::get(Type::FloatTy, val))
 COMPILE_LITERAL(bool,    ConstantInt::get(Type::Int1Ty, val, false))
 
 void
-AFn::liftCall(CEnv& cenv, const AType& argsT)
+LLVMEngine::liftCall(CEnv& cenv, AFn* fn, const AType& argsT)
 {
-	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(this);
+	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(fn);
 	assert(gt != cenv.tenv.genericTypes.end());
 	LLVMEngine* engine      = reinterpret_cast<LLVMEngine*>(cenv.engine());
 	AType*      genericType = new AType(*gt->second);
@@ -243,28 +247,28 @@ AFn::liftCall(CEnv& cenv, const AType& argsT)
 		thisType = argsSubst.apply(genericType)->as<AType*>();
 	}
 
-	THROW_IF(!thisType->concrete(), loc,
+	THROW_IF(!thisType->concrete(), fn->loc,
 			string("call has non-concrete type %1%\n") + thisType->str());
 
 	Object::pool.addRoot(thisType);
-	if (impls.find(thisType))
+	if (fn->impls.find(thisType))
 		return;
 
 	ATuple* protT = thisType->at(1)->as<ATuple*>();
 
 	vector<string> argNames;
-	for (size_t i = 0; i < prot()->size(); ++i)
-		argNames.push_back(prot()->at(i)->str());
+	for (size_t i = 0; i < fn->prot()->size(); ++i)
+		argNames.push_back(fn->prot()->at(i)->str());
 
 	// Write function declaration
-	const string name = (this->name == "") ? cenv.penv.gensymstr("_fn") : this->name;
+	const string name = (fn->name == "") ? cenv.penv.gensymstr("_fn") : fn->name;
 	Function* f = llFunc(cenv.engine()->startFunction(cenv, name,
 			thisType->at(thisType->size()-1)->to<AType*>(),
 			*protT, argNames));
 
 	cenv.push();
 	Subst oldSubst = cenv.tsubst;
-	cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, subst));
+	cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, fn->subst));
 
 //#define EXPLICIT_STACK_FRAMES 1
 
@@ -277,12 +281,12 @@ AFn::liftCall(CEnv& cenv, const AType& argsT)
 
 	// Bind argument values in CEnv
 	vector<Value*> args;
-	const_iterator p = prot()->begin();
+	AFn::const_iterator p = fn->prot()->begin();
 	size_t i = 0;
 	for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++i) {
 		AType* t = protT->at(i)->as<AType*>();
 		const Type* lt = llType(t);
-		THROW_IF(!lt, loc, "untyped parameter\n");
+		THROW_IF(!lt, fn->loc, "untyped parameter\n");
 		cenv.def((*p)->as<ASymbol*>(), *p, t, &*a);
 #ifdef EXPLICIT_STACK_FRAMES
 		types.push_back(lt);
@@ -322,12 +326,12 @@ AFn::liftCall(CEnv& cenv, const AType& argsT)
 	// Write function body
 	try {
 		// Define value first for recursion
-		cenv.precompile(this, f);
-		impls.push_back(make_pair(thisType, f));
+		cenv.precompile(fn, f);
+		fn->impls.push_back(make_pair(thisType, f));
 		CValue retVal = NULL;
-		for (size_t i = 2; i < size(); ++i)
-			retVal = cenv.compile(at(i));
-		cenv.engine()->finishFunction(cenv, f, cenv.type(at(size()-1)), retVal);
+		for (size_t i = 2; i < fn->size(); ++i)
+			retVal = cenv.compile(fn->at(i));
+		cenv.engine()->finishFunction(cenv, f, cenv.type(fn->at(fn->size() - 1)), retVal);
 	} catch (Error& e) {
 		f->eraseFromParent(); // Error reading body, remove function
 		cenv.pop();
@@ -338,27 +342,7 @@ AFn::liftCall(CEnv& cenv, const AType& argsT)
 }
 
 CValue
-AFn::compile(CEnv& cenv)
-{
-	AType* aFnT = cenv.type(this);
-	const Type* fnT = llType(aFnT);
-	return fnT ? static_cast<Function*>(impls.find(aFnT)) : NULL;
-
-	/*vector<const Type*> types;
-	types.push_back(PointerType::get(fnT, 0));
-	types.push_back(PointerType::get(Type::VoidTy, 0));
-	LLVMEngine* engine  = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	IRBuilder<> builder = engine->builder;
-	Value*      tag     = ConstantInt::get(Type::Int8Ty, GC::TAG_FRAME);
-	StructType* tupT    = StructType::get(types, false);
-	Value*      tupSize = ConstantInt::get(Type::Int32Ty, sizeof(void*) * 2);
-	Value*      tup     = builder.CreateCall2(engine->alloc, tupSize, tag, "fn");
-	Value*      tupPtr  = builder.CreateBitCast(tup, PointerType::get(tupT, 0));
-	return tupPtr;*/
-}
-
-CValue
-AIf::compile(CEnv& cenv)
+LLVMEngine::compileIf(CEnv& cenv, AIf* aif)
 {
 	typedef vector< pair<Value*, BasicBlock*> > Branches;
 	LLVMEngine* engine  = reinterpret_cast<LLVMEngine*>(cenv.engine());
@@ -366,8 +350,8 @@ AIf::compile(CEnv& cenv)
 	BasicBlock* mergeBB = BasicBlock::Create("endif");
 	BasicBlock* nextBB  = NULL;
 	Branches    branches;
-	for (size_t i = 1; i < size() - 1; i += 2) {
-		Value*      condV  = llVal(cenv.compile(at(i)));
+	for (size_t i = 1; i < aif->size() - 1; i += 2) {
+		Value*      condV  = llVal(cenv.compile(aif->at(i)));
 		BasicBlock* thenBB = BasicBlock::Create((format("then%1%") % ((i+1)/2)).str());
 
 		nextBB = BasicBlock::Create((format("else%1%") % ((i+1)/2)).str());
@@ -377,7 +361,7 @@ AIf::compile(CEnv& cenv)
 		// Emit then block for this condition
 		parent->getBasicBlockList().push_back(thenBB);
 		engine->builder.SetInsertPoint(thenBB);
-		Value* thenV = llVal(cenv.compile(at(i+1)));
+		Value* thenV = llVal(cenv.compile(aif->at(i + 1)));
 		engine->builder.CreateBr(mergeBB);
 		branches.push_back(make_pair(thenV, engine->builder.GetInsertBlock()));
 
@@ -387,14 +371,14 @@ AIf::compile(CEnv& cenv)
 
 	// Emit final else block
 	engine->builder.SetInsertPoint(nextBB);
-	Value* elseV = llVal(cenv.compile(at(size() - 1)));
+	Value* elseV = llVal(cenv.compile(aif->at(aif->size() - 1)));
 	engine->builder.CreateBr(mergeBB);
 	branches.push_back(make_pair(elseV, engine->builder.GetInsertBlock()));
 
 	// Emit merge block (Phi node)
 	parent->getBasicBlockList().push_back(mergeBB);
 	engine->builder.SetInsertPoint(mergeBB);
-	PHINode* pn = engine->builder.CreatePHI(llType(cenv.type(this)), "ifval");
+	PHINode* pn = engine->builder.CreatePHI(llType(cenv.type(aif)), "ifval");
 
 	FOREACH(Branches::iterator, i, branches)
 		pn->addIncoming(i->first, i->second);
@@ -403,13 +387,13 @@ AIf::compile(CEnv& cenv)
 }
 
 CValue
-APrimitive::compile(CEnv& cenv)
+LLVMEngine::compilePrimitive(CEnv& cenv, APrimitive* prim)
 {
 	LLVMEngine*  engine  = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	Value*       a       = llVal(cenv.compile(at(1)));
-	Value*       b       = llVal(cenv.compile(at(2)));
-	bool         isFloat = cenv.type(at(1))->str() == "Float";
-	const string n       = at(0)->to<ASymbol*>()->str();
+	Value*       a       = llVal(cenv.compile(prim->at(1)));
+	Value*       b       = llVal(cenv.compile(prim->at(2)));
+	bool         isFloat = cenv.type(prim->at(1))->str() == "Float";
+	const string n       = prim->at(0)->to<ASymbol*>()->str();
 
 	// Binary arithmetic operations
 	Instruction::BinaryOps op = (Instruction::BinaryOps)0;
@@ -423,8 +407,8 @@ APrimitive::compile(CEnv& cenv)
 	if (n == "%")   op = isFloat ? Instruction::FRem : Instruction::SRem;
 	if (op != 0) {
 		Value* val = engine->builder.CreateBinOp(op, a, b);
-		for (size_t i = 3; i < size(); ++i)
-			val = engine->builder.CreateBinOp(op, val, llVal(cenv.compile(at(i))));
+		for (size_t i = 3; i < prim->size(); ++i)
+			val = engine->builder.CreateBinOp(op, val, llVal(cenv.compile(prim->at(i))));
 		return val;
 	}
 
@@ -443,5 +427,5 @@ APrimitive::compile(CEnv& cenv)
 			return engine->builder.CreateICmp(pred, a, b);
 	}
 
-	throw Error(loc, "unknown primitive");
+	throw Error(prim->loc, "unknown primitive");
 }