// joycub - an interpeter for the programming language Joy
// 
// (c) 2004-2006 Sergey Zubkov 
// $Id: builtins_combinators.cc,v 1.3 2006/02/27 18:44:01 cubbi Exp $
#include <vector>
#include <sstream>
#include "program.h"
#include "builtins.h"
#include "exceptions.h"
#include "int.h"
#include "float.h"
#include "set.h"
#include "char.h"
#include "string.h"
#include "list.h"
#include "bool.h"

static char RCSID[] ="$Id: builtins_combinators.cc,v 1.3 2006/02/27 18:44:01 cubbi Exp $";

// i      :  [P]  ->  ...
// Executes P. So, [P] i  ==  P.
void op_i(JC_Stack & STACK) {
	STACK.assert_depth(1,"i");
	JC_objref* ref_p = STACK.pop();
	JC_Program * p = new JC_Program(ref_p);
	p->execute(STACK);
	delete p;
	delete ref_p;
}

// dip      :  X [P]  ->  ... X
// Saves X, executes P, pushes X back.
void op_dip(JC_Stack & STACK) {
	STACK.assert_depth(2,"dip");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	JC_Program * p = new JC_Program(ref_p);
	p->execute(STACK);
	delete p;
	delete ref_p;
	STACK.push_back(ref_x);
}

//binrec      :  [B] [T] [R1] [R2]  ->  ...
//Executes B. If that yields true, executes T.
//Else uses R1 to produce two intermediates, recurses on both,
//         then executes R2 to combines their results.
void lambda_op_binrec(JC_Program*, JC_Program*, JC_Program*, JC_Program*, JC_Stack&);
void op_binrec(JC_Stack & STACK) {
	STACK.assert_depth(4,"binrec");
	int i = STACK.size()-1; // last element's index
	JC_objref* ref_b = STACK[i-3];
	JC_objref* ref_t = STACK[i-2];
	JC_objref* ref_r1 = STACK[i-1];
	JC_objref* ref_r2 = STACK[i];

	if(ref_b->get_type()!=LIST || ref_t->get_type()!=LIST
		|| ref_r1->get_type()!=LIST || ref_r2->get_type()!=LIST)
	throw runtime_error("Not a list argument for binrec");

	STACK.pop_back();
	STACK.pop_back();
	STACK.pop_back();
	STACK.pop_back();

	JC_Program * b = new JC_Program(ref_b);
	JC_Program * t = new JC_Program(ref_t);
	JC_Program * r1 = new JC_Program(ref_r1);
	JC_Program * r2 = new JC_Program(ref_r2);

    lambda_op_binrec(b, t, r1, r2, STACK);

	delete b; delete t; delete r1; delete r2;
	delete ref_b; delete ref_t; delete ref_r1; delete ref_r2;
}
// Helper function for binrec
void lambda_op_binrec(JC_Program* b, JC_Program* t, JC_Program* r1, JC_Program* r2, JC_Stack & STACK) {

	// Execute [B] on a copy of the main stack, save result in result_b
	JC_Stack * STACK_copy = new JC_Stack(STACK);
	b->execute(*STACK_copy);
	STACK_copy->assert_depth(1, "binrec");
	int i = STACK_copy->size()-1; // last element's index
	JC_objref* result_b = (*STACK_copy)[i];
	// Obtain [B]'s result: is it true of false?
	bool a = result_b->to_bool();
	delete STACK_copy;

	if(a) { // if [B]'s result is true:
			//	Execute [T] on the main stack and quit recursion
		t->execute(STACK);
	} else { // Otherwise: execute [R1] on main stack
		r1->execute(STACK);
	   // recurse under dip
		JC_objref* second_word = STACK[STACK.size()-1]; STACK.pop_back();
		lambda_op_binrec(b,t,r1,r2,STACK);
		STACK.push_back(second_word);
	   // recurse normally
		lambda_op_binrec(b,t,r1,r2,STACK);
       // execute [R2] on main stack
		r2->execute(STACK);
	}
}


