# -*- cperl -*-
%{
  #### TODO
  #
  # define 'fimdef' ...?
  #
  use Camila;
  use Camila::caller;
  use Camila::Type;
  use Camila::Commands;
  use Data::Dumper;

  our %types_table = ();
  our %functions_table = ();
  our %namespace = ();

  #  int _accao=1;

  our $cont_alt = 0;
  our $cont_tup = 0;

  our $CONTEXTO = 'd';

  #   char straux [30], command [50];
  #   char option;

  # our $jjDEBUG = 1;

  #  ***  Simbolos Terminais              ***
%}

%token <str> SIMB CONSTANTE INTEGER STRING BOOL
%token SET LIST TYPE ENDTYPE P4 NIL RELACAO INCLUDE INCLUDEM DEBUGON
%token DEBUGOFF QUIT MODEL ENDMODEL FSETA2 INV COMP FPROD FADD

%{
  # ***  fim de definicao de terminais   ***

  # *** prioridades e associatividades: ***
%}

%nonassoc minima
%nonassoc ';'
%left ','
%nonassoc FUNCAO
%nonassoc LAMBDA
%nonassoc baixa
%nonassoc LET OTHER SETA IF THEN RELBEGIN RELEND PRE ESTADO
%nonassoc PERTENCE ELSE RETUR ALL EXIST EXIST1
%nonassoc '>'
%left IMPLICA
%left AND
%left OR
%left NOT
%nonassoc EQ NEQ LEQ GEQ '<' GT
%left STRCAT
%left ADD SUB
%left MUL DIV
%nonassoc NOTIN IN
%left UNION
%left INTER
%left '-'
%nonassoc '#' alta
%left '^'
%left PLUS
%left '/'
%left BSLASH
%left '.'
%left '['
%left '('
%left COMP
%left FSETA LIST SET
%right FSETA2
%left FADD
%left FPROD
%nonassoc CONSF ID IS ':' ORIO QUOTE CONCATORIO
%right maxima
%nonassoc maximam
%{
  #  ***  fim de definicao de prioridades ***

  #  ***  Simbolos Nao Terminais          ***
%}


%%
start: especificacao { dumpPerl(); };

especificacao: especificacao bloco
             | especificacao typesMod
             | especificacao ENDMODEL
	     | especificacao MODEL SIMB { }
	     |
	     ;

#--( Definicao de tipos )-------------------------------------------
defTipo: idTipo '=' defTp inv ';' {
		   fimdef(_def(mkatconst("inv_$_[1]->{atomo}"), $_[4])) if $_[4];
		   funnar("deftype", cons($_[1], $_[3]));
				  }
       | idTipo P4 defTp inv ';'  {
		   fimdef(_def(mkatconst("inv_%s$_[1]->{atomo}"),$_[4])) if $_[4];
		   funnar("deftype",cons($_[1], $_[3]));
				  }
       | error ';'                {
		   $_[0]->YYErrok;
		   mkatconst(";ERROR");
                                  }
       ;

inv : INV '(' SIMB ')' '=' { $CONTEXTO = 'd'; }  exp {
  $CONTEXTO = 't';
  return lambdaexp(cons(mkatomo($_[3]),	nill()),$_[7]) }
    |   { return nill() }
    ;

idTipo: SIMB         { mkatomo($_[1]) };

defTp: simpleType    { return ($CONTEXTO == 't')?insereEQ($_[1]):$_[1]; }
     | alternativa2  {
       my ($s,$s1);
       $s = sprintf("_%d", $cont_alt++);
       $s1 = $s;
       fimdef(funnar("deftype",
		     cons(mkatconst($s),
			  cons(mkatconst("ALT"),$_[1] ))));
       cons(mkatconst("TUP (tag ANY)"),
	    lista1(mkpair(mkatconst("val"),mkatomo($s1) )));
     }
  | alternativa  { return cons(mkatconst("ALT"),$_[1] ); }
  | tuplo        { $_[1] }
  ;

simpleType: SIMB               { cons(mkatomo($_[1]),   nill()) }
          | NIL                { cons(mkatconst("NIL"), nill()) }
          | relacao            { $_[1] }
          | funcfin            { $_[1] }
          | lista              { $_[1] }
          | conjunto           { $_[1] }
          | segmentoInicial    { cons($_[1], nill()) }
          | '(' simpleType ')' { $_[2] }
          ;

tuplo: simpleType INTER rtuplo2  { cons(mkatconst("TUP"), cons(funnar("_p1",$_[1]), $_[3])) }
     | itemtuplo rtuplo          { cons(mkatconst("TUP"), conc($_[1],               $_[2])) }
     ;

rtuplo2: simpleType                { $cont_tup = 3; cons(funnar("_p2",$_[1]), nill()) }
       | rtuplo2 INTER simpleType  { conc($_[1], cons( mklista( cons(mkatomo(idtup()), $_[3])), nill())) }
       ;

rtuplo: itemtuplo rtuplo       { conc($_[1], $_[2]); }
      |                        { nill() }
      ;

itemtuplo: SIMB ':' simpleType %prec minima { 
  cons(mklista(cons(mkatomo($_[1]),$_[3])), nill())
};

funcfin: simpleType SETA simpleType       { cons(mkatconst("FF"), [ mklista($_[1]), mklista($_[3])]) };

relacao: simpleType RELACAO simpleType    { cons(mkatconst("REL"), conc($_[1], $_[3])) };

lista: SIMB LIST                   { lista2(mkatconst("LIST"), mklista([mkatomo($_[1])])); }
     | '(' simpleType ')' LIST     { lista2(mkatconst("LIST"), mklista($_[2]));            }
     | segmentoInicial LIST        { lista2(mkatconst("LIST"), mklista([$_[1]]));          }
     ;

conjunto: SIMB SET                { lista2(mkatconst("SET"), mklista([mkatomo($_[1])])); }
        | '(' simpleType ')' SET  { lista2(mkatconst("SET"), mklista($_[2])); }
        | segmentoInicial SET     { lista2(mkatconst("SET"), mklista([$_[1]]));          }
        ;

