home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / ada_1 / Examples_demos_ada_list < prev    next >
Encoding:
Text File  |  1992-10-01  |  3.0 KB  |  181 lines
  1. generic
  2.  
  3.     type ELEMENT is private;
  4.  
  5. package LIST_PACKAGE is
  6.  
  7.     type LIST is private;
  8.  
  9.     EMPTY_LIST : constant LIST;
  10.  
  11.     procedure APPEND(L : in out LIST; E : in ELEMENT);
  12.     procedure REMOVE(L : in out LIST; E : out ELEMENT);
  13.     procedure CONS(E : in ELEMENT; L : in out LIST);
  14.  
  15.     function  FIRST(L : in LIST) return ELEMENT;
  16.     function  LAST(L : in LIST) return ELEMENT;
  17.  
  18.     function IS_EMPTY(L : in LIST) return BOOLEAN;
  19.  
  20.     EMPTY : exception;
  21.  
  22. private
  23.  
  24.     type LIST_ITEM;
  25.  
  26.     type LIST is access LIST_ITEM;
  27.  
  28.     type LIST_ITEM is
  29.         record
  30.         ITEM : ELEMENT;
  31.         LINK : LIST := NULL;
  32.     end record;
  33.  
  34.     EMPTY_LIST : constant LIST := NULL;
  35.  
  36. end LIST_PACKAGE;
  37.  
  38.  
  39. package body LIST_PACKAGE is
  40.  
  41.     FREE : LIST := EMPTY_LIST;
  42.  
  43.     function IS_EMPTY(L : in LIST) return BOOLEAN is
  44.     --
  45.     -- Tests whether the LIST L is empty 
  46.     --
  47.     begin
  48.  
  49.         return L = EMPTY_LIST;
  50.  
  51.     end IS_EMPTY;
  52.  
  53.  
  54.     function NEW_L(E : in ELEMENT) return LIST is
  55.     --
  56.     -- This procedure creates a list node and places the
  57.     -- element in it.  It uses the FREE list if it is not empty.
  58.     --
  59.  
  60.     P : LIST;
  61.  
  62.     begin
  63.  
  64.     if FREE = EMPTY_LIST then
  65.         return  new LIST_ITEM'(E, NULL);
  66.     else
  67.         P := FREE;
  68.         FREE := FREE.LINK;
  69.         P.ITEM := E ;
  70.         return P;
  71.     end if;
  72.  
  73.     end NEW_L;
  74.  
  75.  
  76.     procedure APPEND(L : in out LIST; E : in ELEMENT) is
  77.     --
  78.     -- This procedure appends the element E to the list L.
  79.     --
  80.  
  81.         P : LIST;
  82.  
  83.     begin
  84.  
  85.     P := NEW_L(E);
  86.  
  87.         if L = EMPTY_LIST then
  88.         P.LINK := P;
  89.         else
  90.         P.LINK := L.LINK;
  91.         L.LINK := P;
  92.         end if;
  93.  
  94.         L := P;
  95.  
  96.     end APPEND;
  97.  
  98.  
  99.     procedure REMOVE(L : in out LIST; E : out ELEMENT) is
  100.     --
  101.     --  This procedure removes the first item from the list L and
  102.     --  returns its value in E.  
  103.     --  If the list is empty, it raises the exception EMPTY.
  104.  
  105.         P : LIST;
  106.  
  107.     begin
  108.  
  109.         if L = EMPTY_LIST then
  110.         raise EMPTY;
  111.         end if;
  112.  
  113.     P := L.LINK;
  114.         E := P.ITEM;
  115.  
  116.         if P = L then
  117.         L := NULL;        -- Removed last item from the list
  118.     else
  119.         L.LINK := P.LINK;
  120.         end if;
  121.  
  122.     P.LINK := FREE;        -- Add to the free list
  123.     FREE := P;
  124.  
  125.     end REMOVE;
  126.  
  127.  
  128.     procedure CONS(E : in ELEMENT; L : in out LIST) is
  129.     --
  130.     -- This procedure adds the element E onto the front of the list
  131.     --
  132.  
  133.     P : LIST;
  134.  
  135.     begin
  136.  
  137.     if L = EMPTY_LIST then
  138.         APPEND(L, E);
  139.     else
  140.         P := L;
  141.         APPEND(L, E);
  142.         L := P;
  143.     end if;
  144.  
  145.     end CONS;
  146.  
  147.  
  148.     function  FIRST(L : in LIST) return ELEMENT is
  149.     --
  150.     -- This function returns the first item in the list if the
  151.     -- list is not empty; otherwise it raises the exception EMPTY.
  152.     --
  153.     begin
  154.  
  155.     if L = EMPTY_LIST then
  156.         raise EMPTY;
  157.     else
  158.         return L.LINK.ITEM;
  159.     end if;
  160.  
  161.     end FIRST;
  162.  
  163.  
  164.     function  LAST(L : in LIST) return ELEMENT is
  165.     --
  166.     -- This function returns the last item in the list if the
  167.     -- list is not empty; otherwise it raises the exception EMPTY.
  168.     --
  169.     begin
  170.  
  171.     if L = EMPTY_LIST then
  172.         raise EMPTY;
  173.     else
  174.         return L.ITEM;
  175.     end if;
  176.  
  177.     end LAST;
  178.  
  179.  
  180. end LIST_PACKAGE;
  181.