//condlinrec      :  [ [C1] [C2] .. [D] ]  ->  ...
//Each [Ci] is of the forms [[B] [T]] or [[B] [R1] [R2]].
//Tries each B.
// If that yields true and there is just a [T], executes T and exit.
//If there are [R1] and [R2], executes R1, recurses, executes R2.
//Subsequent case are ignored. If no B yields true, then [D] is used.
//It is then of the forms [[T]] or [[R1] [R2]]. For the former, executes T.
//For the latter executes R1, recurses, executes R2.
void lambda_op_condlinrec(JC_objref*, JC_Stack&);
void op_condlinrec(JC_Stack & STACK) {
	STACK.assert_depth(1,"condlinrec");
	JC_objref* ref_condlist = STACK.pop();
	lambda_op_condlinrec(ref_condlist, STACK);
	delete ref_condlist;
}
void lambda_op_condlinrec(JC_objref* ref_condlist, JC_Stack& STACK) {
	int number_of_cases = ref_condlist->to_agg().size() - 1;
	bool nothing_triggered = true;
	for(int i = 0; i<number_of_cases; i++) {
		JC_objref * ref_c = ref_condlist->to_agg()[i];
		JC_Program * b = new JC_Program(ref_c->to_agg()[0]);

		// Execute [B] on a copy of the main stack, save result in result_b
		JC_Stack * STACK_copy = new JC_Stack(STACK);
		b->execute(*STACK_copy);
		STACK_copy->assert_depth(1, "binrec");
		int i = STACK_copy->size()-1; // last element's index
		JC_objref* result_b = (*STACK_copy)[i];
		bool a = result_b->to_bool();
		delete STACK_copy;
		delete b;

		// [B] returned true: execute T or R1/R2
		if(a) {
			if(ref_c->to_agg().size() == 2) {
				JC_Program * t = new JC_Program(ref_c->to_agg()[1]);
				t->execute(STACK);
				delete t;
			} else 
			if(ref_c->to_agg().size() == 3) {
				JC_Program * r1 = new JC_Program(ref_c->to_agg()[1]);
				JC_Program * r2 = new JC_Program(ref_c->to_agg()[2]);
				r1->execute(STACK);
				lambda_op_condlinrec(ref_condlist, STACK);
				r2->execute(STACK);
				delete r1;
				delete r2;
			} else {
				throw runtime_error("Ci in condlinrec must have 2 or 3 elements");
			}
			nothing_triggered=false;
			break;
		}
	}
	if(nothing_triggered) {
		JC_objref * ref_c = ref_condlist->to_agg()[number_of_cases];
		if(ref_c->to_agg().size() == 1) {
			JC_Program * t = new JC_Program(ref_c->to_agg()[0]);
			t->execute(STACK);
			delete t;
		} else 
		if(ref_c->to_agg().size() == 2) {
			JC_Program * r1 = new JC_Program(ref_c->to_agg()[0]);
			JC_Program * r2 = new JC_Program(ref_c->to_agg()[1]);
			r1->execute(STACK);
			lambda_op_condlinrec(ref_condlist, STACK);
			r2->execute(STACK);
			delete r1;
			delete r2;
		} else {
			throw runtime_error("D in condlinrec must have 1 or 2 elements");
		}
	}
}

//condnestrec      :  [ [C1] [C2] .. [D] ]  ->  ...
//A generalisation of condlinrec. Each [Ci] is of the form [[B] [R1] [R2] .. [Rn]] and [D] is of the form [[R1] [R2] .. [Rn]]. Tries each B, or if all fail, takes the default [D]. For the case taken, executes each [Ri] but recurses between any two consecutive [Ri]. (n > 3 would be exceptional.)
void lambda_op_condnestrec(JC_objref*, JC_Stack&);
void op_condnestrec(JC_Stack & STACK) {
	STACK.assert_depth(1,"condnestrec");
	JC_objref* ref_condlist = STACK.pop();
	lambda_op_condnestrec(ref_condlist, STACK);
	delete ref_condlist;
}
void lambda_op_condnestrec(JC_objref* ref_condlist, JC_Stack& STACK) {
	int number_of_cases = ref_condlist->to_agg().size() - 1;
	bool nothing_triggered = true;
	for(int i = 0; i<number_of_cases; i++) {
		JC_objref * ref_c = ref_condlist->to_agg()[i];
		JC_Program * b = new JC_Program(ref_c->to_agg()[0]);

		// Execute [B] on a copy of the main stack, save result in result_b
		JC_Stack * STACK_copy = new JC_Stack(STACK);
		b->execute(*STACK_copy);
		STACK_copy->assert_depth(1, "condnestrec");
		int i = STACK_copy->size()-1; // last element's index
		JC_objref* result_b = (*STACK_copy)[i];
		bool a = result_b->to_bool();
		delete STACK_copy;
		delete b;

		// [B] returned true: execute Ri
		if(a) {
			if(ref_c->to_agg().size() > 2) {
				for(int j=1; j<ref_c->to_agg().size()-1; j++) {
					JC_Program* ri = new JC_Program(ref_c->to_agg()[i]);
					ri->execute(STACK);
					lambda_op_condnestrec(ref_condlist, STACK);
					delete ri;
				}
				JC_Program* rl = new JC_Program(ref_c->to_agg()[ref_c->to_agg().size()-1]);
				rl->execute(STACK); // don't recurse after the last ri
				delete rl;
			} else {
				throw runtime_error("Ci in condnestrec must have over 2 elements");
			}
			nothing_triggered=false;
			break;
		}
	}
	if(nothing_triggered) {
		JC_objref * ref_c = ref_condlist->to_agg()[number_of_cases];
		if(ref_c->to_agg().size() > 1) {
			for(int j=0; j<ref_c->to_agg().size()-1; j++) {
				JC_Program* ri = new JC_Program(ref_c->to_agg()[j]);
				ri->execute(STACK);
				lambda_op_condnestrec(ref_condlist, STACK);
				delete ri;
			}
			JC_Program* rl =
				new JC_Program(ref_c->to_agg()[ref_c->to_agg().size()-1]);
			rl->execute(STACK); // don't recurse after the last ri
			delete rl;
		} else {
			throw runtime_error("D in condnestrec must have over 1 elements");
		}
	}
}


