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

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

// size      :  A  ->  I
// Integer I is the number of elements of aggregate A.
void op_size(JC_Stack & STACK) {
	STACK.assert_depth(1,"size");
	JC_objref* ref_m = STACK.pop();
	int result=-1;
	switch(ref_m->get_type()) {
		case STRING:
		case SET:
		case LIST:
			result = ref_m->to_agg().size();
			break;
		default:
		   	throw runtime_error("Different type needed for size.");
			  break;
	}
	delete ref_m;
	STACK.push(new JC_int(result));
}

//at      :  A I  ->  X
//X (= A[I]) is the member of A at position I.
void op_at(JC_Stack & STACK) {
	STACK.assert_depth(2,"at");
	JC_objref* ref_i = STACK.pop();
	JC_objref* ref_a = STACK.pop();

	int index=ref_i->to_int();
	JC_objref* result;
	switch(ref_a->get_type()) {
		case STRING:
		case SET:
		case LIST:
			result = new JC_objref(*ref_a->to_agg()[index]);
		  	break;
		default:  throw runtime_error("Different type needed for at.");
				  break;
	}
	delete ref_a;
	delete ref_i;
	STACK.push_back(result);
}

//has      :  A X  ->  B
//Tests whether aggregate A has X as a member.
void op_has(JC_Stack & STACK) {
	STACK.assert_depth(2,"has");
	JC_objref* ref_x = STACK.pop();
	JC_objref* ref_a = STACK.pop();

	bool result=false;
	for(int i=0; i<ref_a->to_agg().size(); i++) {
		JC_Stack* STACK_local = new JC_Stack();
		STACK_local->push_back(new JC_objref(*ref_a->to_agg()[i]));
		STACK_local->push_back(new JC_objref(*ref_x));
		op_eq(*STACK_local);
		if( STACK_local->back()->to_bool() ) result=true;
		delete STACK_local;
	}
	delete ref_a; delete ref_x;
	STACK.push(new JC_bool(result));
}

// cons      :  X A  ->  B
// Aggregate B is A with a new member X (first member for sequences).
void op_cons(JC_Stack & STACK) {
	STACK.assert_depth(2,"cons");
	JC_objref* ref_a = STACK.pop();
	JC_objref* ref_x = STACK.pop();

	switch(ref_a->get_type()) {
		case STRING:
		case SET:
		case LIST:
			ref_a->to_agg().push_front(ref_x);
		  	break;
		default:
		   	throw runtime_error("Aggregate type needed for cons.");
			break;
	}
	STACK.push_back(ref_a);
}

// uncons      :  A  ->  F R
// F and R are the first and the rest of non-empty aggregate A.
void op_uncons(JC_Stack & STACK) {
	STACK.assert_depth(1,"unconcs");
	JC_objref* ref_a = STACK.pop();
	switch(ref_a->get_type()) {
		case STRING:
		case SET:
		case LIST:
			if(ref_a->to_agg().size() < 1)
					throw runtime_error("Non-empty list needed for uncons");
			STACK.push_back(new JC_objref(*ref_a->to_agg()[0]));
			ref_a->to_agg().drop(0);
			STACK.push_back(ref_a);
		  	break;
		default:
			delete ref_a;
		   	throw runtime_error("Aggregate type needed for cons.");
			break;
	}
}

//drop      :  A N  ->  B
//Aggregate B is the result of deleting the first N elements of A.
void op_drop(JC_Stack & STACK) {
	STACK.assert_depth(2,"drop");
	JC_objref* ref_n = STACK.pop();
	JC_objref* ref_a = STACK.back();
	switch(ref_a->get_type()) {
		case STRING:
		case SET:
		case LIST:
			for(int i=0; i<ref_n->to_int(); i++) 
				ref_a->to_agg().drop(0);
		  	break;
		default:
		   	throw runtime_error("Aggregate type needed for cons.");
			break;
	}
}
//take      :  A N  ->  B
//Aggregate B is the result of retaining just the first N elements of A.
void op_take(JC_Stack & STACK) {
	STACK.assert_depth(2,"take");
	JC_objref* ref_n = STACK.pop();
	JC_objref* ref_a = STACK.back();
	switch(ref_a->get_type()) {
		case STRING:
		case SET:
		case LIST:
			for(int i=ref_a->to_agg().size(); i>ref_n->to_int(); i--) 
				ref_a->to_agg().drop(ref_n->to_int());
		  	break;
		default:
		   	throw runtime_error("Aggregate type needed for cons.");
			break;
	}
}