segmentoInicial : INTEGER        { mkatconst("INT$_[1]") };

alternativa :      '[' simpleType ']'   %prec minima       { cons(mkatconst("NIL"), $_[2]); }
  | simpleType '|' simpleType           %prec minima       { conc($_[1],$_[3]); }
  | alternativa '|' '[' simpleType ']'  %prec minima       { conc($_[1],
								  cons(mkatconst("NIL"),$_[4] )); }
  | alternativa '|' simpleType          %prec minima       { conc($_[1],$_[3] ); }
  ;

alternativa2: simpleType PLUS simpleType   %prec minima        { conc($_[1],$_[3]) }
            | alternativa2 PLUS simpleType %prec minima        { conc($_[1],$_[3]) }
            ;

#--( Definicao de tipos nos modulos )-------------------------------

typesMod: TYPE {$CONTEXTO='t'} defTipo {defType($_[3])} restDefTypesMod ENDTYPE {$CONTEXTO='d'};

restDefTypesMod: defTipo { defType($_[1]); } restDefTypesMod
               |
               ;

#--( Bloco = (deffuncao+include+teste)* )---------------------------

bloco: bloco elemento    { }
     | elemento          { }
     ;

elemento: exp ';'                  { fimdef($_[1]) }
        | include                  { fimdef($_[1]) }
        | ESTADO SIMB ':' tipo ';' { fimdef(_def(mkatconst("_state"), _quote(mkatomo($_[2])))) }
        | directiva
        | deffuncao ';'            { functionDefinition($_[1]) }
        | error ';' { $_[0]->YYErrok } elemento
        | QUIT                     { fimdef(funnar("!",nill())); return(0); }
        ;

#--( directivas de debug/outras )-----------------------------------
directiva : DEBUGON   { } #$jjDEBUG = 1; }
  | DEBUGOFF          { } #$jjDEBUG = 0; }
  ;

#--( Includes )-----------------------------------------------------

include : INCLUDE SIMB '.' SIMB {
  my $comando;
  $comando = sprintf("seca %s.%s %s.met", $_[2], $_[4], $_[2] );
  print STDERR "system ($comando);\n";
  $comando = sprintf ("\"%s.met\"", $_[2]);
  fununa("load",mkatconst($comando));
}
  | INCLUDE STRING { fununa("nload",mkatomo($_[2])); }
  | INCLUDE SIMB { 
    my $comando;
    $comando = sprintf("seca %s %s.met",$_[2],$_[2] );
    print STDERR "system ($comando);\n";
    $comando = sprintf ("\"%s.met\"", $_[2]);
    fununa("load",mkatconst($comando));
  }
  | INCLUDEM STRING { fununa("load",mkatomo($_[2])); }
  | INCLUDEM SIMB '.' SIMB { 
    my $comando;
    $comando = sprintf ("\"%s.%s\"",$_[2], $_[4]);
    fununa("load",mkatconst($comando)); }
  | INCLUDEM SIMB {
    my $comando;
    $comando = sprintf ("\"%s\"",$_[2]);
    fununa("load",mkatconst($comando)); };

#--( definicao de funcoes )-----------------------------------------

deffuncao : SIMB '(' explist ')' '=' exp  { deffun($_[1],$_[3],$_[6]) }
  | FUNCAO SIMB assinatura precond # mensagem
  poscondicao {
    deffuncao($_[2],
	      $_[3]->{par},
	      $_[3]->{sig},
	      $_[4]->{s1},
	      $_[4]->{s2},
	      $_[5]);
  };

poscondicao : estado retorno  {  poscondicao($_[1],$_[2],1);}
  | retorno estado  {  poscondicao($_[1],$_[2],2);}
  | retorno         {  poscondicao(snill(),$_[1],1);}
  | estado          {  poscondicao($_[1],snill(),1);}
  | LET '(' deflist ')' IN poscondicao {
    funbin("let",mklista($_[3]),$_[6]);
  }
  ;

retorno : RETUR exp { $_[2] }
  ;

estado  : ESTADO exp { $_[2] }
  ;

assinatura : '(' explist2 ')' resultado  {
  my $a = {};
  $a->{par} = $_[2]->{par};
  $a->{sig} = mkpair(mklista($_[2]->{partyp}),$_[4]);
  return $a;
}
  ;

resultado : ':' resultado1 { $_[2] }
  |               { return mkatconst("NIL"); }
  ;

resultado1 : resultado1 tipo  { $_[2] }
  |                { return mkatconst("NIL"); }
  ;

tipo       : defTp                { return mklista($_[1]); }
  ;

explist2  : SIMB ':' tipo ',' explist2   {
  my $a = {};
  $a->{par}=cons(mkatomo($_[1]),$_[5]->{par});
  $a->{partyp}=cons($_[3],$_[5]->{partyp}); $a;
}
  | SIMB ':' tipo                 {
    my $a = {};
    $a->{par}=cons(mkatomo($_[1]),nill());
    $a->{partyp}=cons($_[3],nill()); $a;
  }
  | SIMB ',' explist2             {
    my $a = {};
    $a -> {par}=cons(mkatomo($_[1]),$_[3]->{par});
    $a -> {partyp}=cons(mkatconst("ANY"),$_[3]->{partyp}); $a;
  }
  | SIMB        {
    my $a = {};
    $a->{par}=cons(mkatomo($_[1]),nill()); 
    $a->{partyp}=cons(mkatconst("ANY"),nill()); $a;
  }
  | '(' SIMB ')'  ',' explist2    {
    my $a={};
    $a->{par}=$_[5]->{par};
    $a->{partyp}=$_[5]->{partyp}; $a;
  }
  | '(' SIMB ')'                  { return +{ par => nill(), partyp => nill() } }
  |                               { return +{ par => nill(), partyp => nill() } }
  ;

