Remove use of ACall subclasses for contrain phase.

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

5 files changed, 154 insertions, 127 deletions

diff --git a/src/compile.cpp b/src/compile.cpp
index ccde2ca..8518051 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -84,12 +84,13 @@ compile_call(CEnv& cenv, const ACall* call) throw()
 static CVal
 compile_def(CEnv& cenv, const ADef* def) throw()
 {
-	const ASymbol* const sym = def->list_ref(1)->as<const ASymbol*>();
-	cenv.def(sym, def->body(), cenv.type(def->body()), NULL); // define stub first for recursion
-	CVal val = resp_compile(cenv, def->body());
-	if (cenv.vals.size() == 1 && cenv.type(def->body())->head()->str() != "Fn") {
+	const ASymbol* const sym  = def->list_ref(1)->as<const ASymbol*>();
+	const AST*     const body = def->list_ref(2);
+	cenv.def(sym, body, cenv.type(body), NULL); // define stub first for recursion
+	CVal val = resp_compile(cenv, body);
+	if (cenv.vals.size() == 1 && cenv.type(body)->head()->str() != "Fn") {
 		val = cenv.engine()->compileGlobal(
-				cenv, cenv.type(def->body()), sym->str(), val);
+				cenv, cenv.type(body), sym->str(), val);
 		cenv.lock(def);
 	}
 	cenv.vals.def(sym, val);
diff --git a/src/constrain.cpp b/src/constrain.cpp
index bd43b8e..4e507c9 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -46,13 +46,6 @@ ALexeme::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 }
 
 void
-AQuote::constrain(TEnv& tenv, Constraints& c) const throw(Error)
-{
-	c.constrain(tenv, this, tenv.named("Quote"));
-	list_ref(1)->constrain(tenv, c);
-}
-
-void
 ASymbol::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 {
 	const AType** ref = tenv.ref(this);
@@ -125,78 +118,58 @@ AFn::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 	c.constrain(tenv, this, fnT);
 }
 
-void
-ACall::constrain(TEnv& tenv, Constraints& c) const throw(Error)
-{
-	for (const_iterator i = begin(); i != end(); ++i)
-		(*i)->constrain(tenv, c);
-
-	const AType* fnType = tenv.var(head());
-	if (fnType->kind != AType::VAR) {
-		if (fnType->kind == AType::PRIM
-				|| fnType->list_len() < 2
-				|| fnType->head()->str() != "Fn")
-			throw Error(loc, (format("call to non-function `%1%'") % head()->str()).str());
-
-		size_t numArgs = fnType->prot()->list_len();
-		THROW_IF(numArgs != list_len() - 1, loc,
-				(format("expected %1% arguments, got %2%") % numArgs % (list_len() - 1)).str());
-	}
-
-	const AType* retT  = tenv.var(this);
-	TList        argsT;
-	for (const_iterator i = iter_at(1); i != end(); ++i)
-		argsT.push_back(const_cast<AType*>(tenv.var(*i)));
-	argsT.head->loc = loc;
-	c.constrain(tenv, head(), tup<AType>(head()->loc, tenv.Fn, argsT.head, retT, 0));
-	c.constrain(tenv, this, retT);
-}
-
-void
-ADef::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_def(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	THROW_IF(list_len() != 3, loc, "`def' requires exactly 2 arguments");
-	const ASymbol* sym = this->list_ref(1)->as<const ASymbol*>();
-	THROW_IF(!sym, loc, "`def' has no symbol")
+	THROW_IF(call->list_len() != 3, call->loc, "`def' requires exactly 2 arguments");
+	const ASymbol* const sym = call->list_ref(1)->as<const ASymbol*>();
+	THROW_IF(!sym, call->loc, "`def' has no symbol")
+	const AST* const body = call->list_ref(2);
 
-	const AType* tvar = tenv.var(body());
+	const AType* tvar = tenv.var(body);
 	tenv.def(sym, tvar);
-	body()->constrain(tenv, c);
+	body->constrain(tenv, c);
 	c.constrain(tenv, sym, tvar);
-	c.constrain(tenv, this, tenv.named("Nothing"));
+	c.constrain(tenv, call, tenv.named("Nothing"));
 }
 
