/*
 * lithium4.cc -- Lithum4 Virtual Machine -- a monadic kind of Lisp
 *
 # Copyright (c) 2006 Henry Strickland -- <strick> in the domain <yak.net>
 #
 # Permission is hereby granted, free of charge, to any person obtaining a
 # copy of this software and associated documentation files (the "Software"),
 # to deal in the Software without restriction, including without limitation
 # the rights to use, copy, modify, merge, publish, distribute, sublicense,
 # and/or sell copies of the Software, and to permit persons to whom the
 # Software is furnished to do so, subject to the following conditions:
 #
 # The above copyright notice and this permission notice shall be included
 # in all copies or substantial portions of the Software.
 #
 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 # OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 # ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 # OTHER DEALINGS IN THE SOFTWARE.
 #
 #         (* http://www.opensource.org/licenses/mit-license.php *)
 *
 */

#include "li.h"

namespace Lithium4 {
using namespace Li;
using Li::uint;
using Li::word;



typedef class Node* node;
struct Node {
	node	n_hd;
	node	n_tl;
};


//class EvalCounter;
class Lithium4Machine : public TaggedMachine {

public:
	node	global_vars[26];	// 'a' thru 'z'

protected:
        virtual ~Lithium4Machine();
        virtual void eval_virtual( );

	void	explainRecursive(node p, string& z);

public:
        Lithium4Machine(Link<Params> p, Link<Creature> c );

	node	eval(node p);
	node	evalPair(node h, node t);
	node	evalPairHdIsNum(Number hnum, node t);
	node	evalPairHdIsSpecialChar(int c, node t);
	node	evalPairHdHdIsPartialChar(int c, node a, node t);