//unstack      :  [X Y ..]  ->  ..Y X
//The list [X Y ..] becomes the new stack.
void op_unstack(JC_Stack & STACK) {
	STACK.assert_depth(1,"unstack");
	JC_objref* ref_l = STACK.pop();
	STACK.erase();
	JC_Stack* s = new JC_Stack(ref_l->to_agg());
	STACK = *s;
}

// stack      :  .. X Y Z  ->  .. X Y Z [Z Y X ..]
// Pushes the stack as a list.
void op_stack(JC_Stack & STACK) {
	STACK.push(new JC_Stack(STACK));
}


//concat      :  S T  ->  U
//Sequence U is the concatenation of sequences S and T.
void op_concat(JC_Stack & STACK) {
	STACK.assert_depth(2,"concat");
	JC_objref* ref_t = STACK.pop();
	JC_objref* ref_s = STACK.pop();

	switch(ref_s->get_type()) {
		case STRING:
		case SET:
		case LIST:
			ref_s->to_agg().concat(ref_t->to_agg());
			break;
		default:
		   	throw runtime_error("Different type needed for cons.");
			break;
	}
	delete ref_t;
	STACK.push_back(ref_s);
}


// .      :  X  -> 
// prints out X
void op_dot(JC_Stack & STACK) {
	if(STACK.size()>0) {
		JC_objref* ref_x = STACK.pop();
		cout << ref_x->to_output_string() << endl;
		delete ref_x;
	}
}

//putch      :  N  ->
//N : numeric, writes character whose ASCII is N.
void op_putch(JC_Stack & STACK) {
	STACK.assert_depth(1,"putch");
	JC_objref* ref_c = STACK.pop();
	cout << ref_c->to_char();
	delete ref_c;
}

//put      :  X  ->
//Writes X to output, pops X off stack.
void op_put(JC_Stack & STACK) {
	STACK.assert_depth(1,"put");
	JC_objref* ref_c = STACK.pop();
	cout << ref_c->to_output_string() << " " ;
	delete ref_c;
}

//get      :  ->  F
//Reads a factor from input and pushes it onto stack.
void op_get(JC_Stack & STACK) {
	string s_in;
	cin >> s_in;
	STACK.push(new JC_string(s_in));
}


//format      :  N C I J  ->  S
//S is the formatted version of N in mode C
//('d or 'i = decimal, 'o = octal, 'x or
// 'X = hex with lower or upper case letters)
//with maximum width I and minimum width J.
void op_format(JC_Stack & STACK) {
	STACK.assert_depth(4,"format");
	JC_objref* ref_j = STACK.pop();
	JC_objref* ref_i = STACK.pop();
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_n = STACK.pop();

	char* result=new char[256];

	char format=(char)ref_c->to_int();
	int max=ref_j->to_int();
	int min=ref_i->to_int();
    std::ostringstream tmp_string;
    tmp_string << "%" << min << "." << max << format;
	sprintf(result, tmp_string.str().data(), ref_n->to_int());
	STACK.push(new JC_string(result));
	delete ref_j; delete ref_i; delete ref_c; delete ref_n;
}


//formatf      :  F C I J  ->  S
//S is the formatted version of F in mode C
//('e or 'E = exponential, 'f = fractional,
// 'g or G = general with lower or upper case letters)
//with maximum width I and precision J.
void op_formatf(JC_Stack & STACK) {
	STACK.assert_depth(4,"formatf");
	JC_objref* ref_j = STACK.pop();
	JC_objref* ref_i = STACK.pop();
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_n = STACK.pop();

	char* result=new char[256];

	char format=(char)ref_c->to_int();
	int max=ref_j->to_int();
	int min=ref_i->to_int();
    std::ostringstream tmp_string;
    tmp_string << "%" << min << "." << max << format;
	sprintf(result, tmp_string.str().data(), ref_n->to_double());
	STACK.push(new JC_string(result));
	delete ref_j; delete ref_i; delete ref_c; delete ref_n;
}



//include      :  "filnam.ext"  ->
//Transfers input to file whose name is "filnam.ext".
//On end-of-file returns to previous input file.
void op_include(JC_Stack & STACK) {
	STACK.assert_depth(1,"include");
	JC_objref* ref_s = STACK.pop();
	ifstream f;
    f.open((LIBRARY_PREFIX+ref_s->to_string()).c_str(), ios::in);
	if(!f.is_open())
		throw runtime_error("Could not open file "+ref_s->to_string());
	string file_content;
	char line[2000];
    while (f.good() ) {
      f.getline(line,2000);
	  if(line[0]=='#') continue;
	  file_content += " ";
	  file_content += line;
    }
	Token_list pl = Token_list(file_content);
	JC_Program* p = new JC_Program(pl);
	p->execute(STACK);
	f.close();
	delete p;
}

