%{
#undef yywrap
#undef YY_USER_INIT
#define YY_USER_INIT initialise_database()
# include	"../header.h"
# include	"../db/tc/tc.h"
# include	"../db/df/df.h"
# include	"../db/hf/hf.h"
# include	"../db/db.h"
# include	"../hp/cell.h"
# include	"../hp/cstack.h"
# include	"../hp/hp.h"
# include	"../expr/expr.h"
# include	"../type/type.h"
# include	"../user/user.h"
# include	"../eval/eval.h"
# include	"../oper/oper.h"
# include	"stream.h"

int 	initialise_database( void );
void	prompt_user( void );
int 	yyparse( void );

hp	*heap;
db	*database;
oper	*f;
expr	*expressions;
type	types;

int	prof = False;
int	Xgraphics = False;
int	heap_size = 25000;
int	interrupt = False;
char	db_name[MaxString];

field	result;

extern	"C"	char*	getenv(const char* name);
extern	"C"	void	init_handler();
extern	"C"	int	switch_input(const char* name);
// extern	"C"	void	closewin();


extern "C" 	int	yywrap( void );

void	yyerror(char* string);

cell*	form_qualifier(cell* qual, cell* exp);

cell*	form_abst(cell* exp, cell* quals);

%}

%token	Token
%token	CommandToken
%token	CommitToken
%token	DefineToken
%token	DisplayToken
%token	ExcludeToken
%token	FunctionToken
%token	IncludeToken
%token	LoadToken
%token	RestoreToken
%token	ExtSelToken
%token	IntSelToken
%token	SetToken
%token	SystemToken
%token	TypeToken
%token	ValueToken
%token	WrongToken

%token	LArrow
%token	RArrow
%token	Bar
%token	Comma
%token	DotDot
%token	LSB
%token	RSB
%token	LRB
%token	RRB
%token	End

%token	ConsToken
%token	AppendToken
%token	DifferenceToken
%token	PlusToken
%token	MinusToken
%token	MultiplyToken
%token	IDivideToken
%token	RDivideToken
%token	ModulusToken
%token	MatchToken
%token	EqualToken
%token	NotEqualToken
%token	LesserToken
%token	NotLesserToken
%token	GreaterToken
%token	NotGreaterToken
%token	AndToken
%token	OrToken
%token	IndexToken

%left	ConsToken	AppendToken	DifferenceToken
%left	AndToken	OrToken
%left	MatchToken	EqualToken	NotEqualToken	LesserToken	NotLesserToken	GreaterToken	NotGreaterToken
%left	PlusToken	MinusToken
%left	MultiplyToken	IDivideToken	RDivideToken	ModulusToken
%left	IndexToken

%type	<cval>	comm appl expr seq token quals qual mtype mtexp otype otexp otseq

%union {
	cell*	cval;
};

%start	comms

%%

comms :
	comms comm
	{
		prompt_user();
	}
|	{
	};

comm :
	appl End
	{
		f->show($1);
		if (prof)
			f->profile_rep();
	}
|	CommandToken appl End
	{
		f->process($2);
		if (prof)
			f->profile_rep();
	}
|	LoadToken token End
	{
		char	string[MaxString];

		cout << "Calling switch_input from parser [1]\n";
		if ($2->tag() == Str) {
			strcpy(string,database->id_to_str($2->value()));
			switch_input(string);
		}
		else	cout << "<< `" << $2 << "' is not a string >>" << endl << flush;
	}
|	SystemToken token End
	{
		char	string[MaxString];

		if ($2->tag() == Str) {
			strcpy(string,database->id_to_str($2->value()));
			cout << "// executing `" << string << "'" << endl << flush;
			cout << "// return code " << system(string) << endl << flush;
		}
		else	cout << "<< `" << $2 << "' is not a string >>" << endl << flush;
	}
|	CommitToken End
	{
		f->filemanager("Commit");
	}
|	RestoreToken End
	{
		f->filemanager("Restore");
	}
|	ExcludeToken token appl End
	{
		f->update($2->data(),$3,False);
	}
|	IncludeToken token appl End
	{
		f->update($2->data(),$3,True);
	}
|	FunctionToken token SetToken otype End
	{
		f->function($2->data(),$4);
	}
|	TypeToken token SetToken mtype End
	{
		f->type($2->data(),$4);
	}
|	ValueToken token SetToken otype End
	{
		f->value($2->data(),$4);
	}
