/* Resp: A programming language
 * Copyright (C) 2008-2009 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 Simplify (reduce to simpler forms, e.g. match => if)
 */

#include <string>

#include "resp.hpp"

using namespace std;

static const AST*
simplify_if(CEnv& cenv, Code& code, const ATuple* aif) throw()
{
	List copy(aif->loc, cenv.penv.sym("if"), NULL);
	copy.push_back(aif->list_ref(1));
	copy.push_back(aif->list_ref(2));

	ATuple* tail = copy.tail;
	ATuple::const_iterator i = aif->iter_at(3);
	for (; ; ++i) {
		ATuple::const_iterator next = i;
		if (++next == aif->end())
			break;

		List inner_if((*i)->loc, cenv.penv.sym("if"), *i, *next, NULL);
		tail->last(new ATuple(inner_if.head, NULL, Cursor()));
		tail = inner_if.tail;

		cenv.setTypeSameAs(inner_if, aif);

		i = next; // jump 2 elements (to the next predicate)
	}

	tail->last(new ATuple(*i, NULL, Cursor()));
	cenv.setTypeSameAs(copy, aif);
	return copy;
}

static const AST*
simplify_match(CEnv& cenv, Code& code, const ATuple* match) throw()
{
	const AST* const obj = resp_simplify(cenv, code, match->list_ref(1));

	// Dot expression to get tag.  Note index is -1 to compensate for the lift phase
	// which adds 1 to skip the RTTI, which we don't want here (FIXME: ick...)
	const AST* index = new ALiteral<int32_t>(T_INT32, -1, Cursor());
	List tval(Cursor(), cenv.penv.sym("."), obj, index, 0);

	const ASymbol* tsym = cenv.penv.gensym("__tag");

	List def(match->loc, cenv.penv.sym("define"), tsym, tval.head, NULL);
	cenv.setType(tval.head, cenv.tenv.named("Symbol"));

	List 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++;

		const ASymbol* consTag = cenv.penv.sym(pat->fst()->str(), pat->fst()->loc);
		const_cast<ASymbol*>(consTag)->tag(T_LITSYM);
		cenv.setType(consTag, cenv.tenv.named("Symbol"));

		const TEnv::Constructor& constructor = cenv.tenv.tags.find(consTag->str())->second;
		const ATuple*            texp        = constructor.expr->as_tuple();

		// Append condition for this case
		List cond(Cursor(), cenv.penv.sym("="), tsym, consTag, 0);
		cenv.setType(cond, cenv.tenv.named("Bool"));
		copyIf.push_back(cond);

		// If constructor has no variables, append body and continue
		// (don't generate pointless fn)
		if (texp->list_len() == 1) {
			copyIf.push_back(body);
			continue;
		}

		// Build fn for the body of this case
		const ASymbol* osym  = cenv.penv.gensym("__obj");
		const ATuple*  prot  = new ATuple(osym, 0, Cursor());
		const ATuple*  protT = new ATuple(texp, 0, Cursor());

		List fn(Cursor(), cenv.penv.sym("lambda"), prot, 0);
		int idx = 0;
		ATuple::const_iterator ti = texp->iter_at(1);
		for (ATuple::const_iterator j = pat->iter_at(1); j != pat->end(); ++j, ++ti, ++idx) {
			const AST* index = new ALiteral<int32_t>(T_INT32, idx, Cursor());
			const AST* dot   = tup(Cursor(), cenv.penv.sym("."), osym, index, 0);
			const AST* def   = tup(Cursor(), cenv.penv.sym("define"), *j, dot, 0);
			fn.push_back(def);
		}

		fn.push_back(resp_simplify(cenv, code, body));

		List fnT(Cursor(), cenv.tenv.Fn, protT, cenv.type(match), 0);
		assert(fnT.head->list_ref(1));
		cenv.setType(fn, fnT);

		List call(Cursor(), fn, obj, 0);
		cenv.setTypeSameAs(call, match);
		copyIf.push_back(call);
	}
	copyIf.push_back(cenv.penv.sym("__unreachable"));
	cenv.setTypeSameAs(copyIf, match);

	List copy(match->loc, cenv.penv.sym("do"), def.head, simplify_if(cenv, code, copyIf), 0);
	cenv.setTypeSameAs(copy, match);

	return copy;
}

static const AST*
simplify_list(CEnv& cenv, Code& code, const ATuple* call) throw()
{
	List copy;
	for (ATuple::const_iterator i = call->begin(); i != call->end(); ++i)
		copy.push_back(resp_simplify(cenv, code, *i));

	cenv.setTypeSameAs(copy.head, call);

	return copy;
}

static inline const AST*
quote(CEnv& cenv, const AST* ast);

static inline const AST*
simplify_list_elem(CEnv& cenv, const ATuple* node, const AST* type)
{
	if (!node) {
		const AST* empty = new ATuple(cenv.tenv.Empty, 0, Cursor());
		cenv.setType(empty, type);
		return empty;
	}

	assert(cenv.type(node->fst()));

	const AST* const fst = tup(Cursor(), cenv.type(node->fst()), node->fst(), 0);
	const AST* const rst = simplify_list_elem(cenv, node->rst(), type);
	assert(node->fst());
	assert(rst);
	List cons(node->loc, cenv.tenv.List, fst, rst, 0);
	cenv.setType(fst, tup(Cursor(), cenv.tenv.Expr, 0));
	cenv.setType(cons, type);
	return cons;
}

static inline const AST*
quote(CEnv& cenv, const AST* ast)
{
	if (ast->tag() == T_TUPLE) {
		const ATuple* const list = ast->as_tuple();
		return simplify_list_elem(cenv, list, tup(Cursor(), cenv.tenv.Expr, 0));
	} else {
		const AST* cons = tup(Cursor(), cenv.type(ast), ast, 0);
		cenv.setType(cons, tup(Cursor(), cenv.tenv.Expr, 0));
		return cons;
	}
}

static const AST*
simplify_quote(CEnv& cenv, Code& code, const ATuple* call) throw()
{
	return quote(cenv, call->frst());
}

const AST*
resp_simplify(CEnv& cenv, Code& code, const AST* ast) throw()
{
	const ATuple* const list = ast->to_tuple();
	if (!list || !list->fst())
		return ast;

	const ASymbol* const sym  = list->fst() ? list->fst()->to_symbol() : 0;
	const std::string    form = sym ? sym->sym() : "";

	if (form == "match")
		return simplify_match(cenv, code, list);
	else if (form == "if")
		return simplify_if(cenv, code, list);
	else if (form == "quote")
		return simplify_quote(cenv, code, list);
	else
		return simplify_list(cenv, code, list);
}