//cond      :  [..[[Bi] Ti]..[D]]  ->  ...
//Tries each Bi. If that yields true, then executes Ti and exits.
//If no Bi yields true, executes default D.
void op_cond(JC_Stack & STACK) {
	STACK.assert_depth(1,"cond");
	JC_objref* ref_condlist = STACK.pop();
	int number_of_cases = ref_condlist->to_agg().size() - 1;
	bool nothing_triggered = true;
	for(int i = 0; i<number_of_cases; i++) {
		JC_objref * ref_c = ref_condlist->to_agg()[i];
		JC_Program * b = new JC_Program(ref_c->to_agg()[0]);

		// Execute [B] on a copy of the main stack, save result in result_b
		JC_Stack * STACK_copy = new JC_Stack(STACK);
		b->execute(*STACK_copy);
		STACK_copy->assert_depth(1, "cond");
		int i = STACK_copy->size()-1; // last element's index
		JC_objref* result_b = (*STACK_copy)[i];
		bool a = result_b->to_bool();
		delete STACK_copy;
		delete b;

		// [B] returned true: execute T
		if(a) {
			ref_c->to_agg().drop(0);
			JC_Program * t = new JC_Program(ref_c);
			t->execute(STACK);
			delete t;
			nothing_triggered=false;
			break;
		}
	}
	if(nothing_triggered) { // execute D
		JC_objref * ref_c = ref_condlist->to_agg()[number_of_cases];
		JC_Program * t = new JC_Program(ref_c);
		t->execute(STACK);
		delete t;
	}
	delete ref_condlist;
}


//tailrec      :  [P] [T] [R1]  ->  ...
//Executes P. If that yields true, executes T.
//Else executes R1, recurses.
void lambda_op_tailrec(JC_Program*, JC_Program*, JC_Program*, JC_Stack&);
void op_tailrec(JC_Stack & STACK) {
	STACK.assert_depth(3,"tailrec");
	JC_objref* ref_r1 = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_objref* ref_p = STACK.pop();

	if(ref_p->get_type()!=LIST || ref_t->get_type()!=LIST
		|| ref_r1->get_type()!=LIST)
	throw runtime_error("Not a list argument for tailrec");

	JC_Program * p = new JC_Program(ref_p);
	JC_Program * t = new JC_Program(ref_t);
	JC_Program * r1 = new JC_Program(ref_r1);

    lambda_op_tailrec(p, t, r1, STACK);

	delete p; delete t; delete r1;
	delete ref_p; delete ref_t; delete ref_r1;
}
// Helper function for binrec
void lambda_op_tailrec(JC_Program* b, JC_Program* t, JC_Program* r1, JC_Stack & STACK) {

	// Execute [B] on a copy of the main stack, save result in result_b
	JC_Stack * STACK_copy = new JC_Stack(STACK);
	b->execute(*STACK_copy);
	STACK_copy->assert_depth(1, "tailrec");
	int i = STACK_copy->size()-1; // last element's index
	JC_objref* result_b = (*STACK_copy)[i];
	bool a = result_b->to_bool();
	delete STACK_copy;

	if(a) { // if [B]'s result is true:
			//	Execute [T] on the main stack and quit recursion
		t->execute(STACK);
	} else { // Otherwise: execute [R1] on main stack
		r1->execute(STACK);
	   // recurse normally
		lambda_op_tailrec(b,t,r1,STACK);
	}
}