precond: PRE exp {
  my $a = {};
  $a->{s1}=$_[2];
  $a->{s2} = snill();
  $a;
}
  | PRE exp SETA exp {
    my $a={};
    $a->{s1}=$_[2];
    $a->{S2}=$_[4];
    $a;
  }
  |         {
	     my $a={};
	     $a->{s1}=snill();
	     $a->{s2}=snill();
	     $a;
	    }
  ;

#--( definicao de variaveis de Estado )-----------------------------

defobj   : SIMB  atrib exp           %prec baixa {
  _def(mkatomo($_[1]),$_[3]);
}
  | SIMB '.' SIMB  atrib exp  %prec baixa {
    funtre("tplus",mkatomo($_[1]),mkatomo($_[3]),$_[5]);
  }
  ;

atrib    : PERTENCE 
  ;

#--( Expressoes )---------------------------------------------------


exp: SIMB                      { mkatomo($_[1]) }
   | '(' exp ')'               { $_[2] }
   | CONSTANTE                 { mkatomo($_[1]) }
   | exp '(' explist ')'  %prec '('  { +{tipo => 'LISTA',
					lista => cons($_[1],$_[3])} }
   | FUNCAO assinatura precond #/* mensagem */ 
     poscondicao { lambdaexpfunc($_[2]->{par},$_[3]->{s1},$_[3]->{s2},$_[4]) }
   | LAMBDA '(' explist ')' '.' exp    %prec PERTENCE  { lambdaexp($_[3],$_[6]) }
   | SIMB '(' explist ')'     %prec '('                { mklista(cons(mkatomo($_[1]), $_[3])) }
   | QUOTE '(' explist ')'                    { mklista(cons(mkatconst("quote"), $_[3])) }
   | op_orio ORIO '(' exp ',' exp ')'     { funtre("reduce",$_[4],$_[1],$_[6]) }
   | CONCATORIO '(' exp ',' exp ')'     { funtre("reduce",$_[4], mkatconst("append"),$_[6]) }
   | NIL                       { mkatconst(undef) }
   | defobj                    { $_[1] }
   | strexp                    { $_[1] }
   | intexp                    { $_[1] }
   | ffexp                     { $_[1] }
   | relexp                    { $_[1] }
   | seqexp                    { $_[1] }
   | setexp                    { $_[1] }
   | letexp                    { $_[1] }
   | ifexp                     { $_[1] }
   | boolexp                   { $_[1] }
   | exp BSLASH exp             { _ds($_[1],$_[3]) }
   | exp '/' exp               { funbin("dr",$_[1],$_[3]) }
   | exp '[' exp ']'  %prec maxima        { _ap($_[1],$_[3]); }
   | SIMB '.' SIMB            {  _ap(mkatomo($_[1]), _quote(mkatomo($_[3]))) }
   | FunctExp
   ;

# | exp  exp {
#  #ifdef NYAG
#  $$=mklista(cons($_[1],$_[2]));
#  #endif
#  #ifdef PRETTY
#  $$ = ppExpExpList($_[1],$_[2]);
#  #endif
#  }


# DONE
strexp: STRING            { mkatomo($_[1],'String');     }
      | exp STRCAT exp    { funbin("strcap",$_[1],$_[3]) }
      ;

op_orio: SIMB   {   mkatomo($_[1])    }
       | UNION  { mkatconst("union")  }
       | ADD    { mkatconst("add")    }
       | STRCAT { mkatconst("strcat") }
       | MUL    { mkatconst("mul")    }
       | OR     { mkatconst("or")     }
#       | '^'    { mkatconst("append") }
       | PLUS   { mkatconst("plus")   }
       ;

#--( Expressoes Inteiras )----------------------------------------------
intexp: INTEGER      { mkatomo($_[1],"Number")   }
      | '#' exp      { fununa("card",$_[2])      }
      | exp ADD exp  { funbin("add",$_[1],$_[3]) }
      | exp SUB exp  { funbin("sub",$_[1],$_[3]) }
      | exp DIV exp  { funbin("div",$_[1],$_[3]) }
      | exp MUL exp  { funbin("mul",$_[1],$_[3]) }
      ;

#--( Expressoes Bool )----------------------------------------------

boolexp: exp IN exp            {      _in($_[1],$_[3]);    }
       | exp NOTIN exp         { _not(_in($_[1],$_[3]));   }
       | exp EQ exp            {      _eq($_[1],$_[3]);    }
       | exp AND exp           {     _and($_[1],$_[3]);    }
       | exp IMPLICA exp       { _or(_not($_[1]),$_[3]);   }
       | exp OR exp            {      _or($_[1],$_[3]);    }
       | NOT exp               {     _not($_[2])           }
       | exp '<' exp           { funbin("lt", $_[1],$_[3]) }
       | exp GT  exp           { funbin("gt", $_[1],$_[3]) }
       | exp '>' exp           { funbin("gt", $_[1],$_[3]) }
       | exp LEQ exp           { funbin("leq",   $_[1],$_[3]) }
       | exp GEQ exp           { funbin("geq",   $_[1],$_[3]) }
       | exp NEQ exp           { funbin("neq",$_[1],$_[3]) }
       | IS defTp '(' exp ')'  { funnar("is",conc($_[2], cons($_[4],nill()))) }
       | ALL '(' all ')'       { $_[3] }
       | EXIST '(' exist ')'   { $_[3] }
       | EXIST1 '(' exist1 ')' { $_[3] }
       | BOOL                   { mkatomo($_[1],'Boolean') }
       ;

