{
BUG CONNU:
Le dernier caractere d'une ligne est ignoré si c'est une unite syntaxique d'un seul caractere(genre A , ; . ,etc)...
C'est a cause des eoln() situe un peu partout dans le fichier...(surtout dans la fonction ANALEX) il faudrait les remplacer par des test
CARLU=#13 mais ca ne marcherais que pour des fichier unix...Sous windows ou mac les fichiers sont differents, il y aurait des problemes
avec les test sur CARLU=#10 aussi etc...
}

program compilo;
uses CRT;

const
   LONG_MAX_IDENT   = 20;
   LONG_MAX_CHAINE  = 50;
   NB_MOTS_RESERVES = 9;

type
   T_UNILEX = ({separ,}motcle, ident, ent, ch, virg, ptvirg, point, deuxpts, parouv, parfer, inf, sup, eg, plus, moins, mult, divi, infe, supe, diff, aff );

var
   SOURCE	       : text;
   CARLU{,RDL}	       : char;
   CHAINE	       : array [1..LONG_MAX_CHAINE] of char;
   NOMBRE,NUMLINE      : integer;
   TABLE_MOTS_RESERVES : array [1..NB_MOTS_RESERVES,1..LONG_MAX_IDENT] of char;

procedure ERREUR(errnum : integer);
begin
   case errnum of
     1	       : begin
		    writeln('Fin de fichier...');
		    halt(1);
		 end;
     otherwise  writeln('une erreur est apparue...');
   end;
end; { ERREUR }

procedure LIRE_CAR;
begin
   if not eof(SOURCE) then
   begin
      read(SOURCE,CARLU);
      {writeln('Carlu=',CARLU);}
      if eoln(SOURCE) then
      begin
	 {writeln('Ligne suivante!');}
	 NUMLINE:=NUMLINE+1;
      end;
      {if (integer(CARLU)=10) then LIRE_CAR;}
   end
   else ERREUR(1);
end; { LIRE_CAR }

procedure SAUTER_COMMENTAIRE;
var i : integer;
begin
   i:=1;
   while {(not eof(SOURCE))}(TRUE) and (i<>0) do
   begin
      LIRE_CAR;
      if(CARLU='{') then i:=i+1;
      if(CARLU='}') then i:=i-1;
   end;
   LIRE_CAR;
   if (i<>0) then writeln('Erreur de separateur');
end; { SAUTER_COMMENTAIRE }