//while      :  [B] [D]  ->  ...
//While executing B yields true executes D.
void op_while(JC_Stack & STACK) {
	STACK.assert_depth(2,"while");
	int i = STACK.size()-1; // last element's index
	JC_objref* ref_b = STACK[i-1];
	JC_objref* ref_d = STACK[i];

	if(ref_b->get_type()!=LIST || ref_d->get_type()!=LIST)
	throw runtime_error("Not a list argument for while");

	STACK.pop_back();
	STACK.pop_back();

	JC_Program * b = new JC_Program(ref_b);
	JC_Program * d = new JC_Program(ref_d);

	bool a = true;
	while(a) {
		// Execute [B] on a copy of the main stack, save result in result_b
		JC_Stack * STACK_copy = new JC_Stack(STACK);
		b->execute(*STACK_copy);
		STACK_copy->assert_depth(1, "binrec");
		int i = STACK_copy->size()-1; // last element's index
		JC_objref* result_b = (*STACK_copy)[i];
		a = result_b->to_bool();
		delete STACK_copy;

		if(a) d->execute(STACK);
	}
	delete b; delete d;
	delete ref_b; delete ref_d;
}


// times      :  N [P]  ->  ...
// N times executes P.
void op_times(JC_Stack & STACK) {
	STACK.assert_depth(2,"times");
	int i = STACK.size()-1; // last element's index
	JC_objref* ref_n = STACK[i-1];
	JC_objref* ref_p = STACK[i];

	if(ref_p->get_type()!=LIST || ref_n->get_type()!=INT)
	throw runtime_error("Argument type error for times");

	STACK.pop_back();
	STACK.pop_back();

	JC_Program * p = new JC_Program(ref_p);
	int counter = ref_n->to_int();

	for(;counter>0; counter--) {
		p->execute(STACK);
	}
	delete p;
	delete ref_n; delete ref_p;
}

//nullary      :  [P]  ->  R
//Executes P, which leaves R on top of the stack.
//No matter how many parameters this consumes, none are removed from the stack.
void op_nullary(JC_Stack & STACK) {
	STACK.assert_depth(1,"nullary");
	JC_objref* ref_p = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	// Execute [P] on a copy of the main stack, save result in result_b
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	p->execute(*STACK_copy);
	JC_objref* ref_r = STACK_copy->pop();
	delete STACK_copy;
	//
	STACK.push_back(ref_r);
	delete ref_p;
}

// branch      :  B [T] [F]  ->  ...
// If B is true, then executes T else executes F.
void op_branch(JC_Stack & STACK) {
	STACK.assert_depth(3,"branch");
	JC_objref* ref_f = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_objref* ref_b = STACK.pop();
	if(ref_b->to_bool()) {
		JC_Program * t=new JC_Program(ref_t);
		t->execute(STACK);
		delete t;
	} else {
		JC_Program * f=new JC_Program(ref_f);
		f->execute(STACK);
		delete f;
	}
	delete ref_b; delete ref_t; delete ref_f;
}

//step      :  A  [P]  ->  ...
//Sequentially putting members of aggregate A onto stack,
//executes P for each member of A.
void op_step(JC_Stack & STACK) {
	STACK.assert_depth(2,"step");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);
//cerr << " calling op_step for " << ref_a->to_string() << endl;
//cerr << " its *agg is " << &(ref_a->to_agg()) << endl;
//cerr << " its size is " << ref_a->to_agg().size() << endl;
	for(int i=0; i<ref_a->to_agg().size(); i++) {
		STACK.push_back(new JC_objref(*ref_a->to_agg()[i]));
		p->execute(STACK);
	}
	delete p; delete ref_p; delete ref_a;
//cerr << "op_step done" << endl;
}

//map      :  A [P]  ->  B
//Executes P on each member of aggregate A,
//collects results in sametype aggregate B.
void op_map(JC_Stack & STACK) {
	STACK.assert_depth(2,"step");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);

	for(int i=0; i<ref_a->to_agg().size(); i++) {
		JC_Stack* STACK_copy = new JC_Stack(STACK);
		STACK_copy->push_back(new JC_objref(*ref_a->to_agg()[i]));
		p->execute(*STACK_copy);
		ref_a->to_agg()[i] = new JC_objref(*(STACK_copy->pop()));
		delete STACK_copy;
	}
	STACK.push_back(ref_a);
	delete p; delete ref_p;
}

//filter      :  A [B]  ->  A1
//Uses test B to filter aggregate A producing sametype aggregate A1.
void op_filter(JC_Stack & STACK) {
	STACK.assert_depth(2,"filter");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);

	for(int i=0; i<ref_a->to_agg().size(); i++) {
		JC_Stack* STACK_copy = new JC_Stack(STACK);
		STACK_copy->push_back(new JC_objref(*ref_a->to_agg()[i]));
		p->execute(*STACK_copy);
		if(!STACK_copy->pop()->to_bool()) {
			ref_a->to_agg().drop(i);
			i--;
		}
		delete STACK_copy;
	}
	STACK.push_back(ref_a);
	delete p; delete ref_p;
}

