-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with FatalErrors, HeapIndex;

use type HeapIndex.IndexType;

package body FileHeap
--# own State is StartOfPointersList,
--#              TheDetails,
--#              ThePointers;
is

   ThePointers         : Heap.HeapRecord;
   TheDetails          : FileDetails.DataType;
   StartOfPointersList : Heap.Atom;

   function FirstEntry return  Heap.Atom
   --# global in StartOfPointersList;
   is
   begin
      return StartOfPointersList;
   end FirstEntry;

   ------------------------------------------------------------------------
   procedure Add (StartIndex  : in Heap.Atom;
                  NewName     : in E_Strings.T;
                  NewFileType : in FileDetails.FileTypes)
   --# global in out FatalErrors.State;
   --#        in out TheDetails;
   --#        in out ThePointers;
   --# derives FatalErrors.State,
   --#         TheDetails,
   --#         ThePointers       from *,
   --#                                NewFileType,
   --#                                NewName,
   --#                                StartIndex,
   --#                                TheDetails,
   --#                                ThePointers;
   is
      Dummy            : Boolean;
      ExistingName     : E_Strings.T;
      ExistingFileType : FileDetails.FileTypes;
      ListIndex        : Heap.Atom;
      LoopFinished     : Boolean := False;
      NextEntryInList  : Heap.Atom;
      OrderResult      : E_Strings.Order_Types;
      OrderSuccess     : Boolean;
      RetrieveSuccess  : Boolean;

      ------------------------------------------------------------------------
      procedure InsertInList
        (ListIndex       : in Heap.Atom;
         NextEntryInList : in Heap.Atom;
         Name            : in E_Strings.T;
         FileType        : in FileDetails.FileTypes)
      --# global in out FatalErrors.State;
      --#        in out TheDetails;
      --#        in out ThePointers;
      --# derives FatalErrors.State from *,
      --#                                TheDetails,
      --#                                ThePointers &
      --#         TheDetails        from *,
      --#                                FileType,
      --#                                Name &
      --#         ThePointers       from *,
      --#                                ListIndex,
      --#                                NextEntryInList,
      --#                                TheDetails;
      is
         CreateAtomSuccess : Boolean;
         DetailsAddSuccess : Boolean;
         NewDetailsIndex   : HeapIndex.IndexType;
         NewPointersIndex  : Heap.Atom;
      begin -- InsertInList

         -- allocate heap atom
         Heap.CreateAtom (ThePointers, NewPointersIndex, CreateAtomSuccess);

         -- allocate file details entry
         FileDetails.Add (TheDetails, NewDetailsIndex, DetailsAddSuccess, Name, FileType);

         if not (CreateAtomSuccess and DetailsAddSuccess) then
            FatalErrors.Process (FatalErrors.File_Heap_Full, E_Strings.Empty_String);
         end if;

         -- point heap atom to file details entry
         Heap.UpdateAValue (ThePointers, NewPointersIndex, NewDetailsIndex);

         -- link heap atom into list
         Heap.UpdateAPointer (ThePointers, ListIndex, NewPointersIndex);
         Heap.UpdateAPointer (ThePointers, NewPointersIndex, NextEntryInList);

      end InsertInList;

      -------------------------------------------------------------------------
   begin -- Add

      -- start at point specified in linked list
      ListIndex := StartIndex;

      while not LoopFinished loop
         -- if current item is last then add after it
         NextEntryInList := Heap.APointer (ThePointers, ListIndex);

         if NextEntryInList = 0 then
            InsertInList (ListIndex, NextEntryInList, NewName, NewFileType);
            LoopFinished := True;
         else
            -- otherwise get relative order of next item in list and the new item
            --# accept F, 10, Dummy, "Dummy unused here";
            FileDetails.Retrieve
              (TheDetails,
               Heap.AValue (ThePointers, NextEntryInList),
               RetrieveSuccess,
               ExistingName,
               ExistingFileType,
               Dummy);
            --# end accept;
            if not RetrieveSuccess then
               FatalErrors.Process (FatalErrors.Data_Structure_Inconsistency, E_Strings.Empty_String);
            end if;

            FileDetails.Order (ExistingName, ExistingFileType, NewName, NewFileType, OrderSuccess, OrderResult);
            if not OrderSuccess then
               FatalErrors.Process (FatalErrors.Data_Structure_Inconsistency, E_Strings.Empty_String);
            end if;

            case OrderResult is
               when E_Strings.First_One_First =>
                  -- next item in list is first, keep going down list
                  ListIndex := NextEntryInList;

               when E_Strings.Second_One_First =>
                  -- new item is first, insert here
                  InsertInList (ListIndex, NextEntryInList, NewName, NewFileType);
                  LoopFinished := True;

               when E_Strings.Neither_First =>
                  -- items identical: do nothing
                  LoopFinished := True;

            end case;
         end if;
      end loop;

      --# accept F, 33, Dummy, "Dummy unused here";
   end Add;

   ----------------------------------------------------------------------------
   -- this procedure returns the file details for the specified entry in the
   -- linked list. Success if ListIndex points to a heap record which points to
   -- a valid set of file details
   procedure Details
     (ListIndex           : in     Heap.Atom;
      Success             :    out Boolean;
      Name                :    out E_Strings.T;
      FileType            :    out FileDetails.FileTypes;
      DirectoryIsResolved :    out Boolean)
   --# global in TheDetails;
   --#        in ThePointers;
   --# derives DirectoryIsResolved,
   --#         FileType,
   --#         Name,
   --#         Success             from ListIndex,
   --#                                  TheDetails,
   --#                                  ThePointers;
   is
      DetailsIndex : HeapIndex.IndexType;
   begin -- Details

      -- dereference linked list pointer
      DetailsIndex := Heap.AValue (ThePointers, ListIndex);

      -- if not null pointer then follow it
      if DetailsIndex /= 0 then
         FileDetails.Retrieve (TheDetails, DetailsIndex, Success, Name, FileType, DirectoryIsResolved);
      else
         -- if null pointer then return failure
         Success             := False;
         Name                := E_Strings.Empty_String;
         FileType            := FileDetails.Invalid;
         DirectoryIsResolved := False;
      end if;
   end Details;

   --------------------------------------------------------------------------
   procedure Initialize (TopDirectory : in E_Strings.T)
   --# global out StartOfPointersList;
   --#        out TheDetails;
   --#        out ThePointers;
   --# derives StartOfPointersList,
   --#         ThePointers         from  &
   --#         TheDetails          from TopDirectory;
   is
      Dummy              : Boolean;
      FirstDetailsIndex  : HeapIndex.IndexType;
      FirstPointersIndex : Heap.Atom;
   begin -- Initialize
      Heap.Initialize (ThePointers);
      FileDetails.Initialize (TheDetails);

      -- insert first item
      --# accept F, 10, Dummy, "Dummy unused here";
      FileDetails.Add (TheDetails, FirstDetailsIndex, Dummy, TopDirectory, FileDetails.Directory);

      Heap.CreateAtom (ThePointers, FirstPointersIndex, Dummy);
      --# end accept;

      Heap.UpdateAValue (ThePointers, FirstPointersIndex, FirstDetailsIndex);
      Heap.UpdateAPointer (ThePointers, FirstPointersIndex, 0);

      StartOfPointersList := FirstPointersIndex;

      --# accept F, 33, Dummy, "Dummy unused here";
   end Initialize;

   ---------------------------------------------------------------------------
   procedure MarkDirectoryResolved (ListIndex : in Heap.Atom)
   --# global in     ThePointers;
   --#        in out TheDetails;
   --# derives TheDetails from *,
   --#                         ListIndex,
   --#                         ThePointers;
   is
      DetailsIndex : HeapIndex.IndexType;
   begin
      DetailsIndex := Heap.AValue (ThePointers, ListIndex);

      if DetailsIndex /= 0 then
         FileDetails.MarkDirectoryResolved (TheDetails, DetailsIndex);
      end if;
   end MarkDirectoryResolved;

   ---------------------------------------------------------------------------
   -- this procedure returns the 'NextOne' ordered element in FH after
   -- 'AfterThis'. It is successful if the NextOne is not a 'null' pointer
   procedure Next (AfterThis : in     Heap.Atom;
                   Success   :    out Boolean;
                   NextOne   :    out Heap.Atom)
   --# global in ThePointers;
   --# derives NextOne,
   --#         Success from AfterThis,
   --#                      ThePointers;
   is
      NextInList : Heap.Atom;
   begin -- Next
      NextInList := Heap.APointer (ThePointers, AfterThis);
      if NextInList = 0 then
         Success := False;
         NextOne := 0;
      else
         Success := True;
         NextOne := NextInList;
      end if;
   end Next;

end FileHeap;
