/***************************** LICENSE START ***********************************

 Copyright 2012 ECMWF and INPE. This software is distributed under the terms
 of the Apache License version 2.0. In applying this license, ECMWF does not
 waive the privileges and immunities granted to it by virtue of its status as
 an Intergovernmental Organization or submit itself to any jurisdiction.

 ***************************** LICENSE END *************************************/

%{
#include <stdio.h>
#include <stdlib.h>
#include "opcodes.h"

extern int   yylineno;
extern void  update_branch(void *a,void *b);
extern void *new_code(int opcode,char *carg,int iarg,int line);
extern void  new_context(char *name,int handler,int user,int oo);
extern void  start_global(char *name);
extern void  end_global(char *name);
extern void  end_context(char *name);
extern void  argument_count(int);
extern void  argument_type(char*);
extern void  extern_command(char*,char*);
extern char *strdup(const char*);
int zzlex();
void zzerror(const char *s);

static void *stack[1024];
static int  top = 0;

static int  tmpdepth = 0;

static void include(char*);
static void begin_function(char *name,int handler,int user,int oo)
{
	/* extern int yydebug; yydebug = 1; */
	new_context(name,handler,user,oo);
}

static void return_function(int has_value)
{
	if(!has_value) new_code(OP_PUSH,NULL,PUSH_NIL,yylineno);
	new_code(OP_RETURN,NULL,0,yylineno);
}

static void end_function(char *name)
{
	new_code(OP_PUSH,NULL,PUSH_NIL,yylineno);
	new_code(OP_RETURN,NULL,0,yylineno);

	end_context(name);
}

static void begin_while()
{
	stack[top++] = new_code(OP_NOP,NULL,0,yylineno);
}

static void end_while()
{
	void *l1 = stack[--top];
	void *l2 = stack[--top];
	update_branch(new_code(OP_GOTO,NULL,0,yylineno),l2);
	update_branch(l1,new_code(OP_NOP,NULL,0,yylineno));
}

static void begin_repeat()
{
	stack[top++] = new_code(OP_NOP,NULL,0,yylineno);
}

static void end_until()
{
	void *l = stack[--top];
	update_branch(new_code(OP_TEST,NULL,0,yylineno),l);
}

static void do_while()
{
	stack[top++] = new_code(OP_TEST,NULL,0,yylineno);
}


static void begin_if()
{
	stack[top++] = new_code(OP_TEST,NULL,0,yylineno);
}

static void else_if()
{
	void *l = stack[--top];

	stack[top++] = new_code(OP_GOTO,NULL,0,yylineno);
	update_branch(l,new_code(OP_NOP,NULL,0,yylineno));
}

static void end_if()
{
	void *l = stack[--top];
	update_branch(l,new_code(OP_NOP,NULL,0,yylineno));
}

static void push(char *name,int type)
{
	new_code(OP_PUSH,name,type,yylineno);
}


static void param(char *name,char *type)
{
	new_code(OP_PARAM,name,0,yylineno);
	argument_type(type);
}

static void pop(char *name,int n)
{
	if(name)
		new_code(OP_STORE,name,n,yylineno);
	else
		new_code(OP_POP,NULL,n,yylineno);
}

static void call(char *name,int arity)
{
	new_code(OP_CALL,name,arity,yylineno);
}

/*===========================================================================*/

static void begin_case(void)
{
	void *l1,*l2,*l3;
	char tmp[20];

	sprintf(tmp,".tmp.%d",tmpdepth++);
	pop(tmp,0);

	l1 = new_code(OP_GOTO,NULL,0,yylineno);
	l2 = new_code(OP_GOTO,NULL,0,yylineno); /* endcase case */
	l3 = new_code(OP_NOP, NULL,0,yylineno);

	update_branch(l1,l3);
	stack[top++] = l2;
}

static void end_case(void)
{
	void *l = stack[--top];
	update_branch(l,new_code(OP_NOP,NULL,0,yylineno));
	tmpdepth--;
}

static void begin_choice(int count)
{
	char tmp1[20];
	char tmp2[20];

	sprintf(tmp1,".tmp.%d",tmpdepth-1);

	if(count == 1) /* faster */
	{
		push(tmp1,PUSH_IDENT);
		call("=", 2);
	}
	else
	{
		int i;
		for(i=0;i<count;i++)  /* copy all cases */
		{
			sprintf(tmp2,".tmp.%d",tmpdepth+i);
			pop(tmp2,0);
		}

		for(i=0;i<count;i++)  /* = all cases */
		{
			sprintf(tmp2,".tmp.%d",tmpdepth+i);
			push(tmp1,PUSH_IDENT);
			push(tmp2,PUSH_IDENT);
			call("=", 2);
		}

		for(i=0;i<count-1;i++)  /* or all cases */
			call("or",2);
	}

	stack[top++] = new_code(OP_TEST,NULL,0,yylineno);

}

static void end_choice(void)
{
	void *l1 = stack[--top]; /* OP_TEST */
	void *l2 = stack[top-1]; /* begin_case l2 */

	update_branch(new_code(OP_GOTO,NULL,0,yylineno),l2);
	update_branch(l1,new_code(OP_NOP ,NULL,0,yylineno));
}

/*===========================================================================*/

static void begin_for(char *name,int by)
{
	char tmp1[20];
	char tmp2[20];

	sprintf(tmp1,".tmp.%d",tmpdepth++);
	sprintf(tmp2,".tmp.%d",tmpdepth++);

	if(by == 0) push("1",PUSH_NUMBER); /* default by */

	pop(tmp2,0);             /* by is on top */

	push(name,PUSH_IDENT); /*  end - start (end is on stack)  */
	call("-",2);

	push(tmp2,PUSH_IDENT); /*  end - start + by */
	call("+",2);

	push(tmp2,PUSH_IDENT); /*  (end - start + 1)/by */
	call("/",2);
	call("int",1);
	pop(tmp1,0);             /* into tmp var */

	begin_while();         /* while tmp > 0 */

	push(tmp1,PUSH_IDENT);
	push("0",PUSH_NUMBER);
	call(">",2);

	do_while();

}

static void end_for(char *name)
{
	char tmp1[20];
	char tmp2[20];

	sprintf(tmp2,".tmp.%d",--tmpdepth);
	sprintf(tmp1,".tmp.%d",--tmpdepth);

	push(name,PUSH_IDENT); /* name = name + by */
	push(tmp2,PUSH_IDENT);
	call("+",2);
	pop(name,0);

	push(tmp1,PUSH_IDENT); /* tmp = tmp - 1 */
	push("1",PUSH_NUMBER);
	call("-",2);
	pop(tmp1,0);

	end_while();

/* pmit@up*/
}

/*===========================================================================*/

static void begin_loop(char *name)
{
	char tmp1[20];
	char tmp2[20];
	char tmp3[20];

	sprintf(tmp1,".tmp.%d",tmpdepth++);
	sprintf(tmp2,".tmp.%d",tmpdepth++);
	sprintf(tmp3,".tmp.%d",tmpdepth++);

	pop(tmp2,0);             /* get list */
	push(tmp2,PUSH_IDENT);
	call("count",1);       /* count */

	pop(tmp1,0);             /* into tmp var */

	push("1",PUSH_NUMBER);
	pop(tmp3,0);

	begin_while();         /* while tmp > 0 */

	push(tmp1,PUSH_IDENT);
	push("0",PUSH_NUMBER);
	call(">",2);

	do_while();

	push(tmp2,PUSH_IDENT);	
	push(tmp3,PUSH_IDENT);	
	call("[]",2);
	pop(name,0);

}

static void end_loop()
{
	char tmp1[20];
	char tmp2[20];
	char tmp3[20];

	sprintf(tmp3,".tmp.%d",--tmpdepth);
	sprintf(tmp2,".tmp.%d",--tmpdepth);
	sprintf(tmp1,".tmp.%d",--tmpdepth);

	push(tmp1,PUSH_IDENT); /* tmp = tmp - 1 */
	push("1",PUSH_NUMBER);
	call("-",2);
	pop(tmp1,0);

	push(tmp3,PUSH_IDENT); /* tmp = tmp + 1 */
	push("1",PUSH_NUMBER);
	call("+",2);
	pop(tmp3,0);

	end_while();

}

/*===========================================================================*/

static void begin_when(void)
{
	void *l1,*l2,*l3;

	l1 = new_code(OP_GOTO,NULL,0,yylineno);
	l2 = new_code(OP_GOTO,NULL,0,yylineno); /* endcase when */
	l3 = new_code(OP_NOP, NULL,0,yylineno);

	update_branch(l1,l3);
	stack[top++] = l2;
}

static void end_when(void)
{
	void *l = stack[--top];
	update_branch(l,new_code(OP_NOP,NULL,0,yylineno));
}

static void begin_selection(void)
{
	stack[top++] = new_code(OP_TEST,NULL,0,yylineno);
}

static void end_selection(void)
{
	void *l1 = stack[--top]; /* OP_TEST */
	void *l2 = stack[top-1]; /* begin_when l2 */

	update_branch(new_code(OP_GOTO,NULL,0,yylineno),l2);
	update_branch(l1,new_code(OP_NOP ,NULL,0,yylineno));
}

/*===========================================================================*/
%}