//split      :  A [B]  ->  A1 A2
//Uses test B to split aggregate A into sametype aggregates A1 and A2 .
void op_split(JC_Stack & STACK) {
	STACK.assert_depth(2,"filter");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);

	JC_objref* ref_a2 = new JC_objref(new JC_list());
	for(int i=0; i<ref_a->to_agg().size(); i++) {
		JC_Stack* STACK_copy = new JC_Stack(STACK);
		STACK_copy->push_back(new JC_objref(*ref_a->to_agg()[i]));
		p->execute(*STACK_copy);
		if(!STACK_copy->pop()->to_bool()) {
			ref_a2->to_agg().push_back(new JC_objref(*ref_a->to_agg()[i]));
			ref_a->to_agg().drop(i);
			i--;
		}
		delete STACK_copy;
	}
	STACK.push_back(ref_a);
	STACK.push_back(ref_a2);
	delete p; delete ref_p;
}

// fold      :  A V0 [P]  ->  V
// Starting with value V0, sequentially pushes members of aggregate A
// and combines with binary operator P to produce value V.
void op_fold(JC_Stack & STACK) {
	STACK.assert_depth(3,"fold");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_v0 = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);
	STACK.push_back(ref_v0);
	for(int i=0; i<ref_a->to_agg().size(); i++) {
		STACK.push_back(new JC_objref(*ref_a->to_agg()[i]));
		p->execute(STACK);
	}
	delete p; delete ref_p; delete ref_a;
}

// linrec      :  [P] [T] [R1] [R2]  ->  ...
// Executes P. If that yields true, executes T.
// Else executes R1, recurses, executes R2.
void lambda_op_linrec(JC_Program*, JC_Program*, JC_Program*, JC_Program*, JC_Stack&);
void op_linrec(JC_Stack & STACK) {
	STACK.assert_depth(4,"linrec");
	JC_objref* ref_r2 = STACK.pop();
	JC_objref* ref_r1 = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_objref* ref_p = STACK.pop();

	if(ref_p->get_type()!=LIST || ref_t->get_type()!=LIST
		|| ref_r1->get_type()!=LIST || ref_r2->get_type()!=LIST)
	throw runtime_error("Not a list argument for linrec");

	JC_Program * p = new JC_Program(ref_p);
	JC_Program * t = new JC_Program(ref_t);
	JC_Program * r1 = new JC_Program(ref_r1);
	JC_Program * r2 = new JC_Program(ref_r2);

    lambda_op_linrec(p, t, r1, r2, STACK);

	delete p; delete t; delete r1; delete r2;
	delete ref_p; delete ref_t; delete ref_r1; delete ref_r2;
}
// Helper function for binrec
void lambda_op_linrec(JC_Program* b, JC_Program* t, JC_Program* r1, JC_Program* r2, JC_Stack & STACK) {

	// Execute [B] on a copy of the main stack, save result in result_b
	JC_Stack * STACK_copy = new JC_Stack(STACK);
	b->execute(*STACK_copy);
	STACK_copy->assert_depth(1, "linrec");
	int i = STACK_copy->size()-1; // last element's index
	JC_objref* result_b = (*STACK_copy)[i];
	bool a = result_b->to_bool();
	delete STACK_copy;

	if(a) { // if [B]'s result is true:
			//	Execute [T] on the main stack and quit recursion
		t->execute(STACK);
	} else { // Otherwise: execute [R1] on main stack
		r1->execute(STACK);
		lambda_op_linrec(b,t,r1,r2,STACK); // recurse 
		r2->execute(STACK);
	}
}

// infra      :  L1 [P]  ->  L2
// Using list L1 as stack, executes P and returns a new list L2.
// The first element of L1 is used as the top of stack,
// and after execution of P the top of stack becomes the first element of L2.
void op_infra(JC_Stack & STACK) {
	STACK.assert_depth(2,"infra");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_l1 = STACK.pop();
	JC_Program * p=new JC_Program(ref_p);
    JC_Stack * infra_stack = new JC_Stack();
	for(int i=ref_l1->to_agg().size()-1; i>=0; i--) {
		infra_stack->push_back(new JC_objref(*ref_l1->to_agg()[i]));
	}
	p->execute(*infra_stack);
	JC_objref* result=new JC_objref(new JC_list());
	for(int i=infra_stack->size()-1; i>=0; i--) {
		result->to_agg().push_back(new JC_objref(*(*infra_stack)[i]));
	}
	STACK.push_back(result);
	delete ref_p; delete ref_l1; delete infra_stack; delete p;
}