FunctExp : exp SET {
  _lambda1( mkatconst("_y_"), 
	    _set( mkpair($_[1], mkatconst("_x_")),
		  _from(mkatconst("_x_"),mkatconst("_y_"))));
}
  | exp LIST {
    _lambda1( mkatconst("_y_"), 
	      _seq( mkpair($_[1], mkatconst("_x_")),
		    _from(mkatconst("_x_"),mkatconst("_y_"))));
  }
  | exp FSETA {
    _lambda1( mkatconst("_a_"), 
	      _ff1( _list2( mkpair( $_[1],mkatconst("_b_")),
			    _ap(mkatconst("_a_"),mkatconst("_b_"))),
		    _from(mkatconst("_b_"),_dom(mkatconst("_a_")))));
  }
  | FSETA2 exp  {
    _lambda1( mkatconst("_y_"), 
	      _ff1( _list2(mkatconst("_x_"),
			   mkpair($_[2], _ap(mkatconst("_y_"),mkatconst("_x_")))),
		    _from(mkatconst("_x_"),_dom(mkatconst("_y_")))));
  }
  | exp COMP exp {
    _lambda1( mkatconst("_y_"), mkpair($_[1],mkpair($_[3],mkatconst("_y_"))));
  }
  | ID exp  {
    _ff1( _list2( mkatconst("_x_"), mkatconst("_x_")),
	  _from(mkatconst("_x_"),$_[2]));
  }
  | CONSF exp  {  _lambda1( mkatconst("_y_"), $_[2]) }
  | expFAlist  {  fununa("fadd", funnar("list",$_[1])) }
  | expFPlist  {  fununa("fprod",funnar("list",$_[1])) }
  ;

expFAlist: exp FADD exp         { cons($_[1],cons($_[3],nill())) }
         | expFAlist FADD exp   { conc($_[1],cons($_[3],nill())) }
         ;

expFPlist: exp FPROD exp        { cons($_[1], cons($_[3],nill())) }
         | expFPlist FPROD exp  { conc($_[1], cons($_[3],nill())) }
         ;

all: SIMB PERTENCE exp ',' all  { funtre("ALL",mkatomo($_[1]),$_[3],$_[5]) }
   | SIMB PERTENCE exp ':' exp  { funtre("ALL",mkatomo($_[1]),$_[3],$_[5]) }
   ;

exist: SIMB PERTENCE exp ',' exist { funtre("EXIST",mkatomo($_[1]),$_[3],$_[5]) }
     | SIMB PERTENCE exp ':'  exp  { funtre("EXIST",mkatomo($_[1]),$_[3],$_[5]) }
     ;

exist1: SIMB PERTENCE exp ',' exist1  { funtre("EXIST1",mkatomo($_[1]),$_[3],$_[5]) }
      | SIMB PERTENCE exp ':'  exp    { funtre("EXIST1",mkatomo($_[1]),$_[3],$_[5]) }
      ;

#--( Set e Seq )----------------------------------------------------

setexp : '{' compreensao '}'      { funnar("set",$_[2])                }
       | '{' extensao '}'         { funnar("makeset",inverte($_[2]))   }
       | '{' '}'                  { funnar("makeset",nill())           }
       | exp INTER exp            { funbin("intersection",$_[1],$_[3]) }
       | exp UNION exp            { funbin("union",       $_[1],$_[3]) }
       | exp '-' exp              {                 _diff($_[1],$_[3]) }
       ;

compreensao:   exp '|' fromlist    { cons($_[1],$_[3]) };
compreensao2:  exp '|' fromlist2   { cons($_[1],$_[3]) };

extensao: extensao ',' exp       { cons($_[3], $_[1])  }
        | exp                    { cons($_[1], nill()) }
        ;

seqexp2: compreensao2           { funnar("seq",$_[1]) }
  | extensao ',' exp '>'   { funnar("makeseq",inverte(cons($_[3],$_[1]))) }
  | exp '>'                { funnar("makeseq",cons($_[1],nill())) }
  | '>'                    { funnar("makeseq",nill()) }
  | exp ':' exp '>'        { funbin("cons",$_[1],$_[3]) }
  ;

seqexp: '<' { Camila::caller::set_in_sequence(Camila::caller::get_in_sequence() + 1) } seqexp2 {
              Camila::caller::set_in_sequence(Camila::caller::get_in_sequence() - 1); $_[3] }
  | exp '^' exp              { funbin("append",$_[1],$_[3]) }
  ;

fromlist : from ',' fromlist           { cons($_[1],$_[3]) }
  | from                        { cons($_[1], nill()) }
  ;

fromlist2: from ',' fromlist2          { cons($_[1],$_[3]) }
  | from2                       { cons($_[1], nill()) }
  ;

from     : SIMB PERTENCE exp           { _from(mkatomo($_[1]),$_[3]) }
  | SIMB PERTENCE exp ':' exp  {
    funtre("from",mkatomo($_[1]),$_[3],$_[5]);
  } 
  ;

from2     : SIMB PERTENCE exp '>'         {
					   _from(mkatomo($_[1]),$_[3]);
					  }
  | SIMB PERTENCE exp ':' exp '>' {
				   funtre("from",mkatomo($_[1]),$_[3],$_[5]);
				  } 
  ;

#--( Funcoes finitas e relacoes binarias )--------------------------


ffexp: '[' ffcompreensao ']'    { funnar("ff1",$_[2]); }
     | '[' exppairlist ']'      { funnar("makeff",inverte($_[2])); }
     | exp PLUS exp             { _plus($_[1],$_[3]); }
     ;

ffcompreensao:  exp SETA exp '|' fromlist   { cons(_list2($_[1],$_[3]),$_[5]) };

exppairlist: exppairlist ',' exppair     { cons($_[3],  $_[1]) }
           | exppair                     { cons($_[1], nill()) }
           |                             { nill(); }
           ;

exppair: exp SETA exp   { mkpair($_[1],$_[3]) };

relexp: RELBEGIN ffcompreensao RELEND  { funnar("rel",             $_[2]) }
      | RELBEGIN exppairlist RELEND    { funnar("makerel",inverte($_[2])) }
      ;

explist: exp ',' explist             { cons($_[1],  $_[3]) }
       | exp                         { cons($_[1], nill()) }
       |                             { nill(); }
       ;

#--( Expressoes condicionais )--------------------------------------

letexp: LET '(' deflist ')' IN exp  %prec LET { funbin("let",mklista($_[3]),$_[6]) };

