Move simplification from lift stage to a new (post-typing) simplify stage.

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

6 files changed, 115 insertions, 46 deletions

diff --git a/Makefile b/Makefile
index c5af049..cbb3ace 100644
--- a/Makefile
+++ b/Makefile
@@ -32,6 +32,7 @@ OBJECTS = \
 	build/pprint.o \
 	build/repl.o \
 	build/resp.o \
+	build/simplify.o \
 	build/tlsf.o \
 	build/unify.o
 
diff --git a/src/lift.cpp b/src/lift.cpp
index 239b02e..5791e41 100644
--- a/src/lift.cpp
+++ b/src/lift.cpp
@@ -213,48 +213,6 @@ lift_let(CEnv& cenv, Code& code, const ATuple* let) throw()
 }
 
 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;
-}
-
-static const AST*
 lift_call(CEnv& cenv, Code& code, const ATuple* call) throw()
 {
 	List<ATuple, const AST> copy;
@@ -345,8 +303,8 @@ resp_lift(CEnv& cenv, Code& code, const AST* ast) throw()
 			return lift_args(cenv, code, call);
 		else if (form == "let")
 			return lift_let(cenv, code, call);
-		else if (form == "match")
-			return lift_match(cenv, code, call);
+		else if (form == "__tag_is")
+			return call;
 		else
 			return lift_call(cenv, code, call);
 	}
diff --git a/src/repl.cpp b/src/repl.cpp
index 52d35c5..063f1e7 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -100,12 +100,26 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 			return 0;
 		}
 
+		// Simplify all expressions
+		Code simplified;
+		for (Parsed::const_iterator i = parsed.begin(); i != parsed.end(); ++i) {
+			const AST* l = resp_simplify(cenv, *i);
+			if (l)
+				simplified.push_back(l);
+		}
+
+		if (cenv.args.find("-R") != cenv.args.end()) {
+			for (Code::const_iterator i = simplified.begin(); i != simplified.end(); ++i)
+				pprint(cout, *i, &cenv, (cenv.args.find("-a") != cenv.args.end()));
+			return 0;
+		}
+
 		CVal  val = NULL;
 		CFunc f   = NULL;
 
 		// Lift all expressions
 		Code lifted;
-		for (Parsed::const_iterator i = parsed.begin(); i != parsed.end(); ++i) {
+		for (Parsed::const_iterator i = simplified.begin(); i != simplified.end(); ++i) {
 			const AST* l = resp_lift(cenv, lifted, *i);
 			if (l)
 				lifted.push_back(l);
@@ -114,7 +128,6 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 		if (cenv.args.find("-L") != cenv.args.end()) {
 			for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i)
 				pprint(cout, *i, &cenv, (cenv.args.find("-a") != cenv.args.end()));
-
 			return 0;
 		}
 
diff --git a/src/resp.cpp b/src/resp.cpp
index 765939c..5f45bdd 100644
--- a/src/resp.cpp
+++ b/src/resp.cpp
@@ -77,6 +77,7 @@ print_usage(char* name, bool error)
 	os << "  -r               Enter REPL after evaluating files"         << endl;
 	os << "  -P               Parse only"                                << endl;
 	os << "  -T               Type check only"                           << endl;
+	os << "  -R               Reduce to simpler forms only"              << endl;
 	os << "  -L               Lambda lift only"                          << endl;
 	os << "  -S               Compile to assembly only (do not execute)" << endl;
 
@@ -96,6 +97,7 @@ main(int argc, char** argv)
 			files.push_back(argv[i]);
 		} else if (!strncmp(argv[i], "-L", 3)
 		           || !strncmp(argv[i], "-P", 3)
+		           || !strncmp(argv[i], "-R", 3)
 		           || !strncmp(argv[i], "-S", 3)
 		           || !strncmp(argv[i], "-T", 3)
 		           || !strncmp(argv[i], "-a", 3)
diff --git a/src/resp.hpp b/src/resp.hpp
index 266387c..a2b5cf8 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -877,6 +877,7 @@ int  eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute);
 int  repl(CEnv& cenv);
 
 void       resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Error);
+const AST* resp_simplify(CEnv& cenv, const AST* ast) throw();
 const AST* resp_lift(CEnv& cenv, Code& code, const AST* ast) throw();
 CVal       resp_compile(CEnv& cenv, const AST* ast) throw();
 
diff --git a/src/simplify.cpp b/src/simplify.cpp
new file mode 100644
index 0000000..31eb83a
--- /dev/null
+++ b/src/simplify.cpp
@@ -0,0 +1,94 @@
+/* Resp: A programming language
+ * Copyright (C) 2008-2009 David Robillard <dave@drobilla.net>
+ *
+ * Resp is free software: you can redistribute it and/or modify it under
+ * the terms of the GNU Affero General Public License as published by the
+ * Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Resp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+ * Public License for more details.
+ *
+ * You should have received a copy of the GNU Affero General Public License
+ * along with Resp.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+/** @file
+ * @brief Simplify (reduce to simpler forms, e.g. match => if)
+ */
+
+#include <string>
+
+#include "resp.hpp"
+
+using namespace std;
+
+static const AST*
+simplify_match(CEnv& cenv, 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_simplify(cenv, 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);
+		copyIf.push_back(resp_simplify(cenv, body));
+	}
+	copyIf.push_back(cenv.penv.sym("__unreachable"));
+	copy.push_back(copyIf);
+
+	cenv.setTypeSameAs(copyIf, match);
+	cenv.setTypeSameAs(copy, match);
+
+	return copy;
+}
+
+static const AST*
+simplify_list(CEnv& cenv, const ATuple* call) throw()
+{
+	List<ATuple, const AST> copy;
+	for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i)
+		copy.push_back(resp_simplify(cenv, *i));
+
+	cenv.setTypeSameAs(copy.head, call);
+
+	return copy;
+}
+
+const AST*
+resp_simplify(CEnv& cenv, const AST* ast) throw()
+{
+	const ATuple* const list = ast->to_tuple();
+	if (!list)
+		return ast;
+	
+	const ASymbol* const sym  = list->head()->to_symbol();
+	const std::string    form = sym ? sym->sym() : "";
+
+	if (form == "match")
+		return simplify_match(cenv, list);
+	else
+		return simplify_list(cenv, list);
+}