//construct      :  [P] [[P1] [P2] ..]  ->  R1 R2 ..
//Saves state of stack and then executes [P].
//Then executes each [Pi] to give Ri pushed onto saved stack.
void op_construct(JC_Stack & STACK) {
	STACK.assert_depth(2,"construct");
	JC_objref* ref_l = STACK.pop();
	JC_objref* ref_p = STACK.pop();
	JC_Program* p=new JC_Program(ref_p);
	// Execute [B] on a copy of the main stack
	JC_Stack * STACK_copy = new JC_Stack(STACK);
	p->execute(*STACK_copy);

	for(int i=0; i<ref_l->to_agg().size(); i++) {
		JC_Stack* STACK_icopy = new JC_Stack(*STACK_copy);
		JC_Program* ri = new JC_Program(ref_l->to_agg()[i]);
		ri->execute(*STACK_icopy);
		STACK.push_back(STACK_icopy->pop());
	}
	delete STACK_copy; delete ref_l; delete ref_p;
}


// unary      :  X [P]  ->  R
// Executes P, which leaves R on top of the stack.
// No matter how many parameters this consumes,
// exactly one is removed from the stack.
void op_unary(JC_Stack & STACK) {
	STACK.assert_depth(2,"unary");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x1 = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x1);
	p->execute(*STACK_copy);
	STACK.push_back(STACK_copy->pop());
	delete STACK_copy; delete ref_p; delete p;
}

// app1      :  X [P]  ->  R
// Executes P, pushes result R on stack without X.
void op_app1(JC_Stack & STACK) {
	STACK.assert_depth(2,"app1");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x1 = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x1);
	p->execute(*STACK_copy);
	STACK.concat(*STACK_copy);
	delete STACK_copy; delete ref_p; delete p;
}

// app11      :  X Y [P]  ->  R
// Executes P, pushes result R on stack.
void op_app11(JC_Stack & STACK) {
	STACK.assert_depth(3,"app11");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	JC_objref* ref_y = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	JC_Stack* STACK_copy = new JC_Stack();
	STACK_copy->push_back(ref_x);
	STACK_copy->push_back(ref_y);
	p->execute(*STACK_copy);
	STACK.concat(*STACK_copy);
	delete STACK_copy; delete ref_p; delete p;
}

// app12      :  X Y1 Y2 [P]  ->  R1 R2
// Executes P twice, with Y1 and Y2, returns R1 and R2.
void op_app12(JC_Stack & STACK) {
	STACK.assert_depth(4,"app12");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_y2 = STACK.pop();
	JC_objref* ref_y1 = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	JC_Stack* STACK_copy = new JC_Stack();
	STACK_copy->push_back(new JC_objref(*ref_x));
	STACK_copy->push_back(ref_y1);
	p->execute(*STACK_copy);
	STACK.concat(*STACK_copy);
	delete STACK_copy;
	STACK_copy = new JC_Stack();
	STACK_copy->push_back(ref_x);
	STACK_copy->push_back(ref_y2);
	p->execute(*STACK_copy);
	STACK.concat(*STACK_copy);
	delete STACK_copy; delete ref_p; delete p;
}


// unary2      :  X1 X2 [P]  ->  R1 R2
// Executes P twice, with X1 and X2 on top of the stack.
// Returns the two values R1 and R2. 
void op_unary2(JC_Stack & STACK) {
	STACK.assert_depth(3,"unary2");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x2 = STACK.pop();
	JC_objref* ref_x1 = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	// Execute [P] on a copy of the main stack, save result in result_b
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x1);
	p->execute(*STACK_copy);
	JC_objref* ref_r1 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x2);
	p->execute(*STACK_copy);
	JC_objref* ref_r2 = STACK_copy->pop();
	delete STACK_copy;
	//
	STACK.push_back(ref_r1);
	STACK.push_back(ref_r2);
	delete ref_p;
}

// unary3      :  X1 X2 X3 [P]  ->  R1 R2 R3
// Executes P three times, with Xi, returns Ri (i = 1..3). *)
void op_unary3(JC_Stack & STACK) {
	STACK.assert_depth(4,"unary3");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x3 = STACK.pop();
	JC_objref* ref_x2 = STACK.pop();
	JC_objref* ref_x1 = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	// Execute [P] on a copy of the main stack, save result in result_b
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x1);
	p->execute(*STACK_copy);
	JC_objref* ref_r1 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x2);
	p->execute(*STACK_copy);
	JC_objref* ref_r2 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x3);
	p->execute(*STACK_copy);
	JC_objref* ref_r3 = STACK_copy->pop();
	delete STACK_copy;
	//
	STACK.push_back(ref_r1);
	STACK.push_back(ref_r2);
	STACK.push_back(ref_r3);
	delete ref_p;
}