%union {
	char       *str;
	long		num;
};

%start script

%token IF
%token AND
%token NOT
%token OR
%token THEN
%token ELSE
%token END
%token RETURN
%token DO
%token FUNCTION
%token ON
%token GLOBAL
%token VECTOR
%token WHILE
%token INCLUDE
%token EXTERN
%token GE
%token LE
%token NE
%token FOR
%token TO
%token BY
%token NIL
%token OBJECT
%token IMPORT
%token EXPORT

%token INLINE

%token CASE
%token OTHERWISE
%token OF

%token IN

%token REPEAT
%token UNTIL
%token LOOP
%token WHEN
%token TELL
%token TASK

%token ARROW

%token <str>WORD
%token <str>STRING
%token <str>NUMBER
%token <str>DATE
%token <str>TIME
%token <str>ENDINLINE

%type <str>name;
%type <str>fname;
%type <str>operator;
%type <num>parameters;
%type <num>attribute_list;
%type <num>param_or_empty;
%type <num>param_list;
%type <num>vector_list;
%type <num>by;
%type <str>inline;

%type <num>super_list;

%%

script 	: block {return_function(0);};
		;

block	: lines	
		| empty
		;

lines   : line 
		| lines line 
		;

line	: statement 
		| function
		| control
		| declare  
		| extern  
		| import
		| export
		| include
		| ';'
		;

