// grenuoille.cpp
// 

#include <stdexcept>
#include <iostream>
#include <string>
#include <sstream>
#include <map>
#include <deque>
#include <list>
#include <deque>
#include <vector>
#include <fstream>
#include <iterator>
#include <cstdlib>

//#include "memCheck.h"

using namespace std;

// TODO: typechecking, ariety, cond, load, contexts 

// ast ---------------------------------------------------------------------- //
class Sexpr;
typedef double Real;
typedef Sexpr* (*funcptr) (Sexpr* args, Sexpr* env);

enum SexprType {
	NUMBER,
	SYMBOL,
	CONS,
	PROCEDURE,
	LAMBDA
};

class MemoryManager {
public:
	virtual ~MemoryManager (); // lazy implementation

    static MemoryManager* instance () {
		static MemoryManager instance;
        return &instance;
    }
	void attach (Sexpr* s) { 
		++m_alloc;
		m_collection.push_front (s);
	}

	void collect (Sexpr* root) {
		mark (root);
		sweep ();
	}
	void mark (Sexpr* p); // lazy implementation
private:
	void sweep (); // lazy implementation
	
    MemoryManager () { m_alloc = 0; }
    MemoryManager (MemoryManager const&);
    void operator= (MemoryManager const&);
	std::deque<Sexpr*> m_collection;
	long m_alloc;
};

struct Sexpr {
protected:
	Sexpr ()  { 
		type = CONS;
		val = 0;
		//lexeme = "";
		car = cdr = 0;
		action = 0;
		mark = false; 
		MemoryManager::instance ()->attach (this); 

	}
public:
	virtual ~Sexpr () {}
	
	SexprType type;
	Real val;
	std::string lexeme;	
	Sexpr* car;
	Sexpr* cdr;
	funcptr action;
	
	bool mark;
};

struct Number : public Sexpr { Number (Real v) { type = NUMBER; val = v; } };
struct Symbol : public Sexpr { 
private:
	Symbol (const std::string& lex) { 
		type = SYMBOL; lexeme = lex; 
	} 
public:
	static Symbol* make (const std::string& lex) {
		static std::map<std::string, Symbol*> symbols;
		std::map<std::string, Symbol*>::iterator it = symbols.find (lex);
		if (it == symbols.end ()) {
			Symbol* s = new Symbol (lex);
			symbols[lex] = s;
			return s;
		}
		return it->second;		
	}
};

Symbol* nil = Symbol::make ("nil");
Symbol* true_s = Symbol::make ("#t");
Symbol* false_s = Symbol::make ("#f");
Symbol* quote = Symbol::make ("quote");
Symbol* if_s = Symbol::make ("if");
Symbol* lambda = Symbol::make ("lambda");
Symbol* define = Symbol::make ("define");
Symbol* set_s = Symbol::make ("set!");
Symbol* begin_s = Symbol::make ("begin");

struct Cons : public Sexpr { 
	Cons (Sexpr* car, Sexpr* cdr) { 
		type = CONS; Sexpr::car = car; Sexpr::cdr = cdr;
	 }
};

Sexpr* cons (Sexpr* car, Sexpr* cdr) {
	return new Cons (car, cdr);
}

struct Procedure : public Sexpr { 
	Procedure (funcptr action, const std::string& lex) { 
		type = PROCEDURE; Sexpr::action = action; lexeme = lex; 
	} 
};

struct Lambda : public Sexpr { 
	Lambda (Sexpr* body, Sexpr* args, Sexpr* env) { 
		type = LAMBDA;
		car = env;
		cdr = cons (body, args);
	} 
};

#define car(x)(x->car)
#define cdr(x)(x->cdr)
#define setcar(x,y)(x->car = y)
#define setcdr(x,y)(x->cdr = y)
#define isnil(x)(x == 0 || x == nil)

void MemoryManager::mark (Sexpr* p) {
	if (!p) return;
	if (p->mark == false) {
		p->mark = true;
		mark (car (p));
        mark (cdr (p)); 	
	}
}

