/* 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 Read and expand macros.
 */

#include "resp.hpp"

using namespace std;

/** Try to match pattern @a p with @p e and build a Subst in the process.
 * @return true iff @e matches @p.
 */
static bool
match(PEnv&                 penv,
      Subst&                subst,
      std::set<std::string> keywords,
      const AST*            p,
      const AST*            e,
      bool                  bind)
{
	if (p->to_tuple() && e->to_tuple()) {
		ATuple::const_iterator pi = p->as_tuple()->begin();
		ATuple::const_iterator ei = e->as_tuple()->begin();
		ATuple::const_iterator next = pi;
		if (next != p->as_tuple()->end()) {
			++next;
		}
		for (; pi != p->as_tuple()->end() && ei != e->as_tuple()->end();
		     ++pi, ++ei) {
			if (next != p->as_tuple()->end() && is_dots(*next)) {
				if ((*pi)->to_tuple()) {
					/* We have something like "(foo bar) ..."
					   Add a new ellipsis list for each element (foo and bar)
					   so they can be used in templates like "foo ..." */
					for (auto elem : *(*pi)->as_tuple()) {
						subst.add(elem, new ATuple(NULL, NULL, (*pi)->loc));
					}
				}

				List out;  // The list that dots after *pi will be mapped to
				for (; ei != e->as_tuple()->end() && !is_dots(*ei); ++ei) {
					if (match(penv, subst, keywords, *pi, *ei, false)) {
						out.push_back(*ei);  // Element matches, append
					} else {
						return false;  // Element doesn't match, mismatch
					}
				}
				if (out) {
					subst.add(new AEllipsis(*pi, (*pi++)->loc), out);
				}
				break;
			} else if (!match(penv, subst, keywords, *pi, *ei, true)) {
				return false;  // Pattern element doesn't match
			}
			if (next != p->as_tuple()->end()) {
				++next;
			}
		}
		if ((pi == p->as_tuple()->end() && ei != e->as_tuple()->end())) {
			return false;  // Reached end of pattern but not expression
		}
	} else if (p->to_symbol() && !is_dots(p) && !is_dots(e)) {
		if (keywords.count(p->str())) {
			if (!e->to_symbol() || e->str() != p->str()) {
				return false;  // Keyword mismatch
			}
		} else if (p->as_symbol()->str() != "_" && bind) {
			AEllipsis*            ellipsis = new AEllipsis(p, e->loc);
			Subst::const_iterator s        = subst.find_ellipsis(p);
			if (s != subst.end()) {
				// Already an ellipsis list for this element, append to it
				list_append(const_cast<ATuple*>(s->second->as_tuple()), e);
			} else if ((s = subst.find(p)) != subst.end()) {
				// Prev is mapped, but no ellipsis list yet, add a new one
				subst.add(ellipsis, tup(s->second->loc, e, NULL));
			} else {
				subst.add(p, e);  // Symbol p match with symbol e
			}
		} // else _ matches with everything but creates no bindings
	} else {
		return false;  // Recursive list p mismatch with list e
	}

	return true;
}

static const AST*
apply_mac(PEnv& penv, const Macro& mac, const ATuple* exp)
{
	const AST* out = exp;
	for (auto r : mac.rules) {
		Subst subst;
		if (match(penv, subst, mac.keywords, r.pattern, out, true)) {
			return subst.apply(r.templ);
		}
	}
	return out;
}

static const AST*
expand_list(PEnv& penv, const ATuple* e)
{
	// Attempt to match against macro rule
	const ASymbol* sym = e->fst()->to_symbol();
	if (sym) {
		PEnv::Macros::const_iterator m = penv.macros.find(sym->str());
		if (m != penv.macros.end()) {
			const AST* out = apply_mac(penv, m->second, e);
			if (out) {
				return out;
			}
		}
	}

	// No match, try to expand children
	List ret;
	for (const auto& i : *e)
		ret.push_back(penv.expand(i));
	ret.head->loc = e->loc;
	return ret.head;
}

static const AST*
expand_fn(PEnv& penv, const AST* exp)
{
	const ATuple* tup = exp->to_tuple();
	ATuple::const_iterator a = tup->begin();
	THROW_IF(++a == tup->end(), exp->loc, "Unexpected end of `lambda' form");
	THROW_IF(!(*a)->to_tuple(), (*a)->loc, "First argument of `lambda' is not a list");
	const ATuple* prot = (*a++)->to_tuple();
	List ret(new ATuple(penv.sym("lambda"), NULL, exp->loc));
	ret.push_back(prot);
	while (a != tup->end())
		ret.push_back(penv.expand(*a++));
	return ret.head;
}