name		: WORD;

declare : GLOBAL name { start_global($2); push("0",PUSH_NUMBER); 
						pop($2,0); end_global($2);free($2); }
        | GLOBAL name '=' { start_global($2);} expression 
						  { pop($2,0); end_global($2);free($2); }
		;

import  : IMPORT name { push($2,PUSH_STRING); 
					   call("import",1); pop($2,0); free($2); }
		;

export  : EXPORT name { push($2,PUSH_STRING);call("export",1); 
						pop(NULL,0);free($2); }
		;

extern  : extern_name param_declare          { end_function(NULL);}
		| extern_name param_declare STRING   
			 { extern_command($3,NULL); end_function(NULL); free($3);}

		| extern_name param_declare STRING inline 
			 { extern_command($3,$4); end_function(NULL);free($3);free($4);}
		;

extern_name : EXTERN fname { begin_function($2,0,0,0); free($2); }
            ;

include : INCLUDE STRING { include($2); free($2);}
        | INCLUDE name   { include($2); free($2);}
        ;

inline  : INLINE ENDINLINE { $$ = $2; }
		;

/*======================================================================*/

function : functionheader  param_declare super_declare block  endfunction
		 ;

param_declare : empty              { argument_count(-1); }
              | '(' ')'            { argument_count(0);  }
			  | '(' param_list ')' { argument_count($2); };
			  ;

functionheader : FUNCTION fname				   { begin_function($2,0,1,0); free($2);}
               | ON       fname                { begin_function($2,1,1,0); free($2);}
               | OBJECT   fname                { begin_function($2,1,1,1); free($2);}
			   ;

super_declare   : empty          
				| ':' super_list { 
						call("list",$2);
						pop(".super",0);
						}
				;

super_list : super  { $$ = 1; } 
			| super_list ',' super { $$ = $1 + 1; }
			;

super: function_call
	;

param_list     : param						{ $$ = 1;      }
			   | param_list ',' param		{ $$ = $1 + 1; }
			   ;