// unary4      :  X1 X2 X3 X4 [P]  ->  R1 R2 R3 R4
//Executes P four times, with Xi, returns Ri (i = 1..4). *)
void op_unary4(JC_Stack & STACK) {
	STACK.assert_depth(5,"unary4");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_x4 = STACK.pop();
	JC_objref* ref_x3 = STACK.pop();
	JC_objref* ref_x2 = STACK.pop();
	JC_objref* ref_x1 = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	// Execute [P] on a copy of the main stack, save result in result_b
	JC_Stack* STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x1);
	p->execute(*STACK_copy);
	JC_objref* ref_r1 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x2);
	p->execute(*STACK_copy);
	JC_objref* ref_r2 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x3);
	p->execute(*STACK_copy);
	JC_objref* ref_r3 = STACK_copy->pop();
	delete STACK_copy;
	STACK_copy = new JC_Stack(STACK);
	STACK_copy->push_back(ref_x4);
	p->execute(*STACK_copy);
	JC_objref* ref_r4 = STACK_copy->pop();
	delete STACK_copy;
	//
	STACK.push_back(ref_r1);
	STACK.push_back(ref_r2);
	STACK.push_back(ref_r3);
	STACK.push_back(ref_r4);
	delete ref_p;
}


//treestep      :  T [P]  ->  ...
//Recursively traverses leaves of tree T, executes P for each leaf.
void op_treestep_l(JC_objref*, JC_Program*, JC_Stack&);
void op_treestep(JC_Stack & STACK) {
	STACK.assert_depth(2,"treestep");
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_Program* p = new JC_Program(ref_p);
	op_treestep_l(ref_t, p, STACK);
	delete ref_t; delete ref_p; delete p;
}
void op_treestep_l(JC_objref* t, JC_Program* p, JC_Stack& STACK) {
	for(int i=0; i<t->to_agg().size(); i++) {
		switch(t->to_agg()[i]->get_type()) {
			case SET:
			case LIST:
			case STRING:
				op_treestep_l(t->to_agg()[i], p, STACK);
				break;
			default:
				STACK.push_back(new JC_objref(*t->to_agg()[i]));
				p->execute(STACK);
				break;
		}
	}
}


//treerec      :  T [O] [C]  ->  ...
//T is a tree. If T is a leaf, executes O. Else executes [[O] [C] treerec] C.
// This description is incorrect.
// What it really does is for every leaf in T it executes [leaf] [O] C, and saves one element of output in the same position of the tree where the leaf was.
void op_treerec_l(JC_objref*, JC_Program*, JC_Program*, JC_Stack&);
void op_treerec(JC_Stack & STACK) {
	STACK.assert_depth(3,"treerec");
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_o = STACK.pop();
	JC_objref* ref_t = STACK.back();
	JC_Program* o = new JC_Program(ref_o);
	JC_Program* c = new JC_Program(ref_c);
	op_treerec_l(ref_t, o, c, STACK);
	delete ref_c; delete ref_o;
	delete o; delete c;
}
void op_treerec_l(JC_objref* t, JC_Program* o, JC_Program* c, JC_Stack& STACK) {
	for(int i=0; i<t->to_agg().size(); i++) {
		switch(t->to_agg()[i]->get_type()) {
			case SET:
			case LIST:
			case STRING:
                op_treerec_l(t->to_agg()[i], o, c, STACK);
				break;
			default: // leaf: execute "[leaf] o c"
				JC_Stack* STACK_local=new JC_Stack();
				JC_objref* ll_ref=new JC_objref(new JC_list());
				ll_ref->to_agg().push_back(new JC_objref(*t->to_agg()[i]));
				STACK_local->push_back(new JC_objref(*ll_ref));
				STACK_local->push_back(new JC_objref(new JC_Program(*o)));
				c->execute(*STACK_local);
				t->to_agg()[i] = STACK_local->pop()->to_agg()[0];
				delete STACK_local; delete ll_ref;
				break;
		}
	}
}


