Support multiple ellipses in macros.

Support lambda expressions with empty argument lists.

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

8 files changed, 104 insertions, 76 deletions

diff --git a/src/compile.cpp b/src/compile.cpp
index 69cce6d..9921382 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -253,6 +253,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
 		else if (form == "call")
 			return compile_call(cenv, call);
 	}
+	default:
+		break;
 	}
 
 	cenv.err << "Attempt to compile unknown form: " << ast << endl;
diff --git a/src/constrain.cpp b/src/constrain.cpp
index 2a3c8fe..3655396 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -164,8 +164,13 @@ constrain_fn(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 		frame.push_back(make_pair(sym->sym(), tvar));
 		protT.push_back(tvar);
 	}
-	protT.head->loc = call->loc;
 
+	if (!protT.head) {
+		protT.head = new ATuple(NULL, NULL, call->loc);
+	} else {
+		protT.head->loc = call->loc;
+	}
+	
 	ATuple::const_iterator i = call->iter_at(1);
 	c.constrain(tenv, *i, protT);
 
@@ -352,7 +357,8 @@ constrain_call(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 	List       argsT;
 	for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
 		argsT.push_back(tenv.var(*i));
-	argsT.head->loc = call->loc;
+	if (argsT.head)
+		argsT.head->loc = call->loc;
 	c.constrain(tenv, head, tup(head->loc, tenv.Fn, argsT.head, retT, 0));
 	c.constrain(tenv, call, retT);
 }
@@ -473,5 +479,7 @@ resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Error)
 	case T_TUPLE:
 		constrain_list(tenv, c, ast->as_tuple());
 		break;
+	case T_ELLIPSIS:
+		throw Error(ast->loc, "ellipsis present after expand stage");
 	}
 }
diff --git a/src/expand.cpp b/src/expand.cpp
index c0f2f64..658eafd 100644
--- a/src/expand.cpp
+++ b/src/expand.cpp
@@ -23,6 +23,9 @@
 
 using namespace std;
 