//time      :  ->  I
//Pushes the current time (in seconds since the Epoch).
void op_time(JC_Stack & STACK) {
	STACK.push(new JC_int(time(NULL)));
}

//localtime      :  I  ->  T
//Converts a time I into a list T representing local time:
//[year month day hour minute second isdst yearday weekday].
//Month is 1 = January ... 12 = December;
//isdst is a Boolean flagging daylight savings/summer time;
//weekday is 0 = Monday ... 7 = Sunday.
void op_localtime(JC_Stack & STACK) {
	STACK.assert_depth(1,"localtime");
	JC_objref* ref_t = STACK.pop();
	const time_t t_i = ref_t->to_int();
	struct tm * l_t  = localtime(&t_i);
	delete ref_t;
	JC_objref* result = new JC_objref(new JC_list());
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_year+1900)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_mon+1)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_mday)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_hour)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_min)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_sec)));
	result->to_agg().push_back(new JC_objref(new JC_bool(l_t->tm_isdst)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_yday)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_wday)));
	STACK.push_back(result);
}

// gmtime      :  I  ->  T
// Converts a time I into a list T representing universal time:
// [year month day hour minute second isdst yearday weekday].
// Month is 1 = January ... 12 = December;
// isdst is false; weekday is 0 = Monday ... 7 = Sunday.
void op_gmtime(JC_Stack & STACK) {
	STACK.assert_depth(1,"gmtime");
	JC_objref* ref_t = STACK.pop();
	const time_t t_i = ref_t->to_int();
	struct tm * l_t  = gmtime(&t_i);
	delete ref_t;
	JC_objref* result = new JC_objref(new JC_list());
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_year+1900)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_mon+1)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_mday)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_hour)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_min)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_sec)));
	result->to_agg().push_back(new JC_objref(new JC_bool(l_t->tm_isdst)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_yday)));
	result->to_agg().push_back(new JC_objref(new JC_int(l_t->tm_wday)));
	STACK.push_back(result);
}

// mktime      :  T  ->  I
// Converts a list T representing local time into a time I.
// T is in the format generated by localtime.
void op_mktime(JC_Stack & STACK) {
	STACK.assert_depth(1,"mktime");
	JC_objref* ref_i = STACK.pop();
	if(ref_i->to_agg().size() != 9)
		throw runtime_error("wrong argument for mktime");
	struct tm l_t;
	l_t.tm_year = ref_i->to_agg()[0]->to_int() - 1900;
	l_t.tm_mon = ref_i->to_agg()[1]->to_int() - 1;
	l_t.tm_mday = ref_i->to_agg()[2]->to_int();
	l_t.tm_hour = ref_i->to_agg()[3]->to_int();
	l_t.tm_min = ref_i->to_agg()[4]->to_int();
	l_t.tm_sec = ref_i->to_agg()[5]->to_int();
	l_t.tm_isdst = ref_i->to_agg()[6]->to_bool();
	l_t.tm_yday = ref_i->to_agg()[7]->to_int();
	l_t.tm_wday = ref_i->to_agg()[8]->to_int();
	STACK.push(new JC_int(mktime(&l_t)));
	delete ref_i;
}

// strftime      :  T S1  ->  S2
// Formats a list T in the format of localtime or gmtime
// using string S1 and pushes the result S2.
void op_strftime(JC_Stack & STACK) {
	char result[255];
	STACK.assert_depth(2,"strftime");
	JC_objref* ref_s = STACK.pop();
	JC_objref* ref_i = STACK.pop();
	if(ref_i->to_agg().size() != 9)
		throw runtime_error("wrong argument for mktime");
	struct tm l_t;
	l_t.tm_year = ref_i->to_agg()[0]->to_int() - 1900;
	l_t.tm_mon = ref_i->to_agg()[1]->to_int() - 1;
	l_t.tm_mday = ref_i->to_agg()[2]->to_int();
	l_t.tm_hour = ref_i->to_agg()[3]->to_int();
	l_t.tm_min = ref_i->to_agg()[4]->to_int();
	l_t.tm_sec = ref_i->to_agg()[5]->to_int();
	l_t.tm_isdst = ref_i->to_agg()[6]->to_bool();
	l_t.tm_yday = ref_i->to_agg()[7]->to_int();
	l_t.tm_wday = ref_i->to_agg()[8]->to_int();

	strftime(result, 255, ref_s->to_string().c_str(), &l_t);
	STACK.push(new JC_string(result));
	delete ref_i; delete ref_s;
}