-void
-AIf::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_def_type(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	THROW_IF(list_len() < 4, loc, "`if' requires at least 3 arguments");
-	THROW_IF(list_len() % 2 != 0, loc, "`if' missing final else clause");
-	for (const_iterator i = iter_at(1); i != end(); ++i)
-		(*i)->constrain(tenv, c);
-	const AType* retT = tenv.var(this);
-	for (const_iterator i = iter_at(1); true; ++i) {
-		const_iterator next = i;
-		++next;
-		if (next == end()) { // final (else) expression
-			c.constrain(tenv, *i, retT);
-			break;
-		} else {
-			c.constrain(tenv, *i, tenv.named("Bool"));
-			c.constrain(tenv, *next, retT);
+	THROW_IF(call->list_len() < 3, call->loc, "`def-type' requires at least 2 arguments");
+	ATuple::const_iterator i = call->iter_at(1);
+	const ATuple* prot = (*i)->to<const ATuple*>();
+	THROW_IF(!prot, (*i)->loc, "first argument of `def-type' is not a tuple");
+	const ASymbol* sym = (*prot->begin())->as<const ASymbol*>();
+	THROW_IF(!sym, (*prot->begin())->loc, "type name is not a symbol");
+	THROW_IF(tenv.ref(sym), call->loc, "type redefinition");
+	TList type(new AType(tenv.U, NULL, call->loc));
+	for (ATuple::const_iterator i = call->iter_at(2); i != call->end(); ++i) {
+		const ATuple*  exp   = (*i)->as<const ATuple*>();
+		const ASymbol* tag   = (*exp->begin())->as<const ASymbol*>();
+		TList          consT;
+		consT.push_back(new AType(const_cast<ASymbol*>(sym), AType::NAME));
+		for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) {
+			const ASymbol* sym = (*i)->to<const ASymbol*>();
+			THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol");
+			consT.push_back(new AType(const_cast<ASymbol*>(sym), AType::NAME));
 		}
-		i = next; // jump 2 each iteration (to the next predicate)
+		consT.head->loc = exp->loc;
+		type.push_back(consT);
+		tenv.def(tag, consT);
 	}
+	tenv.def(sym, type);
 }
 
-void
-AMatch::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_match(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	THROW_IF(list_len() < 5, loc, "`match' requires at least 4 arguments");
-	const AST*   matchee  = list_ref(1);
+	THROW_IF(call->list_len() < 5, call->loc, "`match' requires at least 4 arguments");
+	const AST*   matchee  = call->list_ref(1);
 	const AType* retT     = tenv.var();
 	const AType* matcheeT = NULL;// = tup<AType>(loc, tenv.U, 0);
 	matchee->constrain(tenv, c);
-	for (const_iterator i = iter_at(2); i != end();) {
+	for (ATuple::const_iterator i = call->iter_at(2); i != call->end();) {
 		const AST*    exp     = *i++;
 		const ATuple* pattern = exp->to<const ATuple*>();
 		THROW_IF(!pattern, exp->loc, "pattern expression expected");
@@ -207,84 +180,79 @@ AMatch::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 
 		if (!matcheeT) {
 			const AType* headT = consT->head()->as<const AType*>();
-			matcheeT = tup<AType>(loc, const_cast<AType*>(headT), 0);
+			matcheeT = tup<AType>(call->loc, const_cast<AType*>(headT), 0);
 		}
 
-		THROW_IF(i == end(), pattern->loc, "missing pattern body");
+		THROW_IF(i == call->end(), pattern->loc, "missing pattern body");
 		const AST* body = *i++;
 		body->constrain(tenv, c);
 		c.constrain(tenv, body, retT); 
 	}
-	c.constrain(tenv, this, retT);
+	c.constrain(tenv, call, retT);
 	c.constrain(tenv, matchee, matcheeT);
 }
 
-void
-ADefType::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_if(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	THROW_IF(list_len() < 3, loc, "`def-type' requires at least 2 arguments");
-	const_iterator i = iter_at(1);
-	const ATuple* prot = (*i)->to<const ATuple*>();
-	THROW_IF(!prot, (*i)->loc, "first argument of `def-type' is not a tuple");
-	const ASymbol* sym = (*prot->begin())->as<const ASymbol*>();
-	THROW_IF(!sym, (*prot->begin())->loc, "type name is not a symbol");
-	THROW_IF(tenv.ref(sym), loc, "type redefinition");
-	TList type(new AType(tenv.U, NULL, loc));
-	for (const_iterator i = iter_at(2); i != end(); ++i) {
-		const ATuple*  exp   = (*i)->as<const ATuple*>();
-		const ASymbol* tag   = (*exp->begin())->as<const ASymbol*>();
-		TList          consT;
-		consT.push_back(new AType(const_cast<ASymbol*>(sym), AType::NAME));
-		for (ATuple::const_iterator i = exp->begin(); i != exp->end(); ++i) {
-			const ASymbol* sym = (*i)->to<const ASymbol*>();
-			THROW_IF(!sym, (*i)->loc, "type expression element is not a symbol");
-			consT.push_back(new AType(const_cast<ASymbol*>(sym), AType::NAME));
+	THROW_IF(call->list_len() < 4, call->loc, "`if' requires at least 3 arguments");
+	THROW_IF(call->list_len() % 2 != 0, call->loc, "`if' missing final else clause");
+	for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
+		(*i)->constrain(tenv, c);
+	const AType* retT = tenv.var(call);
+	for (ATuple::const_iterator i = call->iter_at(1); true; ++i) {
+		ATuple::const_iterator next = i;
+		++next;
+		if (next == call->end()) { // final (else) expression
+			c.constrain(tenv, *i, retT);
+			break;
+		} else {
+			c.constrain(tenv, *i, tenv.named("Bool"));
+			c.constrain(tenv, *next, retT);
 		}
-		consT.head->loc = exp->loc;
-		type.push_back(consT);
-		tenv.def(tag, consT);
+		i = next; // jump 2 each iteration (to the next predicate)
 	}
-	tenv.def(sym, type);
 }
 
-void
-ACons::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_cons(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	const ASymbol* sym  = (*begin())->as<const ASymbol*>();
+	const ASymbol* sym  = (*call->begin())->as<const ASymbol*>();
 	const AType*   type = NULL;
 
-	for (const_iterator i = iter_at(1); i != end(); ++i)
+	for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
 		(*i)->constrain(tenv, c);
 
 	if (sym->cppstr == "Tup") {
-		TList tupT(new AType(tenv.Tup, NULL, loc));
-		for (const_iterator i = iter_at(1); i != end(); ++i) {
+		TList tupT(new AType(tenv.Tup, NULL, call->loc));
+		for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i) {
 			tupT.push_back(const_cast<AType*>(tenv.var(*i)));
 		}
 		type = tupT;
 	} else {
 		const AType** consTRef = tenv.ref(sym);
-		THROW_IF(!consTRef, loc, (format("call to undefined constructor `%1%'") % sym->cppstr).str());
+		THROW_IF(!consTRef, call->loc,
+		         (format("call to undefined constructor `%1%'") % sym->cppstr).str());
 		const AType* consT = *consTRef;
-		type = tup<AType>(loc, const_cast<AType*>(consT->head()->as<const AType*>()), 0);
+		type = tup<AType>(call->loc, const_cast<AType*>(consT->head()->as<const AType*>()), 0);
 	}
-	c.constrain(tenv, this, type);
+	c.constrain(tenv, call, type);
 }
 
-void
-ADot::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+static void
+constrain_dot(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
 {
-	THROW_IF(list_len() != 3, loc, "`.' requires exactly 2 arguments");
-	const_iterator           i   = begin();
+	THROW_IF(call->list_len() != 3, call->loc, "`.' requires exactly 2 arguments");
+	ATuple::const_iterator   i   = call->begin();
 	const AST*               obj = *++i;
 	const ALiteral<int32_t>* idx = (*++i)->to<const ALiteral<int32_t>*>();
-	THROW_IF(!idx, loc, "the 2nd argument to `.' must be a literal integer");
+	THROW_IF(!idx, call->loc, "the 2nd argument to `.' must be a literal integer");
 	obj->constrain(tenv, c);
 
-	const AType* retT = tenv.var(this);
-	c.constrain(tenv, this, retT);
+	const AType* retT = tenv.var(call);
+	c.constrain(tenv, call, retT);
 
-	TList objT(new AType(tenv.Tup, NULL, loc));
+	TList objT(new AType(tenv.Tup, NULL, call->loc));
 	for (int i = 0; i < idx->val; ++i)
 		objT.push_back(const_cast<AType*>(tenv.var()));
 	objT.push_back(const_cast<AType*>(retT));
@@ -292,6 +260,70 @@ ADot::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 	c.constrain(tenv, obj, objT);
 }
 
+static void
+constrain_quote(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
+{
+	c.constrain(tenv, call, tenv.named("Quote"));
+	call->list_ref(1)->constrain(tenv, c);
+}
+
+static void
+constrain_call(TEnv& tenv, Constraints& c, const ACall* call) throw(Error)
+{
+	const AST* const head = call->head();
+	
+	for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i)
+		(*i)->constrain(tenv, c);
+
+	const AType* fnType = tenv.var(head);
+	if (fnType->kind != AType::VAR) {
+		if (fnType->kind == AType::PRIM
+				|| fnType->list_len() < 2
+				|| fnType->head()->str() != "Fn")
+			throw Error(call->loc, (format("call to non-function `%1%'") % head->str()).str());
+
+		size_t numArgs = fnType->prot()->list_len();
+		THROW_IF(numArgs != call->list_len() - 1, call->loc,
+				(format("expected %1% arguments, got %2%") % numArgs % (call->list_len() - 1)).str());
+	}
+
+	const AType* retT  = tenv.var(call);
+	TList        argsT;
+	for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
+		argsT.push_back(const_cast<AType*>(tenv.var(*i)));
+	argsT.head->loc = call->loc;
+	c.constrain(tenv, head, tup<AType>(head->loc, tenv.Fn, argsT.head, retT, 0));
+	c.constrain(tenv, call, retT);
+}
+
+void
+ACall::constrain(TEnv& tenv, Constraints& c) const throw(Error)
+{
+	const ASymbol* const sym = head()->to<const ASymbol*>();
+	if (!sym) {
+		constrain_call(tenv, c, this);
+		return;
+	}
+
+	const std::string form = sym->cppstr;
+	if (form == "def")
+		constrain_def(tenv, c, this);
+	else if (form == "def-type")
+		constrain_def_type(tenv, c, this);
+	else if (form == "match")
+		constrain_match(tenv, c, this);
+	else if (form == "if")
+		constrain_if(tenv, c, this);
+	else if (form == "cons" || isupper(form[0]))
+		constrain_cons(tenv, c, this);
+	else if (form == ".")
+		constrain_dot(tenv, c, this);
+	else if (form == "quote")
+		constrain_quote(tenv, c, this);
+	else
+		constrain_call(tenv, c, this);
+}
+
 void
 APrimitive::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 {
@@ -308,7 +340,7 @@ APrimitive::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 	else
 		throw Error(loc, (format("unknown primitive `%1%'") % n).str());
 
-	const_iterator i = begin();
+	ATuple::const_iterator i = begin();
 
 	for (++i; i != end(); ++i)
 		(*i)->constrain(tenv, c);
diff --git a/src/lift.cpp b/src/lift.cpp
index 754118a..29a25fe 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -181,9 +181,10 @@ static AST*
 lift_def(CEnv& cenv, Code& code, ADef* def) throw()
 {
 	// Define stub first for recursion
-	const ASymbol* const sym = def->list_ref(1)->as<const ASymbol*>();
-	cenv.def(sym, def->body(), cenv.type(def->body()), NULL);
-	AFn* c = def->body()->to<AFn*>();
+	const ASymbol* const sym  = def->list_ref(1)->as<const ASymbol*>();
+	AST*           const body = def->list_ref(2);
+	cenv.def(sym, body, cenv.type(body), NULL);
+	AFn* c = body->to<AFn*>();
 	if (c)
 		c->name = sym->str();
 
diff --git a/src/parse.cpp b/src/parse.cpp
index 066db76..3aa5b74 100644
--- a/src/parse.cpp
+++ b/src/parse.cpp
@@ -150,7 +150,7 @@ parseFn(PEnv& penv, const AST* exp, void* arg)
 	ATuple::const_iterator a = texp->begin();
 	THROW_IF(++a == texp->end(), exp->loc, "Unexpected end of `fn' form");
 	ATuple* prot = parseTuple<ATuple>(penv, (*a++)->to<const ATuple*>());
-	List<ATuple, AST> ret(new ATuple(penv.sym("fn"), NULL));
+	List<ATuple, AST> ret(new ATuple(penv.sym("fn"), NULL, Cursor()));
 	ret.push_back(prot);
 	while (a != texp->end())
 		ret.push_back(penv.parse(*a++));
@@ -165,7 +165,8 @@ parseQuote(PEnv& penv, const AST* exp, void* arg)
 	THROW_IF(texp->list_len() != 2, exp->loc, "`quote' requires exactly 1 argument");
 	const ALexeme* quotee = texp->list_ref(1)->to<const ALexeme*>();
 	THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme");
-	return new AQuote(texp);
+	AQuote* ret = tup<AQuote>(texp->loc, penv.sym("quote"), quotee, NULL);
+	return ret;
 }
 
 
diff --git a/src/resp.hpp b/src/resp.hpp
index 632e1a2..d429168 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -549,23 +549,18 @@ struct ADef : public ACall {
 	ADef(const ATuple* exp) : ACall(exp) {}
 	ADef(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	ADef(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	const AST* body() const { return list_ref(2); }
-	AST*       body()       { return list_ref(2); }
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 struct ADefType : public ACall {
 	ADefType(const ATuple* exp) : ACall(exp) {}
 	ADefType(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	ADefType(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 struct AMatch : public ACall {
 	AMatch(const ATuple* exp) : ACall(exp) {}
 	AMatch(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	AMatch(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 /// Conditional special form, e.g. "(if cond thenexp elseexp)"
@@ -573,21 +568,18 @@ struct AIf : public ACall {
 	AIf(const ATuple* exp) : ACall(exp) {}
 	AIf(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	AIf(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 struct ACons : public ACall {
 	ACons(const ATuple* exp) : ACall(exp) {}
 	ACons(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	ACons(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 struct ADot : public ACall {
 	ADot(const ATuple* exp) : ACall(exp) {}
 	ADot(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 	ADot(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
 };
 
 /// Primitive (builtin arithmetic function), e.g. "(+ 2 3)"
@@ -600,7 +592,7 @@ struct APrimitive : public ACall {
 struct AQuote : public ACall {
 	AQuote(const ATuple* exp) : ACall(exp) {}
 	AQuote(AST* first, AST* rest, Cursor c) : ACall(first, rest, c) {}
-	void constrain(TEnv& tenv, Constraints& c) const throw(Error);
+	AQuote(Cursor c, AST* ast, va_list args) : ACall(c, ast, args) {}
 };