Convert match form to if at lift stage (remove knowledge of match from compile stage and backends).

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

4 files changed, 89 insertions, 42 deletions

diff --git a/src/c.cpp b/src/c.cpp
index a19f005..5bd3036 100644
--- a/src/c.cpp
+++ b/src/c.cpp
@@ -58,7 +58,7 @@ struct CEngine : public Engine {
 	CVal    compileLiteral(CEnv& cenv, const AST* lit);
 	CVal    compilePrimitive(CEnv& cenv, const ATuple* prim);
 	CVal    compileString(CEnv& cenv, const char* str);
-	
+
 	void writeModule(CEnv& cenv, std::ostream& os);
 
 	const string call(CEnv& cenv, CFunc f, const AType* retT);
@@ -72,11 +72,11 @@ private:
 		string name;
 		string text;
 	};
-	
+
 	inline Value*    llVal(CVal v)   { return static_cast<Value*>(v); }
 	inline Function* llFunc(CFunc f) { return static_cast<Function*>(f); }
 	const Type*      llType(const AType* t);
-	
+
 	std::string out;
 };
 
diff --git a/src/compile.cpp b/src/compile.cpp
index b5d7222..123b403 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -57,7 +57,7 @@ compile_dot(CEnv& cenv, const ATuple* dot) throw()
 	const ALiteral<int32_t>* index = (ALiteral<int32_t>*)(*++i);
 	assert(index->tag() == T_INT32);
 	CVal tupVal = resp_compile(cenv, tup);
-	return cenv.engine()->compileDot(cenv, tupVal, index->val + 1); // + 1 to skip RTTI
+	return cenv.engine()->compileDot(cenv, tupVal, index->val);
 }
 
 static CVal
@@ -120,7 +120,10 @@ compile_if(CEnv& cenv, const ATuple* aif) throw()
 		i = next; // jump 2 each iteration (to the next predicate)
 	}
 
-	CVal elseV = resp_compile(cenv, aif->list_last());
+	CVal elseV = NULL;
+	if (*aif->list_last() != *cenv.penv.sym("__unreachable"))
+		elseV = resp_compile(cenv, aif->list_last());
+
 	return cenv.engine()->compileIfEnd(cenv, state, elseV, cenv.type(aif));
 }
 
@@ -147,25 +150,11 @@ compile_let(CEnv& cenv, const ATuple* let) throw()
 }
 
 static CVal
-compile_match(CEnv& cenv, const ATuple* match) throw()
+compile_tag_is(CEnv& cenv, const ATuple* call) throw()
 {
-	IfState     state   = cenv.engine()->compileIfStart(cenv);
-	CVal        matchee = resp_compile(cenv, match->list_ref(1));
-	CVal        rtti    = cenv.engine()->compileDot(cenv, matchee, 0);
-
-	size_t idx = 1;
-	for (ATuple::const_iterator i = match->iter_at(2); i != match->end(); ++idx) {
-		const AST*     pat  = *i++;
-		const AST*     body = *i++;
-		const ASymbol* sym  = pat->as_tuple()->head()->as_symbol();
-
-		CVal condV = cenv.engine()->compileIsA(cenv, rtti, sym);
-
-		cenv.engine()->compileIfBranch(cenv, state, condV, body);
-	}
-
-	const AType* type  = cenv.type(match);
-	return cenv.engine()->compileIfEnd(cenv, state, NULL, type);
+	const AST*     lhs = call->list_ref(1);
+	const ASymbol* rhs = call->list_ref(2)->as_symbol();
+	return cenv.engine()->compileIsA(cenv, resp_compile(cenv, lhs), rhs);
 }
 
 static CVal
@@ -235,8 +224,8 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
 			return compile_if(cenv, call);
 		else if (form == "let")
 			return compile_let(cenv, call);
-		else if (form == "match")
-			return compile_match(cenv, call);
+		else if (form == "__tag_is")
+			return compile_tag_is(cenv, call);
 		else
 			return compile_call(cenv, call);
 	}
