Add flatten stage to generate flat s-expression IR for the (now simpler) compilation stage.

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

6 files changed, 274 insertions, 91 deletions

diff --git a/src/compile.cpp b/src/compile.cpp
index ba8cc5e..1f82a47 100644
--- a/src/compile.cpp
+++ b/src/compile.cpp
@@ -29,6 +29,9 @@ using namespace std;
 static CVal
 compile_symbol(CEnv& cenv, const ASymbol* sym) throw()
 {
+	if (*sym == *cenv.penv.sym("__unreachable"))
+		return NULL;
+
 	if (cenv.repl && cenv.vals.topLevel(sym) && !is_form(cenv.type(sym), "Fn")) {
 		return cenv.engine()->compileGlobalGet(cenv, sym->sym(), *cenv.vals.ref(sym));
 	} else {
@@ -94,14 +97,8 @@ compile_def(CEnv& cenv, const ATuple* def) throw()
 {
 	const ASymbol* const sym  = def->list_ref(1)->as_symbol();
 	const AST*     const body = def->list_ref(2);
-	cenv.def(sym, body, cenv.type(body), NULL); // define stub first for recursion
 	CVal val = resp_compile(cenv, body);
-	if (cenv.repl && cenv.vals.size() == 1 && !is_form(cenv.type(body), "Fn")) {
-		val = cenv.engine()->compileGlobalSet(
-			cenv, sym->str(), val, cenv.type(body));
-		cenv.lock(def);
-	}
-	cenv.vals.def(sym, val);
+	cenv.def(sym, body, cenv.type(body), val);
 	return NULL;
 }
 
@@ -125,63 +122,6 @@ compile_def_type(CEnv& cenv, const ATuple* def) throw()
 }
 
 static CVal
-compile_do(CEnv& cenv, const ATuple* ado) throw()
-{
-	CVal retVal = NULL;
-	for (ATuple::const_iterator i = ado->iter_at(1); i != ado->end(); ++i)
-		retVal = resp_compile(cenv, *i);
-
-	return retVal;
-}
-
-static CVal
-compile_fn(CEnv& cenv, const ATuple* fn) throw()
-{
-	assert(!cenv.currentFn);
-
-	const AST* const type = cenv.type(fn);
-	CFunc f = cenv.findImpl(fn, type);
-	if (f)
-		return f;
-
-	// Write function declaration and push stack frame
-	f = cenv.engine()->startFn(cenv, cenv.name(fn), fn->prot(), type->as_tuple());
-	cenv.engine()->pushFnArgs(cenv, fn->prot(), type->as_tuple(), f);
-	cenv.currentFn = f;
-
-	// Write function body
-	CVal retVal = NULL;
-	for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i)
-		retVal = resp_compile(cenv, *i);
-
-	// Write function conclusion and pop stack frame
-	cenv.engine()->finishFn(cenv, f, retVal, type->as_tuple()->frrst());
-	cenv.pop();
-	cenv.currentFn = NULL;
-
-	cenv.vals.def(cenv.penv.sym(cenv.name(fn)), f);
-	cenv.addImpl(fn, f);
-	return f;
-}
-
-static CVal
-compile_if(CEnv& cenv, const ATuple* aif) throw()
-{
-	const AST* cond  = aif->list_ref(1);
-	const AST* then  = aif->list_ref(2);
-	const AST* aelse = NULL;
-	if (*aif->list_last() != *cenv.penv.sym("__unreachable"))
-		aelse = aif->list_ref(3);
-
-	const AST* type = cenv.type(then);
-
-	cenv.engine()->compileIfStart(cenv, cond, type);
-	cenv.engine()->compileIfThen(cenv, resp_compile(cenv, then));
-	cenv.engine()->compileIfElse(cenv, resp_compile(cenv, aelse));
-	return cenv.engine()->compileIfEnd(cenv);
-}
-
-static CVal
 compile_quote(CEnv& cenv, const ATuple* quote) throw()
 {
 	switch (quote->list_ref(1)->tag()) {
@@ -218,6 +158,34 @@ compile_call(CEnv& cenv, const ATuple* call) throw()
 	return cenv.engine()->compileCall(cenv, f, cenv.type(call->fst())->as_tuple(), args);
 }
 
+static CVal
+compile_fn_start(CEnv& cenv, const ATuple* call) throw()
+{
+	const ASymbol* name = call->list_ref(1)->as_symbol();
+	const ATuple*  type = cenv.type(name)->as_tuple();
+	const ATuple*  args = call->rst()->rst();
+
+	CFunc func = cenv.engine()->startFn(cenv, name->sym(), args, type);
+	cenv.def(name, NULL, type, func);
+
+	cenv.engine()->pushFnArgs(cenv, args, type, func);
+	cenv.currentFn = func;
+
+	return NULL;
+}
+
+static CVal
+compile_fn_end(CEnv& cenv, const ATuple* call) throw()
+{
+	const AST* retT = cenv.type(call->frst())->as_tuple()->frrst();
+	cenv.engine()->finishFn(cenv, cenv.currentFn,
+	                        resp_compile(cenv, call->frrst()),
+	                        retT);
+	cenv.pop();
+	cenv.currentFn = NULL;
+	return NULL;
+}
+
 CVal
 resp_compile(CEnv& cenv, const AST* ast) throw()
 {
@@ -255,14 +223,20 @@ resp_compile(CEnv& cenv, const AST* ast) throw()
 			return compile_def(cenv, call);
 		else if (form == "def-type")
 			return compile_def_type(cenv, call);
-		else if (form == "do")
-			return compile_do(cenv, call);
-		else if (form == "fn")
-			return compile_fn(cenv, call);
-		else if (form == "if")
-			return compile_if(cenv, call);
 		else if (form == "quote")
 			return compile_quote(cenv, call);
+		else if (form == "fn-start")
+			return compile_fn_start(cenv, call);
+		else if (form == "fn-end")
+			return compile_fn_end(cenv, call);
+		else if (form == "if-start")
+			return cenv.engine()->compileIfStart(cenv, call->frrst(), cenv.type(call));
+		else if (form == "if-then")
+			return cenv.engine()->compileIfThen(cenv, resp_compile(cenv, call->frrst()));
+		else if (form == "if-else")
+			return cenv.engine()->compileIfElse(cenv, resp_compile(cenv, call->frrst()));
+		else if (form == "if-end")
+			return cenv.engine()->compileIfEnd(cenv);
 		else
 			return compile_call(cenv, call);
 	}
diff --git a/src/flatten.cpp b/src/flatten.cpp
new file mode 100644
index 0000000..59748f3
--- /dev/null
+++ b/src/flatten.cpp
@@ -0,0 +1,196 @@
+/* Resp: A programming language
+ * Copyright (C) 2008-2011 David Robillard <http://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 Flatten code (raise all nested expressions)
+ */
+
+#include <string>
+#include <vector>
+
+#include "resp.hpp"
+
+using namespace std;
+
+static const AST*
+flatten_def(CEnv& cenv, Code& code, const ATuple* def) throw()
+{
+	const ASymbol* const sym  = def->list_ref(1)->as_symbol();
+	const AST*     const body = def->list_ref(2);
+
+	if (!is_form(body, "fn")) {
+		code.push_back(def);
+		return NULL;
+	}
+
+	const ATuple* fn   = (*def->iter_at(2))->as_tuple();
+	const ATuple* prot = fn->frst()->as_tuple();
+	List pre(Cursor(), cenv.penv.sym("fn-start"), sym, 0);
+	for (ATuple::const_iterator i = prot->begin(); i != prot->end(); ++i)
+		pre.push_back(*i);
+
+	code.push_back(pre);
+
+	cenv.def(sym, body, cenv.type(body), NULL); // define stub first for recursion
+
+	const AST* retVal = NULL;
+	const AST* retT   = NULL;
+	for (ATuple::const_iterator i = fn->iter_at(2); i != fn->end(); ++i) {
+		retVal = resp_flatten(cenv, code, *i);
+		retT   = cenv.type(*i);
+	}
+
+	cenv.setTypeSameAs(retVal, retT);
+	List post(Cursor(), cenv.penv.sym("fn-end"), sym, retVal, 0);
+	code.push_back(post);
+
+	return NULL;
+}
+
+static const AST*
+flatten_def_type(CEnv& cenv, Code& code, const ATuple* def) throw()
+{
+	const ASymbol* name = def->frst()->to_symbol();
+	if (name) {
+		cenv.tenv.def(name, def->frrst());
+	} else {
+		name = def->frst()->as_tuple()->fst()->as_symbol();
+		cenv.tenv.def(name, def->frrst());
+	}
+	code.push_back(def);
+	return NULL;
+}
+
+static const AST*
+flatten_do(CEnv& cenv, Code& code, const ATuple* ado) throw()
+{
+	const AST* ret = NULL;
+	for (ATuple::const_iterator i = ado->iter_at(1); i != ado->end(); ++i) {
+		ret = resp_flatten(cenv, code, *i);
+		if (ret)
+			code.push_back(ret);
+	}
+	const ASymbol* sym = cenv.penv.gensym("doval");
+	List def(Cursor(), cenv.penv.sym("def"), sym, ret, NULL);
+	code.push_back(def);
+	cenv.setTypeSameAs(sym, ado);
+	return sym;
+}
+
+static const AST*
+flatten_if(CEnv& cenv, Code& code, const ATuple* aif) throw()
+{
+	const ASymbol* cond = NULL;
+	if (aif->frst()->to_symbol()) {
+		cond = aif->frst()->as_symbol();
+	} else {
+		cond = cenv.penv.gensym("ifcond");
+		List def(Cursor(), cenv.penv.sym("def"), cond,
+		         resp_flatten(cenv, code, aif->frst()), 0);
+		cenv.setTypeSameAs(cond, aif->frst());
+		code.push_back(def);
+	}
+
+	const ASymbol* if_lab = cenv.penv.gensym("if");
+	const ASymbol* result = cenv.penv.gensym("ifval");
+
+	List pre(Cursor(), cenv.penv.sym("if-start"),
+	         if_lab, cond, /*then_lab, else_lab,*/ NULL);
+	code.push_back(pre);
+	cenv.setTypeSameAs(pre, aif);
+
+	const AST* athen = *aif->iter_at(2);
+	const AST* aelse = *aif->iter_at(3);
+
+	const AST* then_val = resp_flatten(cenv, code, athen);
+	cenv.setTypeSameAs(then_val, athen);
+	List then_goto(Cursor(), cenv.penv.sym("if-then"), if_lab, then_val, NULL);
+	code.push_back(then_goto);
+
+	const AST* else_val = resp_flatten(cenv, code, aelse);
+	cenv.setTypeSameAs(else_val, aelse);
+	List else_goto(Cursor(), cenv.penv.sym("if-else"), if_lab, else_val, NULL);
+	code.push_back(else_goto);
+
+	List end(Cursor(), cenv.penv.sym("if-end"), if_lab, NULL);
+	List def(Cursor(), cenv.penv.sym("def"), result, end, NULL);
+	code.push_back(def);
+
+	cenv.setTypeSameAs(end, aif);
+	cenv.setTypeSameAs(result, aif);
+	return result;
+}
+
+static const AST*
+flatten_call(CEnv& cenv, Code& code, const ATuple* call) throw()
+{
+	List copy;
+	for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i) {
+		const AST* flat_i = resp_flatten(cenv, code, *i);
+		const AST* arg    = NULL;
+		if (!flat_i->to_tuple()) {
+			arg = flat_i;
+		} else {
+			const ASymbol* sym = cenv.penv.gensym();
+			List def(Cursor(), cenv.penv.sym("def"), sym, flat_i, NULL);
+			code.push_back(def);
+			arg = sym;
+			cenv.setTypeSameAs(sym, *i);
+		}
+		cenv.setTypeSameAs(flat_i, *i);
+		copy.push_back(arg);
+	}
+	const ASymbol* sym = cenv.penv.gensym();
+	List def(Cursor(), cenv.penv.sym("def"), sym, copy, NULL);
+	code.push_back(def);
+
+	cenv.setTypeSameAs(copy, call);
+	cenv.setTypeSameAs(sym, call);
+	return sym;
+}
+
+const AST*
+resp_flatten(CEnv& cenv, Code& code, const AST* ast) throw()
+{
+	switch (ast->tag()) {
+	case T_TUPLE: {
+		const ATuple* const  call = ast->as_tuple();
+		const ASymbol* const sym  = call->fst()->to_symbol();
+		const std::string    form = sym ? sym->sym() : "";
+		assert(form != "fn");
+		if (form == "cast"
+		    || form == "quote")
+			return ast;
+		else if (form == "def")
+			return flatten_def(cenv, code, call);
+		else if (form == "def-type")
+			return flatten_def_type(cenv, code, call);
+		else if (form == "do")
+			return flatten_do(cenv, code, call);
+		else if (form == "if")
+			return flatten_if(cenv, code, call);
+		else
+			return flatten_call(cenv, code, call);
+	}
+	default:
+		return ast;
+	}
+
+	cenv.err << "Attempt to compile unknown type: " << ast << endl;
+	assert(false);
+	return NULL;
+}
diff --git a/src/llvm.cpp b/src/llvm.cpp
index 06a895a..68a2a83 100644
--- a/src/llvm.cpp
+++ b/src/llvm.cpp
@@ -88,9 +88,9 @@ struct LLVMEngine : public Engine {
 	CVal  compileDot(CEnv& cenv, CVal tup, int32_t index);
 	CVal  compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t);
 	CVal  compileGlobalGet(CEnv& cenv, const string& s, CVal v);
