Implement ellipses as in R*RS.

Let macro is now the one from R7RS, but missing the second clause (no letrec yet).


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

4 files changed, 50 insertions, 30 deletions

diff --git a/src/expand.cpp b/src/expand.cpp
index 658eafd..5ede0dd 100644
--- a/src/expand.cpp
+++ b/src/expand.cpp
@@ -35,34 +35,47 @@ match(PEnv&                 penv,
       bool                  bind)
 {
 	if (p->to_tuple() && e->to_tuple()) {
-		ATuple::const_iterator pi      = p->as_tuple()->begin();
-		ATuple::const_iterator ei      = e->as_tuple()->begin();
-		ATuple::const_iterator prev_pi = pi;
-		if (!match(penv, subst, keywords, *pi++, *ei++, true)) {
-			return false;  // Mismatch
+		ATuple::const_iterator pi = p->as_tuple()->begin();
+		ATuple::const_iterator ei = e->as_tuple()->begin();
+		ATuple::const_iterator next = pi;
+		if (next != p->as_tuple()->end()) {
+			++next;
 		}
 		for (; pi != p->as_tuple()->end() && ei != e->as_tuple()->end();
-		     ++pi, ++ei, ++prev_pi) {
-			if (is_dots(*pi)) {
-				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);  // Element matches prev, append
+		     ++pi, ++ei) {
+			if (next != p->as_tuple()->end() && is_dots(*next)) {
+				if ((*pi)->to_tuple()) {
+					/* We have something like "(foo bar) ..."
+					   Add a new ellipsis list for each element (foo and bar)
+					   so they can be used in templates like "foo ..." */
+					for (auto elem : *(*pi)->as_tuple()) {
+						subst.add(elem, new ATuple(NULL, NULL, (*pi)->loc));
+					}
+				}
+
+				List out;  // The list that dots after *pi will be mapped to
+				for (; ei != e->as_tuple()->end() && !is_dots(*ei); ++ei) {
+					if (match(penv, subst, keywords, *pi, *ei, false)) {
+						out.push_back(*ei);  // Element matches, append
 					} else {
-						return false;  // Element doesn't match prev, mismatch
+						return false;  // Element doesn't match, mismatch
 					}
 				}
-				subst.add(new AEllipsis(*prev_pi, (*pi++)->loc), out);
+				if (out) {
+					subst.add(new AEllipsis(*pi, (*pi++)->loc), out);
+				}
 				break;
 			} else if (!match(penv, subst, keywords, *pi, *ei, true)) {
 				return false;  // Pattern element doesn't match
 			}
+			if (next != p->as_tuple()->end()) {
+				++next;
+			}
 		}
-		if ((pi == p->as_tuple()->end() || is_dots(*pi)) &&
-		    ei != e->as_tuple()->end()) {
+		if ((pi == p->as_tuple()->end() && ei != e->as_tuple()->end())) {
 			return false;  // Reached end of pattern but not expression
 		}
-	} else if (p->to_symbol()) {
+	} else if (p->to_symbol() && !is_dots(p) && !is_dots(e)) {
 		if (keywords.count(p->str())) {
 			if (!e->to_symbol() || e->str() != p->str()) {
 				return false;  // Keyword mismatch
@@ -71,7 +84,7 @@ match(PEnv&                 penv,
 			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
+				// Already an ellipsis list for this element, 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
diff --git a/src/resp.hpp b/src/resp.hpp
index 02d2746..5eb9ef0 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -243,6 +243,7 @@ struct ATuple : public AST {
 		return NULL;
 	}
 
+	void set_fst(const AST* ast) { _fst = ast; }
 	void last(ATuple* ast) { _rst = ast; }
 
 	struct const_iterator {
@@ -336,13 +337,16 @@ list_equals(const ATuple* lhs, const ATuple* rhs)
 	
 	ATuple::const_iterator l = lhs->begin();
 	for (const auto& r : *rhs)
-		if (!(*(*l++) == *r))
+		if (l == lhs->end() || !(*(*l++) == *r))
 			return false;
 	return true;
 }
 
 inline void
 list_append(ATuple* head, const AST* child) {
+	if (!head->fst()) {
+		head->set_fst(child);
+	}
 	for (ATuple* i = head; i; i = const_cast<ATuple*>(i->rst())) {
 		if (!i->rst()) {
 			i->last(new ATuple(child, NULL, child->loc));
@@ -593,26 +597,29 @@ struct Subst : public list<Constraint> {
 		return end();
 	}
 	const AST* apply(const AST* in) const {
-		if (AType::is_expr(in)) {
-			if (in->as_tuple()->empty())
-				return in;
+		if (AType::is_expr(in) && !in->as_tuple()->empty()) {
+			const ATuple* tup = in->as_tuple();
 			List out;
-			const AST* prev = NULL;
-			for (const auto& i : *in->as_tuple()) {
-				if (is_dots(i)) {
-					const_iterator o = find_ellipsis(prev);
+			ATuple::const_iterator next = tup->begin();
+			++next;
+			for (auto i : *tup) {
+				if (next != tup->end() && is_dots(*next)) {
+					const_iterator o = find_ellipsis(i);
 					if (o != end()) {
 						for (auto j : *o->second->as_tuple()) {
 							out.push_back(apply(j));
 						}
 					}
-				} else {
+				} else if (!is_dots(i)) {
 					out.push_back(apply(i));
 				}
-				prev = i;
+				if (next != tup->end())
+					++next;
 			}
 			if (out.head)
 				out.head->loc = in->loc;
+			else
+				out.head = new ATuple(NULL, NULL, in->loc);
 			return out.head;
 		} else {
 			const_iterator i = find(in);
diff --git a/test/let.scm b/test/let.scm
index 3fb57a7..cc4e4c4 100644
--- a/test/let.scm
+++ b/test/let.scm
@@ -1,7 +1,7 @@
 (define-syntax let
   (syntax-rules ()
-    ((let ((name val) ...) body1 ...)
-     ((lambda (name ...) body1 ...)
+    ((let ((name val) ...) body1 body2 ...)
+     ((lambda (name ...) body1 body2 ...)
       val ...))))
 
 (define inc
diff --git a/test/mac.scm b/test/mac.scm
index d5df7f3..cdf3e14 100644
--- a/test/mac.scm
+++ b/test/mac.scm
@@ -5,4 +5,4 @@
     ((and test1 test2 ...)
      (if test1 (and test2 ...) #f))))
 
-(and (= 1 1) (= 2 2) #t #t (= 1 4))
+(and (= 1 1) (= 2 2) (= 3 3) (= 42 24))