void display (Sexpr* node, std::ostream& out);
void MemoryManager::sweep () {
	std::deque<Sexpr*>::iterator it = m_collection.begin ();
	
	while (it != m_collection.end ()) {
		Sexpr* elem = *it;		
		if (elem->mark == true) {
			elem->mark = false;
			++it;
		} else {
			--m_alloc;
			// cout << "delete " << elem << " "  << endl;
			delete elem;
			it = m_collection.erase (it);
		}
	}
}

MemoryManager::~MemoryManager () {
	sweep ();
 }

// lexing ------------------------------------------------------------------- //
void replace (std::string &s, std::string from, std::string to) {
    int idx = 0;
    int next;
    while ((next = s.find (from, idx)) != std::string::npos) {
        s.replace (next, from.size (), to);
        idx = next + to.size ();
    } 
}

std::deque<std::string>& tokenize (std::string& s, std::deque<std::string>& result) {
    replace (s, "(", " ( ");
    replace (s, ")", " ) ");
    replace (s, "'", " ' ");
    std::istringstream iss (s);
    result.insert (result.end (), std::istream_iterator<std::string> (iss),
		std::istream_iterator<std::string> ());
    return result;
}

template <typename T>
bool isNumber (const char* s) {
	std::istringstream iss (s);
	T dummy;
	iss >> std::noskipws >> dummy;
	return iss && iss.eof ();
}

// parsing ------------------------------------------------------------------ //
Sexpr* read_cons (std::deque<std::string>& tokens);
Sexpr* read_atom (std::deque<std::string>& tokens) {
  	std::string token = tokens.front ();
  	tokens.pop_front ();
    if (token == "(") return read_cons (tokens);
	else if (token == "'") {
		return cons (quote, cons (read_atom (tokens), nil));
	} else if (isNumber<Real> (token.c_str ())) {
		return new Number (atof (token.c_str ()));
	} else {
		return Symbol::make (token);
	}
}

Sexpr* read_cons (std::deque<std::string>& tokens) {
	if (!tokens.size ()) throw runtime_error ("syntax error");
	std::string token = tokens.front ();
	tokens.pop_front ();

    if (token == ")") return nil;	
	tokens.push_front (token);
  	Sexpr* tmp = read_atom (tokens);
    return cons (tmp, read_cons (tokens));
}

// evaluation --------------------------------------------------------------- //
void display (Sexpr* node, std::ostream& out) {
	if (isnil (node)) { out << "()"; return; }
	if (node->type == CONS) {
		out << "(";
        for (;;) {
            display (car (node), out);
            if (isnil (cdr (node))) {
				out << ")";
                break;
            }
            node = cdr (node);
            if (node->type != CONS) {
                out << " . ";
                display (node, out);
				out << ")";
                break;
            }
			out << " ";
        }
	} else if (node->type == NUMBER) {
		out << node->val;
	} else if (node->type == SYMBOL) {
		out << node->lexeme;		
	} else if (node->type == PROCEDURE) {
		out << "<Procedure " << node->lexeme << ">";		
	} else if (node->type == LAMBDA) {
		std::stringstream body;
		std::stringstream args;
	
		display (cdr(cdr(node)), args);
		display (car(cdr(node)), body);
				
		out << "<Lambda " << args.str () << " " << body.str () << ">";		
	}
}

Sexpr* assoc (Sexpr* env, Sexpr* symbol) {
tail_call:
	Sexpr* parent = car (env);
	Sexpr* bs = cdr (env);

	while (!isnil (bs)) {
		Sexpr* b = car (bs);
		if (car (b) == symbol) {

			return b;
		}
		bs = cdr (bs);
	}

	if (isnil (parent))	return nil;
	// return assoc (parent, symbol);
	env = parent;
	goto tail_call;
}

Sexpr* extend (Sexpr* env, Sexpr* symbol, Sexpr* value) {
	Sexpr* bs = cdr (env);
	Sexpr* b = assoc (env, symbol);
	if (b != nil) setcdr (b, value);
	else {
		b = cons (symbol, value);
		setcdr (env, cons (b, cdr (env)));		
	}

	return value;
}

Sexpr* null_env = cons (nil, nil);

////////////////////////////////////////////////////////////////////////////////