-	void  compileIfStart(CEnv& cenv, const AST* cond, const AST* type);
-	void  compileIfThen(CEnv& cenv, CVal thenV);
-	void  compileIfElse(CEnv& cenv, CVal elseV);
+	CVal  compileIfStart(CEnv& cenv, const AST* cond, const AST* type);
+	CVal  compileIfThen(CEnv& cenv, CVal thenV);
+	CVal  compileIfElse(CEnv& cenv, CVal elseV);
 	CVal  compileIfEnd(CEnv& cenv);
 	CVal  compileLiteral(CEnv& cenv, const AST* lit);
 	CVal  compilePrimitive(CEnv& cenv, const ATuple* prim);
@@ -436,7 +436,7 @@ LLVMEngine::eraseFn(CEnv& cenv, CFunc f)
 		llFunc(f)->eraseFromParent();
 }
 
-void
+CVal
 LLVMEngine::compileIfStart(CEnv& cenv, const AST* cond, const AST* type)
 {
 	LLVMEngine* engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
@@ -450,9 +450,10 @@ LLVMEngine::compileIfStart(CEnv& cenv, const AST* cond, const AST* type)
 
 	// Start then block
 	appendBlock(engine, parent, rec->thenBB);
+	return NULL;
 }
 
-void
+CVal
 LLVMEngine::compileIfThen(CEnv& cenv, CVal thenV)
 {
 	LLVMEngine* engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
@@ -467,9 +468,10 @@ LLVMEngine::compileIfThen(CEnv& cenv, CVal thenV)
 
 	// Start else block
 	appendBlock(engine, parent, rec->elseBB);
+	return NULL;
 }
 