extern JC_symtab * SYMTAB;
// intern      :  "sym"  -> sym
// Pushes the item whose name is "sym".
void op_intern(JC_Stack & STACK) {
	STACK.assert_depth(1,"intern");
	JC_objref* ref_o = STACK.pop();
	string result="";
	if(SYMTAB->check(ref_o->to_string())) {
		STACK.push(new JC_op(ref_o->to_string()));
	} else {
		STACK.push(new JC_string(ref_o->to_string()));
	}
	delete ref_o;
}

//name      :  sym  ->  "sym"
//For operators and combinators, the string "sym" is the name of item sym,
//for literals sym the result string is its type.
void op_name(JC_Stack & STACK) {
	STACK.assert_depth(1,"name");
	JC_objref* ref_s = STACK.pop();
	if(ref_s->get_type()==OPERATOR) {
		STACK.push(new JC_string(ref_s->to_string()));
	} else {
    	std::ostringstream tmp_string;
    	tmp_string << "type #" << ref_s->get_type();
		STACK.push(new JC_string(tmp_string.str()));
	}
}

// body      :  U  ->  [P]
// Quotation [P] is the body of user-defined symbol U.
void op_body(JC_Stack & STACK) {
	STACK.assert_depth(1,"body");
	JC_objref* ref_o = STACK.pop();
	string result="";
	if(ref_o->get_type()==OPERATOR && SYMTAB->check(ref_o->to_string())) {
		string result=SYMTAB->get_body(ref_o->get_opnum());
	} 
	STACK.push(new JC_string(result));
	delete ref_o;
}

// ord      :  C  ->  I
// Integer I is the Ascii value of character C (or logical or integer).
void op_ord(JC_Stack & STACK) {
	STACK.assert_depth(1,"ord");
	JC_objref* ref_c = STACK.pop();
	STACK.push(new JC_int(ref_c->to_int()));
	delete ref_c;
}


//chr      :  I  ->  C
//C is the character whose Ascii value is integer I (or logical or character).
void op_chr(JC_Stack & STACK) {
	STACK.assert_depth(1,"chr");
	JC_objref* ref_i = STACK.pop();
	switch (ref_i->get_type()) {
			case INT:
			case BOOL:
			case CHAR:
				STACK.push(new JC_char(ref_i->to_int()));
				delete ref_i;
				break;
			default:
				throw runtime_error("Incorrect type for chr");
				break;
	}
}

// strtol      :  S I  ->  J
// String S is converted to the integer J using base I.
// If I = 0, assumes base 10,
// but leading "0" means base 8 and leading "0x" means base 16.
void op_strtol(JC_Stack & STACK) {
	STACK.assert_depth(2,"strtol");
	JC_objref* ref_i = STACK.pop();
	JC_objref* ref_s = STACK.pop();
	STACK.push(
	 new JC_int(
	  strtol(ref_s->to_string().c_str(), NULL, ref_i->to_int())
	  ));
	delete ref_s; delete ref_i;
}


//strtod      :  S  ->  R
//String S is converted to the float R.
void op_strtod(JC_Stack & STACK) {
	STACK.assert_depth(1,"strtod");
	JC_objref* ref_s = STACK.pop();
	STACK.push(
	 new JC_float(strtod(ref_s->to_string().c_str(), NULL)));
	delete ref_s;
}


