Generalise `cons': a call to any symbol beginning with an uppercase character

(i.e. a type symbol), e.g. (Thing 2), is a call to a type constructor which creates a Tup
containing the arguments, with the symbol as the first element in the type expression,
e.g. (Thing 2) has type (Thing Int) and compiles to a tuple containing a single Int.

The type constructor `Tup' can be used as a `cons' replacement to construct
generic tuples.


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

6 files changed, 34 insertions, 19 deletions

diff --git a/src/constrain.cpp b/src/constrain.cpp
index 13bb9e8..e5a8dc4 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -187,7 +187,8 @@ AIf::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 void
 ACons::constrain(TEnv& tenv, Constraints& c) const throw(Error)
 {
-	AType* type = tup<AType>(loc, tenv.Tup, 0);
+	ASymbol* sym  = (*begin())->as<ASymbol*>();
+	AType*   type = tup<AType>(loc, new AType(sym), 0);
 	for (const_iterator i = begin() + 1; i != end(); ++i) {
 		(*i)->constrain(tenv, c);
 		type->push_back(const_cast<AType*>(tenv.var(*i)));
diff --git a/src/lift.cpp b/src/lift.cpp
index 3dd0297..939d529 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -119,7 +119,7 @@ AFn::lift(CEnv& cenv, Code& code) throw()
 	AType* implT = new AType(*type); // Type of the implementation function
 	AType* tupT  = tup<AType>(loc, cenv.tenv.Tup, cenv.tenv.var(), NULL);
 	AType* consT = tup<AType>(loc, cenv.tenv.Tup, implT, NULL);
-	ACons* cons  = tup<ACons>(loc, cenv.penv.sym("cons"), implName, NULL); // Closure
+	ACons* cons  = tup<ACons>(loc, cenv.penv.sym("Closure"), implName, NULL);
 
 	*(implT->begin() + 1) = implProtT;
 
@@ -162,10 +162,11 @@ ACall::lift(CEnv& cenv, Code& code) throw()
 		copy->push_front(cenv.penv.sym(cenv.liftStack.top().implName));
 	} else if (head()->to<AFn*>()) {
 		/* Special case: ((fn ...) ...)
-		 * Lifting (fn ...) yields: (cons _impl ...).
-		 * We don't want ((cons _impl ...) (cons _impl ...) ...),
-		 * so call the implementation function (_impl) directly:
-		 * (_impl (cons _impl ...) ...)
+		 * Lifting (fn ...) yields: (Fn _impl ...).
+		 * We don't want ((Fn _impl ...) (Fn _impl ...) ...),
+		 * so call the implementation function (_impl) directly and pass the
+		 * closure as the first parameter:
+		 * (_impl (Fn _impl ...) ...)
 		 */
 		ACons*       closure = (*copy->begin())->as<ACons*>();
 		ASymbol*     implSym = (*(closure->begin() + 1))->as<ASymbol*>();
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 9ca6e46..6aedd93 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -113,7 +113,7 @@ struct LLVMEngine : public Engine {
 			}
 
 			return PointerType::get(FunctionType::get(llType(retT), cprot, false), 0);
-		} else if (t->kind == AType::EXPR && t->head()->str() == "Tup") {
+		} else if (t->kind == AType::EXPR && isupper(t->head()->str()[0])) {
 			vector<const Type*> ctypes;
 			for (AType::const_iterator i = t->begin() + 1; i != t->end(); ++i) {
 				const Type* lt = llType((*i)->to<const AType*>());
diff --git a/src/parse.cpp b/src/parse.cpp
index 3184f8a..7482039 100644
--- a/src/parse.cpp
+++ b/src/parse.cpp
@@ -37,18 +37,32 @@ PEnv::parse(const AST* exp)
 {
 	const ATuple* tup = exp->to<const ATuple*>();
 	if (tup) {
-		if (tup->empty()) throw Error(exp->loc, "call to empty list");
-		if (!tup->head()->to<const ATuple*>()) {
-			MF mf = mac(*tup->head()->to<const ALexeme*>());
-			const AST*    expanded     = (mf ? mf(*this, exp) : exp);
-			const ATuple* expanded_tup = expanded->to<const ATuple*>();
-			const PEnv::Handler* h = handler(true, *expanded_tup->head()->to<const ALexeme*>());
+		THROW_IF(tup->empty(), exp->loc, "Call to empty list");
+		const ALexeme* form = tup->head()->to<const ALexeme*>();
+		if (form) {
+			MF mf = mac(*form);
+			if (mf) {
+				exp = mf(*this, exp)->as<ATuple*>(); // Apply macro
+				tup = exp->to<const ATuple*>();
+			}
+		}
+	}
+	
+	if (tup) {
+		THROW_IF(tup->empty(), exp->loc, "Call to empty list");
+		const ALexeme* form = tup->head()->to<const ALexeme*>();
+		if (form) {
+			const PEnv::Handler* h = handler(true, *form);
 			if (h)
-				return h->func(*this, expanded, h->arg);
+				return h->func(*this, exp, h->arg); // Parse special form
+
+			if (isupper(form->c_str()[0])) // Call constructor (any uppercase symbol)
+				return new ACons(parseTuple(*this, tup));
 		}
-		ATuple* parsed_tup = parseTuple(*this, tup);
-		return new ACall(parsed_tup); // Parse as regular call
+			
+		return new ACall(parseTuple(*this, tup)); // Parse regular call
 	}
+
 	const ALexeme* lex = exp->to<const ALexeme*>();
 	assert(lex);
 	if (isdigit((*lex)[0])) {
@@ -177,7 +191,6 @@ initLang(PEnv& penv, TEnv& tenv)
 	penv.reg(true, "fn",    PEnv::Handler(parseFn));
 	penv.reg(true, "quote", PEnv::Handler(parseQuote));
 	penv.reg(true, "if",    PEnv::Handler(parseCall<AIf>));
-	penv.reg(true, "cons",  PEnv::Handler(parseCall<ACons>));
 	penv.reg(true, ".",     PEnv::Handler(parseCall<ADot>));
 	penv.reg(true, "def",   PEnv::Handler(parseCall<ADef>));
 
diff --git a/src/repl.cpp b/src/repl.cpp
index 977976b..65f04ef 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -58,7 +58,7 @@ readParseType(CEnv& cenv, Cursor& cursor, istream& is, AST*& exp, AST*& ast)
 	//cenv.tsubst = Subst::compose(cenv.tsubst, subst);
 
 	Object::pool.addRoot(ast); // Make parsed expression a GC root so it is not deleted
-	
+
 	return true;
 }
 
diff --git a/test/tup.resp b/test/tup.resp
index 17d59cb..e856f81 100644
--- a/test/tup.resp
+++ b/test/tup.resp
@@ -1,4 +1,4 @@
-(def t (cons 1 2 3 4 5))
+(def t (Tup 1 2 3 4 5))
 (. t 0)
 (. t 1)
 (. t 2)