Sexpr* evlis (Sexpr* alist, Sexpr* env);
Sexpr* eval (Sexpr* node, Sexpr* env) { 
	static int stack_counter = 0;
tail_call:			
	if (isnil (node)) return nil;

   	switch (node->type) {
	    case PROCEDURE: return node;
	    case LAMBDA: return node;		
	    case NUMBER: return node;
	    case SYMBOL: {
			Sexpr* s = assoc (env, node);
			
			if (s == nil) {
				stringstream msg;
				msg << "unbound symbol " << node->lexeme;
				throw runtime_error (msg.str ());
			}
			return cdr (s); 
		}
	    case CONS: {
			if (car (node) == quote) {
				return car (cdr (node));
			} else if (car (node) == if_s) {
				if (eval (car (cdr (node)), env) != false_s) {
					node = car (cdr (cdr (node)));
				} else {
					Sexpr* b = cdr (cdr (cdr (node)));
					
					if (b) node =  car (b);
					else node = false_s;
				}
				goto tail_call;
			} else if (car (node) == lambda) {
				Sexpr* body = car (cdr (cdr (node)));
				Sexpr* args = (car (cdr (node)));
				return new Lambda (body, args, env);
			} else if (car (node) == begin_s) {
	            node = cdr (node);
	            if (isnil (node)) return nil;
	            for (;;) {
	                if (isnil (cdr (node))) {
	                    node = car (node);							
		
	                    goto tail_call;
	                }
	                eval (car (node), env);
	                node = cdr (node);		
																				
	            }
	        } else if (car (node) == define) {
				Sexpr* key = car (cdr (node));
				Sexpr* val = eval (car (cdr (cdr (node))), env);
				return extend (env, key, val);
			} else if (car (node) == set_s) {
				Sexpr* s = assoc (env, car (cdr (node)));
			
				if (s == nil) {
					stringstream msg;
					msg << "unbound symbol " << node->lexeme;
					throw runtime_error (msg.str ());
				}
				Sexpr* val = eval (car (cdr (cdr (node))), env);
				setcdr (s, val);
				return val; 
			}			

			#ifdef GARBAGE_COLLECTION
				if (stack_counter == 0) {
				  	MemoryManager::instance ()->mark (null_env);
				  	MemoryManager::instance ()->mark (env);
				  	MemoryManager::instance ()->collect (node);	 	
				}			
			#endif	

			Sexpr* fun = eval (car (node), env);	
			++stack_counter;
			Sexpr* params = evlis (cdr (node), env);
			--stack_counter;
			
			if (fun->type == PROCEDURE) {
				return fun->action (params, env); 
			}
			if (fun->type == LAMBDA) {				
				// static scope = use car (fun) 
				// dynamic scope = use env 
				Sexpr* nenv = cons (car (fun), nil);
				Sexpr* a = cdr (cdr(fun));
				Sexpr* p = params;
				while (!isnil (a)) {
					 extend (nenv, car (a), car (p));
					 a = cdr (a);
					 p = cdr (p);
				}
				//return eval (fun->body, nenv);
				node = car(cdr(fun));
				env = nenv;
				goto tail_call;
			}
		
			throw runtime_error ("function expected");
		}
		
    }

	// not reached
	return node;
}

Sexpr* evlis (Sexpr* alist, Sexpr* env) {
	if (isnil (alist)) return alist  ;
	return cons (eval (car (alist), env), evlis (cdr (alist), env));
}

Sexpr* fn_cons (Sexpr* params, Sexpr* env) {
	return cons (car (params), car (cdr (params)));
}

Sexpr* fn_car (Sexpr* params, Sexpr* env) {
	return car (car (params));
}

Sexpr* fn_cdr (Sexpr* params, Sexpr* env) {
	return cdr (car (params));
}

Sexpr* fn_eq (Sexpr* params, Sexpr* env) {
	return (car (params) == car (cdr (params))) ? true_s : false_s;
}

Sexpr* fn_add (Sexpr* params, Sexpr* env) {
	Real r = 0;
	Sexpr* c = params;
	while (!isnil (c)) {
		r += car (c)->val;
		c = cdr (c);
	}
	return new Number (r);
}