//treegenrec      :  T [O1] [O2] [C]  ->  ...
//T is a tree. If T is a leaf, executes O1.
//Else executes O2 and then [[O1] [O2] [C] treegenrec] C.
// what it really does is this: for every list execute [list] O2
// keep the resulting list as the current list
// then for every leaf (including if any were added by O2)
// execute [leaf] [O1] C
// for example treesampl [dup *] [1 swons] [map] treegenrec.
void op_treegenrec_l(JC_objref*, JC_Program*, JC_Program*, JC_Program*, JC_Stack&);
void op_treegenrec(JC_Stack & STACK) {
	STACK.assert_depth(4,"treegenrec");
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_o2 = STACK.pop();
	JC_objref* ref_o1 = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_Program* o2 = new JC_Program(ref_o2);
	JC_Program* o1 = new JC_Program(ref_o1);
	JC_Program* c = new JC_Program(ref_c);
	// execute O2 to the entire tree first
		JC_Stack* STACK_local=new JC_Stack();
		STACK_local->push_back(new JC_objref(*ref_t));
		o2->execute(*STACK_local);
		ref_t = new JC_objref(*STACK_local->pop());
		delete STACK_local;
	op_treegenrec_l(ref_t, o1, o2, c, STACK);
	STACK.push_back(ref_t);
	delete ref_c; delete ref_o1; delete ref_o2;
	delete o1; delete o2; delete c;
}
void op_treegenrec_l(JC_objref* t, JC_Program* o1, JC_Program* o2, JC_Program* c, JC_Stack& STACK) {
	JC_Stack* STACK_local;
	for(int i=0; i<t->to_agg().size(); i++) {
		switch(t->to_agg()[i]->get_type()) {
			case SET:
			case LIST:
			case STRING:
				STACK_local=new JC_Stack();
				STACK_local->push_back(new JC_objref(*(t->to_agg()[i])));
				o2->execute(*STACK_local);
				t->to_agg()[i] = new JC_objref(*STACK_local->pop());
                op_treegenrec_l(t->to_agg()[i], o1, o2, c, STACK);
				delete STACK_local;
				break;
			default: // leaf: execute "[leaf] o c"
				STACK_local=new JC_Stack();
				JC_objref* ll_ref=new JC_objref(new JC_list());
				ll_ref->to_agg().push_back(new JC_objref(*t->to_agg()[i]));
				STACK_local->push_back(new JC_objref(*ll_ref));
				STACK_local->push_back(new JC_objref(new JC_Program(*o1)));
				c->execute(*STACK_local);
				t->to_agg()[i] = STACK_local->pop()->to_agg()[0];
				delete STACK_local; delete ll_ref;
				break;
		}
	}
}


//primrec      :  X [I] [C]  ->  R
//executes I to obtain an initial value R0.
//for integer X uses increasing positive integers to X, combines by C for new R.
//for aggregate X uses successive members and combines by C for new R.

// 5 factorial is:  5 [1] [*] primrec
void op_primrec(JC_Stack & STACK) {
	STACK.assert_depth(3,"primrec");
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_i = STACK.pop();
	int r0 = ref_i->to_agg()[0]->to_int();
	JC_objref* ref_x = STACK.pop();
	JC_Program* c = new JC_Program(ref_c);

	if(ref_x->get_type() == INT) {
		STACK.push(new JC_int(r0));
		for(int i=r0; i<=ref_x->to_int(); i++) {
			STACK.push(new JC_int(i));
			c->execute(STACK);
		}
	}
	if(ref_x->get_type() == LIST) {
		STACK.push(new JC_int(r0));
		for(int i=0; i<ref_x->to_agg().size(); i++) {
			STACK.push_back(new JC_objref(*ref_x->to_agg()[i]));
			c->execute(STACK);
		}
	}
	delete c;
	delete ref_c; delete ref_i; delete ref_x;
}


//case      :  X [..[X Y]..]  ->  Y i
//Indexing on the value of X, execute the matching Y.
void op_case(JC_Stack & STACK) {
	STACK.assert_depth(2,"case");
	JC_objref* ref_l = STACK.pop();
	JC_objref* ref_x = STACK.pop();

	bool case_worked=false;
	for(int i=0; i<ref_l->to_agg().size(); i++) {
		if(ref_l->to_agg()[i]->to_agg().size() < 2)
			throw runtime_error("need >2 elements in opcase"
									);
		if(ref_l->to_agg()[i]->to_agg()[0]->to_int()
			== ref_x->to_int()) {
				JC_objref* ref_p=new JC_objref(*ref_l->to_agg()[i]);
				ref_p->to_agg().drop(0);
				JC_Program* p = new JC_Program(ref_p);
				p->execute(STACK);
				delete p; delete ref_p;
				case_worked=true;
		}
	}
	if(!case_worked) {
		STACK.push_back(ref_x);
		JC_Program* p=new JC_Program(ref_l->to_agg()[ref_l->to_agg().size()-1]) ;
		p->execute(STACK);
		delete p;
	} else {
			delete ref_x;
	}
	delete ref_l;
}