|	ExtSelToken token SetToken otype End
	{
		f->extsel($2->data(),$4);
	}
|	IntSelToken token SetToken appl End
	{
		f->intsel($2,$4);
	}
|	DefineToken appl SetToken appl End
	{
		f->define($2,$4);
	}
|	DisplayToken token End
	{
		f->display($2->data());
	}
|	End
	{
		// the empty command
	};
|	error
	{
		$$ = (cell*) 0;
	};

appl :
	expr
	{
		$$ = $1;
	}
|	appl AppendToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("(++)")),$1),$3);
	}
|	appl DifferenceToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("(--)")),$1),$3);
	}
|	appl AndToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("(&)")),$1),$3);
	}
|	appl OrToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("(#)")),$1),$3);
	}
|	appl IndexToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("(!)")),$1),$3);
	}
|	appl ConsToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(ConsConst),$1),$3);
	}
|	appl PlusToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(+)")),$1),$3);
	}
|	appl MinusToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(-)")),$1),$3);
	}
|	appl MultiplyToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(*)")),$1),$3);
	}
|	appl IDivideToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(div)")),$1),$3);
	}
|	appl RDivideToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(/)")),$1),$3);
	}
|	appl ModulusToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(%)")),$1),$3);
	}
|	appl MatchToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(?=)")),$1),$3);
	}
|	appl EqualToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(=)")),$1),$3);
	}
|	appl NotEqualToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(!=)")),$1),$3);
	}
|	appl GreaterToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(>)")),$1),$3);
	}
|	appl NotGreaterToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(<=)")),$1),$3);
	}
|	appl LesserToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(<)")),$1),$3);
	}
|	appl NotLesserToken appl
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("(>=)")),$1),$3);
	}
|	MinusToken appl		%prec MultiplyToken
	{
		cell*	root;

		root = heap->make(App,0,heap->make(Pre,user_id("(-)")),heap->make(Int,0));
		$$ = heap->make(App,0,root,$2);
	}
|	appl expr
	{
		$$ = heap->make(App,0,$1,$2);
	};

expr :
	token
	{
		$$ = $1;
	}
|	LRB seq RRB
	{
		int	i;
		cell*	root;
		char	string[MaxString];

		for (i = 0, root = $2; root->tag() == App; ++i, root = root->left());
		sprintf(string,"Tuple%d",i);
		*root = *heap->make(Con,database->str_to_id(string));
		$$ = $2;
	}
|	LRB appl RRB
	{
		$$ = $2;
	}
|	LSB seq RSB
	{
		cell*	root = heap->make(NilConst), *curr;

		for (curr = $2; curr->tag() == App; curr = curr->left())
			root = heap->make(App,0,heap->make(App,0,heap->make(ConsConst),curr->right()),root);
		$$ = root;
	}
|	LSB RSB
	{
		$$ = heap->make(NilConst);
	}
|	LSB appl RSB
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(ConsConst),$2),heap->make(NilConst));
	}
|	LSB appl DotDot appl RSB
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("numbers")),$2),$4);
	}
|	LSB appl DotDot RSB
	{
		$$ = heap->make(App,0,heap->make(App,0,heap->make(Var,database->str_to_id("iterate")),heap->make(App,0,heap->make(Pre,user_id("(+)")),heap->make(Int,1))),$2);
	}
|	LSB appl Bar quals RSB
	{
		$$ = form_abst($2,$4);
	};

seq :
	seq Comma appl {
		$$ = heap->make(App,0,$1,$3);
	}
|	appl {
		$$ = heap->make(App,0,heap->make(Con,database->str_to_id("Tuple")),$1);
	};

quals :
	qual End quals			{ $$ = heap->make(Any,0,$1,$3); }
|	qual				{ $$ = heap->make(Any,0,$1,(cell*) 0); };

qual :
	appl				{ $$ = $1; }
|	appl LArrow appl		{ $$ = heap->make(Any,0,$1,$3); };


mtype :
        mtexp {
		$$ = $1;
	}
|	mtype RArrow mtype {
		$$ = heap->make(App,0,heap->make(App,0,heap->make(FunConst),$1),$3);
	};

mtexp :
	token {
		$$ = $1;
	}
|	LRB mtype RRB {
		$$ = $2;
	};

otype :
        otexp {
		$$ = $1;
	}
|	otype RArrow otype {
		$$ = heap->make(App,0,heap->make(App,0,heap->make(FunConst),$1),$3);
	}
