Add let form.

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

5 files changed, 121 insertions, 3 deletions

diff --git a/src/compile.cpp b/src/compile.cpp
index a696836..2132c91 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -122,6 +122,28 @@ compile_if(CEnv& cenv, const ATuple* aif) throw()
 }
 
 static CVal
+compile_let(CEnv& cenv, const ATuple* let) throw()
+{
+	const ATuple* vars = let->list_ref(1)->to_tuple();
+
+	cenv.push();
+	
+	for (ATuple::const_iterator i = vars->begin(); i != vars->end();) {
+		const ASymbol* sym = (*i++)->to_symbol();
+		const AST*     val = (*i++);
+		cenv.def(sym, val, cenv.type(val), resp_compile(cenv, val));
+	}
+	
+	CVal ret = NULL;
+	for (ATuple::const_iterator i = let->iter_at(2); i != let->end(); ++i)
+		ret = resp_compile(cenv, *i);
+
+	cenv.pop();
+	
+	return ret;
+}
+
+static CVal
 compile_match(CEnv& cenv, const ATuple* match) throw()
 {
 	IfState     state   = cenv.engine()->compileIfStart(cenv);
@@ -208,6 +230,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
 			return compile_fn(cenv, call);
 		else if (form == "if")
 			return compile_if(cenv, call);
+		else if (form == "let")
+			return compile_let(cenv, call);
 		else if (form == "match")
 			return compile_match(cenv, call);
 		else
diff --git a/src/constrain.cpp b/src/constrain.cpp
index c4a08ec..047a5b0 100644
--- a/src/constrain.cpp
+++ b/src/constrain.cpp
@@ -199,6 +199,37 @@ constrain_if(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 }
 
 static void
+constrain_let(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
+{
+	THROW_IF(call->list_len() < 3, call->loc, "`let' requires at least 2 arguments");
+	const ATuple* vars = call->list_ref(1)->to_tuple();
+	THROW_IF(!vars, call->list_ref(1)->loc, "first argument of `let' is not a list");
+
+	TEnv::Frame frame;
+	for (ATuple::const_iterator i = vars->begin(); i != vars->end(); ++i) {
+		const ASymbol* sym = (*i)->to_symbol();
+		THROW_IF(!sym, (*i)->loc, "`let' binding name is not a symbol");
+		ATuple::const_iterator val = ++i;
+		THROW_IF(val == vars->end(), sym->loc, "`let' variable missing value");
+
+		resp_constrain(tenv, c, *val);
+		const AType* tvar = tenv.var(*val);
+		frame.push_back(make_pair(sym->sym(), tvar));
+		c.constrain(tenv, sym, tvar);
+		//c.constrain(tenv, *val, tvar);
+	}
+	
+	tenv.push(frame);
+
+	for (ATuple::const_iterator i = call->iter_at(2); i != call->end(); ++i)
+		resp_constrain(tenv, c, *i);
+
+	c.constrain(tenv, call, tenv.var(call->list_last()));
+	
+	tenv.pop();
+}
+
+static void
 constrain_match(TEnv& tenv, Constraints& c, const ATuple* call) throw(Error)
 {
 	THROW_IF(call->list_len() < 5, call->loc, "`match' requires at least 4 arguments");
@@ -338,6 +369,8 @@ constrain_list(TEnv& tenv, Constraints& c, const ATuple* tup) throw(Error)
 		constrain_fn(tenv, c, tup);
 	else if (form == "if")
 		constrain_if(tenv, c, tup);
+	else if (form == "let")
+		constrain_let(tenv, c, tup);
 	else if (form == "match")
 		constrain_match(tenv, c, tup);
 	else
diff --git a/src/lift.cpp b/src/lift.cpp
index ad377d7..e3a741b 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -32,7 +32,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
 {
 	if (!cenv.liftStack.empty() && cenv.name(cenv.liftStack.top().fn) == sym->sym()) {
 		return cenv.penv.sym("_me"); // Reference to innermost function
-	} else if (!cenv.code.innermost(sym)) {
+	} else if (!cenv.liftStack.empty() && !cenv.code.innermost(sym)) {
 		// Replace symbol with code to access free variable from closure
 		const int32_t index = cenv.liftStack.top().index(sym);
 		return tup<ATuple>(sym->loc, cenv.penv.sym("."),
@@ -158,6 +158,36 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 }
 
 static const AST*
+lift_let(CEnv& cenv, Code& code, const ATuple* let) throw()
+{
+	const ATuple* vars = let->list_ref(1)->to_tuple();
+	
+	List<ATuple, const AST> copy(let->loc, let->head(), NULL);
+	List<ATuple, const AST> copyVars;
+	
+	cenv.push();
+	
+	for (ATuple::const_iterator i = vars->begin(); i != vars->end();) {
+		const ASymbol* sym = (*i++)->to_symbol();
+		const AST*     val = (*i++);
+		cenv.def(sym, val, cenv.type(val), NULL);
+		copyVars.push_back(sym);
+		copyVars.push_back(val);
+		resp_lift(cenv, code, val);
+	}
+	copy.push_back(copyVars);
+
+	for (ATuple::const_iterator i = let->iter_at(2); i != let->end(); ++i)
+		copy.push_back(resp_lift(cenv, code, *i));
+
+	cenv.pop();
+	
+	cenv.setTypeSameAs(copy, let);
+	
+	return copy;
+}
+
+static const AST*
 lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
 {
 	List<ATuple, const AST> copy;
@@ -246,6 +276,8 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
 			return lift_fn(cenv, code, call);
 		else if (form == "if")
 			return lift_args(cenv, code, call);
+		else if (form == "let")
+			return lift_let(cenv, code, call);
 		else if (form == "match")
 			return call; // FIXME
 		else
diff --git a/src/pprint.cpp b/src/pprint.cpp
index d082b5d..5ceb039 100644
--- a/src/pprint.cpp
+++ b/src/pprint.cpp
@@ -141,6 +141,31 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types)
 			newline(out, 0);
 			return out;
 
+		} else if (form == "let") {
+			out << (*i++) << " (";
+			const ATuple* vars = (*i)->as_tuple();
+			for (ATuple::const_iterator v = vars->begin(); v != vars->end();) {
+				out << (*v);
+
+				if (types)
+					out << " :" << cenv->tsubst.apply(cenv->tenv.var(*v));
+				
+				out << " " << (*++v);
+
+				if (++v != vars->end())
+					newline(out, indent + 6);
+				else
+					out << ")";
+			}
+			newline(out, indent + 2);
+			for (ATuple::const_iterator i = tup->iter_at(2); i != tup->end(); ++i)
+				print_to(out, *i, indent + 2, cenv, types);
+			out << ")";
+			if (types)
+				out << " :" << cenv->tsubst.apply(cenv->tenv.var(tup->list_last()));
+
+			return out;
+
 		} else {
 			return print_tuple(out, tup, i, indent + 1, false, cenv, types, false);
 		}
@@ -157,7 +182,7 @@ print_to(ostream& out, const AST* ast, unsigned indent, CEnv* cenv, bool types)
 	case T_SYMBOL:
 		return out << ((const ASymbol*)ast)->sym();
 	}
-	
+
 	return out << "?";
 }
 
diff --git a/src/resp.hpp b/src/resp.hpp
index 1fbf3cf..d5ea459 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -829,7 +829,11 @@ struct CEnv {
 		const ATuple* const fn;
 		const std::string   implName;
 		int32_t index(const ASymbol* sym) {
-			const_iterator i = find(begin(), end(), sym);
+			const_iterator i = begin();
+			for (; i != end(); ++i)
+				if ((*i)->sym() == sym->sym())
+					break;
+			
 			if (i != end()) {
 				return i - begin() + 1;
 			} else {