sor.ads

package sor is 
   subtype int is integer range 0..100; 
   type queue(size : int := 10) is private; 
    
   procedure insert(q : in out queue; e : in integer); 
   procedure remove(q : in out queue; e : out integer); 
    
   function getSize(q : queue) return integer; 
   function isEmpty(q : queue) return boolean; 
   function isFull(q : queue) return boolean; 
    
   procedure concat(p : in out queue; q : in out queue);   --a q elemeit atteszi p-be 
    
private    
   type queue_vect is array(int range <>) of integer; 
    
   type queue(size : int := 10) is record 
      q : queue_vect(0..size);   --FIGYELEM 0..size-ig megy!!! 
      k : int := 0;   -- kezdetere mutat 
      l : integer := 0;   -- hossz 
   end record; 
 
end sor; 
 

sor.adb

package body sor is 
 
   --Most nem foglalkozunk a hibas esetekkel 
   procedure insert(q : in out queue; e : in integer) is  
   begin       
      q.q((q.k + q.l) mod (q.size + 1)) := e; 
      q.l := q.l + 1; 
   end insert; 
    
   procedure remove(q : in out queue; e : out integer) is  
   begin 
      e := q.q(q.k); 
      q.k := (q.k + 1) mod (q.size+1); 
      q.l := q.l - 1; 
   end remove; 
    
   function getSize(q : queue) return integer is  
   begin 
      return q.l; 
   end getSize; 
    
   function isEmpty(q : queue) return boolean is  
   begin 
      return q.l = 0; 
   end isEmpty; 
    
   function isFull(q : queue) return boolean is  
   begin  
      return q.l = q.size + 1; 
   end isFull; 
    
   procedure concat(p : in out queue; q : in out queue) is 
      e : integer; 
   begin 
      put_line("a"); 
      while not isEmpty(q) loop 
         remove(q,e); 
         insert(p,e); 
      end loop;    
   end concat; 
 
end sor; 
 

sormain.adb

with ada.text_io, sor; 
use ada.text_io, sor; 
 
procedure sormain is 
   p : queue(14); 
   q : queue(6); 
   e : integer; 
    
begin 
   insert(p,1); 
   insert(q,2); 
   insert(p,3); 
   insert(q,4); 
   insert(p,5); 
   insert(q,6); 
   insert(p,7); 
   insert(q,8); 
    
   concat(p,q); 
    
   while not isEmpty(p) loop 
      remove(p,e); 
      put_line(integer'image(e));            
   end loop; 
      
end sormain;