|       LSB otype RSB {
		$$ = heap->make(App,0,heap->make(ListConst),$2);
	}
|       LRB otseq RRB
	{
		int	i;
		cell*	root;
		char	string[MaxString];

		for (i = 0, root = $2; root->tag() == App; ++i, root = root->left());
		sprintf(string,"Product%d",i);
		*root = *heap->make(Con,database->str_to_id(string));
		$$ = $2;
	}
|       otype otexp {
		$$ = heap->make(App,0,$1,$2);
	};

otseq :
	otseq Comma otype {
		$$ = heap->make(App,0,$1,$3);
	}
|	otype {
		$$ = heap->make(App,0,heap->make(Con,database->str_to_id("Product")),$1);
	};



otexp :
	token {
		$$ = $1;
	}
|	LRB otype RRB {
		$$ = $2;
	};

token :	
	Token	{
		$$ = heap->make(result);
	}

%%

# include	"lex.yy.C"

void	prompt_user()
{
	expressions->unload();
	if (!heap->allocate(MaxCells)) {
		cout << "parser::prompt_user -\tinsufficient heap space" << endl << flush;
		exit(2);
	}
	if (isatty(fileno(yyin)))
		cout << "--> " << flush << flush;
	interrupt = False;
}


// Moved from parser - implement via YY_USER_INIT

int initialise_database( void )
{

	char	command[MaxString], pfldir[MaxString];

//	Copied from FLEX init code. We want to start with a file then move on to 
//	user i/o but to preserve modularity we want the first i/o source to be 
//	standard i/o so that we can return to it on completion of our initialisation

        yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );
	if ( ! yy_start )
	    yy_start = 1;	/* first start state */

	if ( ! yyin )
	    yyin = stdin;

	if ( ! yyout )
	    yyout = stdout;

        yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );

	yy_load_buffer_state();

	strcpy(pfldir,getenv("PFLDIR"));

	sprintf(command,"%s/util/makedb %s",pfldir,db_name); \
	switch (system(command) >> 8) {
	case 0 :
		//	database is corrupt
		exit(1);
	case 2 :
		//	database does not already exist
		sprintf(command,"%s/environ/std.env",pfldir);
		switch_input(command);
		break;
	default :
		//	database already exists
		break;
	}

	heap =	new hp;
	f =	new oper(db_name);
	expressions = new expr;
	prompt_user();
	return(1);
}

main(int argc, char* argv[])
{
	int	temp;

	init_handler();
	strcpy(db_name,"demo");
	for (int i = 1; i < argc; ++i)
		switch (argv[i][1]) {
		case 'p' :
			prof = True;
			break;
		case 'd' :
			if (strlen(&argv[i][2]))
				strcpy(db_name,&argv[i][2]);
			break;
		case 'h' :
			temp = atoi(&argv[i][2]);
			heap_size = (temp > heap_size) ? temp : heap_size;
			break;
		default :
			cout << "unrecognised flag `" << argv[i] << "'\n" << flush;
		}


//	STUFF HERE MOVED TO initialise_database (above) - called via yyparse 

	yyparse();

	delete	heap;
	delete	f;
}


int	yywrap( void )
{
	if (!switch_input(""))
		return True;
	prompt_user();
	return False;
}

void	yyerror(char* string)
{
	cout << "<< " << string << endl << "\t";
	while (!feof(yyin) && strcmp(yytext,";")) {
		cout << yytext << " ";
		yylex();
	}
	if (!strcmp(yytext,";"))
		cout << ";";
	cout << "<eol>" << endl << "\t^" << endl << ">>" << endl << flush;
	/* yyerrok; */
	yyclearin; 
}

cell*	form_qualifier(cell* qual, cell* exp)
{
	if (qual->tag() != Any)				//	A Filter
		return heap->make(App,0,heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("when")),qual),exp),heap->make(NilConst));

	//	A Generator
	cell* body = heap->make(App,0,heap->make(App,0,heap->make(LambdaConst),qual->left()),exp);
	return	heap->make(App,0,heap->make(App,0,heap->make(Pre,user_id("flatmap")),body),qual->right());
}

cell*	form_abst(cell* exp, cell* quals)
{
	if (!quals)
		return heap->make(App,0,heap->make(App,0,heap->make(ConsConst),exp),heap->make(NilConst));
	else	return form_qualifier(quals->left(),form_abst(exp,quals->right()));
}