// or      :  X Y  ->  Z
// Z is the union of sets X and Y, logical disjunction for truth values.
void op_or(JC_Stack & STACK) {
	STACK.assert_depth(2,"or");
	JC_objref* ref_y = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	if( ref_x->get_type()==BOOL && ref_y->get_type()==BOOL) {
		STACK.push(new JC_bool(ref_x->to_bool() | ref_y->to_bool()));
		delete ref_x; delete ref_y;
	} else if (ref_x->get_type()==SET && ref_y->get_type()==SET) {
		for(int i=0; i< ref_y->to_agg().size(); i++) {
			bool ok_to_add=true;
			for(int j=0; j<ref_x->to_agg().size(); j++) {
				if(ref_y->to_agg()[i]->to_int() == ref_x->to_agg()[j]->to_int())
					ok_to_add=false;
			}
			if(ok_to_add)
				ref_x->to_agg().push_back(new JC_objref(*ref_y->to_agg()[i]));
		}	
		STACK.push_back(ref_x); delete ref_y;
	} else {
		throw runtime_error("wrong type for or");
	}
}
// and      :  X Y  ->  Z
// Z is the intersection of sets X and Y, logical conjunction for truth values.
void op_and(JC_Stack & STACK) {
	STACK.assert_depth(2,"and");
	JC_objref* ref_y = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	if( ref_x->get_type()==BOOL && ref_y->get_type()==BOOL) {
		STACK.push(new JC_bool(ref_x->to_bool() & ref_y->to_bool()));
		delete ref_x; delete ref_y;
	} else if (ref_x->get_type()==SET && ref_y->get_type()==SET) {
		JC_objref* ref_z = new JC_objref(new JC_set());
		for(int i=0; i< ref_y->to_agg().size(); i++) {
			bool ok_to_add=false;
			for(int j=0; j<ref_x->to_agg().size(); j++) {
				if(ref_y->to_agg()[i]->to_int() == ref_x->to_agg()[j]->to_int())
					ok_to_add=true;
			}
			if(ok_to_add)
				ref_z->to_agg().push_back(new JC_objref(*ref_y->to_agg()[i]));
		}	
		STACK.push_back(ref_z); delete ref_x; delete ref_y;
	} else {
		throw runtime_error("wrong type for and");
	}
}

// not      :  X  ->  Y
// Y is the complement of set X, logical negation for truth values.
void op_not(JC_Stack & STACK) {
	STACK.assert_depth(1,"not");
	JC_objref* ref_x = STACK.pop();
	if( ref_x->get_type()==BOOL) {
		STACK.push(new JC_bool(!ref_x->to_bool()));
		delete ref_x;
	} else if (ref_x->get_type()==SET) {
		JC_objref* ref_z = new JC_objref(new JC_set());
		for(int i=0; i<SETSIZE; i++) {
			bool ok_to_add=true;
			for(int j=0; j<ref_x->to_agg().size(); j++) {
				if(i == ref_x->to_agg()[j]->to_int())
					ok_to_add=false;
			}
			if(ok_to_add)
				ref_z->to_agg().push_back(new JC_objref(new JC_int(i)));
		}	
		STACK.push_back(ref_z); delete ref_x;
	} else {
		throw runtime_error("wrong type for not");
	}
}

// xor      :  X Y  ->  Z
// Z is the symmetric difference of sets X and Y,
// logical exclusive disjunction for truth values.
void op_xor(JC_Stack & STACK) {
	STACK.assert_depth(2,"xor");
	JC_objref* ref_y = STACK.pop();
	JC_objref* ref_x = STACK.pop();
	if( ref_x->get_type()==BOOL && ref_y->get_type()==BOOL) {
		STACK.push(new JC_bool(ref_x->to_bool() ^ ref_y->to_bool()));
		delete ref_x; delete ref_y;
	} else if (ref_x->get_type()==SET && ref_y->get_type()==SET) {
		JC_objref* ref_z = new JC_objref(new JC_set());
		for(int i=0; i< ref_x->to_agg().size(); i++) {
			bool ok_to_add=true;
			for(int j=0; j<ref_y->to_agg().size(); j++) {
				if(ref_x->to_agg()[i]->to_int() == ref_y->to_agg()[j]->to_int())
					ok_to_add=false;
			}
			if(ok_to_add)
				ref_z->to_agg().push_back(new JC_objref(*ref_x->to_agg()[i]));
		}	
		for(int i=0; i< ref_y->to_agg().size(); i++) {
			bool ok_to_add=true;
			for(int j=0; j<ref_x->to_agg().size(); j++) {
				if(ref_y->to_agg()[i]->to_int() == ref_x->to_agg()[j]->to_int())
					ok_to_add=false;
			}
			if(ok_to_add)
				ref_z->to_agg().push_back(new JC_objref(*ref_y->to_agg()[i]));
		}	
		STACK.push_back(ref_z); delete ref_x; delete ref_y;
	} else {
		throw runtime_error("wrong type for xor");
	}
}


// setsize      :  ->  setsize
// Pushes the maximum number of elements in a set (platform dependent).
// Typically it is 32, and set members are in the range 0..31.
void op_setsize(JC_Stack & STACK) {
	STACK.push(new JC_int(SETSIZE));
}

// setecho      :  I ->
// Sets value of echo flag for listing.
// I = 0: no echo, 1: echo, 2: with tab, 3: and linenumber.
void op_setecho(JC_Stack & STACK) {
	STACK.assert_depth(1,"setecho");
	JC_objref* ref_i = STACK.pop();
	ECHO_SETTING = ref_i->to_int();
	delete ref_i;
}

