%{

  uses crt , dos , yacclib , lexlib ;

			{* Codage des p-operations *}
  const

  {* + *}       {* - *}    {* * *}    {* / *}
  ADD=1;        SUB=2;     MUL=3;     NEG=4;

  {* Operations booleennes *}
  ET=5;         OU=6;      LNEG=7;

  {* Expressions booleenes*}
  EQU=8;        GEQ=9;     LEQ=10;     LES=11;     GRT=12;      NEQ=13;

  {* Adressage et transfert de donnees *}
  LDC=14;       LDO=15;    STO=16;    MOV=17;



  {* Test de domaine *}
  CHK=18;

  {* Entrees et sorties *}
  PECRIRE=19;     PLIRE=20;

  {* Branchements *}
  UJP=21;        FJP=22;

  {* Initialisation *}
  INIT=23;

  {* Reservation de place *}
  RES=24;

  {* Fin de programme *}
  RET=25;       ERREUR=26;

			{* Declaration relative a la table des symboles *}


  TMAX=100;     {* longueur maximale de la table *}

  Type
	symbole = record
		       nom : string ;
		       dim : integer ;
		       depl : integer ;
		       valeur : integer ;
		  end;
  Var
      table : array [1..TMAX] of symbole ;
      longueur : integer ;
      recherche : boolean ;

  Procedure CompleterTable ( place, dimension : integer );
  begin
       table[place].dim:=dimension;
       if place = 1 then
          table[place].depl := 0
       else
           table[place].depl:=table[place-1].depl+table[place-1].dim;
  end;

			{* Declarations relatives au fichier du P-code *}

type
	P_instruction = record
				Operation : integer ;
				argument  : longint
			end;
	liste = ^cliste ;
	cliste = record
			adresse : longint ;
			suivant : liste
		end;


var
   Pcode : file of P_instruction ;
   tmp : liste;


  procedure em ( voperation : integer ; vargument : longint );
  {* ecrit la P-instruction voperation a la position courante du
                fichier assigne a la variable P-code*}

     var v : P_instruction ;
     begin
	  v.operation := voperation ;
	  v.argument := vargument ;
	  write (Pcode, v);
     end;

  procedure em1 (voperation : integer);
  {* ecrit la P_instruction voperation, sans argument, a la position
  courante du fichier assigne a la variable P_code*}
     var p : P_instruction ;
     begin
	  em (voperation, 0);
     end;

  function position  : longint ;
  {*renvoi la position courante*}
     begin position := filepos ( Pcode ) end;

  function liste0  : liste ;
  {*renvoi une liste vide*}
     begin liste0 := nil end;


  function liste1 (p : longint) : liste;
  {*renvoi une liste dont le seul element est p*}
     var l1 : liste ;
     begin
	  new (l1);
	  l1^.suivant := nil ;
	  l1^.adresse := p ;
	  liste1 := l1 ;
	  end;


  function concatener (l1, l2 : liste ) : liste ;
  {*renvoi la concatenation de l1 et l2*}
     var l : liste ;
     begin
     if l1=nil then
     begin
          l:=l2;
     end
     else
     begin
	l := l1 ;
	while l^.suivant <> nil do
		begin
		l := l^.suivant ;
		end;
	l^.suivant := l2;
     end;
	concatener := l;
     end;

  Procedure reprendre (var l : liste ; vaddresse : longint );
  {*ecrit l adresse vadresse comme argument des p-instruction de saut
  dont la position est dans la liste l*}
     var pos : longint ;
         p : P_instruction ;
         l1:liste;
     begin
          pos:=position;
          while l <> nil do
          begin
                seek( Pcode , l^.adresse );
	        read ( Pcode , p );
	        p.argument :=vaddresse ;
                seek ( Pcode , l^.adresse );
                write( Pcode , p );
                l1:=l;
                l := l^.suivant;
                dispose(l1);
          end;
                seek ( Pcode , pos );
     end;



%}




%token  <integer>          programme       retourne        variables
                           id              entier          tableau
                           nb              si              alors
                           sinon           tantque         faire
                           ecrire          lire            fin
                           oprel           opadd           opmult
                           non             affect

%nonassoc		   oprel
%left			   opadd	   '-'
%left			   opmult
%right			   non   	   moinsU

%type   <integer>          Lid             Ty              V
                           E               ES
                           T               F

%type   <longint>          M               Malors          Msinon
                           Mtantque        Mfaire

%type   <liste>             I               Li



%%


P               : programme Dv Li fin           { begin
                                                         tmp:=$3;
							 reprendre( tmp , position);
							 em1(ERREUR);
                                                  end; }
		;
Dv              :                                { recherche := true ;}
		| variables Lid fin              { recherche := true ;}
		;