deflist: def ',' deflist            { cons($_[1],  $_[3]) }
       | def                        { cons($_[1], nill()) }
       | comdef ',' deflist         { conc($_[1],  $_[3]) }
       | comdef                     { $_[1] }
       ;

comdef   : '<' SIMB ',' SIMB GTs '=' exp 
  {
    lista3(mkpair(mkatconst("_"),$_[7]),
	   mkpair(mkatomo($_[2]),fununa("first",mkatconst("_"))),
	   mkpair(mkatomo($_[4]),fununa("second",mkatconst("_"))));
  }
  ;

def: SIMB '=' exp            { mkpair(mkatomo($_[1]), $_[3]) }
   | '=' exp                 { mkpair(mkatconst("__"),$_[2]) }
   ;

ifexp: IF  exp THEN exp            { funbin("if",  $_[2],$_[4])       }
     | IF '(' expcaselist          { funnar("cond",$_[3])             }
     | IF  exp THEN exp ELSE exp   { funtre("if",  $_[2],$_[4],$_[6]) }
     ;

expcaselist: casepair ',' expcaselist  { cons($_[1],$_[3]) }
           | casepair ')'              { cons($_[1],nill()) }
           | ELSE SETA exp ')'         { cons(mkpair(_true(),$_[3]), nill()) }
           | casepair ')' OTHER exp    { cons($_[1],cons(mkpair(_true(),$_[4]), nill())) }
           ;

casepair: exp SETA exp  { mkpair($_[1],$_[3]) }
        | is_exp        { $_[1] }
        ;

is_exp: exp IS '<' SIMB ':' SIMB GTs SETA exp {
  mkpair( _and(_not(_null($_[1])), 
	       _is(mkatconst("LIST ANY"),copia($_[1]))),
	  _let(lista2(mkpair(mkatomo($_[4]),_hd(copia($_[1]))),
		      mkpair(mkatomo($_[6]),_tl(copia($_[1])))),
	       $_[9]));
}
  | exp IS '<' GTs SETA exp  {  mkpair(_null($_[1]),$_[6]) }
  | exp IS '{' SIMB ':' SIMB '}'  SETA exp {
    mkpair(_and(_not(_null($_[1])), 
		_is(mkatconst("SET ANY"),copia($_[1]))),
	   _let(lista2(mkpair(mkatomo($_[4]),_choice(copia($_[1]))),
		       mkpair(mkatomo($_[6]),
			      _diff(copia($_[1]),_set1(mkatconst($_[4]))))),
		$_[9]));
  }
  | exp IS '{' '}' SETA exp  { mkpair(_null($_[1]),$_[6]); }
  | exp IS '[' SIMB SETA SIMB ':' SIMB ']' SETA exp {
    mkpair(
	   _and(_not(_null($_[1])), 
		_is(mkatconst("FF ANY ANY"),copia($_[1]))),
	   _let(lista3(mkpair(mkatomo($_[4]),_choice(_dom(copia($_[1])))),
		       mkpair(mkatomo($_[6]),_ap($_[1],mkatomo(copia($_[4])))),
		       mkpair(mkatomo($_[8]),_ds($_[1],_set1(mkatomo($_[4]))))),
		$_[11]));
  }
  | exp IS '[' ']' SETA exp  { mkpair( _null($_[1]), $_[6]) }
  | exp IS tag ':' SIMB SETA exp {
    mkpair(_and(_not(_null($_[1])), 
		#               /*_and(_is(mkatconst("LIST ANY"),copia($_[1])),)*/
		_eq(_p1(copia($_[1])),mkatomo($_[3]))),
	   _let(lista1(mkpair(mkatomo($_[5]),_p2(copia($_[1])))),
		$_[7]));
  }
  ;

GTs: '>'
   | GT
   ;

tag: INTEGER
   | SIMB
   ;

%%
  
  #  /* ---(Analisador lexico )----------------------------------------------*/
  
#  #include <string.h>
#  #include <malloc.h>


#  static int queres_comentarios=1;



#  #include <setjmp.h>
#  extern jmp_buf xljmpbuf ;
#  #include "lex.yy.c"

#  /* ---(Formata output )-------------------------------------------------*/
#  #if INTERACTIVE || FUNC
#  #include "iformata.c"
#  #else
#  #include "formata.c"
#  #endif

#  /* ---(Funcoes auxiliares)----------------------------------------------*/


#  void met(s)
#  char s [];
#  { 
#    strcat(strcpy(straux,s),".met");
#  }

#  char *aspas(s)
#  char *s;
#  {char *aux;
#   aux=(char *) malloc(strlen(s)+3);
#   return(strcat(strcat(strcpy(aux,"\""),s),"\""));
#  }




#  apsexp lambdaexpfunc(para,pre,exep,post)
#  aplista para;
#  apsexp pre, post, exep;
#  {apsexp defassi,deffu;
#    if(jjDEBUG)
#  /* ----(definicao : )------------------ */
#    {  
#      if (pre == snill()) 
#        deffu=(lambdaexp(para,post));
#      else 
#        { if (exep == snill())
#             exep = mkatconst("\"ERROR (precondition violated) in function \"");
#             deffu=lambdaexp(para,funtre( "if", pre, post, exep));
#         }
#      }
#    else
#  /* ----(definicao : )------------------ */
#        deffu=lambdaexp(para,post);
#    return(deffu);
#  }


#  #ifdef __TURBOC__
#  #define NAOBUF
#  #else
#  #define NAOBUF(f1,f2) setbuf(f1,NULL); setbuf(f2,NULL); fflush(f1); fflush(f2);
#  /*
#  #define NAOBUF setvbuf(yyout,buff,_IOLBF,BUFSIZ)
#  #define NAOBUFi setvbuf(stdin,buff,_IOLBF,BUFSIZ)
#  */
#  #endif __TURBOC__
#  /* ---(main )-----------------------------------------------------------*/
#  FILE *ftags;
#  char fichin[100];

