-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset 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 distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

package body Lists is
   No_Next : constant List := 0;

   ---------------------------------------------------------------------------

   procedure Init (Heap : out List_Heap) is
   begin
      -- Partial initialization for now, since this is expensive on VAX/VMS.
      -- Re-think when VMS is retired.

      --# accept F, 32, Heap.Heap_Array, "Partial initialization OK" &
      --#        F, 31, Heap.Heap_Array, "Partial initialization OK" &
      --#        F, 602, Heap, Heap.Heap_Array, "Partial initialization OK";
      Heap.High_Mark  := 0;
      Heap.First_Free := No_Next;
   end Init;

   ---------------------------------------------------------------------------

   procedure New_List (Heap     : in out List_Heap;
                       The_List :    out List;
                       OK       :    out Boolean) is
      The_List_Local : List;
   begin
      if Heap.High_Mark < List'Last then
         --array not used up yet
         Heap.High_Mark                   := Heap.High_Mark + 1;
         The_List_Local                   := Heap.High_Mark;
         Heap.Heap_Array (The_List_Local) :=
           Heap_Element'(Name   => LexTokenManager.Null_String,
                         Symbol => Dictionary.NullSymbol,
                         Next   => No_Next);
         The_List                         := The_List_Local;
         OK                               := True;
      elsif Heap.First_Free = No_Next then
         The_List := Null_List;
         OK       := False;
      else
         The_List_Local                   := Heap.First_Free;
         Heap.First_Free                  := Heap.Heap_Array (Heap.First_Free).Next;
         Heap.Heap_Array (The_List_Local) :=
           Heap_Element'(Name   => LexTokenManager.Null_String,
                         Symbol => Dictionary.NullSymbol,
                         Next   => No_Next);
         The_List                         := The_List_Local;
         OK                               := True;
      end if;
   end New_List;

   ---------------------------------------------------------------------------

   procedure Add_Name
     (Heap            : in out List_Heap;
      The_List        : in     List;
      Name            : in     LexTokenManager.Lex_String;
      Already_Present :    out Boolean;
      Ok              :    out Boolean)
   is
      Try, Try_Next, Add_Point : List;
      Done                     : Boolean;
   begin
      Already_Present := False;
      Ok              := False;
      if The_List /= Null_List then
         Try := The_List;
         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Heap.Heap_Array (Try).Name,
            Lex_Str2 => LexTokenManager.Null_String) =
           LexTokenManager.Str_Eq
           and then Dictionary.Is_Null_Symbol (Heap.Heap_Array (Try).Symbol) then -- list is valid
            Try_Next := Heap.Heap_Array (Try).Next;
            Done     := False;
            loop
               if Try_Next = No_Next
                 or else LexTokenManager.Lex_String_Case_Insensitive_Compare
                 (Lex_Str1 => Heap.Heap_Array (Try_Next).Name,
                  Lex_Str2 => Name) =
                 LexTokenManager.Str_Second then
                  if Heap.High_Mark < List'Last then
                     -- Array not used up yet
                     Ok                          := True;
                     Done                        := True;
                     Heap.High_Mark              := Heap.High_Mark + 1;
                     Add_Point                   := Heap.High_Mark;
                     Heap.Heap_Array (Add_Point) :=
                       Heap_Element'(Name   => Name,
                                     Symbol => Dictionary.NullSymbol,
                                     Next   => Try_Next);
                     Heap.Heap_Array (Try).Next  := Add_Point;
                  elsif Heap.First_Free = No_Next then --heap is full
                     Done := True;
                  else
                     Ok                          := True;
                     Done                        := True;
                     Add_Point                   := Heap.First_Free;
                     Heap.First_Free             := Heap.Heap_Array (Heap.First_Free).Next;
                     Heap.Heap_Array (Add_Point) :=
                       Heap_Element'(Name   => Name,
                                     Symbol => Dictionary.NullSymbol,
                                     Next   => Try_Next);
                     Heap.Heap_Array (Try).Next  := Add_Point;
                  end if;
               elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
                 (Lex_Str1 => Heap.Heap_Array (Try_Next).Name,
                  Lex_Str2 => Name) =
                 LexTokenManager.Str_Eq then
                  Ok              := True;
                  Done            := True;
                  Already_Present := True;
               end if;
               exit when Done;
               Try      := Try_Next;
               Try_Next := Heap.Heap_Array (Try).Next;
            end loop;
         end if;
      end if;
   end Add_Name;

   ---------------------------------------------------------------------------

   procedure Add_Symbol
     (Heap            : in out List_Heap;
      The_List        : in     List;
      Symbol          : in     Dictionary.Symbol;
      Already_Present :    out Boolean;
      Ok              :    out Boolean)
   is
      Try, Try_Next, Add_Point : List;
      Done                     : Boolean;
   begin
      Already_Present := False;
      Ok              := False;
      if The_List /= Null_List then
         Try := The_List;
         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Heap.Heap_Array (Try).Name,
            Lex_Str2 => LexTokenManager.Null_String) =
           LexTokenManager.Str_Eq
           and then Dictionary.Is_Null_Symbol (Heap.Heap_Array (Try).Symbol) then -- list is valid
            Try_Next := Heap.Heap_Array (Try).Next;
            Done     := False;
            loop
               if Try_Next = No_Next
                 or else Dictionary.SymbolRef (Item => Heap.Heap_Array (Try_Next).Symbol) >
                 Dictionary.SymbolRef (Item => Symbol) then
                  if Heap.High_Mark < List'Last then
                     -- Array not used up yet
                     Ok                          := True;
                     Done                        := True;
                     Heap.High_Mark              := Heap.High_Mark + 1;
                     Add_Point                   := Heap.High_Mark;
                     Heap.Heap_Array (Add_Point) :=
                       Heap_Element'(Name   => LexTokenManager.Null_String,
                                     Symbol => Symbol,
                                     Next   => Try_Next);
                     Heap.Heap_Array (Try).Next  := Add_Point;
                  elsif Heap.First_Free = No_Next then --heap is full
                     Done := True;
                  else
                     Ok                          := True;
                     Done                        := True;
                     Add_Point                   := Heap.First_Free;
                     Heap.First_Free             := Heap.Heap_Array (Heap.First_Free).Next;
                     Heap.Heap_Array (Add_Point) :=
                       Heap_Element'(Name   => LexTokenManager.Null_String,
                                     Symbol => Symbol,
                                     Next   => Try_Next);
                     Heap.Heap_Array (Try).Next  := Add_Point;
                  end if;
               elsif Heap.Heap_Array (Try_Next).Symbol = Symbol then
                  Ok              := True;
                  Done            := True;
                  Already_Present := True;
               end if;
               exit when Done;
               Try      := Try_Next;
               Try_Next := Heap.Heap_Array (Try).Next;
            end loop;
         end if;
      end if;
   end Add_Symbol;

   ---------------------------------------------------------------------------

   procedure Get_First
     (Heap     : in out List_Heap;
      The_List : in out List;
      Symbol   :    out Dictionary.Symbol;
      Empty    :    out Boolean;
      Ok       :    out Boolean)
   is
      Ptr : List;
   begin
      if The_List = Null_List then -- can't get value from null list
         Ok     := False;
         Empty  := True;
         Symbol := Dictionary.NullSymbol;
      elsif LexTokenManager.Lex_String_Case_Insensitive_Compare
        (Lex_Str1 => Heap.Heap_Array (The_List).Name,
         Lex_Str2 => LexTokenManager.Null_String) =
        LexTokenManager.Str_Eq
        and then Dictionary.Is_Null_Symbol (Heap.Heap_Array (The_List).Symbol) then -- list is valid
         Ptr := Heap.Heap_Array (The_List).Next; -- point to first element
         if Ptr = No_Next then -- list is empty
            Ok     := True; --list is ok its just empty!
            Empty  := True;
            Symbol := Dictionary.NullSymbol;
         else  --list is not empty
            Ok                           := True;
            Empty                        := False;
            Symbol                       := Heap.Heap_Array (Ptr).Symbol;
            Heap.Heap_Array (Ptr).Name   := LexTokenManager.Null_String;
            Heap.Heap_Array (Ptr).Symbol := Dictionary.NullSymbol;
            Heap.Heap_Array (The_List)   :=
              Heap_Element'(Name   => LexTokenManager.Null_String,
                            Symbol => Dictionary.NullSymbol,
                            Next   => Heap.First_Free);
            Heap.First_Free              := The_List;
            The_List                     := Ptr;
         end if;
      else
         Ok     := False;
         Empty  := True;
         Symbol := Dictionary.NullSymbol;
      end if;
   end Get_First;

   ---------------------------------------------------------------------------

   procedure Delete_List (Heap     : in out List_Heap;
                          The_List : in out List) is
      Ptr, Free_Ptr : List;
   begin
      if The_List /= Null_List then -- can't delete null list
         Ptr := The_List;
         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Heap.Heap_Array (Ptr).Name,
            Lex_Str2 => LexTokenManager.Null_String) =
           LexTokenManager.Str_Eq
           and then Dictionary.Is_Null_Symbol (Heap.Heap_Array (Ptr).Symbol) then -- list is valid
            Free_Ptr        := Heap.First_Free;
            Heap.First_Free := Ptr;
            while Heap.Heap_Array (Ptr).Next /= No_Next loop
               Ptr                          := Heap.Heap_Array (Ptr).Next;
               Heap.Heap_Array (Ptr).Name   := LexTokenManager.Null_String;
               Heap.Heap_Array (Ptr).Symbol := Dictionary.NullSymbol;
            end loop;
            Heap.Heap_Array (Ptr).Next := Free_Ptr;
         end if;
      end if;
      The_List := Null_List;
   end Delete_List;

   ---------------------------------------------------------------------------

   function Is_Member
     (Heap     : List_Heap;
      The_List : List;
      Str      : LexTokenManager.Lex_String)
     return     Boolean
   is
      Result : Boolean;
      Try    : List;
   begin
      if The_List = Null_List then --can't check memebership of null list
         Result := False;
      else
         Try := The_List; -- 782 - Deleted redundant type conversion
         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Heap.Heap_Array (Try).Name,
            Lex_Str2 => LexTokenManager.Null_String) =
           LexTokenManager.Str_Eq
           and then Dictionary.Is_Null_Symbol (Heap.Heap_Array (Try).Symbol) then -- list is valid
            Result := False;
            while Heap.Heap_Array (Try).Next /= No_Next loop
               Try := Heap.Heap_Array (Try).Next;
               if LexTokenManager.Lex_String_Case_Insensitive_Compare (Lex_Str1 => Heap.Heap_Array (Try).Name,
                                                                       Lex_Str2 => Str) =
                 LexTokenManager.Str_Eq then
                  Result := True;
                  exit;
               end if;
            end loop;
         else -- STR supplied was not a valid list pointer
            Result := False;
         end if;
      end if;
      return Result;
   end Is_Member;

end Lists;
