Exceptions, paquetages et récursivité

Exceptions

• "Levées" lorsqu'un problème grave survient dans le programme.
• On arrete alors l'exécution et on cherche les blocs de traitement d'exception, on quitte si on n'en trouve pas.
• On peut ainsi gérer les cas de constraint_error et autres.

begin
     -- bout de programme susceptible de provoquer
     -- l'exception E1 ou l'exception E2, ou une autre encore
exception
     -- bloc de traitement des exceptions
     when E1 =>  T1 ; -- traitement de l'exception E1
     when E2 =>  T2 ; -- traitement de l'exception E2
     when others => T3 ; -- autres cas
end

• Dessiner le déroulement dans différents cas
• Si elle n'est pas traitée, l'exception est "remontée" à la procédure appelante, et ainsi de suite.
• On peut définir ses propres exceptions : erreur : exception;. Faire raise erreur; pour la lever.
• A réserver aux cas d'erreur grave ou imprévus.

   Put ("Donner un entier naturel : ");
   loop
      begin
         Get (X); -- X est déclarée comme Natural
	 exit;    -- sortie de la boucle si get sans problème
      exception
          when Constraint_Error =>
             Put("valeur hors bornes, recommencez : ");
             Skip_Line ; -- vide le tampon
         when Data_error =>
            Put ("data error, recommencez : ");
            Skip_Line ;
      end ;
   end loop;
   Put("Valeur lue : ") ; Put (X) ;

Paquetages

• Regroupement des contraintes et opérations sur un type complexe.
• Séparation en deux fichiers ads (specification) et adb (body).

-- Ex_Package.ads :  spécification du package, partie visible et bien documentée
package Ex_Package is
   -- Renvoie un naturel qui est incrémenté à chaque appel.
   -- La première valeur renvoyée est 1.
   -- Pas d'exception spécifique. CONSTRAINT_ERROR quand on atteint Natural'Last 
   function Next return Natural ;
end Ex_Package ;

-- WITH : aller chercher ces packages, on va s'en servir
with Text_IO, Ada.Integer_Text_Io, Ex_package ;

-- USE : a partir de maintenant, si on utilise une procedure
-- du genre "get", il faut la chercher dans un de ces paquetages,
-- et on sait qu'il y en a une seule.
-- Si on ne met pas de USE, il faut prefixer tous les appels
-- de fonctions et procedures du paquetage par le nom du
-- paquetage. Indispensable si deux paquetages definissent
-- la meme chose, et qu'on veut choisir l'une ou l'autre version
-- selon les appels.
use Text_IO, Ada.Integer_Text_Io, Ex_package ;

procedure Use_Ex_Package is
   -- Renommage eventuel, pour raccourcir le nom,
   -- mais c'est le meme package, en un seul exemplaire, avec une seule variable Cpt
   --    package P1 renames Ex_Package ;

begin
   for I in 1..10 loop
      Put (Next) ;
      -- ou : Put (Ex_package.Next) ;
      -- prefixage inutile si on a le USE plus haut.
      -- ou put (P1.next) si on a renomme.
   end loop ;
end Use_Ex_Package ;

-- Ex_Package.adb : le corps du paquatage
package body Ex_Package is

   Cpt : Natural := 0 ;  -- caché !

   function Next return Natural is
   begin
      Cpt := Cpt+1;
      return Cpt ;
   end Next ;
end Ex_Package ;

• Séparation de l'interface publique et de l'implémentation interne, cachée.
• Réutilisation d'un meme code dans plusieurs programmes (factorisation, voir aussi généricité).
• Définition dans le ads des exceptions levées par le adb:
  Le programme utilisant le package sait quelles exceptions sont à traiter, dans quels cas.
• Type private ou limited private : type fourni, utilisé dans les signatures mais à structure cachée...

package Seq_Dans_Tab is
   type Seq is limited private ; -- Le type est déclaré ici, il est utilisable...
   function "=" (S1, S2 : Seq) return Boolean ;
   procedure Get (S : out Seq) ;
   procedure Put (S : in Seq)  ;
