home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnat / examples / gen_list.adb < prev    next >
Text File  |  2000-07-19  |  2KB  |  85 lines
  1. package body Gen_List is
  2.  
  3.    function Append ( E1 : Elmt) return List is 
  4.    begin 
  5.       return new Internal'(E1, Nil);
  6.    end Append;
  7.    
  8.    function Append ( E1, E2 : Elmt) return List is
  9.    begin
  10.       return new Internal'(E1, new Internal'(E2, Nil));
  11.    end Append;
  12.    
  13.    function Append ( E1 : Elmt; L1 : List) return List is 
  14.    begin
  15.       return new Internal'(E1, L1);
  16.    end Append;
  17.    
  18.    function Append ( L1 : List; E1 : Elmt) return List is
  19.       L : List;
  20.    begin
  21.       if L1 = Nil then 
  22.          return new Internal'(E1, Nil);
  23.       else
  24.          L := L1;
  25.          while L.Next /= Nil loop
  26.             L := L.Next;
  27.          end loop;
  28.          L.Next := new Internal'(E1, Nil);
  29.          return L1;
  30.       end if;
  31.    end Append;
  32.  
  33.    function Append ( L1, L2 : List) return List is
  34.       L : List;
  35.    begin
  36.       if L1 = Nil then 
  37.          return L2;
  38.       else
  39.          L := L1;
  40.          while L.Next /= Nil loop
  41.             L := L.Next;
  42.          end loop;
  43.          L.Next := L2;
  44.          return L1;
  45.       end if;
  46.    end Append;
  47.    
  48.  
  49.    function Element (L : List; Number : Positive := 1) return Elmt is
  50.       L1 : List := L;
  51.    begin
  52.       for I in 2 .. Number loop
  53.          if L1 = Nil then 
  54.             raise Error_List;
  55.          end if;
  56.          L1 := L1.Next;
  57.       end loop;
  58.       return L1.E;
  59.    end Element;
  60.    
  61.    function Tail (L : List; Skip : Positive := 1) return List is
  62.       L1 : List := L;
  63.    begin
  64.       for I in 1 .. Skip loop
  65.          if L1 = Nil then 
  66.             raise Error_List;
  67.          end if;
  68.          L1 := L1.Next;
  69.       end loop;
  70.       return L1;
  71.    end Tail;
  72.  
  73.    function Length (L : List) return Natural is
  74.       C : Natural := 0;
  75.       L1 : List := L;
  76.    begin
  77.       while L1 /= Nil loop
  78.          C := C + 1;
  79.          L1 := L1.Next;
  80.       end loop;
  81.       return C;
  82.    end Length;
  83.  
  84. end Gen_List;
  85.