%{

#define DEBUG if (0)

/*
    Lex's function prototypes
*/

int yylook();
int yywrap();
int yyfussy();
int yyback();

/*
    Inherited attributes
*/


/* 
    Variables
*/


/*
    Flags
*/

/*
    Types
*/

%}

%union{
    int INT;
    char STR[2048];
}

%type  <STR> DefList DefType EKey
%type  <STR> Sets SetsList Cst Var Equi Pset List Ffun Prod Plus
%token <STR> IDENT
%token <INT> NUMBER
%token DEF LET OPR DEFTYPE LAMBDA COMMENT
%token EQ SET TUP ALT LIST FFUN
%token SYMBOL STRING LOAD C_ANY C_SYM C_STR C_INT C_BOOL

%start S

%%

S	:	DefList { printf("M <- [\n%s\n];\n",$1); }
	;

DefList :               { /*strcpy($$,"");*/ }
	|	DefList DefAny  { /*strcpy($$,"");*/ }
	|	DefList DefLoad { /*strcpy($$,"");*/ }
	|	DefList Comment { /*strcpy($$,"");*/ }
	|	DefList DefType { if (!strcmp($1,"")) sprintf($$,"%s",$2);
                          else sprintf($$,"%s,\n%s",$1,$2); }
	;

Comment : COMMENT
	;

DefLoad	:	'(' LOAD STRING ')'
	;

DefAny  : '(' DEF IDENT Sexp ')'
        { DEBUG printf("\ncst %s ok.",$3); }
	|	'(' DEF IDENT LAMBDA '(' ArgList ')' Sexp ')'
        { DEBUG printf("\nopr %s ok.",$3); }
	;

Sexp:	Atom
	|	Oper
	|	'(' SexpList ')'
	|	'(' Oper SexpList ')'
	;

SexpList:
	|	SexpList Sexp
	;

Oper:	DEF
	|	LET
	|	OPR
	|	SET
	|	ALT
	|	TUP
	|	LIST
	|	FFUN
	;

Atom:	Cst
	|	IDENT
	|	SYMBOL
	|	STRING
	|	NUMBER
	;

ArgList	:
	|	ArgList IDENT
	;

DefType : '(' DEFTYPE EKey Sets ')' { sprintf($$,"\"%s\" -> %s",$3,$4); }
	;

EKey:	IDENT { strcpy($$,$1); }
	;

Sets:	Cst   { strcpy($$,$1); }
	|	Var   { strcpy($$,$1); }
	|	Equi  { strcpy($$,$1); }
	|	Pset  { strcpy($$,$1); }
	|	List  { strcpy($$,$1); }
	|	Ffun  { strcpy($$,$1); }
	|	Prod  { strcpy($$,$1); }
	|	Plus  { strcpy($$,$1); }
	;

Cst	:	C_ANY { sprintf($$,"Cst(\"%s\")","ANY"); }
	|	C_SYM { sprintf($$,"Cst(\"%s\")","SYM"); }
	|	C_STR { sprintf($$,"Cst(\"%s\")","STR"); }
	|	C_INT { sprintf($$,"Cst(\"%s\")","INT"); }
	|	C_BOOL { sprintf($$,"Cst(\"%s\")","BOOL"); }
	;

Var :	IDENT { sprintf($$,"Var(\"%s\")",$1); }
	;

Equi:	EQ Sets  { sprintf($$,"%s",$2); }
	;

Pset:	SET Sets  { sprintf($$,"Pset(Cst(\"2\"),%s)",$2); }
	;

List:	LIST Sets { sprintf($$,"List(%s)",$2); }
	;

Ffun:	FFUN Sets Sets { sprintf($$,"Ffun(%s,%s)",$2,$3); }
	;

Prod:	TUP SetsList { sprintf($$,"Prod(<%s>)",$2); }
	;

Plus:	ALT SetsList { sprintf($$,"Plus(<%s>)",$2); }
	;

SetsList	:	Sets { strcpy($$,$1); }
	|	'(' IDENT Sets ')' { strcpy($$,$3); }
	|	SetsList '(' IDENT Sets ')' { sprintf($$,"%s,%s",$1,$4); }
	|	SetsList Sets { sprintf($$,"%s,%s",$1,$2); }
	;

%%

#ifdef __unix__
#include "lex.yy.c"
#else
#include "lexyy.c"
#endif

#ifdef __unix__

int yyerror(char *s)
{
    (void)printf("\nLine %d: %s at '%s'\n",yylineno,s,yytext);
}

#else

void yyerror(char *s)
{
    static char dummy[20];

    fputs("\nLine ",yyout);
    fputs(itoa(yylineno,dummy,10),yyout);
    fputs(": ",yyout);
    fputs(s,yyout);
    fputs(" at '",yyout);
    fputs(yytext,yyout);
    fputs("'\n",yyout);
}

#endif

/*
int yyerror(char *s) {return 1;}
*/


char *toUpperCase(char *s)
{
    register i=0;

    while (s[i] != '\0') {s[i] = toupper(s[i]);++i;}

    return(s);
}

void main()
{
    yyparse();
}