daily pastebin goal
39%
SHARE
TWEET

p_expression.ads

evanescente-ondine Feb 13th, 2018 68 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. with Ada.Exceptions, Ada.Strings.Unbounded.Text_Io, Ada.Text_IO, P_Pile_4, Ada.Strings.Fixed, Ada.Strings.Unbounded, Ada.Text_IO, Ada.Strings.Maps;
  2. use Ada.Strings.Unbounded, Ada.Strings, Ada.Strings.Fixed, Ada.Text_IO, Ada.Strings.Maps;
  3.  
  4. with P_Token, P_Token.Parenthese, P_Token.Operande, P_Token.Terminateur, P_Token.Operateur;
  5. use P_Token, P_Token.Parenthese, P_Token.Operande, P_Token.Terminateur, P_Token.Operateur;
  6.  
  7. package body P_Expression is
  8.  
  9.    procedure LIRE (L_EXPRES : out UNBOUNDED_STRING) is
  10.    begin
  11.       loop
  12.      GET_LINE (L_EXPRES);
  13.      if LENGTH (L_EXPRES) > 80 then PUT_LINE ("Trop de charactères, ne doit pas dépasser 80. Refaites.");
  14.      else return;
  15.      end if;
  16.       end loop;
  17.    end;
  18.    procedure Analyse_Lexicale
  19.      (V            : out T_Vect_Token;
  20.       C            : in  Unbounded_String;
  21.       LONG_VEC_OUT : out NATURAL) is
  22.  
  23.       INDEX_COURANT : NATURAL range 1 .. LENGTH (C) := 1;
  24.       CHAINE        : STRING := TO_STRING (C);
  25.       ELEMENT       : Character renames CHAINE (INDEX_COURANT);
  26.    begin
  27.       LONG_VEC_OUT := 1;
  28.       loop
  29.      case ELEMENT is
  30.         when '+' | '-' | '*' | '/' =>
  31.            V (LONG_VEC_OUT) := new T_Token_Operateur'(L_Operateur => T_Operateur'Value (STRING'(1 => ELEMENT)));
  32.         when '(' => V (LONG_VEC_OUT) := new T_TOKEN_PARENTHESE'(La_Parenthese => '(');
  33.         when ')' => V (LONG_VEC_OUT) := new T_TOKEN_PARENTHESE'(La_Parenthese => ')');
  34.         when ';' => V (LONG_VEC_OUT) := new T_TOKEN_TERMINATEUR'(Le_Terminateur => ';');
  35.            return;
  36.         when '1' .. '9' =>
  37.            declare
  38.           FIRST, FIN : NATURAL := 0;
  39.            begin
  40.           PUT_LINE("LONG_VEC_OUT: " & INTEGER'Image(LONG_VEC_OUT) & " INDEX_COURANT:" & INTEGER'Image(INDEX_COURANT));
  41.           PUT_LINE ("FIRST :" & INTEGER'Image (FIRST) & " Fin: " & INTEGER'Image (FIN));
  42.           Find_Token (CHAINE, TO_SET ("123456789"), INDEX_COURANT, INSIDE, First, FIN);
  43.          
  44.           V (LONG_VEC_OUT) := new T_Token_Operande'(TO_TOKEN (Elem => INTEGER'Value (CHAINE(FIRST..FIN))));
  45.         --  V (LONG_VEC_OUT) := new T_Token_Operande'(TO_TOKEN (INTEGER'Value (CHAINE (FIRST .. FIN))));
  46.           INDEX_COURANT := FIN;
  47.            exception when others => PUT_LINE ("ICI !");    
  48.            end;
  49.         when others => raise DATA_ERROR with "La chaîne contient autre chose que les opérateurs +,-/,*, les parenthèses, des chiffres et un terminateur (;)";
  50.      end case;
  51.      exit when INDEX_COURANT = CHAINE'Length;
  52.      INDEX_COURANT := INDEX_COURANT + 1;
  53.      LONG_VEC_OUT := LONG_VEC_OUT + 1;
  54.       end loop;
  55.    end Analyse_Lexicale;
  56.          
  57.    procedure Syntaxe
  58.      (V           : in T_Vect_Token;
  59.       LONG_VEC_IN : in NATURAL;
  60.       Ok          : out Boolean) is
  61.       INDEX : NATURAL := 0;        
  62.       function TOKEN_COURANT return T_TOKEN'Class is
  63.       begin
  64.      INDEX := INDEX + 1;
  65.      return V (INDEX).all;
  66.       end;
  67.       procedure SUITE;
  68.       function DERNIER_TOKEN return BOOLEAN is (V(INDEX + 1) = null);
  69.       procedure VALIDE is
  70.       begin
  71.      if TOKEN_COURANT in T_TOKEN_OPERANDE then SUITE;
  72.      elsif TOKEN_COURANT in T_TOKEN_PARENTHESE then
  73.         if GET_ELEM (T_Token_Parenthese (TOKEN_COURANT)) = '(' then VALIDE;
  74.         else SUITE; end if;
  75.      else OK := FALSE;
  76.      end if;
  77.       end VALIDE;
  78.       procedure SUITE is
  79.       begin
  80.      if TOKEN_COURANT in P_Token.Operateur.T_Token_Operateur then VALIDE;
  81.      else OK := FALSE;
  82.      end if;
  83.       end SUITE;
  84.       procedure FIN is
  85.       begin
  86.      if TOKEN_COURANT in T_TOKEN_TERMINATEUR and then DERNIER_TOKEN then OK := TRUE;
  87.      else OK := FALSE;
  88.      end if;
  89.       end FIN;
  90.    begin
  91.       VALIDE; FIN;
  92.    exception
  93.       when MARQUEUR : others =>
  94.      PUT_LINE (ADA.EXCEPTIONS.EXCEPTION_INFORMATION (MARQUEUR)); OK := FALSE;
  95.    end Syntaxe;
  96.    
  97.    procedure Polonaise ( V_Entree    : in T_Vect_Token;
  98.              V_Result     : out T_Vect_Token;
  99.              LONG_VEC_IN  : in NATURAL;
  100.              LONG_VEC_OUT : out NATURAL) is
  101.       LOCAL             : NATURAL range 0 .. V_Entree'Length := 0;
  102.       PRIORITE_COURANTE : NATURAL := 0;
  103.       type TAMPON_PRIORITE_TYPE is new P_Token.Operateur.T_Token_Operateur with record
  104.      PRIORITE :  NATURAL range 0 .. 50 := 0;
  105.       end record;
  106.       overriding function To_Token (Elem  : in  T_Operateur) return TAMPON_PRIORITE_TYPE
  107.       is (ELEM, 0);
  108.       TAMPON_PRIORITE   : TAMPON_PRIORITE_TYPE;
  109.       type PTR_TOKEN_CLASS is access constant T_Token'Class;
  110.       package P_PILE_1 is new P_Pile_4 (T_Elem   => PTR_TOKEN_CLASS, Max_Pile => V_ENTREE'Length);
  111.       package P_PILE_2 is new P_PILE_4 (T_Elem => TAMPON_PRIORITE_TYPE, Max_Pile => V_Entree'Length / 2);
  112.       use P_PILE_1, P_Pile_2;
  113.       PILE_PRIORITE     : P_PILE_2.T_Pile (50);
  114.       PILE              : P_PILE_1.T_Pile (50);
  115.    begin
  116.       for I in 1 .. LONG_VEC_IN loop
  117.      declare
  118.         TOKEN : T_TOKEN'Class renames V_Entree (I).all;
  119.      begin
  120.         if TOKEN in T_Token_Parenthese then
  121.            PRIORITE_COURANTE := (if GET_ELEM (T_Token_Parenthese (TOKEN)) = '(' then PRIORITE_COURANTE + 1 else PRIORITE_COURANTE - 1);
  122.         elsif TOKEN in T_Token_Operateur then
  123.            for I in 1.. HAUTEUR(PILE_PRIORITE) loop
  124.           exit when Haut_Pile (PILE_PRIORITE).PRIORITE < PRIORITE_COURANTE;
  125.           Depiler (PILE_PRIORITE, TAMPON_PRIORITE);
  126.           EMPILER (PILE_PRIORITE, To_Token (TAMPON_PRIORITE.L_Operateur));
  127.            end loop;
  128.            EMPILER (PILE_PRIORITE, (Get_Elem (T_Token_Operateur (TOKEN)), PRIORITE_COURANTE));
  129.         else
  130.            EMPILER (PILE, TOKEN'Access);
  131.         end if;
  132.      end;
  133.       end loop;
  134.       for I in 1 .. HAUTEUR (PILE_PRIORITE) loop
  135.      DEPILER (Une_Pile => PILE_PRIORITE, Elem => TAMPON_PRIORITE);
  136.      EMPILER (PILE, new T_Token_Operateur'(To_Token (TAMPON_PRIORITE.L_Operateur)));
  137.       end loop;
  138.       LONG_VEC_OUT := Hauteur (PILE);
  139.       for I in reverse 1 .. LONG_VEC_OUT loop
  140.      DEPILER (PILE, V_Result (I));
  141.       end loop;
  142.  
  143.    end Polonaise;
  144.    
  145.    
  146.    function  Calcul ( V : in T_Vect_Token; LONG_VEC_IN: NATURAL) return Integer is
  147.       package P_PILE_OPERANDE is new P_PILE_4 (INTEGER, 45);
  148.       use P_PILE_OPERANDE;
  149.       PILE  : T_PILE (2);
  150.       TAMPON1, TAMPON2 : INTEGER;
  151.    begin
  152.       for I of V(1..LONG_VEC_IN) loop
  153.      if I.all in T_TOKEN_OPERANDE then
  154.         EMPILER (PILE, GET_ELEM (T_TOKEN_OPERANDE (I.all)));
  155.      else
  156.         DEPILER (PILE, TAMPON1);
  157.         DEPILER (PILE, TAMPON2);
  158.         case GET_ELEM (T_Token_Operateur (I.all)) is
  159.            when '-' => EMPILER (PILE, TAMPON1 - TAMPON2);
  160.            when '+' => EMPILER (PILE, TAMPON1 + TAMPON2);
  161.            when '*' => EMPILER (PILE, TAMPON1 * TAMPON2);
  162.            when '/' => EMPILER (PILE, TAMPON1 / TAMPON2);
  163.         end case;
  164.      end if;
  165.       end loop;
  166.       DEPILER (PILE, TAMPON1); return TAMPON1;
  167.    end;
  168.    
  169.    procedure Ecrire (V : in T_Vect_Token; LONG_VEC_IN: NATURAL) is
  170.    begin
  171.       for INDEX in 1..LONG_VEC_IN loop
  172.      V (INDEX).all.ECRIRE;
  173.       end loop;
  174.    end;
  175.    
  176. end P_EXPRESSION;
RAW Paste Data
Top