// echo      :  ->  I
// Pushes value of echo flag, I = 0..3.
void op_echo(JC_Stack & STACK) {
	STACK.push(new JC_int(ECHO_SETTING));
}

// clock      :  ->  I
// Pushes the integer value of current CPU usage in hundreds of a second.
void op_clock(JC_Stack & STACK) {
	STACK.push(new JC_int( 100*clock()/CLOCKS_PER_SEC ));
}

// choice      :  B T F  ->  X
// If B is true, then X = T else X = F.
void op_choice(JC_Stack & STACK) {
	STACK.assert_depth(3,"choice");
	JC_objref* ref_f = STACK.pop();
	JC_objref* ref_t = STACK.pop();
	JC_objref* ref_b = STACK.pop();
	if(ref_b->to_bool()) {
		STACK.push_back(ref_t); delete ref_f;
	} else {
		STACK.push_back(ref_f); delete ref_t;
	}
	delete ref_b;
}

// stdin      :  ->  S
// Pushes the standard input stream.
void op_stdin(JC_Stack & STACK) {
	STACK.push(new JC_file(stdin));
}

//stdout      :  ->  S
//Pushes the standard output stream.
void op_stdout(JC_Stack & STACK) {
	STACK.push(new JC_file(stdout));
}

//stderr      :  ->  S
//Pushes the standard error stream.
void op_stderr(JC_Stack & STACK) {
	STACK.push(new JC_file(stderr));
}

// nonimplemented	S -> :
// throw error
void op_nonimpl(JC_Stack & STACK) {
	STACK.assert_depth(1,"nonimpl");
	JC_objref* ref_f = STACK.pop();
	throw runtime_error(ref_f->to_string()+" is not implemeted");
}

// undefined : -> :
// throw error
void op_undef(JC_Stack & STACK) {
	throw runtime_error(" attempted to execute undefined word ");
}

// fclose      :  S  ->
// Stream S is closed and removed from the stack.
void op_fclose(JC_Stack & STACK) {
	STACK.assert_depth(1,"fclose");
	JC_objref* ref_f = STACK.pop();
	if(ref_f->get_type() !=_FILE_) throw runtime_error("Wrong type for fclose");
	delete ref_f; // desctructor will do it
}

// feof      :  S  ->  S B
// B is the end-of-file status of stream S.
void op_feof(JC_Stack & STACK) {
	STACK.assert_depth(1,"feof");
	JC_objref* ref_f = STACK.back();
	if(feof(ref_f->to_file()))
		STACK.push(new JC_bool(true));
	else
		STACK.push(new JC_bool(false));
}

// ferror      :  S  ->  S B
// B is the error status of stream S.
void op_ferror(JC_Stack & STACK) {
	STACK.assert_depth(1,"ferror");
	JC_objref* ref_f = STACK.back();
	if(ferror(ref_f->to_file()))
		STACK.push(new JC_bool(true));
	else
		STACK.push(new JC_bool(false));
}

//fflush      :  S  ->  S
//Flush stream S, forcing all buffered output to be written.
void op_fflush(JC_Stack & STACK) {
	STACK.assert_depth(1,"ferror");
	JC_objref* ref_f = STACK.back();
	fflush(ref_f->to_file());
}

//fgetch      :  S  ->  S C
//C is the next available character from stream S.
void op_fgetch(JC_Stack & STACK) {
	STACK.assert_depth(1,"fgetch");
	JC_objref* ref_f = STACK.back();
	STACK.push(new JC_char(fgetc(ref_f->to_file())));
}

//fgets      :  S  ->  S L
//L is the next available line (as a string) from stream S.
void op_fgets(JC_Stack & STACK) {
	char* buf;
	int bufsize=1024;
	buf = new char[bufsize];
	STACK.assert_depth(1,"fgets");
	JC_objref* ref_f = STACK.back();
	STACK.push(new JC_string(fgets(buf,bufsize,ref_f->to_file())));
}

//fopen      :  P M  ->  S
//The file system object with pathname P is opened with mode M (r, w, a, etc.)
//and stream object S is pushed; if the open fails, file:NULL is pushed.
void op_fopen(JC_Stack & STACK) {
	STACK.assert_depth(2,"fopen");
	JC_objref* ref_m = STACK.pop();
	JC_objref* ref_p = STACK.pop();
	STACK.push(new JC_file(
		fopen(ref_p->to_string().c_str(), ref_m->to_string().c_str())));
	delete ref_p; delete ref_m;
}

