/* 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 Convert AST to Continuation Passing Style
 */

#include <set>
#include <utility>
#include <vector>

#include "resp.hpp"

/** (cps x cont) => (cont x) */
static const AST*
cps_value(TEnv& tenv, AST* cont) const
{
	return tup(loc, cont, this, 0);
}

/** (cps (fn (a ...) body) cont) => (cont (fn (a ... k) (cps body k)) */
static const AST*
cps_fn(TEnv& tenv, AST* cont) const
{
	ATuple*  copyProt = new ATuple(*prot());
	ASymbol* contArg  = tenv.penv.gensym("_k");
	copyProt->push_back(contArg);
	AFn* copy = tup(loc, tenv.penv.sym("fn"), copyProt, 0);
	const_iterator p = begin();
	++(++p);
	for (; p != end(); ++p)
		copy->push_back((*p)->(tenv, contArg));
	return tup(loc, cont, copy, 0);
}

static const AST*
cps_primitive(TEnv& tenv, AST* cont) const
{
	return value() ? tup(loc, cont, this, 0) : ATuple::(tenv, cont);
}

/** (cps (f a b ...)) => (a (fn (x) (b (fn (y) ... (cont (f x y ...)) */
static const AST*
cps_tuple(TEnv& tenv, AST* cont) const
{
	std::vector< std::pair<AFn*, AST*> > funcs;
	AFn*     fn  = NULL;
	ASymbol* arg = NULL;

	// Make a continuation for each element (operator and arguments)
	// Argument evaluation continuations are not themselves in CPS.
	// Each makes a tail call to the next, and the last makes a tail
	// call to the continuation of this call
	const_iterator firstFnIter = end();
	AFn*           firstFn     = NULL;
	ssize_t        index       = 0;
	FOREACHP(const_iterator, i, this) {
		if (!(*i)->to_tuple()) {
			funcs.push_back(make_pair((AFn*)NULL, (*i)));
		} else {
			arg = tenv.penv.gensym("a");

			AFn* thisFn = tup(loc, tenv.penv.sym("fn"),
					tup((*i)->loc, arg, 0),
					0);

			if (firstFnIter == end()) {
				firstFnIter = i;
				firstFn = thisFn;
			}

			if (fn)
				fn->push_back((*i)->(tenv, thisFn));

			funcs.push_back(make_pair(thisFn, arg));
			fn = thisFn;
		}
		++index;
	}

	if (firstFnIter != end()) {
		// Call this call's callee in the last argument evaluator
		ATuple* call = tup(loc, 0);
		assert(funcs.size() == size());
		for (size_t i = 0; i < funcs.size(); ++i)
			call->push_back(funcs[i].second);

		assert(fn);
		fn->push_back(call->(tenv, cont));
		return (*firstFnIter)->(tenv, firstFn);
	} else {
		assert(fst()->value());
		ATuple* ret = tup(loc, 0);
		FOREACHP(const_iterator, i, this)
			ret->push_back((*i));
		if (!is_primitive(this))
			ret->push_back(cont);
		return ret;
	}
}

/** (cps (def x y)) => (y (fn (x) (cont))) */
static const AST*
cps_def(TEnv& tenv, AST* cont) const
{
	AST*    val     = body()->(tenv, cont);
	ATuple* valCall = val->to_tuple();
	ATuple::iterator i = valCall->begin();
	return tup(loc, tenv.penv.sym("def"), sym(), *++i, 0);
}

/** (cps (if c t ... e)) => */
static const AST*
cps_iff(TEnv& tenv, AST* cont) const
{
	ASymbol* argSym = tenv.penv.gensym("c");
	const_iterator i = begin();
	AST* cond = *++i;
	AST* exp  = *++i;
	AST* next = *++i;
	if (cond->value()) {
		return tup(loc, tenv.penv.sym("if"), cond,
			exp->(tenv, cont),
			next->(tenv, cont), 0);
	} else {
		AFn* contFn = tup(loc, tenv.penv.sym("fn"),
				tup(cond->loc, argSym, tenv.penv.gensym("_k"), 0),
				tup(loc, tenv.penv.sym("if"), argSym,
					exp->(tenv, cont),
					next->(tenv, cont), 0));
		return cond->(tenv, contFn);
	}
}