Sexpr* fn_sub (Sexpr* params, Sexpr* env) {
	Real r = car (params)->val;
	Sexpr* c = cdr (params);
	while (!isnil (c)) {
		r -= car (c)->val;
		c = cdr (c);
	}
	return new Number (r);
}

Sexpr* fn_mul (Sexpr* params, Sexpr* env) {
	Real r = 1;
	Sexpr* c = params;
	while (!isnil (c)) {
		r *= car (c)->val;
		c = cdr (c);
	}
	return new Number (r);
}

Sexpr* fn_div (Sexpr* params, Sexpr* env) {
	Real r = car (params)->val;
	Sexpr* c = cdr (params);
	while (!isnil (c)) {
		r /= car (c)->val;
		c = cdr (c);
	}
	return new Number (r);
}

Sexpr* fn_same_value (Sexpr* params, Sexpr* env) {
	Real r = car (params)->val;
	bool equal = true;
	Sexpr* c = cdr (params);
	while (!isnil (c)) {
		equal = (r == car (c)->val);
		r = car (c)->val;
		c = cdr (c);
	}
	return equal ? true_s : false_s;
}

Sexpr* fn_env (Sexpr* params, Sexpr* env) {
	return env;
}

Sexpr* fn_display (Sexpr* params, Sexpr* env) {
	display (car (params), cout); cout << endl;
	return car (params);
}


int main (int arcollect, char* argv[]) {
	try {							
		extend (null_env, define, define);
		extend (null_env, quote, quote);
		extend (null_env, if_s, if_s);
		extend (null_env, lambda, lambda);
		extend (null_env, begin_s, begin_s);

		
		Sexpr* env = cons (nil, nil);
		
		
		extend (env, nil, nil);				
		extend (env, true_s, true_s);
		extend (env, false_s, false_s);
			
		extend (env, Symbol::make ("cons"), new Procedure (fn_cons, "cons"));
		extend (env, Symbol::make ("car"), new Procedure (fn_car, "car"));
		extend (env, Symbol::make ("cdr"), new Procedure (fn_cdr, "cdr"));
		extend (env, Symbol::make ("eq?"), new Procedure (fn_eq, "eq?"));
		
		extend (env, Symbol::make ("+"), new Procedure (fn_add, "+"));
		extend (env, Symbol::make ("-"), new Procedure (fn_sub, "-"));
		extend (env, Symbol::make ("*"), new Procedure (fn_mul, "*"));
		extend (env, Symbol::make ("/"), new Procedure (fn_div, "/"));
		
		extend (env, Symbol::make ("="), new Procedure (fn_same_value, "="));

		extend (env, Symbol::make ("interaction-environment"), new Procedure (fn_env, "interaction-environment"));
		extend (env, Symbol::make ("display"), new Procedure (fn_display, "display"));

		Sexpr* e = nil;
#ifdef TEST
		string line = "(define fib (lambda (n)(if (= n 0) 0 (if (= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))))";
		deque<string> tokens;
		Sexpr* r = read_atom (tokenize (line, tokens));

		e = eval (r, env);
			
		line = "(fib 30)";
		r = read_atom (tokenize (line, tokens));
		clock_t tic = clock ();
		e = eval (r, env);
		clock_t toc = clock ();
		cout << "performance: "<<  ((double) toc - tic) / CLOCKS_PER_SEC << " sec." << endl;

		cout << "result: "; display (e, cout); cout << endl;
		cout << "press return..."; getchar ();

#else
		while (true) {
			try {
				cout << ">> ";
				string line;
				getline (cin, line);
				if (!line.size ()) continue;
				deque<string> tokens;
				Sexpr* r = read_atom (tokenize (line, tokens));

				e = eval (r,  env);
				display (e, cout);	cout << endl;
			
				if (tokens.size ()) cout << "warning: " << tokens.size () << " unparsed element(s)" << endl;
			} catch (runtime_error& e) {
				cout << "error: " << e.what () << endl;
			}
		}
#endif
	}
	catch (exception& e) {
		cout << "Error: " << e.what () << endl;
	}
	catch (...) {
		cout << "Fatal error: unknown exception" << endl;
	}
	return 0;
}

// EOF