#  char buff[BUFSIZ];
#  char buffi[BUFSIZ];
#  int _ERRO=0;
#  char *FILENAME="";

#  #ifdef FUNC
#  char * S_GLOBI;
#  char * S_GLOBO;
#  int seca(S,S2)
#  char * S;
#  char * S2;
#  {
#   _ERRO=0;
#   line_read=(char*)NULL;
#   S_GLOBI=S;
#   S_GLOBO=S2;
#   clear_metoobuf();
#   yyparse();
#   return(_ERRO);
#  }

#  /* ---(Tratamento de erros em FUNC)-------------------------------------*/

#  void erro(s) char *s; { _ERRO=1;}
#  void yyerror() {_ERRO=1;}

#  #else /*FUNC*/

#  extern int neverprompt;
#  main (argc,argv)
#  int argc;
#  char *argv[];
#  {
#  #ifdef INTERACTIVE
#       int i;
#       char S[200];
#  #ifdef PIPE
#       neverprompt=1;
#       NAOBUF(stdin,stdout);
#  #endif /*PIPE*/
#       tags( ftags=fopen("tags.aux","a"));
#  #ifndef PIPE
#         printversion();
#         printf("camila    version %s (%s)\n",cam_version, cam_date);
#  #endif /*PIPE*/
#         libxminit(0,NULL);   /* inicia xmetoo  */
#         sprintf(S,"(load \"%s/.metoorc\")",getenv("HOME"));
#  #ifndef PIPE
#       puts(S+7);
#  #endif /*PIPE*/
#       libxmevalstr(S);
#       if((argc ==3) && (!strcmp(argv[1],"-n")))
#         {
#  #ifdef PIPE
#            yyin=fopen(argv[2],"r");
#  #else /*PIPE*/
#            freopen(argv[2],"r",stdin);
#  #endif /*PIPE*/
#            FILENAME = strdup(argv[2]);
#            yyout = stdout;
#            queres_comentarios=0;
#            NAOBUF(yyin,yyout);
#          }
#       else if((argc ==2) && (!strcmp(argv[1],"-n")))
#         {
#            yyout = stdout;
#            queres_comentarios=0;
#            NAOBUF(stdin,yyout);
#          }
#       else
#          for(i=1; i< argc ; i++)
#            { puts(argv[i]);
#              sprintf(S,"(def _FILENAME \"%s\" ) ",argv[i]);
#              libxmevalstr(S);
#              sprintf(S,"(nload \"%s\" ) ",argv[i]);
#              libxmevalstr(S);
#            }
#      yyparse();
#  #else /*INTERACTIVE */

#  if((argc ==3) && (!strcmp(argv[1],"-n")))
#     { yyin = fopen(argv[2],"r");
#       FILENAME = strdup(argv[2]);
#       fprintf(stderr,"DEBUG1: %s %s %s\n",argv[0],argv[1], argv[2]);
#       yyout = stdout;
#       queres_comentarios=0;
#       NAOBUF(yyout,yyin);
#       yyparse();    }
#  else if((argc ==2) && (!strcmp(argv[1],"-n")))
#     { yyin = stdin;
#       FILENAME = strdup("");
#       fprintf(stderr,"DEBUG2: %s -n\n",argv[0]);
#       yyout = stdout;
#       queres_comentarios=0;
#       NAOBUF(yyout,yyin);
#       yyparse();    }
#    /* tags  : seca -t file 
#  else if((argc ==3) && (!strcmp(argv[1],"-t")))
#     {   _accao = 2;
#         yyin = fopen(argv[2],"r"); 
#         FILENAME = strdup(argv[2]);
#         if(yyin)
#           { ftags=fopen("tags.aux","a");
#         queres_comentarios=0;
#             strcpy(fichin,argv[2]); 
#             yyparse();
#           }
#         else    
#           fprintf(stderr,".can't open file '%s'\n",argv[3]);
#      } */
#    /* prettyp : seca -p infile outfile */
#  else if((argc == 4) && (!strcmp(argv[1],"-p")))
#     { _accao = 3;
#         yyin = fopen(argv[2],"r"); 
#         FILENAME = strdup(argv[2]);
#         if(yyin)
#           { yyout = fopen(argv[3],"w+");
#            yyparse();}
#         else    
#            fprintf(stderr,"..can't open file '%s'\n",argv[2]);
#      }
#    /* nyag  : seca filein fileout */
#  else if(argc == 3)
#     { _accao = 1;
#       yyin = fopen(argv[1],"r"); 
#       FILENAME = strdup(argv[1]);
#       if(yyin)
#         { yyout = fopen(argv[2],"w+");
#          yyparse();}
#       else    
#          fprintf(stderr,"...can't open file '%s'\n",argv[1]);
#      }
#    /* nyag  : seca file */
#  else if(argc ==2)
#      { _accao = 1;
#       yyin = fopen(argv[1],"r"); 
#       FILENAME = strdup(argv[1]);
#       if(yyin)
#          yyparse();
#       else    
#          fprintf(stderr,"....can't open file '%s'\n",argv[1]);
#      }
#  else if(argc == 1)
#      yyparse();
#  else 
#      fprintf(stderr,"Use:\n%s [filein [fileout]]\n     -p filein fileout\n     -t filein\n",argv[0]);

#  return _ERRO;
#  #endif /*INTERACTIVE */
#  }

#  /* ---(Tratamento de erros )--------------------------------------------*/

#  void erro(s)
#  char *s;
#  { _ERRO=1;fprintf(stderr,"%s %d : semantic ERROR: %s\n",FILENAME, yylineno,s);}

#  void yyerror()
#  { _ERRO=1;fprintf(stderr,"%s %d : syntatic ERROR detected in '%s'\n", 
#             FILENAME, yylineno,yytext);}

#  #endif /*FUNC */
#  yywrap() { return (1);}


#  /* ---(Tratamento de tipos )--------------------------------------------*/

#  #include "secatipo.c"

#  /*---(Gerador de TAGS )------------------------------------------------
#  */
#  static char func_name[30];

