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

----------------------------------------------------------------------
-- Find_Previous_Package
--
-- Given a initial_declarative_item_rep node, we sometimes need to find
-- if there's a embedded package declaration in the tree rooted at that
-- node.  This function returns the LexString of that package if it
-- can be found, or NullString if it can't.
--
-- This function is used by wf_renaming_declararation and
-- wf_use_type_declaration, both of which need to locate such
-- packages, so this function appears here so it can be called
-- by both subunits.
----------------------------------------------------------------------

separate (Sem)
function Find_Previous_Package (Node : STree.SyntaxNode) return LexTokenManager.Lex_String is
   Last_Node, Next_Node : STree.SyntaxNode;
   Pack_Ident           : LexTokenManager.Lex_String;
begin
   -- Phase 1 - search down the tree rooted at Node for a
   -- basic_declarative_item node or a package_declaration node
   Last_Node := Child_Node (Current_Node => Node);
   loop
      -- ASSUME Last_Node = initial_declarative_item_rep OR basic_declarative_item OR
      --                    package_declaration OR generic_package_instantiation
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Last_Node) = SP_Symbols.initial_declarative_item_rep
           or else Syntax_Node_Type (Node => Last_Node) = SP_Symbols.basic_declarative_item
           or else Syntax_Node_Type (Node => Last_Node) = SP_Symbols.package_declaration
           or else Syntax_Node_Type (Node => Last_Node) = SP_Symbols.generic_package_instantiation,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Last_Node = initial_declarative_item_rep OR basic_declarative_item OR " &
           "package_declaration OR generic_package_instantiation in Find_Previous_Package");
      exit when Syntax_Node_Type (Node => Last_Node) /= SP_Symbols.initial_declarative_item_rep;
      --# assert Syntax_Node_Type (Last_Node, STree.Table) = SP_Symbols.initial_declarative_item_rep;
      Next_Node := Next_Sibling (Current_Node => Last_Node);
      -- ASSUME Next_Node = basic_declarative_item OR package_declaration OR renaming_declaration OR
      --                    use_type_clause OR proof_renaming_declaration OR apragma
      if Syntax_Node_Type (Node => Next_Node) = SP_Symbols.basic_declarative_item
        or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.package_declaration then
         -- ASSUME Next_Node = basic_declarative_item OR package_declaration
         -- If there's a basic_declarative_item or a package_declaration to the right
         -- of Last_Node, then set Last_Node to that node and exit.
         Last_Node := Next_Node;
      elsif Syntax_Node_Type (Node => Next_Node) = SP_Symbols.renaming_declaration
        or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.use_type_clause
        or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.proof_renaming_declaration
        or else Syntax_Node_Type (Node => Next_Node) = SP_Symbols.apragma then
         -- ASSUME Next_Node = renaming_declaration OR use_type_clause OR
         --                    proof_renaming_declaration OR apragma
         -- No?  Then go down the tree and try again
         Last_Node := Child_Node (Current_Node => Last_Node);
      else
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Next_Node = basic_declarative_item OR package_declaration OR renaming_declaration OR " &
              "use_type_clause OR proof_renaming_declaration OR apragma in Find_Previous_Package");
      end if;
   end loop;
   --# assert Syntax_Node_Type (Last_Node, STree.Table) = SP_Symbols.basic_declarative_item or
   --#   Syntax_Node_Type (Last_Node, STree.Table) = SP_Symbols.package_declaration or
   --#   Syntax_Node_Type (Last_Node, STree.Table) = SP_Symbols.generic_package_instantiation;
   -- Phase 2
   -- Last_Node should be a basic_declarative_item or a package_declaration
   case Syntax_Node_Type (Node => Last_Node) is
      when SP_Symbols.basic_declarative_item =>
         -- ASSUME Last_Node = basic_declarative_item
         -- No previous package, so return NullString
         Pack_Ident := LexTokenManager.Null_String;
      when SP_Symbols.package_declaration =>
         -- ASSUME Last_Node = package_declaration
         -- If this package has an inherit clause, then skip over it
         Last_Node := Child_Node (Current_Node => Last_Node);
         -- ASSUME Last_Node = inherit_clause OR package_specification
         if Syntax_Node_Type (Node => Last_Node) = SP_Symbols.inherit_clause then
            -- ASSUME Last_Node = inherit_clause
            Last_Node := Next_Sibling (Current_Node => Last_Node);
         elsif Syntax_Node_Type (Node => Last_Node) /= SP_Symbols.package_specification then
            Last_Node := STree.NullNode;
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Last_Node = inherit_clause OR package_specification in Find_Previous_Package");
         end if;
         -- ASSUME Last_Node = package_specification
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Last_Node) = SP_Symbols.package_specification,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Last_Node = package_specification in Find_Previous_Package");
         -- Find and return the package's identifier node
         Last_Node := Last_Child_Of (Start_Node => Last_Node);
         -- ASSUME Last_Node = identifier
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Last_Node) = SP_Symbols.identifier,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Last_Node = identifier in Find_Previous_Package");
         Pack_Ident := Node_Lex_String (Node => Last_Node);
      when SP_Symbols.generic_package_instantiation =>
         -- ASSUME Last_Node = generic_package_instantiation
         Pack_Ident := LexTokenManager.Null_String;
      when others =>
         Pack_Ident := LexTokenManager.Null_String; -- to avoid flow error
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Last_Node = basic_declarative_item OR package_declaration OR " &
              "generic_package_instantiation in Find_Previous_Package");
   end case;
   return Pack_Ident;
end Find_Previous_Package;