private
   Max : constant Natural := 100 ;
   type Tab is array (Integer range <>) of Integer ;
   type Seq is record           -- mais sa structure interne est privée et innaccessible
      T : Tab(1..Max);
      N : Integer range 0..Max := 0 ;
   end record ;
end Seq_Dans_Tab ;

package body Seq_Dans_Tab is
   function "=" (S1, S2 : Seq) return Boolean is
   begin
    [...]

with Ada.Text_Io, Ada.Integer_Text_IO, Seq_Dans_Tab ;
use Ada.Text_Io, Ada.Integer_Text_IO, Seq_Dans_Tab ;

procedure Use_Seq_Dans_Tab is
   S1, S2 : Seq ;
begin
   Get (S1) ;
   Get (S2) ;
   Put (S1) ;
   Put (S2) ;
   if S1 = S2 then
      Put ("sequences egales") ;
   else
      Put ("sequences inegales");
   end if ;
end Use_Seq_Dans_Tab ;

• Paquetages génériques : paramétrés par des types, des fonctions...
• Exemple : Paquetage de liste, paramétré par le type des éléments.
  package ListeEntier is new package Liste(Integer);.

Fonctions récursives

function fact (x : natural) return positive is
begin
   if x = 0 then 
      return 1 ;
   else
      return fact (x - 1) * x ;
   end if ;
end fact ;

• Plusieurs calculs en suspens, plusieurs "x" existant en même temps.
• Attention à la preuve de terminaison, sinon boucle infinie. Ici : strictement décroissant.

procedure AffBin (n : in natural) is
    -- affichage de la representation binaire de n
    -- on suppose que ca tient sur la ligne
    -- etat initial : le curseur est sur la ligne no i, en colonne c
    -- etat final : les chiffres binaires de n ont ete affiches a partir
    --              de la position (i,c) comprise, le curseur est sur la ligne
    --              i, dans la colonne qui suit le dernier chiffre affiche.
begin
    if n = 0  then
       put ('0') ;
    elsif n = 1 then
       put ('1') ;
    else
       AffBin (n/2);
       put (n mod 2);
    end if 
end AffBin ;

• Fonction "chapeau" : appelée une seule fois, au début ou à la fin.

procedure AffBinNL (n : in natural) is
  -- idem, mais passe à la ligne. On ne peut pas faire autrement.
begin
  AffBin (n);
  New_Line;
end AffBin ;

• Si la récursivité est terminale, on peut transformer la récursion en itérations.
• Intéret : Hanoi, les 8 reines ou le compte est bon qui seraient très complexes à coder sinon.
Fibonacci : Attention au nombre d'appels.
• Exercice : Fibonacci. Graphe d'appels
• Très utiles dans les parcours d'arbres ou de listes (cf cours suivants).
• Exemples : Tri par fusion :

type Tabint is array (Integer range <>) of Integer ;

   function  Fusion (Td1, Td2 :  Tabint) return Tabint is
      -- interclassement de deux tableaux tries dans un tableau intermediaire.
      Tt : Tabint(1..Td1'Length+Td2'length);
      I : Integer range Td1'First..Td1'Last+1 := Td1'First ;
      J : Integer range Td2'First..Td2'Last+1 := Td2'First ;
      K : Integer range 1..Td1'Length+Td2'Length+1 := 1 ;
      
   begin
      while I <= Td1'Last and J <= Td2'Last loop
         -- comparaison des 2 premiers elements Td1(I) et Td2(J)
         -- ajout du plus petit au resultat
         if Td1(I) < Td2(J) then
            Tt(K) := Td1(I) ;    I := I + 1 ;      K := K + 1 ;
         else
            Tt(K) := Td2(J) ;    J := J + 1 ;      K := K + 1 ;
         end if ;
      end loop ;

      -- recopie des elements de Td1 qui restent
      while I <= Td1'Last loop
         Tt(K) := Td1(I) ;       I := I + 1 ;      K := K + 1 ;
      end loop;

      -- recopie des elements de Td2 qui restent
      while J <= Td2'Last loop
         Tt(K) := Td2(J) ;       J := J + 1 ;      K := K + 1 ;
      end loop;

      return Tt ;
   end Fusion ;

• Procédure principale récursive avec tranches ou indices du tableau.
• Exercice : Recherche dichotomique.