	vector<node>	parseForest( const char* s );
	node	parseOneTree( const char* s, uint& arrow );
	string	explain(node p);
};

node Lithium4Machine::evalPair(node h, node t)
{
	EvalCounter counterObject(this);

	if ( isNum(h) ) {
		return evalPairHdIsNum( asNum(h), t );
	} 
	
	if ( isPair(h) ) {
		node hh= hd(h);
		node th= tl(h);
		int c= isChar(hh) ? asChar(hh) : '\x00';

		// Look ahead for Partial Function.
		// character values 1 thru 9 indicate partials. 
		if ( 1<=c && c<=9 ) {
			return evalPairHdHdIsPartialChar( c, th, t );
		}

		// eval the head pair, recursively
		node f= evalPair( hd(h), tl(h) );
		return evalPair( f, t );
	}

	assert( isChar(h) );
	int c= asChar(h);

	if ( '0'<=c && c<='9' ) {
		return evalPairHdIsNum( asNum( eval(h) ), t );
	}

	if ( 'a'<=c && c<='z' ) {  // set global var
		int i= c-'a';
		assert( 0<=i && i<=25 );

		node z= eval(t);
		global_vars[i]= z;
		return z;
	}

	// it is some special char
	return evalPairHdIsSpecialChar( c, t );
}

enum PARTIALS { PARTIAL_ADD=1, PARTIAL_MUL=2, PARTIAL_K=3, PARTIAL_LAZY_K=4 };

node Lithium4Machine::evalPairHdHdIsPartialChar(int c, node a, node t)
{
  switch (c) {

    case PARTIAL_ADD: { // Partial Add
	node x= eval(t);
	Number anum= isNum(a) ? asNum(a) : 0;
	Number xnum= isNum(x) ? asNum(x) : 0;
	return numNode( anum + xnum );
    }

    case PARTIAL_MUL: { // Partial Multiply
	node x= eval(t);
	Number anum= isNum(a) ? asNum(a) : 0;
	Number xnum= isNum(x) ? asNum(x) : 0;
	return numNode( anum * xnum );
    }

    case PARTIAL_K: { // Partial Konstant Function
	eval(t);  // evaluate t, but dont use it.
	return a;		// instead use a.
    }

    case PARTIAL_LAZY_K: { // Partial Konstant Function, does not eval t
	return a;
    }
  }
  return eval(t); // identity function
}
node Lithium4Machine::evalPairHdIsSpecialChar(int c, node t)
{
  switch (c) {

    case '-': { // Negate
	node x= eval(t);
	return isNum(x) ? numNode( -asNum(x) ) : x;
    }

    case '+': { // Add
	node x= eval(t);
	return cons( charNode(PARTIAL_ADD), x );
    }

    case '*': { // Multiply
	node x= eval(t);
	return cons( charNode(PARTIAL_MUL), x );
    }

    case 'J': { // Lithium J Combinator: evals two args, returns 2nd
	eval(t);
	return charNode('I');
    }

    case 'K': { // K Combinator (Konst Function Generator)
	node x= eval(t);
	return cons( charNode(PARTIAL_K), x );
    }

    case 'U': { // Lithium U Combinator: skips first arg, evals and returns 2nd arg; i.e. lazy J
	return charNode('I');
    }

    case 'V': { // Lithium V Combinator: skips second arg, evals and returns 1st arg; i.e. lazy K
	node x= eval(t);
	return cons( charNode(PARTIAL_LAZY_K), x );
    }

    case '@': { // While Positive

	// While looping on anything but a pair is useless, so abort.
	if ( not isPair(t) ) return numNode(0);

	while (true) {
		node z= evalPair( hd(t), tl(t) );
		if ( not isNum(z) ) break;
		if ( asNum(z) <= 0 ) break;
	}
	return numNode(0);
    }

    case '?': { // If Positive
	node x= eval(t);
	return (isNum(x) && asNum(x)>0 ) ? charNode('V') : charNode('U');
    }

    case '.': { // putnum
	node x= eval(t);
	if ( isNum(x) ) putnum( asNum(x) );
	return x;

    }
	

    case 'I': { // Identity
	// break to bottom for identity
	break;
    }

  }

  // default:
  return eval(t); // identity function
}

node Lithium4Machine::evalPairHdIsNum(Number hnum, node t)
{
	// Numbers eval & increment their arg, if it is number or char.
	// but if it is a lowercase char, it is quoted, and the var is incremented.
	if ( isChar(t) ) {
		int c= asChar(t);
		if ( 'a'<=c && c<='z' ) {
			int i= c-'a';
			assert( 0<=i && i<=25 );
			node gv= global_vars[i];
			if ( isNum( gv ) ) {
				Number x= asNum( gv ) + hnum;
				node z= numNode(x);
				global_vars[i]= z;  // special side-effect
				return z;
			} else {
				// gv did not contain number; identity fn on it.
				return gv;
			}
		}
	}
	// not a global var char, so eval it.
	node x= eval(t);
	if ( isNum( x ) ) {
		Number y= asNum( x ) + hnum;
		node z= numNode(y);
		return z;
	}

	// x did not contain number; identity fn on it.
	return x;
}

node Lithium4Machine::eval(node p)
{
	if ( isNum(p) ) {
		// Numbers return themselves
		return p;
	} else if ( isPair(p) ) {
		// Pairs are evaluated with evalPair()
		return evalPair( hd(p), tl(p) );
	} 

	// Else it is a char.
	assert( isChar(p) );
	char c= asChar(p);

	if ('0'<=c && c<='9') {
		// digit chars generate constants
		int x= c-'0';
		assert( 0<=x && x<=9 );
		if (x>5) x-=10; // chars '6'..'9' => nums -4 .. -1
		assert( -4<=x && x<=5 );
		return numNode(x);
	} 
	if ('a'<=c && c<='z') {
		// lower letters are dereferenced variables
		int i= c-'a';
		assert( 0<=i && i<=25 );
		return global_vars[i];
	}
		
	// chars that are neither digits nor lower letters return themselves.
	return p;
}

node Lithium4Machine::parseOneTree( const char* s, uint& arrow )
{
	if ( not s[arrow] ) return numNode(0);

	if ( s[arrow] == '`' ) {
		++arrow;
		node h= parseOneTree( s, arrow );
		node t= parseOneTree( s, arrow );
		return cons(h,t);
	}

	int c= s[arrow];
	arrow++;
	return ( 0<c && c<NUM_CHARS ) ? charNode(c) : numNode(0);
}

vector<node> Lithium4Machine::parseForest( const char* s )
{
	vector<node> z;
	uint arrow= 0;
	while ( s[arrow] ) {
		z.push_back( parseOneTree( s, arrow ) );
	}
	return z;
}

void Lithium4Machine::explainRecursive(node p, string& z)
{
	if (isNum(p)) {
		z += string() + "{#" + ToString(asNum(p)) + "}";
	} else if (isChar(p)) {
		int c= asChar(p);
		if ( 32<=c && c<=126 && c!='{' && c!='}' && c!='`' ) {
			z.push_back( (char)c );
		} else {
			z += string() + "{" + ToString(c) + "}";
		}
	} else {
		assert( isPair(p) );
		z.push_back( '`' );
		explainRecursive( hd(p), z );
		explainRecursive( tl(p), z );
	}
}

string Lithium4Machine::explain(node p)
{
	string z;
	explainRecursive(p, z);
	return z;
}

Lithium4Machine::~Lithium4Machine() 
{
}

Lithium4Machine::Lithium4Machine( Link<Params> p, Link<Creature> c )
	: TaggedMachine(p,c) 
{
	assert(nodes);
	for (uint i=0; i<26; i++) global_vars[i]= numNode(0);
}


