------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real time scheduling analysis tool.
-- This program provides services to automatically check performances
-- of real time architectures.
--
-- Copyright (C) 2002-2010,  by Frank Singhoff, Alain Plantec, Jerome Legrand
--
-- The Cheddar project was started in 2002 by
-- the LISyC Team, University of Western Britanny.
--
-- Since 2008, Ellidiss technologies also contributes to the development of
-- Cheddar and provides industrial support.
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--
-- Contact : cheddar@listes.univ-brest.fr
--
-----------------------------------------------------------------------------
-- Last update :
--    $Rev: 308 $
--    $Date: 2010-11-30 20:56:47 +0100 (Tue, 30 Nov 2010) $
--    $Author: gaudel $
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with Unchecked_Deallocation;

package body access_lists is

   procedure free is new Unchecked_Deallocation (cell, cell_ptr);

   procedure initialize (l : in out list) is

      current  : cell_ptr := l.head;
      previous : cell_ptr;

   begin
      while current /= null loop
         free (current.info);
         previous := current;
         current  := current.next;
         free (previous);
      end loop;

      l.head := null;
      l.tail := null;
   end initialize;

   procedure add (l : in out list; e : in element_ptr) is

      new_cell : cell_ptr;

   begin
      new_cell      := new cell;
      new_cell.info := e;

      new_cell.next := l.head;
      l.head        := new_cell;

      if (l.tail = null) then
         l.tail := new_cell;
      else
         new_cell.next.previous := new_cell;
      end if;

   end add;

   procedure put (l : in list_ptr) is
   begin
      put (l.all);
   end put;

   procedure put (l : in list) is

      current : cell_ptr := l.head;

   begin
      while current /= null loop
         put (current.info);
         current := current.next;
      end loop;
   end put;

   function get_number_of_elements (l : in list) return Natural is
      current : cell_ptr := l.head;
      size    : Natural  := 0;

   begin
      while current /= null loop
         size    := size + 1;
         current := current.next;
      end loop;

      return size;

   end get_number_of_elements;

   procedure delete (l : in out list; e : in list) is

      current : cell_ptr := e.head;

   begin
      while current /= null loop
         delete (l, current.info);
         current := current.next;
      end loop;
   end delete;

   procedure delete (l : in out list; e : in element_ptr) is

      current  : cell_ptr := l.head;
      is_found : Boolean  := False;

   begin
      while current /= null loop
         if current.info = e then
            is_found := True;

            -- Delete the last item
            --
            if (current.previous = null) and (current.next = null) then
               l.head := null;
               l.tail := null;
            else

               -- Delete the Head item
               --
               if (current.previous = null) then
                  l.head                := current.next;
                  current.next.previous := null;
               else
                  -- delete the Tail item
                  --
                  if (current.next = null) then
                     l.tail                := current.previous;
                     current.previous.next := null;
                  -- Middle item
                  --
                  else
                     current.previous.next := current.next;
                     current.next.previous := current.previous;
                  end if;
               end if;
            end if;

            free (current.info);
            free (current);
            exit;
         end if;

         current := current.next;
      end loop;

      if not is_found then
         raise element_not_found;
      end if;

   end delete;

   function element_in_list
     (e    : in element_ptr;
      l    : in list)
      return Boolean
   is
      current  : cell_ptr := l.head;
      is_found : Boolean  := False;

   begin
      while current /= null loop
         if current.info = e then
            is_found := True;
            exit;
         end if;
         current := current.next;
      end loop;

      return is_found;

   end element_in_list;

   function element_in_list (e : in element; l : in list) return Boolean is
      current  : cell_ptr := l.head;
      is_found : Boolean  := False;

   begin
      while current /= null loop
         if current.info.all = e then
            is_found := True;
            exit;
         end if;
         current := current.next;
      end loop;

      return is_found;

   end element_in_list;

   procedure delete (l : in out list) is

      current  : cell_ptr := l.head;
      previous : cell_ptr;

   begin
      while current /= null loop
         free (current.info);
         previous := current;
         current  := current.next;
         free (previous);
      end loop;

   end delete;

   procedure duplicate (src : in list; dest : in out list) is  --; Complete :
                                                               --Boolean :=
                                                               --false) is

      current : cell_ptr := src.tail;

   begin

      while current /= null loop
         --if Complete then Add (Dest, Copy(Current.Info));
         --    else
         add (dest, current.info);
         -- end if;

         current := current.previous;
      end loop;

   end duplicate;

   procedure duplicate
     (src      : in list;
      dest     : in out list;
      complete : Boolean := False)
   is

      current : cell_ptr := src.tail;

   begin

      while current /= null loop
         if complete then
            add (dest, copy (current.info));
         else
            add (dest, current.info);
         end if;

         current := current.previous;
      end loop;

   end duplicate;


   function xml_string
     (obj   : in list;
      level : in Natural := 0)
      return  Unbounded_String
   is
      result  : Unbounded_String := To_Unbounded_String ("");
      current : cell_ptr := obj.tail;
   begin
      while current /= null loop
         result  := result & xml_string (current.info);
         current := current.previous;
      end loop;
      return result;
   end xml_string;

   function get_head (l : in list) return element_ptr is
   begin
      return (l.head.info);
   end get_head;

   function get_tail (l : in list) return element_ptr is
   begin
      return (l.tail.info);
   end get_tail;

   function is_empty (l : in list) return Boolean is
   begin
      return (l.head = null) or (l.tail = null);
   end is_empty;

   procedure previous_element (l : in list; my_iterator : in out iterator) is
   begin
      my_iterator.current := my_iterator.current.previous;
   end previous_element;

   procedure next_element (l : in list; my_iterator : in out iterator) is
   begin
      my_iterator.current := my_iterator.current.next;
   end next_element;

   function is_tail_element
     (l           : in list;
      my_iterator : in iterator)
      return        Boolean
   is
   begin
      return (my_iterator.current = l.tail) or (l.tail = null);
   end is_tail_element;

   function is_head_element
     (l           : in list;
      my_iterator : in iterator)
      return        Boolean
   is
   begin
      return (my_iterator.current = l.head) or (l.head = null);
   end is_head_element;

   procedure current_element
     (l              : in list;
      return_element : out element_ptr;
      my_iterator    : in iterator)
   is
   begin
      return_element := my_iterator.current.info;
   end current_element;

   procedure reset_head_iterator
     (l           : in list;
      my_iterator : in out iterator)
   is
   begin
      my_iterator.current := l.head;
   end reset_head_iterator;

   procedure reset_tail_iterator
     (l           : in list;
      my_iterator : in out iterator)
   is
   begin
      my_iterator.current := l.tail;
   end reset_tail_iterator;

end access_lists;