static const AST*
expand_def(PEnv& penv, const AST* exp)
{
	const ATuple* tup = exp->as_tuple();
	THROW_IF(tup->list_len() < 3, tup->loc, "`define' requires at least 2 arguments");

	ATuple::const_iterator i    = tup->begin();
	const AST*             arg1 = *(++i);
	if (arg1->to_tuple()) {
		// (def (f x) y) => (def f (fn (x) y))
		const ATuple* pat  = arg1->to_tuple();

		List argsExp;
		ATuple::const_iterator j = pat->begin();
		for (++j; j != pat->end(); ++j)
			argsExp.push_back(*j);
		argsExp.head->loc = exp->loc;

		List fnExp;
		fnExp.push_back(penv.sym("lambda"));
		fnExp.push_back(argsExp.head);
		for (++i; i != tup->end(); ++i)
			fnExp.push_back(*i);
		fnExp.head->loc = exp->loc;

		List ret;
		ret.push_back(tup->fst());
		ret.push_back(pat->fst());
		ret.push_back(fnExp.head);
		ret.head->loc = exp->loc;

		return expand_list(penv, ret.head);
	} else {
		return expand_list(penv, tup);
	}
}

static const AST*
expand_mac(PEnv& penv, const AST* exp)
{
	const ATuple* tup = exp->as_tuple();
	THROW_IF(tup->list_len() < 3, tup->loc,
	         "`define-syntax' requires at least 2 arguments");

	ATuple::const_iterator i   = tup->begin();
	const ASymbol*         sym = (*(++i))->as_symbol();
	THROW_IF(!sym, (*i)->loc, "expected symbol");

	const ATuple* xform = (*(++i))->as_tuple();
	THROW_IF(!xform, (*i)->loc, "expected list expression");

	const ASymbol* form = xform->fst()->as_symbol();
	THROW_IF(!form || form->str() != "syntax-rules",
	         form->loc, "expected syntax-rules");

	Macro macro;
	const ATuple* keywords = xform->frst()->as_tuple();
	for (auto k : *keywords) {
		THROW_IF(!k->to_symbol(), k->loc, "keyword must be a symbol");
		macro.keywords.insert(k->as_symbol()->str());
	}

	for (ATuple::const_iterator r = xform->iter_at(2);
	     r != xform->end();
	     ++r) {
		const ATuple* rule = (*r)->as_tuple();
		const ATuple* pat   = rule->fst()->as_tuple();
		const ATuple* plate = rule->frst()->as_tuple();

		macro.rules.push_back(Macro::Rule(pat, plate));
	}

	penv.macros.insert(std::make_pair(sym->str(), macro));

	return NULL;
}

const AST*
PEnv::expand(const AST* exp)
{
	while (true) {
		const AST*    out = exp;
		const ATuple* tup = out->to_tuple();
		if (!tup)
			return out;

		THROW_IF(tup->empty(), exp->loc, "Call to empty list");

		if (is_form(tup, "define"))
			out = expand_def(*this, out);
		else if (is_form(tup, "define-syntax"))
			return expand_mac(*this, out);
		else if (is_form(tup, "lambda"))
			out = expand_fn(*this, out);
		else
			out = expand_list(*this, tup);

		const bool done = !out || *out == *exp;
		exp = out;
		if (done) {
			break;
		}
	}

	return exp;
}


/***************************************************************************
 * Language Definition                                                     *
 ***************************************************************************/

void
initLang(PEnv& penv, TEnv& tenv)
{
	// Types
	const char* types[] = {
		"Bool", "Float", "Int",  "Nothing", "String", "Symbol", "List", "Expr", 0 };
	for (const char** t = types; *t; ++t) {
		const ASymbol* sym = penv.sym(*t);
		tenv.def(sym, sym); // FIXME: define to NULL?
	}

	const char* primitives[] = {
		"+", "-", "*", "/", "%", "and", "or", "xor", "=", "!=", ">", ">=", "<", "<=", 0 };
	for (const char** p = primitives; *p; ++p)
		penv.primitives.insert(*p);
}