diff --git a/src/lift.cpp b/src/lift.cpp
index 24f0265..239b02e 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -38,7 +38,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
 		if (cenv.name(vars.fn) == sym->sym()) {
 			// Reference to innermost function, replace with "_me"
 			return cenv.penv.sym("_me");
-			
+
 		} else if (!cenv.code.innermost(sym)) {
 			/* Free variable, replace with "(. _me i)" where i is the index
 			 * of the free variable in the closure.
@@ -48,7 +48,7 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
 			 */
 			return tup<ATuple>(sym->loc, cenv.penv.sym("."),
 			                   cenv.penv.sym("_me"),
-			                   new ALiteral<int32_t>(T_INT32, vars.index(sym), Cursor()),
+			                   new ALiteral<int32_t>(T_INT32, vars.index(sym) + 1, Cursor()),
 			                   NULL);
 		}
 	}
@@ -56,6 +56,18 @@ lift_symbol(CEnv& cenv, Code& code, const ASymbol* sym) throw()
 }
 
 static const AST*
+lift_dot(CEnv& cenv, Code& code, const ATuple* dot) throw()
+{
+	const ALiteral<int32_t>* index = (ALiteral<int32_t>*)(dot->list_ref(2));
+	List<ATuple, const AST> copy;
+	copy.push_back(dot->head());
+	copy.push_back(resp_lift(cenv, code, dot->list_ref(1)));
+	copy.push_back(new ALiteral<int32_t>(T_INT32, index->val + 1, Cursor())); // skip RTTI
+	cenv.setTypeSameAs(copy, dot);
+	return copy;
+}
+
+static const AST*
 lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
 {
 	// Define stub first for recursion
@@ -71,7 +83,7 @@ lift_def(CEnv& cenv, Code& code, const ATuple* def) throw()
 	copy.push_back(resp_lift(cenv, code, def->list_ref(1)));
 	for (ATuple::const_iterator t = def->iter_at(2); t != def->end(); ++t)
 		copy.push_back(resp_lift(cenv, code, *t));
-	
+
 	cenv.setTypeSameAs(copy.head, def);
 
 	if (copy.head->list_ref(1) == copy.head->list_ref(2))
@@ -98,7 +110,7 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 	cenv.setName(impl, implNameStr);
 
 	cenv.liftStack.push(CEnv::FreeVars(fn, implNameStr));
-	
+
 	// Create a new stub environment frame for parameters
 	cenv.push();
 	const AType*          type      = cenv.type(fn);
@@ -152,14 +164,14 @@ lift_fn(CEnv& cenv, Code& code, const ATuple* fn) throw()
 	cenv.liftStack.pop();
 
 	implProtT.push_front(tupT);
-	
+
 	implT.push_back((AType*)type->head());
 	implT.push_back(implProtT.head);
 	implT.push_back(implRetT);
 
 	consT.push_front(implT.head);
 	consT.push_front(cenv.tenv.Tup);
-	
+
 	cenv.setType(impl, implT);
 	cenv.setType(cons, consT);
 
@@ -174,12 +186,12 @@ 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++);
@@ -194,9 +206,51 @@ lift_let(CEnv& cenv, Code& code, const ATuple* let) throw()
 		copy.push_back(resp_lift(cenv, code, *i));
 
 	cenv.pop();
-	
+
 	cenv.setTypeSameAs(copy, let);