-void
+CVal
 LLVMEngine::compileIfElse(CEnv& cenv, CVal elseV)
 {
 	LLVMEngine* engine = reinterpret_cast<LLVMEngine*>(cenv.engine());
@@ -484,6 +486,7 @@ LLVMEngine::compileIfElse(CEnv& cenv, CVal elseV)
 	}
 
 	rec->elseBB = engine->builder.GetInsertBlock();
+	return NULL;
 }
 
 CVal
@@ -512,7 +515,7 @@ LLVMEngine::compilePrimitive(CEnv& cenv, const ATuple* prim)
 	ATuple::const_iterator i = prim->iter_at(1);
 
 	LLVMEngine*  engine  = reinterpret_cast<LLVMEngine*>(cenv.engine());
-	bool         isFloat = cenv.type(prim)->str() == "Float";
+	bool         isFloat = (cenv.type(prim)->str() == "Float");
 	Value*       a       = llVal(resp_compile(cenv, *i++));
 	Value*       b       = llVal(resp_compile(cenv, *i++));
 	const string n       = prim->fst()->to_symbol()->str();
diff --git a/src/repl.cpp b/src/repl.cpp
index 8fe43f5..216bbb2 100644
--- a/src/repl.cpp
+++ b/src/repl.cpp
@@ -118,16 +118,15 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 				lifted.push_back(exp);
 		if (cenv.args.find("-L") != cenv.args.end())
 			return dump(cenv, lifted);
