Fix polymorphism.

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

3 files changed, 36 insertions, 16 deletions

diff --git a/llvm.cpp b/llvm.cpp
index 2493056..5d929a2 100644
--- a/llvm.cpp
+++ b/llvm.cpp
@@ -240,7 +240,7 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT)
 {
 	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(this);
 	assert(gt != cenv.tenv.genericTypes.end());
-	AType* genericType = gt->second;
+	AType* genericType = new AType(*gt->second, gt->second->loc);
 
 	// Find type and build substitution
 	assert(argsT.size() == prot()->size());
@@ -250,7 +250,7 @@ AClosure::liftCall(CEnv& cenv, const vector<AType*>& argsT)
 	for (size_t i = 0; i < argsT.size(); ++i)
 		argsSubst[dynamic_cast<AType*>(genericProtT->at(i))] = dynamic_cast<AType*>(argsT.at(i));
 	
-	AType* thisType = new AType(*dynamic_cast<ATuple*>(argsSubst.apply(genericType)), loc);
+	AType* thisType = argsSubst.apply(genericType)->as<AType*>();
 
 	if (!thisType->concrete())
 		throw Error("unable to resolve concrete type for function", loc);
@@ -333,13 +333,13 @@ ACall::lift(CEnv& cenv)
 		throw Error((format("too few arguments to function `%1%'") % at(0)->str()).str(), loc);
 
 	// Extend environment with bound and typed parameters
-	cenv.push();
+	/*cenv.push();
 
 	for (size_t i = 1; i < size(); ++i)
-		cenv.def(c->prot()->at(i-1)->as<ASymbol*>(), at(i), cenv.type(at(i)), NULL);
+		cenv.def(c->prot()->at(i-1)->as<ASymbol*>(), at(i), cenv.type(at(i)), NULL);*/
 
 	c->liftCall(cenv, argsT); // Lift called closure
-	cenv.pop(); // Restore environment
+	//cenv.pop(); // Restore environment
 }
 
 CValue
@@ -355,8 +355,8 @@ ACall::compile(CEnv& cenv)
 
 	TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(c);
 	assert(gt != cenv.tenv.genericTypes.end());
-	AType* polyT = gt->second;
-	AType* fnT   = new AType(loc, cenv.penv.sym("Fn"), protT, polyT->at(2), 0);
+	const AType* polyT = gt->second;
+	AType*       fnT   = new AType(loc, cenv.penv.sym("Fn"), protT, polyT->at(2), 0);
 
 	Function* f = (Function*)c->funcs.find(fnT);
 	if (!f) throw Error("callee failed to compile", loc);
@@ -634,19 +634,23 @@ repl(CEnv& cenv)
 		cenv.out << "() ";
 		cenv.out.flush();
 		Cursor cursor("(stdin)");
-		Constraints c;
+
 		try {
 			SExp exp = readExpression(cursor, std::cin);
 			if (exp.type == SExp::LIST && exp.list.empty())
 				break;
 
 			AST* body = cenv.penv.parse(exp); // Parse input
+			Constraints c;
 			body->constrain(cenv.tenv, c); // Constrain types
 		
 			for (TEnv::GenericTypes::const_iterator i = cenv.tenv.genericTypes.begin();
-					i != cenv.tenv.genericTypes.end(); ++i)
-				c.push_back(Constraint(cenv.tenv.var(i->first), i->second, i->first->loc));
+					i != cenv.tenv.genericTypes.end(); ++i) {
+				c.push_back(Constraint(cenv.tenv.var(i->first),
+							new AType(*i->second), i->first->loc));
+			}
 			
+			Subst oldSubst = cenv.tsubst;
 			cenv.tsubst = Subst::compose(cenv.tsubst, TEnv::unify(c)); // Solve type constraints
 
 			AType* bodyT = cenv.type(body);
@@ -670,6 +674,7 @@ repl(CEnv& cenv)
 				cenv.out << ";   " << cenv.compile(body);
 			}
 			cenv.out << " : " << cenv.type(body) << endl;
+			cenv.tsubst = oldSubst;
 		} catch (Error& e) {
 			cenv.err << e.what() << endl;
 		}
diff --git a/tuplr.hpp b/tuplr.hpp
index 5e60e75..bcfdc86 100644
--- a/tuplr.hpp
+++ b/tuplr.hpp
@@ -158,6 +158,9 @@ struct AST {
 		if (!t) throw Error("internal error: bad cast", loc);
 		return t;
 	}
+	template<typename T> T* copy() {
+		return new T(static_cast<T*>(this));
+	}
 	Cursor loc;
 private:
 	friend class CEnv;
@@ -188,7 +191,6 @@ private:
 	ASymbol(const string& s, Cursor c) : AST(c), cppstr(s) {}
 	friend ostream& operator<<(ostream&, const AST*);
 	const string cppstr;
-
 };
 
 /// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)"
@@ -241,6 +243,20 @@ struct AType : public ATuple {
 			push_back(a);
 		va_end(args);
 	}
+	AType(const AType& copy) : ATuple(0, copy.loc), kind(copy.kind), addr(copy.addr), id(copy.id) {
+		for (AType::const_iterator i = copy.begin(); i != copy.end(); ++i) {
+			AType* typ = dynamic_cast<AType*>(*i);
+			if (typ) {
+				push_back(new AType(*typ));
+				continue;
+			}
+			ATuple* tup = dynamic_cast<ATuple*>(*i);
+			if (tup)
+				push_back(new ATuple(*tup));
+			else
+				push_back(*i);
+		}
+	}
 	CValue compile(CEnv& cenv) { return NULL; }
 	bool   var() const { return kind == VAR; }
 	bool concrete() const {
@@ -488,12 +504,11 @@ struct TEnv : public Env< const ASymbol*, pair<AST*, AType*> > {
 	}
 	static Subst unify(const Constraints& c);
 
-	typedef map<const AST*, AType*>      Vars;
-	typedef map<const AClosure*, AType*> GenericTypes;
+	typedef map<const AST*, AType*>            Vars;
+	typedef map<const AClosure*, const AType*> GenericTypes;
 	Vars         vars;
 	GenericTypes genericTypes;
 	PEnv&        penv;
-	Constraints  constraints;
 	unsigned     varID;
 };
 
diff --git a/typing.cpp b/typing.cpp
index e042283..086db79 100644
--- a/typing.cpp
+++ b/typing.cpp
@@ -55,7 +55,7 @@ ATuple::constrain(TEnv& tenv, Constraints& c) const
 void
 AClosure::constrain(TEnv& tenv, Constraints& c) const
 {
-	AType* genericType;
+	const AType* genericType;
 	TEnv::GenericTypes::const_iterator gt = tenv.genericTypes.find(this);
 	if (gt != tenv.genericTypes.end()) {
 		genericType = gt->second;
@@ -116,7 +116,7 @@ AClosure::constrain(TEnv& tenv, Constraints& c) const
 		subst = new Subst(tsubst);
 	}
 
-	c.constrain(tenv, this, genericType);
+	c.constrain(tenv, this, new AType(*genericType));
 }
 
 void