//fread      :  S I  ->  S L
//I bytes are read from the current position of stream S
//and returned as a list of I integers.
void op_fread(JC_Stack & STACK) {
	STACK.assert_depth(2,"fread");
	JC_objref* ref_i = STACK.pop();
	JC_objref* ref_s = STACK.back();
	int bufsize=ref_i->to_int();
	char* buffer = new char[bufsize];
	fread(buffer, sizeof(char), bufsize, ref_s->to_file());
	JC_list* jl = new JC_list();
	for(int i=0; i<bufsize; i++)
		jl->push_back(new JC_objref(new JC_int(buffer[i])));
	STACK.push(jl);
	delete ref_i;
}

//fwrite      :  S L  ->  S
//A list of integers are written as bytes to the current position of stream S.
void op_fwrite(JC_Stack & STACK) {
	STACK.assert_depth(2,"fwrite");
	JC_objref* ref_l = STACK.pop();
	JC_objref* ref_s = STACK.back();
	int bufsize=ref_l->to_agg().size();
	int* buffer = new int[bufsize];
	for(int i=0; i<bufsize; i++)
		buffer[i]=ref_l->to_agg()[i]->to_int();
	fwrite(buffer, sizeof(int), bufsize, ref_s->to_file());
	delete ref_l;
}

//fremove      :  P  ->  B
//The file system object with pathname P is removed from the file system.
//is a boolean indicating success or failure.
void op_fremove(JC_Stack & STACK) {
	STACK.assert_depth(1,"fremove");
	JC_objref* ref_s = STACK.pop();
	int result=unlink(ref_s->to_string().c_str());
	if(result==0) STACK.push(new JC_bool(true));
	else STACK.push(new JC_bool(false));
	delete ref_s;
}

//frename      :  P1 P2  ->  B
//The file system object with pathname P1 is renamed to P2.
//B is a boolean indicating success or failure.
void op_frename(JC_Stack & STACK) {
	STACK.assert_depth(2,"frename");
	JC_objref* ref_to = STACK.pop();
	JC_objref* ref_from = STACK.pop();
	int result=rename(
		ref_from->to_string().c_str(),
		ref_to->to_string().c_str());
	if(result==0) STACK.push(new JC_bool(true));
	else STACK.push(new JC_bool(false));
	delete ref_to; delete ref_from;
}

//fput      :  S X  ->  S
//Writes X to stream S, pops X off stack.
void op_fput(JC_Stack & STACK) {
	STACK.assert_depth(2,"fput");
	JC_objref* ref_x = STACK.pop();
	JC_objref* ref_s = STACK.back();
	fputs(ref_x->to_string().c_str(), ref_s->to_file());
	delete ref_x;
}

//fputch      :  S C  ->  S
//The character C is written to the current position of stream S.
void op_fputch(JC_Stack & STACK) {
	STACK.assert_depth(2,"fputch");
	JC_objref* ref_c = STACK.pop();
	JC_objref* ref_s = STACK.back();
	fputc(ref_c->to_char(), ref_s->to_file());
	delete ref_c;
}

//fseek      :  S P W  ->  S
//Stream S is repositioned to position P relative to whence-point W,
//where W = 0, 1, 2 for beginning, current position, end respectively.
void op_fseek(JC_Stack & STACK) {
	STACK.assert_depth(3,"fseek");
	JC_objref* ref_w = STACK.pop();
	JC_objref* ref_p = STACK.pop();
	JC_objref* ref_s = STACK.back();
	fseek(ref_s->to_file(), ref_p->to_int(), ref_w->to_int());
	delete ref_p; delete ref_w;
}

//ftell      :  S  ->  S I
//I is the current position of stream S.
void op_ftell(JC_Stack & STACK) {
	STACK.assert_depth(1,"ftell");
	JC_objref* ref_s = STACK.back();
	STACK.push(new JC_int(ftell(ref_s->to_file())));
}

// compare      :  A B  ->  I
// I (=-1,0,+1) is the comparison of aggregates A and B.
// The values correspond to the predicates <, =, >.
void op_compare(JC_Stack & STACK) {
	STACK.assert_depth(2,"compare");
	JC_objref* ref_b = STACK.pop();
	JC_objref* ref_a = STACK.pop();
	int result=0;
	for(int i=0; i<=ref_a->to_agg().size(); i++) {
		if(i==ref_b->to_agg().size()
		|| i==ref_a->to_agg().size()) { // end reached and are still equal
			if(ref_a->to_agg().size() < ref_b->to_agg().size()) result=-1;
			if(ref_a->to_agg().size() > ref_b->to_agg().size()) result=1;
			break;
		};
		if(ref_a->to_agg()[i]->to_int() < ref_b->to_agg()[i]->to_int()) result=-1;
		if(ref_a->to_agg()[i]->to_int() > ref_b->to_agg()[i]->to_int()) result=1;
		if(result!=0) break;
	}
	STACK.push(new JC_int(result));
	delete ref_a; delete ref_b;
}

