Primitivas para la manipulacion de Estructuras Dinamicas - Cadenas

 -- Primitivas para la  manipulacion de Estructuras Dinamicas utilizando de ejemplo el tipo de dato cajero:

type T_Cajero;
   type Ptr_Cajero is access T_Cajero;
   type T_Cajero is
      record
         Codigo_Cajero     : Integer          := 0; 
         Nombre            : String (1 .. 30) := (others => ' '); 
         Tam_Nombre        : Natural:=0;           
         Apellido          : String(1..30):=(OTHERS=> ' ');
         Tam_Apellido      : Natural:=0;
         Carnet            : String(1..30):=(OTHERS=> ' ');
         Tam_Carnet        : Natural:=0;
       Telefono          : String(1..30):=(OTHERS=> ' ');
         Tam_Telefono      : Natural:=0;
       Email             : String(1..30):=(OTHERS=> ' ');
         Tam_Email       : Natural:=0;
       Codigo_Horario    : Integer:= 0; 
         Siguiente         : Ptr_Cajero   := null;
      end record;
------------------------------------------

   procedure Insertar_Inicio (
         Cad_Cajero : in out Ptr_Cajero;
         Elem           : in out Ptr_Cajero  )IS
   BEGIN
      IF (Elem = NULL)
            THEN
         PUT_LINE("Error al Insertar Inicio: No hay nada q insertar");
      ELSE
         Elem.All.Siguiente := Cad_Cajero;
         Cad_Cajero := Elem;
         Elem :=NULL;
      END IF;
      RETURN;
   END Insertar_Inicio ;


   procedure Insertar_Final (
         Cad_Cajero : in out Ptr_Cajero;
         Elem           : in out Ptr_Cajero  )IS
   Tmp : Ptr_Cajero := null;
   BEGIN
      IF (Elem = NULL)
            THEN
      PUT_LINE("Error al Insertar al Final: No hay nada q insertar");
      RETURN;
      END IF;

      IF (Cad_Cajero = NULL)
            THEN
         Cad_Cajero := Elem;
      ELSE
         Tmp := Cad_Cajero;
         LOOP
            EXIT WHEN Tmp.All.Siguiente =NULL;
            Tmp := Tmp.All.Siguiente;
         END LOOP;
         Tmp.all.Siguiente := Elem;
      END IF;
      Elem :=NULL;
      RETURN;
   END Insertar_Final ;


   procedure Eliminar_Inicio (
         Cad_Cajero : in out Ptr_Cajero;
         Elem           : in out Ptr_Cajero  )IS
   BEGIN
      IF (Cad_Cajero = NULL)
            THEN
            PUT_LINE("Hostias! La cadena esta vacia!");
         RETURN;
      END IF;
      Elem := Cad_Cajero;
      Cad_Cajero := Cad_Cajero.All.Siguiente;
      Elem.All.Siguiente :=NULL;
      RETURN;
   END Eliminar_Inicio ;


   procedure Eliminar_Final (
         Cad_Cajero : in out Ptr_Cajero;
         Elem           : in out Ptr_Cajero  )IS
   Tmp: Ptr_Cajero;
   BEGIN
   IF (Cad_Cajero = NULL)
            THEN
            raise  Cadena_Vacia ;
        RETURN;
   END IF;

   IF (Cad_Cajero.All.Siguiente = NULL)
            THEN
         Elem := Cad_Cajero;
         Cad_Cajero := NULL;
         RETURN;
   END IF;
      Tmp:=Cad_Cajero;
      LOOP
      -- Nos detenemos en el penultimo elemento
         EXIT WHEN Tmp.All.Siguiente.All.Siguiente = NULL;
         Tmp:= Tmp.All.Siguiente;
      END LOOP;
      Elem := Tmp.All.Siguiente;
      Tmp.All.Siguiente :=NULL;
      RETURN;
   END Eliminar_Final ;


   procedure Recorrer (
         Cad_Cajero : in     Ptr_Cajero )IS
   Tmp: Ptr_Cajero := null;
   BEGIN
      IF ( Cad_Cajero = NULL)
            THEN
         raise  Cadena_Vacia ;
         RETURN;
      END IF;
     
      Tmp:=  Cad_Cajero ;
      LOOP
         EXIT WHEN Tmp=NULL;
         Mostrar_Cajero(Tmp.All);
         Tmp := Tmp.All.Siguiente;
      END LOOP;
      RETURN;
   END Recorrer ;


   procedure Buscar_Codigo (
         Cad_Cajero : in     Ptr_Cajero;
         Codigo         : in     Integer;       
         Elem           :    out Ptr_Cajero  )IS

    Tmp : Ptr_Cajero := null; 
    begin
      if (Cad_Cajero=null) then
         raise  Cadena_Vacia ;
      else
         Tmp:=Cad_Cajero;
         loop
            exit when Tmp=null;
            exit when Tmp.All.Codigo_Cajero = Codigo;
            Tmp:=Tmp.All.Siguiente;
         end loop;
         if (Tmp=null) then
              raise Elemento_No_Encontrado;
         else
            Elem:=Tmp;
         end if;
      end if;

   END Buscar_Codigo ;

Ada- Accediendo a archivos secuenciales

  -- Primitivas para la manipulacion de Archivos secuenciales

   procedure Leer_TipoDeDato (
         Cad_TipoDeDato : in out Ptr_TipoDeDato )IS
 
      File : TipoDeDato_Seq.File_Type; 
      Tmp : Ptr_TipoDeDato          := null; 
   begin

      begin
         Open(
            File => File,           
            Mode => In_File,        
            Name => "LasAxilasSonDeliciosas.sec"
            );

      exception
         when Ada.Io_Exceptions.Name_Error =>
            Put_Line("FELICIDADES QUERIDO USUARIO ! ACABA DE INICIALIZAR EL PROGRAMA");
            return;
      end;

      loop
         exit when End_Of_File(File => File);
         Tmp:=new T_TipoDeDato;
         Read(File, Tmp.All);
         Tmp.All.Siguiente:=null;
         Insertar_Final(Cad_TipoDeDato,Tmp);
      end loop;
      Close(File => File);
   END Leer_TipoDeDato ;


   procedure Guardar_TipoDeDato (
         Cad_TipoDeDato : in     Ptr_TipoDeDato )IS
    File : TipoDeDato_Seq.File_Type; 
    Tmp  : Ptr_TipoDeDato; 
   begin
      Tmp:=Cad_TipoDeDato; --cabeza
      Create(File, Out_File,"LasAxilasSonDeliciosas.sec");
      loop
         exit when Tmp=null;
         Write (File,Tmp.All);
         Tmp:=Tmp.All.Siguiente;
      end loop;
      Close(File => File);
  
   END Guardar_TipoDeDato ;