From d868d225ea641d81b43e7c574343cd45a1e13700 Mon Sep 17 00:00:00 2001
From: David Robillard <d@drobilla.net>
Date: Tue, 13 Apr 2010 17:37:10 +0000
Subject: Add missing file.

git-svn-id: http://svn.drobilla.net/resp/resp@257 ad02d1e2-f140-0410-9f75-f8b11f17cedd
---
 src/depoly.cpp | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)
 create mode 100644 src/depoly.cpp

(limited to 'src')

diff --git a/src/depoly.cpp b/src/depoly.cpp
new file mode 100644
index 0000000..9b457c2
--- /dev/null
+++ b/src/depoly.cpp
@@ -0,0 +1,110 @@
+/* Resp: A programming language
+ * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
+ *
+ * Resp is free software: you can redistribute it and/or modify it under
+ * the terms of the GNU Affero General Public License as published by the
+ * Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Resp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+ * Public License for more details.
+ *
+ * You should have received a copy of the GNU Affero General Public License
+ * along with Resp.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+/** @file
+ * @brief Remove polymorphism (compilation pass 2)
+ * After this pass:
+ *  - All functions definitions have concrete type
+ */
+
+#include "resp.hpp"
+
+using namespace std;
+
+AST*
+ATuple::depoly(CEnv& cenv, Code& code) throw()
+{
+	ATuple*  ret = new ATuple(*this);
+	iterator ri  = ret->begin();
+	FOREACHP(const_iterator, t, this)
+		*ri++ = (*t)->depoly(cenv, code);
+	return ret;
+}
+
+AST*
+AFn::depoly(CEnv& cenv, Code& code) throw()
+{
+	return (cenv.type(this)->concrete()) ? this : NULL;
+}
+
+template<typename T>
+AST*
+depoly_call(CEnv& cenv, T* call, Code& code) throw()
+{
+	AST* head   = cenv.resolve(call->head());
+	AFn* callee = head->to<AFn*>();
+
+	if (!callee || cenv.type(callee)->concrete())
+		return call;
+
+	/*pair<CEnv::Defs::iterator, CEnv::Defs::iterator> r = cenv.defs.equal_range(this);
+	for (CEnv::Defs::iterator i = r.first; i != r.second; ++i) {
+		if (*i->second.type == *cenv.type(this)) {
+			ADef* def = i->second.def;
+			cout << "CACHED LIFTED FN " << def << endl;
+			return *(def->begin() + 2);
+		}
+	}*/
+
+	// Build arguments type
+	AType argsT(call->loc);
+	for (typename T::const_iterator i = call->begin() + 1; i != call->end(); ++i)
+		argsT.push_back(const_cast<AType*>(cenv.type(*i)));
+
+	const AType* genericType = cenv.type(callee);
+	Subst        argsSubst   = cenv.tenv.buildSubst(genericType, argsT);
+	const AType* thisType    = argsSubst.apply(genericType)->as<const AType*>();
+
+	// Create a new version of callee for this type
+	AFn*     concreteCallee = new AFn(callee);
+	ASymbol* newName        = cenv.penv.gensym(callee->name.c_str());
+	cenv.setType(concreteCallee, thisType);
+	concreteCallee->name = newName->cppstr;
+	ADef* def = tup<ADef>(Cursor(), cenv.penv.sym("def"), newName, concreteCallee, NULL);
+	cenv.setType(concreteCallee, thisType);
+	cenv.setType(def, cenv.tenv.named("Nothing"));
+	code.push_back(def);
+
+	// Create copy of call that calls new concrete callee
+	ATuple* copy = new T(call);
+	*copy->begin() = newName;
+	cenv.setType(copy, (*(thisType->begin() + 2))->as<AType*>());
+	return copy;
+}
+
+AST*
+ADef::depoly(CEnv& cenv, Code& code) throw()
+{
+	// Define stub first for recursion
+	cenv.def(sym(), body(), cenv.type(body()), NULL);
+	AFn* c = body()->to<AFn*>();
+	if (c)
+		c->name = sym()->str();
+
+	ADef* copy = new ADef(ATuple::depoly(cenv, code)->as<ATuple*>());
+	if (copy->body() == NULL)
+		return NULL; // Don't attempt to compile polymorphic functions
+
+	cenv.setType(copy, cenv.type(this));
+	return copy;
+}
+
+AST* ACall::depoly(CEnv& cenv, Code& code)      throw() { return depoly_call(cenv, this, code); }
+AST* AIf::depoly(CEnv& cenv, Code& code)        throw() { return depoly_call(cenv, this, code); }
+AST* ACons::depoly(CEnv& cenv, Code& code)      throw() { return depoly_call(cenv, this, code); }
+AST* ADot::depoly(CEnv& cenv, Code& code)       throw() { return depoly_call(cenv, this, code); }
+AST* APrimitive::depoly(CEnv& cenv, Code& code) throw() { return depoly_call(cenv, this, code); }
-- 
cgit v1.2.1