-	
+
+	return copy;
+}
+
+static const AST*
+lift_match(CEnv& cenv, Code& code, const ATuple* match) throw()
+{
+	List<ATuple, const AST> copy(match->loc, cenv.penv.sym("let"), NULL);
+	List<ATuple, const AST> copyVars;
+
+	const ASymbol* tsym = cenv.penv.gensym("_matchT");
+
+	List<ATuple, const AST> tval;
+	tval.push_back(cenv.penv.sym("."));
+	tval.push_back(resp_lift(cenv, code, match->list_ref(1)));
+	tval.push_back(new ALiteral<int32_t>(T_INT32, 0, Cursor()));
+
+	copyVars.push_back(tsym);
+	copyVars.push_back(tval);
+	copy.push_back(copyVars);
+
+	List<ATuple, const AST> copyIf;
+	copyIf.push_back(cenv.penv.sym("if"));
+	for (ATuple::const_iterator i = match->iter_at(2); i != match->end();) {
+		const ATuple* pat  = (*i++)->as_tuple();
+		const AST*    body = *i++;
+
+		List<ATuple, const AST> cond;
+		cond.push_back(cenv.penv.sym("__tag_is"));
+		cond.push_back(tsym);
+		cond.push_back(pat->head());
+
+		copyIf.push_back(cond);
+		const AST* liftedBody = resp_lift(cenv, code, body);
+		assert(liftedBody);
+		copyIf.push_back(liftedBody);
+	}
+	copyIf.push_back(cenv.penv.sym("__unreachable"));
+	copy.push_back(copyIf);
+
+	cenv.setTypeSameAs(copyIf, match);
+	cenv.setTypeSameAs(copy, match);
+
 	return copy;
 }
 
@@ -212,7 +266,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
 	copy.head->loc = call->loc;
 
 	const AType* copyT = NULL;
-	
+
 	const ASymbol* sym = call->head()->to_symbol();
 	if (sym && !cenv.liftStack.empty() && sym->sym() == cenv.name(cenv.liftStack.top().fn)) {
 		/* Recursive call to innermost function, call implementation directly,
@@ -236,7 +290,7 @@ lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
 		// Call to a closure, prepend code to access implementation function
 		ATuple* getFn = tup<ATuple>(call->loc, cenv.penv.sym("."),
 		                            copy.head->head(),
-		                            new ALiteral<int32_t>(T_INT32, 0, Cursor()), NULL);
+		                            new ALiteral<int32_t>(T_INT32, 1, Cursor()), NULL);
 		const AType* calleeT = cenv.type(copy.head->head());
 		assert(**calleeT->begin() == *cenv.tenv.Tup);
 		const AType* implT = calleeT->list_ref(1)->as_type();
@@ -258,7 +312,7 @@ lift_args(CEnv& cenv, Code& code, const ATuple* call) throw()
 	// Lift all arguments
 	for (ATuple::const_iterator i = call->iter_at(1); i != call->end(); ++i)
 		copy.push_back(resp_lift(cenv, code, *i));
-	
+
 	cenv.setTypeSameAs(copy.head, call);
 
 	return copy;
@@ -280,11 +334,11 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
 		else if (form == "cons" || isupper(form[0]))
 			return lift_args(cenv, code, call);
 		else if (form == ".")
-			return lift_args(cenv, code, call);
+			return lift_dot(cenv, code, call);
 		else if (form == "def")
 			return lift_def(cenv, code, call);
 		else if (form == "def-type")
-			return call; // FIXME
+			return call;
 		else if (form == "fn")
 			return lift_fn(cenv, code, call);
 		else if (form == "if")
@@ -292,7 +346,7 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
 		else if (form == "let")
 			return lift_let(cenv, code, call);
 		else if (form == "match")
-			return call; // FIXME
+			return lift_match(cenv, code, call);
 		else
 			return lift_call(cenv, code, call);
 	}
diff --git a/src/resp.hpp b/src/resp.hpp
index d90ccf0..266387c 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -157,6 +157,8 @@ extern ostream& operator<<(ostream& out, const AST* ast);
 struct AST : public Object {
 	AST(Tag t, Cursor c=Cursor()) : loc(c) { this->tag(t); }
 	bool operator==(const AST& o) const;
+	bool operator!=(const AST& o) const;
+
 	string str() const { ostringstream ss; ss << this; return ss.str(); }
 
 	const ATuple* as_tuple() const {
@@ -485,6 +487,8 @@ AST::operator==(const AST& rhs) const
 	return false;
 }
 
+inline bool AST::operator!=(const AST& rhs) const { return !(operator==(rhs)); }
+
 
 /***************************************************************************
  * Lexical Environmment                                                    *