/* 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 Parsing (build a code AST from a textual AST)
 */

#include "resp.hpp"

using namespace std;

ATuple*
parseTuple(PEnv& penv, const ATuple* e)
{
	List<ATuple, AST> ret;
	FOREACHP(ATuple::const_iterator, i, e)
		ret.push_back(penv.parse(*i));
	return ret.head;
}

AST*
PEnv::parse(const AST* exp)
{
	const ATuple* tup = exp->to<const ATuple*>();
	if (tup) {
		THROW_IF(tup->empty(), exp->loc, "Call to empty list");
		const ALexeme* form = tup->head()->to<const ALexeme*>();
		if (form) {
			MF mf = mac(*form);
			if (mf) {
				exp = mf(*this, exp)->as<ATuple*>(); // Apply macro
				tup = exp->to<const ATuple*>();
			}
		}
	}
	
	if (tup) {
		THROW_IF(tup->empty(), exp->loc, "Call to empty list");
		const ALexeme* form = tup->head()->to<const ALexeme*>();
		if (form) {
			const PEnv::Handler* h = handler(true, form->cppstr);
			if (h)
				return h->func(*this, exp, h->arg); // Parse special form

			if (isupper(form->cppstr.c_str()[0])) // Call constructor (any uppercase symbol)
				return parseTuple(*this, tup);
		}
			
		return parseTuple(*this, tup); // Parse regular call
	}

	const ALexeme* lex = exp->to<const ALexeme*>();
	assert(lex);
	if (isdigit(lex->cppstr[0])) {
		const std::string& s = lex->cppstr;
		if (s.find('.') == string::npos)
			return new ALiteral<int32_t>(T_INT32, strtol(s.c_str(), NULL, 10), exp->loc);
		else
			return new ALiteral<float>(T_FLOAT, strtod(s.c_str(), NULL), exp->loc);
	} else if (lex->cppstr[0] == '\"') {
		return new AString(exp->loc, lex->cppstr.substr(1, lex->cppstr.length() - 2));
	} else {
		const PEnv::Handler* h = handler(false, lex->cppstr);
		if (h)
			return h->func(*this, exp, h->arg);
	}
	return sym(lex->cppstr, exp->loc);
}


/***************************************************************************
 * Macro Functions                                                         *
 ***************************************************************************/

inline AST*
macDef(PEnv& penv, const AST* exp)
{
	const ATuple* tup = exp->to<const ATuple*>();
	ATuple::const_iterator i = tup->begin();
	THROW_IF(i == tup->end(), tup->loc, "Unexpected end of `def' macro call");
	const AST* arg1 = *(++i);
	THROW_IF(i == tup->end(), arg1->loc, "Unexpected end of `def' macro call");
	if (arg1->to<const ALexeme*>()) {
		return const_cast<AST*>(exp);
	} else {
		// (def (f x) y) => (def f (fn (x) y))
		const ATuple* pat  = arg1->to<const ATuple*>();

		List<ATuple, AST> argsExp;
		ATuple::const_iterator j = pat->begin();
		for (++j; j != pat->end(); ++j)
			argsExp.push_back(const_cast<AST*>(*j));
		argsExp.head->loc = exp->loc;
		const AST* body = *(++i);

		List<ATuple, AST> fnExp;
		fnExp.push_back(new ALexeme(exp->loc, "fn"));
		fnExp.push_back(argsExp.head);
		for (; i != tup->end(); ++i)
			fnExp.push_back(const_cast<AST*>(*i));
		fnExp.head->loc = body->loc;
		
		List<ATuple, AST> ret;
		ret.push_back(const_cast<AST*>(tup->head()));
		ret.push_back(const_cast<AST*>(pat->head()));
		ret.push_back(fnExp.head);
		ret.head->loc = exp->loc;
		return ret.head;
	}
}


/***************************************************************************
 * Parser Functions                                                        *
 ***************************************************************************/