#  void gera_tag_pair(nome)
#  char *nome;
#  {
#  printf("invocada - %s\n",nome);
#  }


sub perl_func {
  my $func = shift;
  my @args = @_;
  return "Camila::$func(".join(",",@args).")";
}

sub perl_opbin {
  my ($operator, $arg1, $arg2) = @_;
  return "($arg1 $operator $arg2)";
}

sub mklista {
  my $lista = shift;
  return +{tipo => 'LISTA',
	   lista => $lista};
}

sub mkatconst { return +{tipo => 'ATCONST', atomo => shift} }

sub lista { lista1(@_) }
sub lista1 { cons(shift, nill()) }
sub lista2 { my ($a1,$a2)         = @_; return cons($a1, lista1($a2))         }
sub lista3 { my ($a1,$a2,$a3)     = @_; return cons($a1, lista2($a2,$a3))     }
sub lista4 { my ($a1,$a2,$a3,$a4) = @_; return cons($a1, lista3($a2,$a3,$a4)) }

sub funnar {
  my ($nome,$lista) = @_;
  return mklista(cons(mkatconst($nome), $lista));
}

sub funbin {
  my ($nome,$p1,$p2) = @_;
  mklista(lista3(mkatconst($nome), $p1, $p2));
}

sub funtre {
  my ($nome,$p1,$p2,$p3) = @_;
  mklista(lista4(mkatconst($nome), $p1, $p2, $p3));
}

sub mkatomo {
  my $val = shift;
  my $type;
  if ($type = shift) {
    +{ tipo => $type, atomo => $val };
  } else {
    +{ tipo => 'ATOMO', atomo => $val };
  }
}

sub fimdef {
  debug_show(shift);
  "";
}

sub defType {
  ## %types_table
  my $definition = shift;
  return unless ref $definition eq "HASH";
  return unless $definition->{tipo} eq "LISTA";

  my @list = @{$definition->{lista}};
  shift @list;
  my $var = shift @list;
  $var = $var->{atomo};

  ## print STDERR Dumper($definition);

  my $type = Camila::Type->new_from_list(@list);
  print "Defining type '$var'";
  if ($type->{type} ne "unknown") {
    print " as ",$type->show,"\n";
  } else { print "?\n"; }
  print "Type was rewritten\n" if exists $types_table{$var};
  $types_table{$var} = $type;


}

sub lambdaexp {
  my ($lista, $sexp) = @_;
  return funbin("lambda", mklista($lista), $sexp);
}

sub insereEQ {
  my $itipo = shift;
  my $aux = $itipo;
  my $iatomo;

  if (isatomo(head($itipo))) {
    $iatomo = (head($itipo))->{atomo};
    # se o atomo nao for nenhum dos seguintes:
    if ($iatomo eq "INT" || $iatomo eq"STR" || $iatomo eq "ANY" || $iatomo eq "SYM") {
      # inserir "EQ":
      $aux = cons(mkatconst("EQ"), $itipo);
    }
  }
  return $aux;
}

sub isatomo {
  my $x = shift;
  return $x->{tipo} eq "ATOMO";
}

sub mkpair {
  my ($s1,$s2) = @_;;
  return mklista(lista2($s1,$s2));
}

sub  nill { +[] }
sub snill { +[] }

sub fununa {
  my ($nome,$p1) = @_;
  return mklista(lista2(mkatconst($nome), $p1));
}

sub deffun {
  my ($nome,$l,$p) = @_;
  return mklista(cons(mkatconst("def"),
		      lista4(mkatomo($nome), mkatconst("lambda"),
			     mklista($l), $p)));
}

sub deffuncao {
  my ($nome,$para,$assin,$pre,$exep,$post) = @_;

  my ($defassi,$deffu);

  ### Assinatura!
  functionSignature($nome, $assin);

  if (is_snill($pre)) {
    $deffu = (deffun($nome,$para,$post));
  } else {
    if (is_snill($exep)) {
      $exep = funbin(
		     "strcat",
		     mkatconst("\"ERROR (precondition violated) in function \""),
		     mkatomo(aspas($nome)));
    }
    $deffu=(deffun($nome,
		   $para,
		   funtre( "if", $pre, $post, $exep)));
  }
  return $deffu;
}

sub poscondicao {
  #---(Definicao de Funcoes )-------------------------------------------
  my ($estado,$expressao,$n) = @_;

  my $aux;
  if( is_snill($estado) &&
      (ref($expressao) ne "ARRAY" || @$estado != 0) ) {
    $aux = $expressao;
  } elsif ( is_snill($estado) ) {
    erro("Function without postcondition (or ';' misplaced)");
    $aux = mkatconst("\"????\"");
  } elsif ( is_snill($expressao) ) {
    $aux = $estado;
  } else {
    $aux = funbin(($n==1)?"progn":"prog1", $estado, $expressao);
  }
  return $aux;
}

sub erro {
  my $string = shift;
  print STDERR "function erro: $string";
}

sub cons {
  my ($el,$list) = @_;
  return [$el, @$list];
}

sub conc {
  my ($l1,$l2) = @_;
  return [@$l1,@$l2];
}

sub head { return $_[0]->[0] }

sub idtup { sprintf("_p%d", $cont_tup++) }

sub inverte {
  my $list = shift;
  my @reversed = reverse @$list;
  return \@reversed;
}



sub _ops     { mkatconst("_ops") }
sub _true    { mkatconst("true") }

sub _and     { funbin("and",        @_) }
sub _ap      { funbin("ap",         @_) }
sub _or      { funbin("or",         @_) }
sub _set     { funbin("set",        @_) }
sub _seq     { funbin("seq",        @_) }
sub _from    { funbin("from",       @_) }
sub _plus    { funbin("plus",       @_) }
sub _ff1     { funbin("ff1",        @_) }
sub _list2   { funbin("list",       @_) }
sub _is      { funbin("is",         @_) }
sub _in      { funbin("member",     @_) }
sub _ds      { funbin("ds",         @_) }
sub _eq      { funbin("equal",      @_) }
sub _def     { funbin("def",        @_) }
sub _diff    { funbin("difference", @_) }