procedure SAUTER_SEPARATEUR;
begin
   while {not eof(SOURCE)}(TRUE) do
   begin
      if (CARLU='{') then SAUTER_COMMENTAIRE
      else
	 if ( (CARLU=' ') or eoln(SOURCE) or (CARLU=#10) or (CARLU=#9) ) then
	 begin
	    LIRE_CAR;
	 end
	 else break;
   end;
end; { SAUTER_SEPARATEUR }

function RECO_ENTIER:T_UNILEX;
var
   OLDN	  : integer;
   OLDCAR : char;
begin
   NOMBRE:=0;
   OLDN:=NOMBRE;
   OLDCAR:=CARLU;
   while {(not eof(SOURCE))} (CARLU>='0') and (CARLU<='9') do
   begin
      LIRE_CAR;
      NOMBRE:=NOMBRE*10+integer(OLDCAR)-integer('0');
      OLDCAR:=CARLU;
      if(OLDN>NOMBRE) then
	 ERREUR(4)
      else OLDN:=NOMBRE;{c pareil que de faire le test sur MAXINT et en choisissant un long a la place d'un entier...}
   end;
   RECO_ENTIER:=ent;
end; { RECO_ENTIER }

function RECO_CHAINE:T_UNILEX;
var
   isap	 : boolean;
   index : integer;
begin
   isap:=true;
   index:=1;

   while {not eof(SOURCE)}(TRUE) do
   begin
      LIRE_CAR;
      if(CARLU='''') then
      begin
	 if (isap=true) then isap:=false
	 else
	 begin
	    isap:=true;
	    CHAINE[index]:=CARLU;
	    index:=index+1;
	 end;
      end
      else
	 if isap=true then
	 begin
	    CHAINE[index]:=CARLU;
	    index:=index+1;
	 end
	 else break;{on arrive a la fin de la chaine}
   end;
   CHAINE[index]:=#0;
   RECO_CHAINE:=ch;
end; { RECO_CHAINE }

function EST_UN_MOT_RESERVE :boolean;
var
   i,j : integer;
begin
   {writeln('on Test si->',CHAINE, 'est un mot reserve');
   writeln('CHAINE[4]=',integer(CHAINE[4]),' pour memoire');
   writeln('CHAINE[5]=',integer(CHAINE[5]),' pour memoire');}
   i:=1;j:=1;
   EST_UN_MOT_RESERVE:=FALSE;
   
   while(i<=NB_MOTS_RESERVES) and (j<LONG_MAX_IDENT) do
   begin
      {writeln('on est est a tester avec',TABLE_MOTS_RESERVES[i]);}
      if(TABLE_MOTS_RESERVES[i][j]=CHAINE[j]) then
      begin
	 if(CHAINE[j]=#0) then
	    begin
	       EST_UN_MOT_RESERVE:=TRUE;
	       break;
	    end
	 else j:=j+1;
      end
      else
      begin
	 i:=i+1;
	 j:=1;
      end;
   end;
   if (j=LONG_MAX_IDENT) then EST_UN_MOT_RESERVE:=TRUE;
end; { EST_UN_MOT_RESERVE }


function RECO_IDENT_OU_MOT_RESERVE:T_UNILEX;
var
   size	: integer;
begin
   size:=1;
   while {not eof(SOURCE)}(TRUE) do
   begin
      if ((CARLU>='a') and (CARLU<='z')) or ((CARLU>='A') and (CARLU<='Z')) or ((CARLU>='0') and (CARLU<='9')) or (CARLU='_') then
      begin
	 if (size<=LONG_MAX_IDENT) then
	 begin
	    CHAINE[size]:=CARLU;
	    size:=size+1;
	 end;
	 LIRE_CAR;
      end
      else break;
   end;
   CHAINE[size]:=#0;
   while(size<LONG_MAX_CHAINE) do
   begin
      CHAINE[size+1]:=#0;
      size:=size+1;
   end;
   {Maintenant faut checker si c'est un mot cle ou non..}
   if (EST_UN_MOT_RESERVE) then
      RECO_IDENT_OU_MOT_RESERVE:=motcle
   else RECO_IDENT_OU_MOT_RESERVE:=ident;
end; { RECO_IDENT_OU_MOT_RESERVE }

function RECO_SYMB:T_UNILEX;
{var i : integer;}
begin
   {i:=1;}
   case CARLU of
     ':':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      if (CARLU='=') then
      begin
	 {CHAINE[i]:=CARLU;
         i:=i+1;}
	 RECO_SYMB:=aff;
	 LIRE_CAR;
      end
      else
	 RECO_SYMB:=deuxpts;
   end;
     ';':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=ptvirg;
   end;	
     ',': 
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=virg;
   end;
     '.':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=point;
   end;	
     '(': 
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=parouv;
   end;
     ')': 
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=parfer;
     end;
     '<':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      if(CARLU='=') then
      begin
	 {CHAINE[i]:=CARLU;
      i:=i+1;}
	    RECO_SYMB:=infe;
	    LIRE_CAR;
	 end
	 else
	    if (CARLU='>') then
	    begin
	      { CHAINE[i]:=CARLU;
	       i:=i+1;}
	       LIRE_CAR;
	       RECO_SYMB:=diff;
	    end else  RECO_SYMB:=inf;
   end;
     '>':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
	LIRE_CAR;
	if(CARLU='=') then
	begin
	   {CHAINE[i]:=CARLU;
      i:=i+1;}
	   RECO_SYMB:=supe;
	   LIRE_CAR;
	end
	else
	   RECO_SYMB:=sup;
   end;
     '=':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=eg;
   end;
     '+':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=plus;
   end;
     '-':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=moins;
     end;
     '*':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=mult;
     end;
     '/':
   begin
      {CHAINE[i]:=CARLU;
      i:=i+1;}
      LIRE_CAR;
      RECO_SYMB:=diff;
     end;
     otherwise ERREUR(5)
   end; { case }
   {CHAINE[i]:=#0;}
end; { RECO_SYMB }


function ANALEX:T_UNILEX;
begin
   if (eoln(SOURCE)) then SAUTER_SEPARATEUR;{BUG A CAUSE DU EOLN DE CETTE LIGNE}
   case CARLU of{ON POURRAIT REMPLACER LE eoln(SOURCE) par un if (CARLU=#13) mais c pas tres portable...}
     ' ','{',#10,#9{tab}:SAUTER_SEPARATEUR;
     '''': ANALEX:=RECO_CHAINE;
     'a'..'z','A'..'Z':ANALEX:=RECO_IDENT_OU_MOT_RESERVE;
     '0'..'9':	       ANALEX:=RECO_ENTIER;
     ',',';',':','.','(',')','<','>','=','+','-','*','/':ANALEX:=RECO_SYMB;
   end;
   {if (CARLU='''') then ANALEX:=RECO_CHAINE;
   if ((CARLU>='a') and (CARLU<='z'))or((CARLU>='A') and (CARLU<='Z')) then ANALEX:=RECO_IDENT_OU_MOT_RESERVE;
   if ((CARLU>='0') and (CARLU<='9')) then ANALEX:=RECO_ENTIER;}
end; { ANALEX }

procedure INIT_TABL(Mot :string);
{C'est le INSERE_TABLE_MOTS_RESERVES du polycop, ca gere pas l'insertion triee alphabetiquement...
On pourrait le faire mais bon c pas trop important...}
var i,j	: integer;
begin
   i:=1;j:=1;
   while (TABLE_MOTS_RESERVES[i][1]<>#0) and (i<=NB_MOTS_RESERVES)  do
   begin
      i:=i+1;
   end;
   
   while(MOT[j]<>#0)and(j<LONG_MAX_IDENT) do
   begin
      TABLE_MOTS_RESERVES[i][j]:=Mot[j];
      j:=j+1;
   end;

end; { INIT_TABL }

procedure INITIALISER;
begin
   NUMLINE:=0;
   assign(SOURCE,'test.pas');
   reset(SOURCE);
   INIT_TABL('CONST'#0);{si on mets pas les #0 comme il utilise tjrs le meme buffer, on aura genre FINRE au lieu de FIN dans le buffer}
   INIT_TABL('DEBUT'#0);{car il y avait ECRIRE avant...et donc ca plante}
   INIT_TABL('ECRIRE'#0);
   INIT_TABL('FIN'#0);
   INIT_TABL('LIRE'#0);
   INIT_TABL('PROGRAMME'#0);
   INIT_TABL('VAR'#0);
   {writeln('TABLE...[3]=',TABLE_MOTS_RESERVES[3]);}
   {INIT MOT CLES}
end;

procedure TERMINER;
begin
   close(SOURCE);
end; { TERMINER }

begin
   INITIALISER;
   LIRE_CAR;
   writeln('######################################');
   writeln('#######    ANALYSEUR LEXICAL  ########');
   writeln('#######    Projet 2001-2002   ########');
   writeln('#Berretti sophie / Duqueroix stephane#');
   writeln('######################################');

   while (TRUE){not eof(SOURCE)} do
   begin
     { readln(RDL);
      if (RDL='q') then break else
      begin}
	 case ANALEX of
	   {separ  : writeln('separateur trouve...');}
	   ch	   : writeln('chaine trouvée=',CHAINE);
	   motcle  : writeln('Mot Cle trouvé=',CHAINE);
	   ident   : writeln('identifiant trouvé=',CHAINE);
	   ent	   : writeln('Entier trouvé=',NOMBRE);
	   virg	   : writeln('Virgule trouvée');
	   ptvirg  : writeln('Point Virgule trouvé');
	   point   : writeln('Point trouvé');
	   deuxpts : writeln('Deux points trouvés');
	   parouv  : writeln('Parenthese ouverte trouvée');
	   parfer  : writeln('Parenthese fermée trouvée');
	   inf	   : writeln('Inferieur trouvé');
	   sup	   : writeln('Superieur trouvé');
	   eg	   : writeln('Egal trouvé');
	   plus	   : writeln('Plus trouvé');
	   moins   : writeln('Moins trouvé');
	   mult	   : writeln('Multiplié trouvé');
	   divi	   : writeln('Divisé trouvé');
	   infe	   : writeln('Inferieur ou égal trouvé');
	   supe	   : writeln('Superieur ou égal trouvé');
	   diff	   : writeln('Different trouvé');
	   aff	   : writeln('Affectation trouvé');
	   {otherwise writeln('Autre truc trouvé...')}
	 end; { case }
	 
      {writeln('CARLU courant=',CARLU,'=',integer(CARLU),' | CHAINE=->',CHAINE,'<- | NUMLINE=',NUMLINE,'| eoln(SOURCE)=',eoln(SOURCE));
      end;}
   end;
   TERMINER;
end.