  void
Lithium4Machine::eval_virtual()
{
	vector<node> vec= parseForest( m_creature->sourceCode.c_str() );
	for (uint i=0; i<vec.size(); i++) {
		if (trace) {
			string src= explain(vec[i]);
			fprintf(stderr, "%d: src << %s\n", i, src.c_str() );
		}
		node x= eval( vec[i] );
		if (trace) {
			string out= explain(x);
			fprintf(stderr, "%d: out >> %s\n", i, out.c_str() );
		}
	}
}

//////////////////  Lithium4  Language  ////////////////////////////////

class Lithium4Language : public Language {

private:
        // private singleton, only used via Find()
        Lithium4Language() : Language("li") {}

        static Lithium4Language Singleton;

public:
        virtual Link<Params> defaultParams( );
        virtual Link<Machine> createMachine( Link<Params> p, Link<Creature> c );

} Lithium4Language::Singleton;


Link<Params> Lithium4Language::defaultParams( )
{
        Link<Params> p= Language::defaultParams();
        p->creatureAlphabet = "````````90125abc+-*@?.";
        p->creatureInitialLength = 128;
        return p;
}
Link<Machine> Lithium4Language::createMachine( Link<Params> p, Link<Creature> c )
{
        return new Lithium4Machine( p, c );
}

////////////////////////  TESTING  /////////////////////////////////////

static Lithium4Machine* testMach( string programString ) {

	Language* lang= Language::Find("li");
	Link<Params> params= lang->defaultParams();
	Link<Creature> prog= new Creature(programString, lang);

	return new Lithium4Machine( params, prog );
}

TEST(li_basic_nodes) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	Assert(     m->isNum( m->numNode( 0 ) ) );
	Assert(     m->isNum( m->numNode( 999 ) ) );
	Assert(     m->isNum( m->numNode( -999 ) ) );
	Assert( not m->isNum( m->charNode( 'a' ) ) );
	Assert( not m->isNum( m->cons(  m->numNode(0), m->charNode('a') ) ) );
	Assert(     m->isNum( m->hd( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	Assert( not m->isNum( m->tl( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	
	Assert( not m->isChar( m->numNode( 0 ) ) );
	Assert( not m->isChar( m->numNode( 999 ) ) );
	Assert( not m->isChar( m->numNode( -999 ) ) );
	Assert(     m->isChar( m->charNode( 'a' ) ) );
	Assert( not m->isChar( m->cons(  m->numNode(0), m->charNode('a') ) ) );
	Assert( not m->isChar( m->hd( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	Assert(     m->isChar( m->tl( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	
	Assert( not m->isPair( m->numNode( 0 ) ) );
	Assert( not m->isPair( m->numNode( 999 ) ) );
	Assert( not m->isPair( m->numNode( -999 ) ) );
	Assert( not m->isPair( m->charNode( 'a' ) ) );
	Assert(     m->isPair( m->cons(  m->numNode(0), m->charNode('a') ) ) );
	Assert( not m->isPair( m->hd( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	Assert( not m->isPair( m->tl( m->cons(  m->numNode(0), m->charNode('a') ) ) ) );
	
	AssertEq( 0,    m->asNum( m->numNode( 0 ) ) );
	AssertEq( 999,  m->asNum( m->numNode( 999 ) ) );
	AssertEq( -999, m->asNum( m->numNode( -999 ) ) );
	AssertEq( (word)'a',  m->asChar( m->charNode( 'a' ) ) );
}
		
TEST(li_just_enough_nodes) {
	Link<Lithium4Machine> m= testMach( "???" );
	bool caught= false;

	try {
		// There are NUM_NODES - NUM_CHARS nodes available.
		for (uint i=0; i<NUM_NODES-NUM_CHARS; i++) {
			m->cons( m->charNode('a'), m->charNode('b') );
		}
	} catch (Error& e) {
		caught= false;
	}
	Assert( not caught );
}

TEST(li_too_many_nodes) {
	Link<Lithium4Machine> m= testMach( "???" );
	bool caught= false;

	try {
		// There are NUM_NODES - NUM_CHARS nodes available.
		// Allocating one more should break it.
		for (uint i=0; i<NUM_NODES-NUM_CHARS+1; i++) {
			m->cons( m->charNode('a'), m->charNode('b') );
		}
	} catch (Error& e) {
		caught= true;
	}
	Assert( caught );
}


TEST(li_eval_num) {
	Link<Lithium4Machine> m= testMach( "???" );

	AssertEq( -100, m->asNum( m->eval( m->numNode( -100 ))));
	AssertEq( 0, m->asNum( m->eval( m->numNode( 0 ))));
	AssertEq( 1, m->asNum( m->eval( m->numNode( 1 ))));
	AssertEq( 100, m->asNum( m->eval( m->numNode( 100 ))));
}

TEST(li_eval_digit) {
	Link<Lithium4Machine> m= testMach( "???" );

	AssertEq( -4, m->asNum( m->eval( m->charNode( '6' ))));
	AssertEq( -1, m->asNum( m->eval( m->charNode( '9' ))));
	AssertEq( 0, m->asNum( m->eval( m->charNode( '0' ))));
	AssertEq( 1, m->asNum( m->eval( m->charNode( '1' ))));
	AssertEq( 5, m->asNum( m->eval( m->charNode( '5' ))));
}

TEST(li_eval_var) {
	Link<Lithium4Machine> m= testMach( "???" );
	m->global_vars[0]= m->charNode('?'); //a
	m->global_vars[1]= m->charNode('*'); //b
	m->global_vars[25]= m->numNode(99); //z

	AssertEq( (word)'?', m->asChar( m->eval( m->charNode( 'a' ))));
	AssertEq( (word)'*', m->asChar( m->eval( m->charNode( 'b' ))));
	AssertEq( 99, m->asNum( m->eval( m->charNode( 'z' ))));

	AssertEq( 0, m->asNum( m->eval( m->charNode( 'q' ))));  // slots default to 0
}

TEST(li_eval_pair_setvar) {
	Link<Lithium4Machine> m= testMach( "???" );

	m->evalPair( m->charNode('x'), m->charNode('3') );  // set x to 3
	AssertEq( m->numNode(3), m->global_vars[23] );	// should be 3
	AssertEq( m->numNode(3), m->eval( m->charNode('x') ) );

	m->evalPair( m->charNode('8'), m->charNode('x') );  // decr x by 2
	AssertEq( m->numNode(1), m->eval( m->charNode('x') ) );  // should now be 1
}

TEST(li_eval_add) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node add_3 = m->cons( m->charNode('+'), m->charNode('3') );
	node add_3_5 = m->cons( add_3, m->charNode('5') );

	node z= m->eval( add_3_5 );
	AssertEq( m->numNode(8), z );
}

TEST(li_eval_mul) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node mul_3 = m->cons( m->charNode('*'), m->charNode('3') );
	node mul_3_5 = m->cons( mul_3, m->charNode('5') );

	node z= m->eval( mul_3_5 );
	AssertEq( m->numNode(15), z );
}

TEST(li_eval_K) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node k_3 = m->cons( m->charNode('K'), m->charNode('3') );
	node k_3_5 = m->cons( k_3, m->charNode('5') );

	node z= m->eval( k_3_5 );
	AssertEq( m->numNode(3), z );
}

TEST(li_eval_I) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node i_3 = m->cons( m->charNode('I'), m->charNode('3') );
	node i_3_5 = m->cons( i_3, m->charNode('5') );

	node z= m->eval( i_3_5 );
	AssertEq( m->numNode(8), z );
}

TEST(li_eval_if_true) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node if_2 = m->cons( m->charNode('?'), m->charNode('2') );
	node if_2_3 = m->cons( if_2, m->charNode('3') );
	node if_2_3_5 = m->cons( if_2_3, m->charNode('5') );

	node z= m->eval( if_2_3_5 );
	AssertEq( m->numNode(3), z );
}

TEST(li_eval_if_false) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	node if_0 = m->cons( m->charNode('?'), m->charNode('0') );
	node if_0_3 = m->cons( if_0, m->charNode('3') );
	node if_0_3_5 = m->cons( if_0_3, m->charNode('5') );

	node z= m->eval( if_0_3_5 );
	AssertEq( m->numNode(5), z );
}

TEST(li_explain) {
	Link<Lithium4Machine> m= testMach( "???" );
	
	const char* code = "`+3";
	uint arrow= 0;
	node x= m->parseOneTree( code, arrow );
	string decode = m->explain( m->eval(x) );
	AssertStrEq( "`{1}{#3}", decode.c_str() );
}

} //Li
//END