+/** Try to match pattern @a p with @p e and build a Subst in the process.
+ * @return true iff @e matches @p.
+ */
 static bool
 match(PEnv&                 penv,
       Subst&                subst,
@@ -36,38 +39,48 @@ match(PEnv&                 penv,
 		ATuple::const_iterator ei      = e->as_tuple()->begin();
 		ATuple::const_iterator prev_pi = pi;
 		if (!match(penv, subst, keywords, *pi++, *ei++, true)) {
-			return false;
+			return false;  // Mismatch
 		}
 		for (; pi != p->as_tuple()->end() && ei != e->as_tuple()->end();
 		     ++pi, ++ei, ++prev_pi) {
 			if (is_dots(*pi)) {
-				List out;
+				List out;  // The list that dots after prev will be mapped to
 				for (; ei != e->as_tuple()->end(); ++ei) {
 					if (match(penv, subst, keywords, *prev_pi, *ei, false)) {
-						out.push_back(*ei);
+						out.push_back(*ei);  // Element matches prev, append
 					} else {
-						return false;
+						return false;  // Element doesn't match prev, mismatch
 					}
 				}
-				subst.add(*pi, out);
-				++pi;
+				subst.add(new AEllipsis(*prev_pi, (*pi++)->loc), out);
 				break;
 			} else if (!match(penv, subst, keywords, *pi, *ei, true)) {
-				return false;
+				return false;  // Pattern element doesn't match
 			}
 		}
-		if ((pi != p->as_tuple()->end()) || (ei != e->as_tuple()->end()))
-			return false;
+		if ((pi == p->as_tuple()->end() || is_dots(*pi)) &&
+		    ei != e->as_tuple()->end()) {
+			return false;  // Reached end of pattern but not expression
+		}
 	} else if (p->to_symbol()) {
 		if (keywords.count(p->str())) {
 			if (!e->to_symbol() || e->str() != p->str()) {
 				return false;  // Keyword mismatch
 			}
 		} else if (p->as_symbol()->str() != "_" && bind) {
-			subst.add(p, e);  // Symbol p match with symbol e
-		} // else _, ... matches with everything but creates no bindings
+			AEllipsis*            ellipsis = new AEllipsis(p, e->loc);
+			Subst::const_iterator s        = subst.find_ellipsis(p);
+			if (s != subst.end()) {
+				// Already an ellipsis list for after this prev, append to it
+				list_append(const_cast<ATuple*>(s->second->as_tuple()), e);
+			} else if ((s = subst.find(p)) != subst.end()) {
+				// Prev is mapped, but no ellipsis list yet, add a new one
+				subst.add(ellipsis, tup(s->second->loc, e, NULL));
+			} else {
+				subst.add(p, e);  // Symbol p match with symbol e
+			}
+		} // else _ matches with everything but creates no bindings
 	} else {
-		THROW_IF(p->tag() != e->tag(), e->loc, "expr type mismatch");
 		return false;  // Recursive list p mismatch with list e
 	}
 
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 2bd1930..3110c72 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -184,7 +184,7 @@ LLVMEngine::~LLVMEngine()
 Type*
 LLVMEngine::llType(const AST* t, const char* name)
 {
-	if (t == NULL) {
+	if (t == NULL || AType::is_var(t)) {
 		return NULL;
 	} else if (AType::is_name(t)) {
 		const std::string sym(t->as_symbol()->sym());
@@ -207,8 +207,8 @@ LLVMEngine::llType(const AST* t, const char* name)
 		return NULL;
 	}
 
-	THROW_IF(!isupper(t->as_tuple()->fst()->str()[0]), t->loc,
-	         "Lower-case type expression");
+	THROW_IF(t->as_tuple()->fst() && !isupper(t->as_tuple()->fst()->str()[0]),
+	         t->loc, "Lower-case type expression");
 
 	// Function type
 	if (is_form(t, "Fn")) {
@@ -414,12 +414,14 @@ LLVMEngine::compileProt(
 	Function::LinkageTypes linkage = Function::ExternalLinkage;
 
 	vector<Type*> cprot;
-	for (const auto& i : *argsT) {
-		const CType iT = (i->to_symbol())
-			? compileType(cenv, i->str(), cenv.resolveType(i))
-			: compileType(cenv, i->as_tuple()->fst()->str(), i);
-		THROW_IF(!iT, Cursor(), string("non-concrete parameter :: ") + i->str());
-		cprot.push_back((Type*)iT);
+	if (argsT) {
+		for (const auto& i : *argsT) {
+			const CType iT = (i->to_symbol())
+				? compileType(cenv, i->str(), cenv.resolveType(i))
+				: compileType(cenv, i->as_tuple()->fst()->str(), i);
+			THROW_IF(!iT, Cursor(), string("non-concrete parameter :: ") + i->str());
+			cprot.push_back((Type*)iT);
+		}
 	}
 
 	THROW_IF(!llType(retT), Cursor(),
diff --git a/src/pprint.cpp b/src/pprint.cpp
index 80a2519..463d91a 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -229,6 +229,8 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types)
 	case T_SYMBOL:
 	case T_LITSYM:
 		return out << ((const ASymbol*)ast)->sym();
+	case T_ELLIPSIS:
+		return out << "...";
 	}
 
 	return out << "?";
diff --git a/src/resp.hpp b/src/resp.hpp
index 9e1e4f7..02d2746 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -83,15 +83,16 @@ struct Object;
 
 /// Type tag for an AST node (must be even and > 1 since LSb is used as mark)
 enum Tag {
-	T_UNKNOWN = 2,
-	T_BOOL    = 4,
-	T_FLOAT   = 6,
-	T_INT32   = 8,
-	T_STRING  = 10,
-	T_SYMBOL  = 12,
-	T_LITSYM  = 14,
-	T_TUPLE   = 16,
-	T_TVAR    = 18
+	T_UNKNOWN  = 2,
+	T_BOOL     = 4,
+	T_FLOAT    = 6,
+	T_INT32    = 8,
+	T_STRING   = 10,
+	T_SYMBOL   = 12,
+	T_LITSYM   = 14,
+	T_TUPLE    = 16,
+	T_TVAR     = 18,
+	T_ELLIPSIS = 20
 };
 
 /// Garbage collector
@@ -197,6 +198,15 @@ private:
 	ASymbol(const char* s, Cursor c) : AST(T_SYMBOL, c), _sym(s) {}
 };
 
+/// Ellipsis, e.g. "..."
+struct AEllipsis : public AST {
+	AEllipsis(const AST* pred, Cursor c) : AST(T_ELLIPSIS, c), _pred(pred) {}
+	const AST* pred() const { return _pred; }
+private:
+	friend class PEnv;
+	const AST* _pred;
+};
+
 /// Tuple (heterogeneous sequence of fixed length), e.g. "(a b c)"
 struct ATuple : public AST {
 	explicit ATuple(Cursor c) : AST(T_TUPLE, c), _fst(0), _rst(0) {}
@@ -331,6 +341,16 @@ list_equals(const ATuple* lhs, const ATuple* rhs)
 	return true;
 }
 
+inline void
+list_append(ATuple* head, const AST* child) {
+	for (ATuple* i = head; i; i = const_cast<ATuple*>(i->rst())) {
+		if (!i->rst()) {
+			i->last(new ATuple(child, NULL, child->loc));
+			return;
+		}
+	}
+}
+
 struct AType {
 	static inline bool is_var(const AST* type)  { return type->tag() == T_TVAR; }
 	static inline bool is_name(const AST* type) { return type->tag() == T_SYMBOL; }
@@ -427,6 +447,8 @@ AST::operator==(const AST& rhs) const
 	case T_SYMBOL:
 	case T_LITSYM:
 		return ((ASymbol*)this)->sym() == ((ASymbol*)&rhs)->sym(); // interned
+	case T_ELLIPSIS:
+		return *((AEllipsis*)this)->pred() == *((AEllipsis*)&rhs)->pred();
 	case T_UNKNOWN:
 		return this == &rhs;
 	}
@@ -542,7 +564,8 @@ struct Constraint : public pair<const AST*,const AST*> {
 
 static inline bool
 is_dots(const AST* exp) {
-	return (exp->to_symbol() && exp->as_symbol()->str() == "...");
+	return (exp->tag() == T_ELLIPSIS ||
+	        (exp->to_symbol() && exp->as_symbol()->str() == "..."));
 }
 
 /// Type substitution
@@ -562,14 +585,22 @@ struct Subst : public list<Constraint> {
 				return j;
 		return end();
 	}
+	const_iterator find_ellipsis(const AST* t) const {
+		for (const_iterator j = begin(); j != end(); ++j)
+			if (j->first->tag() == T_ELLIPSIS &&
+			    *((AEllipsis*)j->first)->pred() == *t)
+				return j;
+		return end();
+	}
 	const AST* apply(const AST* in) const {
 		if (AType::is_expr(in)) {
 			if (in->as_tuple()->empty())
 				return in;
 			List out;
-			for (auto i : *in->as_tuple()) {
+			const AST* prev = NULL;
+			for (const auto& i : *in->as_tuple()) {
 				if (is_dots(i)) {
-					const_iterator o = find(i);
+					const_iterator o = find_ellipsis(prev);
 					if (o != end()) {
 						for (auto j : *o->second->as_tuple()) {
 							out.push_back(apply(j));
@@ -578,6 +609,7 @@ struct Subst : public list<Constraint> {
 				} else {
 					out.push_back(apply(i));
 				}
+				prev = i;
 			}
 			if (out.head)
 				out.head->loc = in->loc;
diff --git a/src/simplify.cpp b/src/simplify.cpp
index f1b1bec..34c1ef0 100644
--- a/src/simplify.cpp
+++ b/src/simplify.cpp
@@ -139,39 +139,6 @@ simplify_list(CEnv& cenv, Code& code, const ATuple* call) throw()
 	return copy;
 }
 
-static const AST*
-simplify_let(CEnv& cenv, Code& code, const ATuple* call) throw()
-{
-	const ATuple* vars = call->list_ref(1)->to_tuple();
-
-	List fn(Cursor(), cenv.penv.sym("lambda"), NULL);
-
-	List fnProt;
-	List fnArgs;
-	List fnProtT;
-	for (ATuple::const_iterator i = vars->begin(); i != vars->end();) {
-		const ASymbol* sym = (*i++)->to_symbol();
-		const AST*     val = (*i++);
-		fnProt.push_back(sym);
-		fnArgs.push_back(resp_simplify(cenv, code, val));
-		fnProtT.push_back(cenv.type(val));
-	}
-
-	fn.push_back(fnProt.head);
-	fn.push_back(resp_simplify(cenv, code, call->list_ref(2)));
-
-	List fnT;
-	fnT.push_back(cenv.tenv.Fn);
-	fnT.push_back(fnProtT);
-	fnT.push_back(cenv.type(call->list_ref(2)));
-	cenv.setType(fn, fnT);
-
-	ATuple* copy = new ATuple(fn, fnArgs, call->loc);
-	cenv.setTypeSameAs(copy, call);
-
-	return copy;
-}
-
 static inline const AST*
 quote(CEnv& cenv, const AST* ast);
 
@@ -219,18 +186,16 @@ const AST*
 resp_simplify(CEnv& cenv, Code& code, const AST* ast) throw()
 {
 	const ATuple* const list = ast->to_tuple();
-	if (!list)
+	if (!list || !list->fst())
 		return ast;
 	
-	const ASymbol* const sym  = list->fst()->to_symbol();
+	const ASymbol* const sym  = list->fst() ? list->fst()->to_symbol() : 0;
 	const std::string    form = sym ? sym->sym() : "";
 
 	if (form == "match")
 		return simplify_match(cenv, code, list);
 	else if (form == "if")
 		return simplify_if(cenv, code, list);
-	else if (form == "let")
-		return simplify_let(cenv, code, list);
 	else if (form == "quote")
 		return simplify_quote(cenv, code, list);
 	else
diff --git a/src/unify.cpp b/src/unify.cpp
index f8ebe1d..9bb2f3c 100644
--- a/src/unify.cpp
+++ b/src/unify.cpp
@@ -66,12 +66,14 @@ substitute(const AST* in, const AST* from, const AST* to)
 		return to;
 
 	const ATuple* tup = in->to_tuple();
-	if (!tup)
+	if (!tup || !tup->fst())
 		return from;
 	
 	List ret;
 	for (const auto& i : *tup->as_tuple()) {
-		if (*i == *from) {
+		if (!i) {
+			continue;
+		} if (*i == *from) {
 			ret.push_back(to); // FIXME: should be a copy w/ (*i)->loc
 		} else if (i != to) {
 			if (AType::is_expr(i))
@@ -123,7 +125,7 @@ Constraints::replace(const AST* s, const AST* t)
 		}
 		if (*c.second == *s) {
 			c.second = t; // FIXME: should be copy w/ c.second->loc;
-		} else if (AType::is_expr(c.second)) {
+		} else if (AType::is_expr(c.second) && c.second->to_tuple()->fst()) {
 			c.second = substitute(c.second, s, t);
 		}
 	}
@@ -156,8 +158,10 @@ unify(const Constraints& constraints)
 		for (; si != st->end() && ti != tt->end(); ++si, ++ti) {
 			if (is_dots(*si) || is_dots(*ti))
 				return unify(cp);
-			else
+			else if (*si && *ti)
 				cp.push_back(Constraint(*si, *ti));
+			else
+				throw Error(Cursor(), "match with missing list element");
 		}
 		if ((si == st->end() && ti == tt->end())
 		    || (si != st->end() && is_dots(*si))