Lid             : id ':' Ty                      { begin
						        completerTable( $1 , $3 );
						        em ( RES, $3 )
						  end; }
		| Lid id ':' Ty                  { begin
						        completerTable( $2 , $4 );
                                                        em(RES,$4);
						  end; }
		;

Ty              : entier                         { $$ :=  1; }
		| tableau'[' nb ']'              { begin
							if $3 < 1 then begin
							     write(' Taille invalide ');
							     halt
							 end;
							 $$ := $3
						 end; }
		;

Li              : I                             { ; }
		| Li M I                        {begin
                                                      tmp:=$1;
						      reprendre ( tmp , $2 );
						      $$ := $3
						 end; }
		;

I               : V affect E                    {begin
						     em1( STO ); $$ := liste0
						 end; }
		| si E Malors Li fin            { begin
						  $$ := concatener( liste1($3) , $4)
                                                  end; }

	        | si E Malors Li Msinon	Li fin	{begin
                                                      tmp:=(liste1($3));
						      reprendre( tmp , $5+1 );
						      $$ := concatener( liste1( $5 ) , $6 );
		                                 end;}

	        | Mtantque E Mfaire Li fin	{begin
						      em( UJP , $1 );
                                                      tmp:=$4;
						      reprendre(tmp,$1);$$ := liste1( $3)
		                                  end;}


		| ecrire '(' E ')'              { begin em1 ( PECRIRE ) ; $$ := liste0
						  end; }
		| retourne                      { begin $$ := liste0 ; em1 ( RET ) ; end; }
		;

V               :id                            { if table[ $1 ].dim = 1 then
                                                     begin
						     em ( LDC ,table [ $1 ].depl)
                                                     end
						  else begin
						       write(' Variable invalide ');
						       end;}
		|id '[' ES ']'                  { begin
                                                       em ( CHK , table [ $1 ].dim );
						       em ( LDC , table [$1 ].depl);
						       em1 ( ADD );
						  end; }
		;

E               : ES                     { ; }
		| ES oprel ES            { em1 ( $2 ) ; }
                ;
ES              : T                      { ; }
		| ES opadd T             { em1 ( $2 ) ; }
		| ES '-' T               { em1 ( SUB ) ; }
T		: F                      { ; }
		| T opmult F             { em1 ( $2 ) ;}

F               : '(' E ')'              { $$ := $2 ; }
                | '-' F    %prec moinsU  {em1( NEG ) ; }
                | non F                  {em1( LNEG ) ;}
		| id '[' ES ']'                  { begin
						       em ( CHK , table [ $1 ].dim );
						       em ( LDC , table [$1 ].depl);
						       em1 ( ADD ); em1 ( MOV )
						  end ; }
		| lire                          { em1 ( PLIRE ) ;}
		| id                            { if table [ $1 ].dim = 1 then
						     begin
						     em ( LDO , table[ $1 ].depl )
                                                     end
						   else begin write (' erreur dans la variable ');halt
							end; }
		| nb                            { em (LDC , $1 ) ; }
		;
M               : ';'                              { $$ := position ; }
		;

Malors          :alors                         { begin $$ := position ; em1 ( FJP ) end; }
		;

Msinon          :sinon                         { begin $$ := position ; em1 ( UJP ) end;}

		;

Mtantque        :tantque                       { $$ := position ; }
		;

Mfaire          :faire                         { begin $$ := position ; em1 ( FJP ) end; }
		;


%%



{$I a:GALLEX }


var fichier : pathstr ;
    repertoire : dirstr ;
    nom : namestr ;
    extension : extstr ;

begin
     if paramcount = 0 then
        begin
	writeln (' Commande : GAL nomDufichier[.GAL] ');
        halt(1)
     end
     else begin
     fichier := fexpand ( paramstr (1 ) );
     fsplit ( fichier , repertoire , nom , extension );
     if nom + extension = ' ' then begin
	writeln( ' Commande : GAL NomDuFichier[.GAL]' );halt(1)
     end;
     if extension = ' ' then extension := '.GAL' ;

     {$I-}
     assign ( yyinput , repertoire + nom + extension ) ;
     reset ( yyinput );
     {$I+}

     if IOresult <> 0 then begin
	write('Impossible d ouvrir le fichier : ');
	writeln( repertoire + nom + extension ) ;
        readln;
        halt(1)
     end
end;

{$I-}
assign (Pcode , repertoire + nom + '.PCO' );
rewrite ( Pcode );
{$I+}

if IOresult <> 0 then begin
   writeln('Impossible d ouvrir un fichier pour la traduction.');
   readln;
   halt ( 1 )
end;
longueur := 0;
recherche := false ;
em1 ( INIT );
if yyparse = 0 then
begin
     writeln ('Traduction terminee.');
     readln;
end;
end.