/*
 * perl.cc -- EvoPerl Virtual Machine -- a typical Statment/Expression/Variable-grammar langauge
 *
 # 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 EvoPerl {
using namespace Li;
using Li::uint;


int ABORT() 
{
	Assert(false);
	return 0;
}

enum KIND { NONE_KIND=0, VAR_KIND='V', EXPR_KIND='E', STMT_KIND='S' };

KIND whatKindOfChar(char c) {
	return 
		'0' <= c && c <= '9' ? VAR_KIND :
		'a' <= c && c <= 'z' ? EXPR_KIND :
		'A' <= c && c <= 'Z' ? STMT_KIND : NONE_KIND;
}

class EvoPerlMachine;
typedef struct PNode* pnode;

typedef Number (EvoPerlMachine::*EVALUATOR)(pnode);

struct Valence {
	char	which;
	char*	needs;
	char*	printable;
	EVALUATOR  evaluator;

	uint whichIndex() {
		uint i= this->which;
		assert( i<NUM_CHARS );
		return i;
	}
};
extern Valence Valences[];

Valence*  LookupValence[NUM_CHARS];

struct ValenceInit {
  ValenceInit() {
	for (Valence* vp= &Valences[0]; vp->which; vp++) {
		int i= vp->whichIndex();
		LookupValence[i] = vp;
	}
  }
} ValenceInitObject;

struct PNode {

#define	MAX_KIDS  3

	char	which;
	KIND	kind;
	pnode	nextTree;
	pnode	kids[MAX_KIDS];

	PNode(char _which) 
	  : which( _which )
	  , kind( whatKindOfChar(_which) ) 
	  , nextTree( 0 )
	{ memset( kids, 0, sizeof kids ); }

	PNode() : which(0), kind(NONE_KIND) , nextTree(0)
	{ memset( kids, 0, sizeof kids ); }

	uint whichIndex() {
		uint i= this->which;
		assert( i<NUM_CHARS );
		return i;
	}
};


class EvoPerlMachine : public Machine {

	string		source;
	vector<PNode>	compiled;
	pnode		firstTree;

public:
	Number		global_vars[16];	// char 48 '0' thru char 63 '?'

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

	void	buildNodeVector();
	void	compileForest();
	void	compile(uint& arrow, int depth);
	char	syntheticChar(KIND k);
	bool	skipToNextNodeOfKind(KIND k, uint& arrow, bool makeSynthetic);

public:
        EvoPerlMachine(Link<Params> p, Link<Creature> c );
	virtual string readableCode();

	string explain(pnode p);

	pnode	peekFirstTree() { return firstTree; }

	// Evaluators:
	Number evaluator_Var(pnode p);

	Number evaluator_Expr0(pnode p);
	Number evaluator_Expr1(pnode p);
	Number evaluator_Expr2(pnode p);
	Number evaluator_Expr5(pnode p);
	Number evaluator_ExprPlus(pnode p);
	Number evaluator_ExprMinus(pnode p);
	Number evaluator_ExprTimes(pnode p);
	Number evaluator_ExprVar(pnode p);

	Number evaluator_Stmt0(pnode p);
	Number evaluator_StmtAssign(pnode p);
	Number evaluator_StmtPair(pnode p);
	Number evaluator_StmtPairBackwards(pnode p);
	Number evaluator_StmtWhile(pnode p);
	Number evaluator_StmtWhilePair(pnode p);
	Number evaluator_StmtLoop(pnode p);
	Number evaluator_StmtIf(pnode p);
	Number evaluator_StmtIncr(pnode p);
	Number evaluator_StmtDecr(pnode p);
	Number evaluator_StmtIncrBy(pnode p);
	Number evaluator_StmtDecrBy(pnode p);
	Number evaluator_StmtPrint(pnode p);

	Number evalNode(pnode p);
	Number evalKid(pnode p, int k) {
		pnode kid= p->kids[k];
		assert( kid );
		return evalNode(kid);
	}

};


Number EvoPerlMachine::evaluator_Var(pnode p) { return global_vars[ p->which-'0' ]; }

Number EvoPerlMachine::evaluator_Expr0(pnode p) { return 0; }
Number EvoPerlMachine::evaluator_Expr1(pnode p) { return 1; }
Number EvoPerlMachine::evaluator_Expr2(pnode p) { return 2; }
Number EvoPerlMachine::evaluator_Expr5(pnode p) { return 5; }
Number EvoPerlMachine::evaluator_ExprPlus(pnode p) { 
	Number a= evalKid(p, 0);
	Number b= evalKid(p, 1);
	return a+b;
}
Number EvoPerlMachine::evaluator_ExprMinus(pnode p) {
	Number a= evalKid(p, 0);
	Number b= evalKid(p, 1);
	return a-b;
}
Number EvoPerlMachine::evaluator_ExprTimes(pnode p) {
	Number a= evalKid(p, 0);
	Number b= evalKid(p, 1);
	return a*b;
}
Number EvoPerlMachine::evaluator_ExprVar(pnode p) {
	Number a= evalKid(p, 0);
	return a;
}

Number EvoPerlMachine::evaluator_Stmt0(pnode p) {
	return 0;
}
Number EvoPerlMachine::evaluator_StmtAssign(pnode p) {
	pnode var= p->kids[0];
	Number b= evalKid(p, 1);
	global_vars[ var->which-'0' ] = b;
	return b;
}
Number EvoPerlMachine::evaluator_StmtPair(pnode p) {
	evalKid(p, 0);
	Number b= evalKid(p, 1);
	return b;
}
Number EvoPerlMachine::evaluator_StmtPairBackwards(pnode p) {
	evalKid(p, 1);
	Number b= evalKid(p, 0);
	return b;
}
Number EvoPerlMachine::evaluator_StmtWhile(pnode p) {
	Number b= 0;
	Number a= evalKid(p, 0);
	while (a) {
		b= evalKid(p, 1);
		a= evalKid(p, 0);
	}
	return b;
}
Number EvoPerlMachine::evaluator_StmtWhilePair(pnode p) {
	Number b= 0;
	Number c= 0;
	Number a= evalKid(p, 0);
	while (a) {
		b= evalKid(p, 1);
		c= evalKid(p, 2);
		a= evalKid(p, 0);
	}
	return c;
}
Number EvoPerlMachine::evaluator_StmtLoop(pnode p) {
	pnode var= p->kids[0];

	while ( --global_vars[ var->which-'0' ] > 0 ) {
		evalKid(p, 1);
	}
	return 0;
}
Number EvoPerlMachine::evaluator_StmtIf(pnode p) {
	Number a= evalKid(p, 0);
	if (a) {
		a= evalKid(p, 1);
	} else {
		a= evalKid(p, 2);
	}
	return a;
}
Number EvoPerlMachine::evaluator_StmtIncr(pnode p) {
	pnode var= p->kids[0];
	Number z= ++ global_vars[ var->which-'0' ];
	return z;
}
Number EvoPerlMachine::evaluator_StmtDecr(pnode p) {
	pnode var= p->kids[0];
	Number z= -- global_vars[ var->which-'0' ];
	return z;
}
Number EvoPerlMachine::evaluator_StmtIncrBy(pnode p) {
	Number b= evalKid(p, 1);
	pnode var= p->kids[0];
	global_vars[ var->which-'0' ] += b;
	Number c= evalKid(p, 2);
	return c;
}
Number EvoPerlMachine::evaluator_StmtDecrBy(pnode p) {
	Number b= evalKid(p, 1);
	pnode var= p->kids[0];
	global_vars[ var->which-'0' ] -= b;
	Number c= evalKid(p, 2);
	return c;
}
Number EvoPerlMachine::evaluator_StmtPrint(pnode p) {
	Number a= evalKid(p, 0);
	this->putnum(a);
	return a;
}

static EvoPerlMachine* testMach( string programString ) {

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

	return new EvoPerlMachine( params, prog );
}
TEST(Add1and2)
{
	// Assign $a := Expr 1 + 2
	EvoPerlMachine* m= testMach( "V0pod" );
	Number x= m->evalNode( m->peekFirstTree() );
	AssertEq( 3, x );
}
TEST(Add1and2WithNoise)
{
	// Assign $a := Expr 1 + 2 // Same as above, but with extra chars thrown in, where they dont matter
	EvoPerlMachine* m= testMach( "000111222ppptttVZZZzzz0ZZZ222p111o111d111" );
	//EvoPerlMachine* m= testMach( "ppptttVZZZzzz0ZZZ222p111o111d111" );
	Number x= m->evalNode( m->peekFirstTree() );
	AssertEq( 3, x );
}
TEST(Mul5Times2)
{
	// Assign $a := Expr 5 * 2
	EvoPerlMachine* m= testMach( "V0tfd" );
	Number x= m->evalNode( m->peekFirstTree() );
	AssertEq( 10, x );
}
TEST(Sub5From2UsingVars)
{
	// Assign $a := 2; Assign $b := 5;  Assign $c := $a-$b
	EvoPerlMachine* m= testMach( "PP V0d V1f V2mv0v1" );
	Number x= m->evalNode( m->peekFirstTree() );
	AssertEq( -3, x );
}

Valence Valences[] = {
	{ '0',	"", "$a",	& EvoPerlMachine::evaluator_Var },
	{ '1',	"", "$b",	& EvoPerlMachine::evaluator_Var },
	{ '2',	"", "$c",	& EvoPerlMachine::evaluator_Var },
	{ '3',	"", "$d",	& EvoPerlMachine::evaluator_Var },
	{ '4',	"", "$e",	& EvoPerlMachine::evaluator_Var },
	{ '5',	"", "$e",	& EvoPerlMachine::evaluator_Var },
	{ '6',	"", "$e",	& EvoPerlMachine::evaluator_Var },
	{ '7',	"", "$e",	& EvoPerlMachine::evaluator_Var },
	{ '8',	"", "$e",	& EvoPerlMachine::evaluator_Var },
	{ '9',	"", "$e",	& EvoPerlMachine::evaluator_Var },
    // Expressions
	{ 'z',	"", "0",	& EvoPerlMachine::evaluator_Expr0 },
	{ 'o',	"", "1",	& EvoPerlMachine::evaluator_Expr1 },
	{ 'd',	"", "2",	& EvoPerlMachine::evaluator_Expr2 },
	{ 'f',	"", "5",	& EvoPerlMachine::evaluator_Expr5 },
	{ 'p',	"EE", "(\1 + \2)",	& EvoPerlMachine::evaluator_ExprPlus },
	{ 'm',	"EE", "(\1 - \2)",	& EvoPerlMachine::evaluator_ExprMinus },
	{ 't',	"EE", "(\1 * \2)",	& EvoPerlMachine::evaluator_ExprTimes },
	{ 'v',	"V", "\1",		& EvoPerlMachine::evaluator_ExprVar },
    // Statements
	{ 'Z',	"", "00; ",		& EvoPerlMachine::evaluator_Stmt0 },
	{ 'V',	"VE", "\1 = (\2); ",		& EvoPerlMachine::evaluator_StmtAssign },
	{ 'P',	"SS", "{ \1 ;; \2 }; ",		& EvoPerlMachine::evaluator_StmtPair },
	{ 'Q',	"SS", "{ \2 ;; \1 }; ",		& EvoPerlMachine::evaluator_StmtPairBackwards },
	{ 'W',	"ES", "while (\1) { \2 }",		& EvoPerlMachine::evaluator_StmtWhile },
	{ 'B',	"ESS", "while (\1) { \2 ;; \3 }",		& EvoPerlMachine::evaluator_StmtWhilePair },
	{ 'I',	"ESS", "if (\1) { \2 } else { \3 }; ",		& EvoPerlMachine::evaluator_StmtIf },
	{ 'M',	"V", "++ \1; ",		& EvoPerlMachine::evaluator_StmtIncr },
	{ 'L',	"V", "-- \1; ",		& EvoPerlMachine::evaluator_StmtDecr },
	{ 'A',	"VES", "\1 += (\2); \3 ",		& EvoPerlMachine::evaluator_StmtIncrBy },
	{ 'S',	"VES", "\1 -= (\2); \3 ",		& EvoPerlMachine::evaluator_StmtDecrBy },
	{ 'N',	"E", "printf \"%d \", (\1); ",		& EvoPerlMachine::evaluator_StmtPrint },
	{ 'X',	"VS", "while (--\1>0) {\2}",	& EvoPerlMachine::evaluator_StmtLoop },
    // End
	{ 0, NULL, NULL }
};


Number EvoPerlMachine::evalNode(pnode p) {
		EvalCounter counterObject(this);

		int c= p->which;
		assert( 32<=c && c<=127 );

		Valence* vp= LookupValence[c];
		assert( vp );

		EVALUATOR method= vp->evaluator;
		assert( method );

		Number z= ( this ->* method )(p);
		return z;
}

EvoPerlMachine::~EvoPerlMachine() 
{
}

string EvoPerlMachine::explain(pnode p)
{
	uint c= p->whichIndex();
	Valence *vp= LookupValence[c];

	string z= vp->printable;
	for (uint k=0; vp->needs[k]; k++) {
		string r= explain( p->kids[k] );
		z= ReplaceCharWithString( z, k+1, r );
	}
	return z;
}


void EvoPerlMachine::buildNodeVector()
{
	uint n= source.size();
	for (uint i=0; i<n; i++) {
		compiled.push_back( PNode(source.at(i)) ); 
	}
}

// return char for a simple pnode of the KIND that does not need other nodes
char EvoPerlMachine::syntheticChar(KIND k) 
{
	return k==VAR_KIND ? '0' : k==EXPR_KIND ? 'z' : k==STMT_KIND ? 'Z' : (char)ABORT();
}

bool EvoPerlMachine::skipToNextNodeOfKind(KIND k, uint& arrow, bool makeSynthetic)
{

	uint n= source.size();
	uint cn= compiled.size();

	while ( arrow<n ) {
		assert( arrow < cn );
		pnode p= & compiled[arrow];
		if ( p->kind == k ) return true;
		++arrow;
	}

	if ( not makeSynthetic ) return false;

	// we will have to make a synthetic pnode on the end.
	compiled.push_back( PNode( syntheticChar(k) ) ); 
	arrow= compiled.size()-1;

	return true;
}


void EvoPerlMachine::compile(uint& arrow, int depth)
{
	uint n= source.size();
	uint cn= compiled.size();
	pnode p= &compiled[arrow];
	uint c= p->whichIndex();

	assert( 48 <= c && c < 128 );
	Valence* vp= LookupValence[ c ];
	assert( vp );

if(0)fprintf(stderr, "n %d cn %d dep %d arrow=%d c `%c' which `%c' needs \"%s\" printable {%s}\n",
                n, cn,     depth,  arrow,     c,    vp->which,  vp->needs, vp->printable );

	++arrow;

	if ( arrow > n ) {
		// it's synthetic
if(0)fprintf(stderr, "SYNTHETIC dep=%d arrow=%d c `%c'\n",
                           depth,  arrow,     c );

		assert( not vp->needs[0] );

	} else {
		// it's real
		for (uint k=0; vp->needs[k]; k++) {
			assert( k < MAX_KIDS );
			skipToNextNodeOfKind( (KIND)vp->needs[k], arrow, true );
if(0)fprintf(stderr, "find k %d needs \"%s\" kind `%c' --> [%d]\n",
                        k,  vp->needs,   vp->needs[k],  arrow );
			p->kids[k]= &compiled[arrow];
			compile(arrow, depth+1);
		}
	}
}
void EvoPerlMachine::compileForest()
{
	uint n= source.size();


	for (uint j=0; j<n; j++) {
		compiled.push_back( PNode(source.at(j)) );
	}

	uint arrow= 0; // <--- will be referenced by compile(int&) et al

	// Handle a forest at the top level
	pnode currentTree= 0;
	while (arrow<n) {
		bool found= skipToNextNodeOfKind( (KIND)'S', arrow, false );
		if (not found) break;

		if (firstTree) {
			currentTree->nextTree= &compiled[arrow];
			currentTree= &compiled[arrow];
		} else {
			firstTree= &compiled[arrow];
			currentTree= &compiled[arrow];
		}
if(0)fprintf(stderr, "\nTREE First %d current %d\n\n",
			firstTree - &compiled[0],
			currentTree - &compiled[0]   
			);

		compile(arrow, 0);
if(0)fprintf(stderr, "\nCOMPILED.\n\n");
	}

	for (pnode p= firstTree; p; p= p->nextTree) {
		string z= explain(p);
if(0)fprintf(stderr, "\nEXPLAIN: {{{  %s  }}}\n", z.c_str() );
	}

}

EvoPerlMachine::EvoPerlMachine( Link<Params> p, Link<Creature> c )
	: Machine(p,c) 
	, firstTree(0)
{
	memset( global_vars, 0, sizeof global_vars );
	source= m_creature->sourceCode;
	compiled.reserve( source.size() * 2 + 100 ); ///////////// TODO quit using pointers in compiled!!!!!

	compileForest();
}


  void
EvoPerlMachine::eval_virtual()
{
	for (pnode p= firstTree; p; p= p->nextTree) {
		evalNode(p);
	}
}

string EvoPerlMachine::readableCode()
{
	string z;
	for (pnode p= firstTree; p; p= p->nextTree) {
		z += explain(p);
		z += ";;;";
	}
	return z;
}

//////////////////  EvoPerl  Language  ////////////////////////////////

class EvoPerlLanguage : public Language {

private:
        // private singleton, only used via Find()
        EvoPerlLanguage() : Language("pl") {}

        static EvoPerlLanguage Singleton;

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

} EvoPerlLanguage::Singleton;

Link<Params> EvoPerlLanguage::defaultParams( )
{
        Link<Params> p= Language::defaultParams();
        p->creatureAlphabet = "012zodfpppmtvvvZVPQWBWBIMLASNX";
        p->creatureAlphabet = "012zodfpppmtvvvZVPQMLASNX";
        p->creatureInitialLength *= 2;
        return p;
}

Link<Machine> EvoPerlLanguage::createMachine( Link<Params> p, Link<Creature> c )
{
        return new EvoPerlMachine( p, c );
}

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


TEST(EvoPerl_basic_nodes) {
}

} //EvoPerl
//END