(* THEORIE DES LANGAGES
   GROUPE 2
   ENSEIGNANT : M. Banderier Cyril

   PROPOSITION DE CORRIGE POUR LE TP1
*)


(* estimation du temps pour ecrire les procedures/fonctions 35 min
   sans la fonction POSISOUSMOT qui peut prendre 25 min,
   une fois tout ca ecrit, il est sage de faire quelques tests
   et de passer a un eventuel debogage (40 min)

   TEMPS TOTAL : 1h40
*)



CONST
Max=300;
(* je mets ici un nombre >255 car sinon, il suffit
d'utiliser le type STRING de Turbo Pascal.  Par ailleurs je supposerai
pour tout le reste du TP qu'il n'aura pas de debordement,
c'est-Ö-dire que personne ne va s'amuser avec perversion 
a  ajouter une 301 lettre a un mot de longueur 300 ! :-)
*)


TYPE
mot= record
      ch : array[1..Max] of char;
      long : integer;
     end;


VAR
 u,v,w:mot;

PROCEDURE motvide(var u:mot);
BEGIN
u.long:=0;
END;

PROCEDURE adjoindre(var u:mot;x:char);
BEGIN
inc(u.long); (* valide si je suppose qu'il n'y pas de debordement *)
u.ch[u.long]:=x
END;


PROCEDURE lire(var u:mot);
var s:string;
    i:word;
BEGIN
write('Saisisez un mot : ');
readln(s);
u.long:=length(s);
for i:=1 to length(s) do u.ch[i]:=s[i]
END;

PROCEDURE retirer(var u:mot);
(* je vais aussi traiter le cas de u=mot vide *)
BEGIN
if u.long<>0 then dec(u.long)
END;

FUNCTION longueur(u:mot):integer;
BEGIN
longueur:=u.long
END;

FUNCTION nieme(u:mot;n:integer):char;
(* je suppose qu'on ne demande pas un caractere de rang plus grand
que la longueur du mot u ! *)
BEGIN
nieme:=u.ch[n]
END;

PROCEDURE ecrire(u:mot);
var i:word;
BEGIN
for i:=1 to u.long do write(u.ch[i]);
END;

PROCEDURE inverser(var u,v:mot);
(* je mets le miroir de u dans v *)
var i:word;
BEGIN
v.long:=u.long;
for i:=1 to u.long do v.ch[i]:=u.ch[u.long-i+1]
END;

FUNCTION compare(u,v:mot):boolean;
(* renvoie vrai ssi u=v *)
var i:word;
BEGIN

(* je traite tout de suite le cas du mot vide *)
if (u.long=v.long) and (u.long=0) then compare:=true
else

if u.long=v.long then
                  begin
                   i:=1;
                   while (u.ch[i]=v.ch[i]) and (i<u.long) do inc(i);
                   compare:=(i=u.long) and (u.ch[i]=v.ch[i])
                  end
                 else compare:=false;
END;

FUNCTION palindrome(u:mot):boolean;
(* Esope reste et se repose
Laval, radar, Roma amor,... *)
var v:mot;
BEGIN
inverser(u,v);
palindrome:=compare(u,v)
END;

PROCEDURE concatene(var u,v,w:mot);
var i:word;
BEGIN
w.long:=u.long+v.long;
for i:=1 to u.long do w.ch[i]:=u.ch[i];
for i:=1 to v.long do w.ch[u.long+i]:=v.ch[i];
END;


FUNCTION posisousmot(u,v:mot):integer;
(* renvoie -1 si v n'est pas un sous-mot de u
 et renvoie sinon la position de v

 C'est sans doute la fonction la moins facile a ecrire de ce TP,
 pour le type STRING, il existe la commande pos,
 faire CTRL-F1 sur le mot pos pour avoir l'aide  *)


var i,j,posi:word;

   FUNCTION egal(u,v:mot;i:word):boolean;
   (* renvoie vrai si u[i]u[i+1]... = v *)
   var j:word;
   BEGIN
   j:=1;
   while (u.ch[i+j-1]=v.ch[j]) and (j<v.long) do inc(j);
   egal:=(j=v.long) and (u.ch[i+j-1]=v.ch[j])
   END;

BEGIN

(* scanne until correspondance en i avec premiere lettre
    si correspondance totale alors c'est fini
     sinon scanne a partir i+1 etc... *)

if v.long>u.long then posisousmot:=-1 else
if v.long=0 then posisousmot:=0
            else begin
                 i:=0;
                 repeat
                 inc(i);
                 while (u.ch[i]<>v.ch[1]) and (i<u.long) do inc(i);
                 until egal(u,v,i) or (i=u.long);
                 if egal(u,v,i) then posisousmot:=i else
                 posisousmot:=-1;
                 end


END;

FUNCTION bienparenthese(u:mot):boolean;
(* je vais ici accepter un mot comme (a(ui)i()l)
  quoique la definition usuelle d'un mot bien parenthese
  est sur un alphabet de deux lettres par exemple '(' et ')'

  cette notion est tres intuitive, mais voici auqnd meme
  un rappel de la definition :
  "a une parenthese fermante correspond toujours une parenthese
  fermante situee _apres_ la parenthese ouvrante"
  Ainsi si on fait +1 pour les parentheses ouvrantes et
                   -1 pour les parentheses fermantes
  on doit toujours etre positif et finir en 0
  ce sera l'utilite de ma variable diff ci-dessous
*)

var i,diff:integer;
BEGIN
diff:=0;i:=0;

while (i<u.long) and (diff>=0) do begin
                                  inc(i);
                                  if u.ch[i]='('then inc(diff)
                                  else if u.ch[i]=')' then dec(diff);
                                  end;

bienparenthese:=(i=u.long) and (diff=0)
END;


BEGIN
writeln('**** Divers Tests ****');

lire(u);
write('Vous avez saisi u=');
ecrire(u);
writeln;

lire(v);
write('Vous avez saisi v=');
ecrire(v);
writeln;

concatene(u,v,w);
write('u.v=');
ecrire(w);
writeln;

writeln('u=v ? ', compare(u,v));

inverser(u,w);
write('Le miroir de u est ');
ecrire(w);
writeln;

writeln('posi de v dans u : ', posisousmot(u,v));

writeln('u palindrome ? ',palindrome(u));

writeln('u bien parenthese ? ',bienparenthese(u));
END.