1 files changed, 130 insertions, 0 deletions
diff --git a/src/depoly.cpp b/src/depoly.cpp
new file mode 100644
index 0000000..2b8554b
--- /dev/null
+++ b/src/depoly.cpp
@@ -0,0 +1,130 @@
+/* Resp: A programming language
+ * Copyright (C) 2008-2012 David Robillard <http://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 Lift instances of parametric types
+ */
+
+#include <string>
+#include <vector>
+
+#include "resp.hpp"
+
+using namespace std;
+
+static bool
+is_concrete(const AST* type)
+{
+	if (type->tag() == T_TVAR) {
+		return false;
+	} else if (type->tag() == T_SYMBOL) {
+		return isupper(type->as_symbol()->str()[0]);
+	} else {
+		const ATuple* tup = type->as_tuple();
+		for (ATuple::const_iterator i = tup->begin(); i != tup->end(); ++i) {
+			if (!is_concrete(*i)) {
+				return false;
+			}
+		}
+	}
+	return true;
+}
+
+static const AST*
+depoly_def_type(CEnv& cenv, Code& code, const ATuple* def) throw()
+{
+	const ASymbol* name = def->frst()->to_symbol();
+	if (name) {
+		cenv.tenv.def(name, def->frrst());
+		return def;
+	} else if (is_concrete(def->frst())) {
+		name = def->frst()->as_tuple()->fst()->as_symbol();
+		cenv.tenv.def(name, def->frrst());
+		return def;
+	}
+	return NULL;
+}
+
+// Create concrete type definitions for a parametric type instantation
+static void
+raise_type(CEnv& cenv, Code& code, const ATuple* type)
+{
+	const ASymbol* tag = type->fst()->as_symbol();
+	if (tag->str() == "Tup" || !type->rst()) {
+		return;
+	}
+
+	const ATuple* exp  = (*cenv.tenv.ref(tag))->as_tuple();
+	const ATuple* prot = exp->frst()->as_tuple();
+
+	List def(Cursor(), cenv.penv.sym("def-type"), type, NULL);
+
+	// Build a substitution for each type parameter to its instantiation
+	Subst subst;
+	ATuple::const_iterator t = type->iter_at(1);
+	for (ATuple::const_iterator p = prot->iter_at(0);
+	     p != prot->end() && t != type->end();
+	     ++p, ++t) {
+		subst.add(*p, *t);
+	}
+
+	// Apply substitution to each clause and add it to the new type definition
+	for (ATuple::const_iterator i = exp->iter_at(2); i != exp->end(); ++i) {
+		def.push_back(subst.apply(*i));
+	}
+
+	code.push_back(def);
+}
+	
+static const AST*
+depoly_args(CEnv& cenv, Code& code, const ATuple* call) throw()
+{
+	for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) {
+		const AST* type = cenv.type(*i);
+		if (type && type->to_tuple()) {
+			if (is_concrete(type)) {
+				raise_type(cenv, code, type->as_tuple());
+			}
+		}
+	}
+	return call;
+}
+
+const AST*
+resp_depoly(CEnv& cenv, Code& code, const AST* ast) throw()
+{
+	switch (ast->tag()) {
+	case T_TUPLE: {
+		const ATuple* const  call = ast->as_tuple();
+		const ASymbol* const sym  = call->fst()->to_symbol();
+		const std::string    form = sym ? sym->sym() : "";
+		assert(form != "fn");
+		if (form == "quote")
+			return ast;
+		else if (form == "def-type")
+			return depoly_def_type(cenv, code, call);
+		else
+			return depoly_args(cenv, code, call);
+	}
+	default:
+		return ast;
+	}
+
+	cenv.err << "Attempt to depoly unknown type: " << ast << endl;
+	assert(false);
+	return NULL;
+}