inline AST*
parseCall(PEnv& penv, const AST* exp, void* arg)
{
	return parseTuple(penv, exp->to<const ATuple*>());
}

inline AST*
parseBool(PEnv& penv, const AST* exp, void* arg)
{
	return new ALiteral<bool>(T_BOOL, *reinterpret_cast<bool*>(arg), exp->loc);
}

inline AST*
parseFn(PEnv& penv, const AST* exp, void* arg)
{
	const ATuple* texp = exp->to<const ATuple*>();
	ATuple::const_iterator a = texp->begin();
	THROW_IF(++a == texp->end(), exp->loc, "Unexpected end of `fn' form");
	ATuple* prot = parseTuple(penv, (*a++)->to<const ATuple*>());
	List<ATuple, AST> ret(new ATuple(penv.sym("fn"), NULL, Cursor()));
	ret.push_back(prot);
	while (a != texp->end())
		ret.push_back(penv.parse(*a++));
	ret.head->loc = exp->loc;
	return new ATuple(*ret.head);
}

inline AST*
parseQuote(PEnv& penv, const AST* exp, void* arg)
{
	const ATuple* texp = exp->to<const ATuple*>();
	THROW_IF(texp->list_len() != 2, exp->loc, "`quote' requires exactly 1 argument");
	const ALexeme* quotee = texp->list_ref(1)->to<const ALexeme*>();
	THROW_IF(!quotee, exp->loc, "`quote' argument is not a lexeme");
	ATuple* ret = tup<ATuple>(texp->loc, penv.sym("quote"), quotee, NULL);
	return ret;
}


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

void
initLang(PEnv& penv, TEnv& tenv)
{
	// Types
	tenv.def(penv.sym("Nothing"), new AType(penv.sym("Nothing"), AType::PRIM));
	tenv.def(penv.sym("Bool"),    new AType(penv.sym("Bool"), AType::PRIM));
	tenv.def(penv.sym("Int"),     new AType(penv.sym("Int"), AType::PRIM));
	tenv.def(penv.sym("Float"),   new AType(penv.sym("Float"), AType::PRIM));
	tenv.def(penv.sym("String"),  new AType(penv.sym("String"), AType::PRIM));
	tenv.def(penv.sym("Lexeme"),  new AType(penv.sym("Lexeme"), AType::PRIM));
	tenv.def(penv.sym("Quote"),   new AType(penv.sym("Quote"), AType::PRIM));
	
	// Literals
	static bool trueVal  = true;
	static bool falseVal = false;
	penv.reg(false, "#t", PEnv::Handler(parseBool, &trueVal));
	penv.reg(false, "#f", PEnv::Handler(parseBool, &falseVal));

	// Macros
	penv.defmac("def",  macDef);

	// Special forms
	penv.reg(true, "fn",       PEnv::Handler(parseFn));
	penv.reg(true, "quote",    PEnv::Handler(parseQuote));
	penv.reg(true, "if",       PEnv::Handler(parseCall));
	penv.reg(true, ".",        PEnv::Handler(parseCall));
	penv.reg(true, "def",      PEnv::Handler(parseCall));
	penv.reg(true, "def-type", PEnv::Handler(parseCall));
	penv.reg(true, "match",    PEnv::Handler(parseCall));

	// Numeric primitives
	penv.primitives.insert("+");
	penv.primitives.insert("-");
	penv.primitives.insert("*");
	penv.primitives.insert("/");
	penv.primitives.insert("%");
	penv.primitives.insert("and");
	penv.primitives.insert("or");
	penv.primitives.insert("xor");
	penv.primitives.insert("=");
	penv.primitives.insert("!=");
	penv.primitives.insert(">");
	penv.primitives.insert(">=");
	penv.primitives.insert("<");
	penv.primitives.insert("<=");
	FOREACH (PEnv::Primitives::const_iterator, i, penv.primitives)
		penv.reg(true, *i, PEnv::Handler(parseCall));
}