param          : name                       { param($1,NULL); free($1); }
			   | name ':' name              { param($1,$3); free($1);free($3);}
			   ;

endfunction	   : END fname					{ end_function($2);free($2); }

fname          : name
			   | operator
			   ;


/*======================================================================*/

statement 	: assignement
			| function_call                 { pop(NULL,0); }
			| return
			| name                          { call($1,0);pop(NULL,0);free($1);}
			;

return		: RETURN						{ return_function(0); }
			| RETURN expression				{ return_function(1); }

/*======================================================================*/

assignement 	: name '=' expression       { pop($1,0);free($1); }
            	| name '[' parameters ']' '=' expression       
							                { 
											   pop($1,$3);
											   free($1);
											 }
            	| name '.' name  '=' { push($3,PUSH_STRING); } expression
											  { 
											   pop($1,1);
											   free($1);
											   free($3);
											 }
            	| name '.' NUMBER  '=' { push($3,PUSH_NUMBER); } expression
											  { 
											   pop($1,1);
											   free($1);
											   free($3);
											 }
				;

/*======================================================================*/

control 	: if
			| while
			| for
			| repeat
			| case
			| loop
			| when
			| tell
			;

/*======================================================================*/

loop        : LOOP name IN expression      { begin_loop($2); }
				block 
			  END LOOP                     { end_loop();     }
            ;


/*======================================================================*/
tell       : TELL expression               { call(".push.dict",1);pop(NULL,0); }
				  block
			 END TELL                      { call(".pop.dict",0);pop(NULL,0);  }
		   ;

/*======================================================================*/

when        : WHEN                          { begin_when(); }
				selections
			  END WHEN                      { end_when(); }

selections  : selection
			| selections selection
			;

selection   : expression ':'                 { begin_selection(); }
				block END                    { end_selection(); }

/*======================================================================*/

case        : CASE expression OF           { begin_case();    }
				choices
				otherwise
			  END CASE                     { end_case();      }
			;

choices     : choice 
			| choices choice
			;

choice      :   parameters ':'             { begin_choice($1);  }
						 block END         { end_choice();    }
            ;

otherwise   :   empty                    
			|	OTHERWISE  ':' 
					     block END 
            ;
			

/*======================================================================*/
repeat      : REPEAT           { begin_repeat(); }
			     block
              UNTIL expression { end_until();    }
			;

/*======================================================================*/

for         :  FOR name '=' expression { pop($2,0); }
			       TO expression by DO { begin_for($2,$8); }
				      block
				   END FOR             { end_for($2); free($2); }
            ;
            
by          : empty         { $$ = 0 ; }
			| BY expression { $$ = 1;  }
			;

/*======================================================================*/

while       : WHILE							{ begin_while(); }
                    expression DO           { do_while();    }
			     block
			  END WHILE                     { end_while() ;  }
			;

/*======================================================================*/

if          : IF expression THEN            { begin_if();    } 
				 block 
			  closeif
			;

closeif     : END IF                        { end_if();      }
            | ELSE    { else_if(); } block closeif
			| ELSE IF { else_if();} 
					 expression THEN        { begin_if();    } 
					    block 
					 closeif                { end_if();      }
			;

/*======================================================================*/

definition : '(' attribute_list ')'           { call("definition",$2);  }
		   | '(' parameter ',' parameters ')' { call("definition",1+$4);}
		   | '(' ')'						  { call("definition",0);   }
           ;

				
function_call 	: name '(' param_or_empty ')'   { call($1,$3);free($1); }
				| name '(' attribute_list ')'   { call($1,$3);free($1); }
				| definition
				| inline_object
				| atom '[' parameters ']' { call("[]",$3+1);}
				| atom '.' name          { push($3,PUSH_STRING);
										 	call("[]",2);
										 	free($3);
										 	}
				| atom '.' NUMBER          { push($3,PUSH_NUMBER);
										 	call("[]",2);
										 	free($3);
										 	}
				| name ARROW name '(' param_or_empty ')'  { 
														push($1,PUSH_IDENT);
														push($3,PUSH_STRING);
														  call("method",$5+2);
														  free($1);
														  free($3);
														 }
				| name ARROW name '(' attribute_list ')'  { 
														push($1,PUSH_IDENT);
														push($3,PUSH_STRING);
														call("method",$5+2);
														free($1);
														free($3);
														}
				;