//quit      :  ->
//Exit from Joy.
void op_quit(JC_Stack & STACK) {
	exit(0);
}

//abort      :  ->
//Aborts execution of current Joy program, returns to Joy main cycle.
void op_abort(JC_Stack & STACK) {
	throw runtime_error("program aborted");
}

// getenv      :  "variable"  ->  "value"
// Retrieves the value of the environment variable "variable".
void op_getenv(JC_Stack & STACK) {
	STACK.assert_depth(1,"getenv");
	JC_objref* ref_s = STACK.pop();
	STACK.push(new JC_string(getenv(ref_s->to_string().c_str())));
}

// system      :  "command"  ->
// escapes to shell, executes string "command".
// the string may cause execution of another program.
// when that has finished, the process returns to joy.
void op_system(JC_Stack & STACK) {
	STACK.assert_depth(1,"system");
	JC_objref* ref_s = STACK.pop();
	system(ref_s->to_string().c_str());
	delete ref_s;
}

// gc      :  ->
// Initiates garbage collection.
void op_gc(JC_Stack & STACK) {
		// no GC here
}

//opcase      :  X [..[X Xs]..]  ->  [Xs]
//Indexing on type of X, returns the list [Xs].
void op_opcase(JC_Stack & STACK) {
	STACK.assert_depth(2,"opcase");
	JC_objref* ref_l = STACK.pop();
	JC_objref* ref_x = STACK.pop();

	JC_objref* result=NULL;
	for(int i=0; i<ref_l->to_agg().size(); i++) {
		if(ref_l->to_agg()[i]->to_agg().size() >= 2)
		if(ref_l->to_agg()[i]->to_agg()[0]->get_type()
			== ref_x->get_type()) {
			result=new JC_objref(*ref_l->to_agg()[i]);
			result->to_agg().drop(0);
		}
	}
	if(result==NULL) {
		result=new JC_objref(*ref_l->to_agg()[ref_l->to_agg().size()-1]);
	}
	STACK.push_back(result);
	delete ref_l; delete ref_x;
}

extern int ARGC;
extern char** ARGV;
// argv      :  -> A
// Creates an aggregate A containing the interpreter's command line arguments.
void op_argv(JC_Stack & STACK) {
	JC_list* jl=new JC_list();
	for(int i=0; i<ARGC; i++) {
		jl->push_back(new JC_objref(new JC_string(ARGV[i])));
	}
	STACK.push(jl);
}

// argc      :  -> I
// Pushes the number of command line arguments. This is quivalent to 'argv size'.
void op_argc(JC_Stack & STACK) {
	STACK.push(new JC_int(ARGC));
}

// help      :  ->
// Lists all defined symbols, including those from library files.
// Then lists all primitives of raw Joy
// (There is a variant: "_help" which lists hidden symbols).
void op_help(JC_Stack & STACK) {
//	STACK.push(new JC_string(SYMTAB->get_all_names()));
	vector<string> all_names = SYMTAB->get_all_names();
	for(unsigned int i=0; i<all_names.size(); i++) {
		cout << all_names[i] << " ";
	}
	cout << endl;
}

// helpdetail      :  [ S1  S2  .. ]
// Gives brief help on each symbol S in the list.
void op_helpdetail(JC_Stack & STACK) {
	STACK.assert_depth(1,"helpdetail");
	JC_objref* ref_l = STACK.pop();
	for(int i=0; i<ref_l->to_agg().size(); i++) {
		if(ref_l->to_agg()[i]->get_type() == OPERATOR) {
			cout << SYMTAB->get_help( ref_l->to_agg()[i]->to_string() ) << endl;
		} else {
			cout << " literal type #" << ref_l->to_agg()[i]->get_type() << endl;
		}
	}
}

// manual      :  ->
// Writes this manual of all Joy primitives to output file.
void op_manual(JC_Stack & STACK) {
	vector<string> all_names = SYMTAB->get_all_names();
	for(unsigned int i=0; i<all_names.size(); i++) {
		cout << all_names[i] << "\t" << SYMTAB->get_help(all_names[i]) << endl;
	}
}