sub _list    { funnar("list",    shift) }
sub _quote   { fununa("quote",   shift) }
sub _p1      { fununa("p1",      shift) }
sub _p2      { fununa("p2",      shift) }
sub _set1    { fununa("makeset", shift) }
sub _tl      { fununa("tl",      shift) }
sub _not     { fununa("not",     shift) }
sub _null    { fununa("null",    shift) }
sub _dom     { fununa("dom",     shift) }
sub _hd      { fununa("hd",      shift) }
sub _choice  { fununa("choice",  shift) }

sub _lambda  { my ($a,$b) = @_; funbin("lambda", mklista($a)           ,$b) }
sub _lambda1 { my ($a,$b) = @_; funbin("lambda", mklista(cons($a,nill)),$b) }
sub _let     { my ($a,$b) = @_; funbin("let",    mklista($a)           ,$b) }

sub el1 { shift }
sub el2 { shift }

sub debug_show {
  Camila::debug(shift);
}

sub is_snill {
  my $x = shift;
  return (ref($x) eq "ARRAY" && @$x == 0);
}

sub functionDefinition {
  my $list = shift;
  my @list = @{$list->{lista}};
  my $fname = $list[1]{atomo};
  $functions_table{$fname}{def} = $list;
}

sub functionProcessing {
  my $list = shift;
  my @list = @{$list->{lista}};

  ## First element should be a 'def'
  my $elem = shift @list;

  ## Next element is the function name...
  $elem = shift @list;
  my $funcName = $elem->{atomo};

  ## Next, a 'lambda' element
  $elem = shift @list;

  %namespace = ();

  ## Vars...
  my $vars = shift @list;
  my @vars = map { $_->{atomo} } @{$vars->{lista}};
  my $contents = "my (".join(", ",map {"\$$_"} @vars).") = \@_;\n";

  if (exists($functions_table{$funcName}{args})) {
    my @args = @{$functions_table{$funcName}{args}};
    @namespace{@vars} = @args;
  } else {
    ### GAH! :)
  }

  ## Definition...
  my $def = shift @list;
  my $c = def2perl($def);
  $contents.= $c->[1];
  my $type = $c->[0];
  if (exists($functions_table{$funcName}{returns})) {
    my $retype = $functions_table{$funcName}{returns}->show;
    if ($retype eq $type) {
      return "sub ${funcName} {\n",indent($contents),"}\n\n";
    } else {
      print STDERR "$funcName should return $retype but is returning $type\n";
      return "";
    }
  } else {
    ### GAH! :)
  }
}

sub def2perl {
  my $def = shift;

  if (exists($def->{lista})) {
    my @def = @{$def->{lista}};
    my $command = shift @def;

    if ($command->{tipo} eq "ATCONST") {
      if ($command->{atomo} eq "let") {
	Camila::Commands::_let(@def);
      } elsif ($command->{atomo} eq "if") {
	Camila::Commands::_if(@def);
      } elsif ($command->{atomo} eq "lambda") {
	Camila::Commands::_lambda(@def);
      } else {
	my @pdefs = map { def2perl($_) } @def;
	my @types = map { ref($_->[0])?$_->[0]->show:$_->[0] } @pdefs;
	print STDERR "Searching for $command->{atomo} (",join(",",@types),")\n";
	my $def = Camila::Prototype::definition($command->{atomo},\@types);
	if (not exists($def->{error})) {
	  [$def->{return} , &{$def->{function}}(@pdefs)]
	} else {
	  print STDERR $def->{error};
	  exit(1);
	}
      }
    } elsif ($command->{tipo} eq "ATOMO") {
      my $name = $command->{atomo};
      if (exists($functions_table{$name})) {
	$command->{atomo}."(".join(", ",map{def2perl($_)}@def).")";
      } else {
	my @pdefs = map { def2perl($_) } @def;
	my @types = map { ref($_->[0])?$_->[0]->show:$_->[0] } @pdefs;
	print STDERR "Searching for $name (",join(",",@types),")\n";
	my $def = Camila::Prototype::definition($name, \@types);
	if (not exists($def->{error})) {
	  [$def->{return} , &{$def->{function}}(@pdefs)]
	} else {
	  print STDERR $def->{error};
	  exit(1);
	}
      }
    } else {
      $command->{tipo}.":".$command->{atomo}.Dumper(\@def);
    }

  } elsif ($def->{tipo} eq "ATOMO") {
    my $type;
    $type = (exists($namespace{$def->{atomo}}))?$namespace{$def->{atomo}}:"UNKNOWN";
    return [$type, "\$$def->{atomo}"];
  } elsif ($def->{tipo} eq "Number") {
    return ['INT', "Camila::Number::new($def->{atomo})"];
  } elsif ($def->{tipo} eq "String") {
    return $def->{atomo}
  } else {
    "$def->{tipo}"
  }
}


sub indent {
  my $text = shift;
  my $indent = " " x 2;
  $text =~ s/^/$indent/;
  $text =~ s/\n/\n$indent/g;
  $text =~ s/\n\s*$/\n/;
  return $text;
}


sub functionSignature {
  my $funcName = shift;
  my $signature = shift;

  my $args = $signature->{lista}[0];
  my $return = $signature->{lista}[1];

  push @{$functions_table{$funcName}{args}},
    map {Camila::Type->new_from_list(@{$_->{lista}})} @{$args->{lista}};

  $functions_table{$funcName}{returns} = Camila::Type->new_from_list(@{$return->{lista}});
}

sub dumpPerl {

  for my $function (keys %functions_table) {
    print "# $function...\n";
    print functionProcessing($functions_table{$function}{def});
  }
}

sub dumpNamespace {
  my $str = "";
  for my $k (sort keys %namespace) {
    $str.= "# $k: ",$namespace{$k}->show(),"\n";
  }
  return $str;
}