-		
-		// Compile top-level (lifted) functions
-		CVal  val = NULL;
-		CFunc f   = NULL;
-		Code exprs;
+
+		// Flatten expressions
+		Code flattened;  // Type and function definitions
+		Code exprs;  // Other top-level expressions (main code)
 		for (Code::const_iterator i = lifted.begin(); i != lifted.end(); ++i) {
 			const ATuple* call = (*i)->to_tuple();
-			if (call && (   (is_form(call, "def-type"))
-			             || (is_form(call, "def") && is_form(call->frrst(), "fn")))) {
-				val = resp_compile(cenv, call);
+			if (call && (is_form(*i, "def-type")
+			             || (is_form(*i, "def") && is_form(call->frrst(), "fn")))) {
+				resp_flatten(cenv, flattened, call);
 			} else {
 				const ATuple* tup = (*i)->to_tuple();
 				if (!tup || !tup->empty()) {
@@ -135,18 +134,26 @@ eval(CEnv& cenv, Cursor& cursor, istream& is, bool execute)
 				}
 			}
 		}
+		if (cenv.args.find("-F") != cenv.args.end())
+			return dump(cenv, flattened);
+
+		// Compile type and function definitions
+		for (Code::const_iterator i = flattened.begin(); i != flattened.end(); ++i) {
+			resp_compile(cenv, *i);
+		}
 
+		// Compile other top-level expressions into "main" function
 		if (!exprs.empty()) {
 			const AST*    type = cenv.type(exprs.back());
 			const ATuple* fnT  = tup(cursor, cenv.tenv.Fn, new ATuple(cursor), type, 0);
 
-			// Create function for program containing all expressions except definitions
-			f = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+			CFunc f   = cenv.engine()->startFn(cenv, "main", new ATuple(cursor), fnT);
+			CVal  val = NULL;
 			for (Code::const_iterator i = exprs.begin(); i != exprs.end(); ++i)
 				val = resp_compile(cenv, *i);
 			cenv.engine()->finishFn(cenv, f, val, type);
 
-			// Call and print result
+			// Call main and print result
 			if (cenv.args.find("-S") == cenv.args.end())
 				callPrintCollect(cenv, f, ast, type, execute);
 		}
diff --git a/src/resp.cpp b/src/resp.cpp
index 0774399..b0d1f72 100644
--- a/src/resp.cpp
+++ b/src/resp.cpp
@@ -80,6 +80,7 @@ print_usage(char* name, bool error)
 	os << "  -R               Reduce to simpler forms only"              << endl;
 	os << "  -C               Convert to CPS only"                       << endl;
 	os << "  -L               Lambda lift only"                          << endl;
+	os << "  -F               Flatten only"                              << endl;
 	os << "  -S               Compile to assembly only (do not execute)" << endl;
 
 	return error ? 1 : 0;
@@ -98,6 +99,7 @@ main(int argc, char** argv)
 		} else if (argv[i][0] != '-') {
 			files.push_back(argv[i]);
 		} else if (!strncmp(argv[i], "-C", 3)
+		           || !strncmp(argv[i], "-F", 3)
 		           || !strncmp(argv[i], "-L", 3)
 		           || !strncmp(argv[i], "-P", 3)
 		           || !strncmp(argv[i], "-R", 3)
diff --git a/src/resp.hpp b/src/resp.hpp
index efd0c43..5ee5047 100644
--- a/src/resp.hpp
+++ b/src/resp.hpp
@@ -682,9 +682,9 @@ struct Engine {
 	virtual CVal  compileDot(CEnv& cenv, CVal tup, int32_t index)                           = 0;
 	virtual CVal  compileGlobalSet(CEnv& cenv, const string& s, CVal v, const AST* t)       = 0;
 	virtual CVal  compileGlobalGet(CEnv& cenv, const string& s, CVal v)                     = 0;
-	virtual void  compileIfStart(CEnv& cenv, const AST* cond, const AST* type)              = 0;
-	virtual void  compileIfThen(CEnv& cenv, CVal thenV)                                     = 0;
-	virtual void  compileIfElse(CEnv& cenv, CVal elseV)                                     = 0;
+	virtual CVal  compileIfStart(CEnv& cenv, const AST* cond, const AST* type)              = 0;
+	virtual CVal  compileIfThen(CEnv& cenv, CVal thenV)                                     = 0;
+	virtual CVal  compileIfElse(CEnv& cenv, CVal elseV)                                     = 0;
 	virtual CVal  compileIfEnd(CEnv& cenv)                                                  = 0;
 	virtual CVal  compileLiteral(CEnv& cenv, const AST* lit)                                = 0;
 	virtual CVal  compilePrimitive(CEnv& cenv, const ATuple* prim)                          = 0;
@@ -834,6 +834,7 @@ void       resp_constrain(TEnv& tenv, Constraints& c, const AST* ast) throw(Erro
 const AST* resp_simplify(CEnv& cenv, const AST* ast) throw();
 const AST* resp_cps(CEnv& cenv, const AST* ast, const AST* k) throw();
 const AST* resp_lift(CEnv& cenv, Code& code, const AST* ast) throw();
+const AST* resp_flatten(CEnv& cenv, Code& code, const AST* ast) throw();
 CVal       resp_compile(CEnv& cenv, const AST* ast) throw();
 
 bool is_form(const AST* ast, const std::string& form);