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

separate (Sem.CompUnit.WalkStatements)

--------------------------------------------------------------------
--  VariableUpdateHistory
--
--  Implementation Notes:
--    The History_T ADT is implmented as a list of pairs using atoms
--    from a given Heap.HeapRecord.  See heap.ads.
--------------------------------------------------------------------
package body VariableUpdateHistory is
   --------------------------------------------------------------------
   --  Create_History
   --
   --  Implementation Notes:
   --    Assumes that The_Heap is initialised using Heap.Initialize.
   --    Sets the A and B values of the initial atom to 0.  The A and B
   --    pointers are set to 0 by Heap.CreateAtom.
   --------------------------------------------------------------------
   procedure Create_History (The_Heap : in out Heap.HeapRecord;
                             History  :    out History_T) is
      Atom : Heap.Atom;
   begin
      Heap.CreateAtom (The_Heap, Atom);
      Heap.UpdateAValue (The_Heap, Atom, 0);
      Heap.UpdateBValue (The_Heap, Atom, 0);
      History := History_T (Atom);
   end Create_History;

   --------------------------------------------------------------------
   --  Dispose_Of_History
   --
   --  Implementation Notes:
   --    The last atom in the list has a null A pointer.
   --------------------------------------------------------------------
   procedure Dispose_Of_History (The_Heap : in out Heap.HeapRecord;
                                 History  : in     History_T) is
      Atom      : Heap.Atom;
      Next_Atom : Heap.Atom;
   begin
      Atom := Heap.Atom (History);
      loop
         Next_Atom := Heap.APointer (The_Heap, Atom);
         Heap.DisposeOfAtom (The_Heap, Atom);
         Atom := Next_Atom;
         exit when Heap.IsNullPointer (Next_Atom);
      end loop;
   end Dispose_Of_History;

   --------------------------------------------------------------------
   --  Add_Update
   --
   --  Implementation Notes:
   --    A linear search is used to locate the specified Variable.
   --    If the end of the list is reached without finding the Variable
   --    a new atom is created and added to the end of the list.
   --    The list cannot contain duplicate variables.
   --------------------------------------------------------------------
   procedure Add_Update
     (The_Heap : in out Heap.HeapRecord;
      History  : in out History_T;
      Variable : in     Natural;
      Node     : in     STree.SyntaxNode)
   is
      Atom     : Heap.Atom;
      New_Atom : Heap.Atom;
      Value    : Natural;
   begin
      Atom  := Heap.Atom (History);
      Value := Heap.AValue (The_Heap, Atom);

      while Value /= Variable and not Heap.IsNullPointer (Heap.APointer (The_Heap, Atom)) loop
         Atom  := Heap.APointer (The_Heap, Atom);
         Value := Heap.AValue (The_Heap, Atom);
      end loop;

      if Value /= Variable then
         -- Variable not found, add a new atom to the end of the list.
         Heap.CreateAtom (The_Heap, New_Atom);
         Heap.UpdateAValue (The_Heap, New_Atom, Variable);
         Heap.UpdateBValue (The_Heap, New_Atom, Natural (STree.NodeToRef (Node)));
         Heap.UpdateAPointer (The_Heap, Atom, New_Atom);
      else
         -- The variable is already in the history, update the previous node.
         Heap.UpdateBValue (The_Heap, Atom, Natural (STree.NodeToRef (Node)));
      end if;
      --# accept F, 30, STree.Table, "Used for precondition only" &
      --#        F, 31, History, "History is logically updated but is represented by a pointer." &
      --#        F, 50, History, The_Heap, "History is logically dependent on the contents of The_Heap." &
      --#        F, 50, History, Variable, "History is logically dependent on Variable." &
      --#        F, 50, History, Node, "History is logically dependent on Node.";
   end Add_Update;

   --------------------------------------------------------------------
   --  Get_Last_Update
   --
   --  Implementation Notes:
   --    A linear search is used to locate the specified Variable.
   --    If the end of the list is reached without finding the Variable
   --    the Result is set to STree.NullNode
   --------------------------------------------------------------------
   procedure Get_Last_Update
     (The_Heap : in     Heap.HeapRecord;
      History  : in     History_T;
      Variable : in     Natural;
      Node     :    out STree.SyntaxNode)
   is
      Atom  : Heap.Atom;
      Value : Natural;
   begin
      Atom  := Heap.Atom (History);
      Value := Heap.AValue (The_Heap, Atom);

      while Value /= Variable and not Heap.IsNullPointer (Heap.APointer (The_Heap, Atom)) loop
         Atom  := Heap.APointer (The_Heap, Atom);
         Value := Heap.AValue (The_Heap, Atom);
      end loop;

      if Value /= Variable then
         -- No previous update, return NullNode.
         Node := STree.NullNode;
      else
         Node := STree.RefToNode (ExaminerConstants.RefType (Heap.BValue (The_Heap, Atom)));
      end if;
      -- ASSUME Node = assignment_statement OR procedure_call_statement OR NULL
      SystemErrors.RT_Assert
        (C       => Node = STree.NullNode
           or else Sem.Syntax_Node_Type (Node => Node) = SP_Symbols.assignment_statement
           or else Sem.Syntax_Node_Type (Node => Node) = SP_Symbols.procedure_call_statement,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Node = assignment_statement OR procedure_call_statement OR NULL in Get_Last_Update");
   end Get_Last_Update;

end VariableUpdateHistory;