inline_object : name inline { push($1,PUSH_STRING); 
							  push($2,PUSH_STRING);
							  call("inline",2);
							  free($1);free($2);
							 }
			  ;

/*======================================================================*/


param_or_empty  : empty                         { $$ = 0; }
                | parameters
		     	;

parameters  : parameter                     { $$ = 1;      }
			| parameter ',' parameters      { $$ = $3 + 1; }
			;

parameter	: expression
			;

attribute   : name   { push($1,PUSH_STRING); } ':' expression  { free($1); }
			| STRING { push($1,PUSH_STRING); } ':' expression  { free($1); }
			;

attribute_list : attribute                    { $$ = 2;      }
			   | attribute ',' parameter      { $$ = 3;      }
			   | attribute ',' attribute_list { $$ = $3 + 2; }
			   | parameter ',' attribute_list { $$ = $3 + 1; }
			   ;

vector_list : vector vector           { $$ = 2;      }
			| vector_list vector      { $$ = $1 + 1; }
			;

matrix      : vector_list               { call("_matrix",$1);     }
            ;

vector      : '|' parameters '|'        { call("_vector",$2); }
			;
list        : '[' param_or_empty ']'    { call("list",$2);    }
			;

number      : NUMBER                { push($1,PUSH_NUMBER); free($1);}
			| '-' NUMBER            { push($2,PUSH_NEGATIVE);free($2); }
			;

atom   		: name					{ push($1,PUSH_IDENT);  free($1);}
			| STRING                { push($1,PUSH_STRING); free($1);}
			| DATE TIME             { push($1,PUSH_DATE);push($2,PUSH_TIME);
									  call("+",2);free($1);free($2);}
			| DATE                  { push($1,PUSH_DATE);   free($1);}
			| TIME                  { push($1,PUSH_TIME);   free($1);}
	   		| function_call
	   		| '(' expression ')'
			| list
			| vector
			| matrix
			| NIL                   { push(NULL,PUSH_NIL); }
			| '-' atom              { call("neg",1); }
	   		;

atom_or_number: atom
              | number
			  ;


/* note: a^b^c -> a^(b^c) as in fortran */
power  		: atom_or_number '^' power        { call("^",2); }
	   		| atom_or_number
	   		;

factor 		: factor '*' power      { call("*",2); }
	   		| factor '/' power      { call("/",2); }
	   		| power
	   		;

term   		: term '+' factor  		{ call("+",2); }
	   		| term '-' factor  		{ call("-",2); }
	   		| term '&' factor  		{ call("&",2); }
	  	 	| factor
	  		;

condition 	: condition '>' term		 { call(">",2); }
	 		| condition '=' term         { call("=",2); }
	 		| condition '<' term         { call("<",2); }
	 		| condition  GE term         { call(">=",2); }
	 		| condition  LE term         { call("<=",2); }
	 		| condition  NE term         { call("<>",2); }
	 		| condition  IN term         { call("in",2); }
	 		| condition  NOT IN term     { call("in",2); call("not",1);}
	 		| NOT condition              { call("not",1); }
			| term
	 		;

conjonction : conjonction AND condition    { call("and",2); }
			| condition
			;

disjonction	: disjonction OR conjonction { call("or",2); }
			| conjonction
			;

expression 	: disjonction
			;

operator    : '>'   { $$ = strdup(">"); }
			| '='   { $$ = strdup("="); }
			| '<'   { $$ = strdup("<"); }
			| GE    { $$ = strdup(">=");}
			| LE    { $$ = strdup("<=");}
			| NE    { $$ = strdup("<>");}
			| IN    { $$ = strdup("in");}
			| NOT    { $$ = strdup("not");}
			| '^'    { $$ = strdup("^");}
			| '*'    { $$ = strdup("*");}
			| '/'    { $$ = strdup("/");}
			| '+'    { $$ = strdup("+");}
			| '-'    { $$ = strdup("-");}
			| '&'    { $$ = strdup("&");}
			| AND    { $$ = strdup("and");}
			| OR    { $$ = strdup("or");}
			| '[' ']' { $$ = strdup("[]"); }
			;

empty		:
			;

%%
#include "macrol.c"

