-------------------------------------------------------------------------------
-- (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 (Dictionary)
function LookupItem
  (Name              : LexTokenManager.Lex_String;
   Scope             : Scopes;
   Context           : Contexts;
   Full_Package_Name : Boolean)
  return              Symbol
is
   Item, Current_Region           : Symbol;
   Package_Item                   : RawDict.Package_Info_Ref;
   Is_Visible, In_A_Subprogram    : Boolean;
   Current_Scope, Enclosing_Scope : Scopes;
   Stop_At                        : LexTokenManager.Lex_String;

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

   procedure Lookup_Context_Clauses
     (Name              : in     LexTokenManager.Lex_String;
      Scope             : in     Scopes;
      Start_Pos         : in     Scopes;
      Context           : in     Contexts;
      Full_Package_Name : in     Boolean;
      Item              :    out Symbol;
      Is_Visible        :    out Boolean)
   --# global in Dict;
   --#        in LexTokenManager.State;
   --# derives Is_Visible from Context,
   --#                         Dict,
   --#                         Full_Package_Name,
   --#                         LexTokenManager.State,
   --#                         Name,
   --#                         Scope,
   --#                         Start_Pos &
   --#         Item       from Dict,
   --#                         Full_Package_Name,
   --#                         LexTokenManager.State,
   --#                         Name,
   --#                         Scope;
   is
      Region             : Symbol;
      The_Generic_Unit   : RawDict.Generic_Unit_Info_Ref;
      The_Inherit_Clause : RawDict.Context_Clause_Info_Ref;
      Current_Package    : RawDict.Package_Info_Ref;
      Current_Subprogram : RawDict.Subprogram_Info_Ref;
      Continue           : Boolean := True;

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

      function Is_Package_Directly_Visible (The_Package : RawDict.Package_Info_Ref;
                                            Scope       : Scopes) return Boolean
      --# global in Dict;
      is
         The_Parent, Library_Package : RawDict.Package_Info_Ref;
         Result                      : Boolean;
      begin
         The_Parent := RawDict.Get_Package_Parent (The_Package => The_Package);
         if The_Parent = RawDict.Null_Package_Info_Ref then
            Result := True;
         elsif not (RawDict.GetSymbolDiscriminant (GetRegion (Scope)) = Package_Symbol) then
            Result := False;
         else  --  The_Package is a child and Scope is in another package
               -- OK if Scope is (possibly embedded within) The_Package's parent
               -- or a descendent of the parent
            Library_Package := Get_Library_Package (Scope => Scope);
            Result          := Library_Package = The_Parent
              or else Is_Proper_Descendent (Inner_Package => Library_Package,
                                            Outer_Package => The_Parent);
         end if;
         return Result;
      end Is_Package_Directly_Visible;

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

      function Is_Subprogram_Directly_Visible (The_Generic_Subprogram : RawDict.Subprogram_Info_Ref) return Boolean
      --# global in Dict;
      is
      begin
         return RawDict.Get_Subprogram_Generic_Unit (The_Subprogram => The_Generic_Subprogram) /=
           RawDict.Null_Generic_Unit_Info_Ref;
      end Is_Subprogram_Directly_Visible;

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

      function Has_Been_Withed (The_Withed_Symbol : Symbol;
                                Scope             : Scopes) return Boolean
      --# global in Dict;
      is
         Current_Scope, Last1 : Scopes;
         Ancestor             : RawDict.Package_Info_Ref;
         Found                : Boolean;
      begin
         Current_Scope := Scope;
         Last1         := Current_Scope;

         loop
            exit when (RawDict.GetSymbolDiscriminant (GetRegion (Current_Scope)) = Package_Symbol
                         and then RawDict.Get_Package_Info_Ref (Item => GetRegion (Current_Scope)) =
                         Get_Predefined_Package_Standard)
              or else Is_Withed (The_Withed_Symbol => The_Withed_Symbol,
                                 Scope             => Current_Scope);
            Last1         := Current_Scope;
            Current_Scope := GetEnclosingScope (Current_Scope);
         end loop;

         Found := RawDict.GetSymbolDiscriminant (GetRegion (Current_Scope)) /= Package_Symbol
           or else RawDict.Get_Package_Info_Ref (Item => GetRegion (Current_Scope)) /= Get_Predefined_Package_Standard;

         if not Found
           and then Last1 /= Current_Scope
           and then RawDict.GetSymbolDiscriminant (GetRegion (Last1)) = Package_Symbol then
            -- search through ancestors
            Ancestor := RawDict.Get_Package_Parent (The_Package => RawDict.Get_Package_Info_Ref (Item => GetRegion (Last1)));
            loop
               exit when Ancestor = RawDict.Null_Package_Info_Ref
                 or else Is_Withed
                 (The_Withed_Symbol => The_Withed_Symbol,
                  Scope             => Set_Visibility
                    (The_Visibility => Visible,
                     The_Unit       => RawDict.Get_Package_Symbol (Ancestor)));
               Ancestor := RawDict.Get_Package_Parent (The_Package => Ancestor);
            end loop;
            Found := Ancestor /= RawDict.Null_Package_Info_Ref;
         end if;
         return Found;
      end Has_Been_Withed;

   begin -- Lookup_Context_Clauses
      Trace_Lex_Str (Msg => "   In Lookup_Context_Clauses, seeking ",
                     L   => Name);

      Item       := NullSymbol;
      Is_Visible := False;
      Region     := GetRegion (Scope);

      case RawDict.GetSymbolDiscriminant (Region) is
         when Package_Symbol =>
            The_Inherit_Clause :=
              RawDict.Get_Package_Inherit_Clauses (The_Package => RawDict.Get_Package_Info_Ref (Item => Region));
         when Subprogram_Symbol =>
            if Is_Main_Program (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => Region)) then
               The_Inherit_Clause :=
                 RawDict.Get_Subprogram_Inherit_Clauses (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => Region));
            else
               The_Inherit_Clause := RawDict.Null_Context_Clause_Info_Ref;
            end if;
         when Generic_Unit_Symbol =>
            The_Generic_Unit := RawDict.Get_Generic_Unit_Info_Ref (Item => Region);
            case RawDict.Get_Generic_Unit_Kind (The_Generic_Unit => The_Generic_Unit) is
               when Generic_Of_Package =>
                  The_Inherit_Clause :=
                    RawDict.Get_Package_Inherit_Clauses
                    (The_Package => RawDict.Get_Generic_Unit_Owning_Package (The_Generic_Unit => The_Generic_Unit));
               when Generic_Of_Subprogram =>
                  The_Inherit_Clause :=
                    RawDict.Get_Subprogram_Inherit_Clauses
                    (The_Subprogram => RawDict.Get_Generic_Unit_Owning_Subprogram (The_Generic_Unit => The_Generic_Unit));
            end case;
         when Type_Symbol =>
            if Is_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Region))
              and then RawDict.Get_Type_Discriminant (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Region)) =
              Protected_Type_Item then
               Region             := RawDict.Get_Package_Symbol (Get_Enclosing_Package (Scope => Scope));
               The_Inherit_Clause := RawDict.Get_Package_Inherit_Clauses (The_Package => Get_Enclosing_Package (Scope => Scope));
            else
               The_Inherit_Clause := RawDict.Null_Context_Clause_Info_Ref;
            end if;
         when others => -- non-exec code
            The_Inherit_Clause := RawDict.Null_Context_Clause_Info_Ref;
            SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                                      Msg     => "in Dictionary.Lookup_Context_Clauses");
      end case;

      while Continue loop
         if The_Inherit_Clause = RawDict.Null_Context_Clause_Info_Ref then
            Item       := NullSymbol;
            Is_Visible := False;
            Continue   := False;
         end if;
         case RawDict.Get_Context_Clause_Is_Subprogram (The_Context_Clause => The_Inherit_Clause) is
            when False =>
               Current_Package := RawDict.Get_Context_Clause_Package (The_Context_Clause => The_Inherit_Clause);
               if LexTokenManager.Lex_String_Case_Insensitive_Compare
                 (Lex_Str1 => RawDict.Get_Package_Name (The_Package => Current_Package),
                  Lex_Str2 => Name) =
                 LexTokenManager.Str_Eq
                 and then Is_Package_Directly_Visible (The_Package => Current_Package,
                                                       Scope       => Scope)
                 and then (not Full_Package_Name
                             or else RawDict.Get_Package_Parent (The_Package => Current_Package) = RawDict.Null_Package_Info_Ref) then
                  Item       := RawDict.Get_Package_Symbol (Current_Package);
                  Is_Visible :=
                    Context = ProofContext
                    or else Is_Embedded_Package (The_Package => Current_Package)
                    or else IsLocal
                    (Scope,
                     Set_Visibility (The_Visibility => Local,
                                     The_Unit       => RawDict.Get_Package_Symbol (Current_Package)))
                    or else (RawDict.GetSymbolDiscriminant (Region) = Package_Symbol
                               and then Is_Proper_Descendent
                               (Inner_Package => Get_Library_Package (Scope => Scope),
                                Outer_Package => Current_Package))
                    or else Has_Been_Withed (The_Withed_Symbol => RawDict.Get_Package_Symbol (Current_Package),
                                             Scope             => Start_Pos);
                  Continue   := False;
               end if;
            when True =>
               Current_Subprogram := RawDict.Get_Context_Clause_Subprogram (The_Context_Clause => The_Inherit_Clause);
               if LexTokenManager.Lex_String_Case_Insensitive_Compare
                 (Lex_Str1 => RawDict.Get_Subprogram_Name (The_Subprogram => Current_Subprogram),
                  Lex_Str2 => Name) =
                 LexTokenManager.Str_Eq
                 and then Is_Subprogram_Directly_Visible (The_Generic_Subprogram => Current_Subprogram) then
                  Item       := RawDict.Get_Subprogram_Symbol (Current_Subprogram);
                  Is_Visible :=
                    Context = ProofContext
                    or else IsLocal
                    (Scope,
                     Set_Visibility
                       (The_Visibility => Local,
                        The_Unit       => RawDict.Get_Subprogram_Symbol (Current_Subprogram)))
                    or else Has_Been_Withed
                    (The_Withed_Symbol => RawDict.Get_Subprogram_Symbol (Current_Subprogram),
                     Scope             => Start_Pos);
                  Continue   := False;
               end if;
         end case;
         The_Inherit_Clause := RawDict.Get_Next_Context_Clause (The_Context_Clause => The_Inherit_Clause);
      end loop;
      Trace_Sym (Msg   => "   found in  Lookup_Context_Clauses ",
                 Sym   => Item,
                 Scope => Scope);
   end Lookup_Context_Clauses;

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

   procedure Lookup_Children
     (Child_Sort   : in     PackageSort;
      Name         : in     LexTokenManager.Lex_String;
      The_Package  : in     RawDict.Package_Info_Ref;
      Scope        : in     Scopes;
      Context      : in     Contexts;
      Package_Item :    out RawDict.Package_Info_Ref;
      Is_Visible   :    out Boolean)
   --# global in Dict;
   --#        in LexTokenManager.State;
   --# derives Is_Visible,
   --#         Package_Item from Child_Sort,
   --#                           Context,
   --#                           Dict,
   --#                           LexTokenManager.State,
   --#                           Name,
   --#                           Scope,
   --#                           The_Package;
   is
      Current_Package : RawDict.Package_Info_Ref;

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

      function Check_Is_Withed
        (The_Package : RawDict.Package_Info_Ref;
         Scope       : Scopes;
         Context     : Contexts)
        return        RawDict.Package_Info_Ref
      --# global in Dict;
      is
         Current_Scope : Scopes;
         Result        : RawDict.Package_Info_Ref;
      begin
         if Context = ProofContext then
            Result := The_Package;
         else
            Current_Scope := Scope;
            loop
               exit when (RawDict.GetSymbolDiscriminant (GetRegion (Current_Scope)) = Package_Symbol
                            and then RawDict.Get_Package_Info_Ref (Item => GetRegion (Current_Scope)) =
                            Get_Predefined_Package_Standard)
                 or else Is_Withed (The_Withed_Symbol => RawDict.Get_Package_Symbol (The_Package),
                                    Scope             => Current_Scope);
               Current_Scope := GetEnclosingScope (Current_Scope);
            end loop;

            if RawDict.GetSymbolDiscriminant (GetRegion (Current_Scope)) = Package_Symbol
              and then RawDict.Get_Package_Info_Ref (Item => GetRegion (Current_Scope)) = Get_Predefined_Package_Standard then
               Result := RawDict.Null_Package_Info_Ref;
            else
               Result := The_Package;
            end if;
         end if;
         return Result;
      end Check_Is_Withed;

   begin -- Lookup_Children
      Package_Item := RawDict.Null_Package_Info_Ref;
      case Child_Sort is
         when Public =>
            Current_Package := RawDict.Get_Package_First_Public_Child (The_Package => The_Package);
         when PrivateChild =>
            Current_Package := RawDict.Get_Package_First_Private_Child (The_Package => The_Package);
      end case;
      loop
         exit when Current_Package = RawDict.Null_Package_Info_Ref;

         if LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => RawDict.Get_Package_Name (The_Package => Current_Package),
            Lex_Str2 => Name) =
           LexTokenManager.Str_Eq then
            Package_Item := Current_Package;
            exit;
         end if;

         Current_Package := RawDict.Get_Package_Next_Sibling (The_Package => Current_Package);
      end loop;

      if Package_Item /= RawDict.Null_Package_Info_Ref then
         Package_Item := Check_Is_Withed (The_Package => Package_Item,
                                          Scope       => Scope,
                                          Context     => Context);
      end if;
      Is_Visible := Package_Item /= RawDict.Null_Package_Info_Ref;
   end Lookup_Children;

begin -- LookupItem
   Current_Scope  := Scope;
   Current_Region := GetRegion (Current_Scope);

   TraceMsg ("--------------------------------------------------------------------------");
   Trace_Lex_Str (Msg => "In LookupItem, seeking ",
                  L   => Name);
   Trace_Sym (Msg   => "   in ",
              Sym   => Current_Region,
              Scope => Scope);

   loop
      LookupScope
        (Name          => Name,
         Stop_At       => LexTokenManager.Null_String,
         Scope         => Current_Scope,
         Calling_Scope => Current_Scope,
         Context       => Context,
         Item          => Item,
         Is_Visible    => Is_Visible);
      exit when Item /= NullSymbol;
      exit when IsCompilationUnit (Current_Region)
        or else (RawDict.GetSymbolDiscriminant (Current_Region) = Type_Symbol
                   and then (Is_Protected_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Current_Region))
                               or else Is_Task_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Current_Region))));
      Current_Scope  := GetEnclosingScope (Current_Scope);
      Current_Region := GetRegion (Current_Scope);
   end loop;

   if Item = NullSymbol then

      In_A_Subprogram :=
        Is_Subprogram (Current_Region)
        or else (RawDict.GetSymbolDiscriminant (Current_Region) = Generic_Unit_Symbol
                   and then RawDict.Get_Generic_Unit_Kind
                   (The_Generic_Unit => RawDict.Get_Generic_Unit_Info_Ref (Item => Current_Region)) =
                   Generic_Of_Subprogram)
        or else (RawDict.GetSymbolDiscriminant (Current_Region) = Type_Symbol
                   and then Is_Task_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Current_Region)));

      loop
         if RawDict.GetSymbolDiscriminant (Current_Region) = Package_Symbol then
            Lookup_Children
              (Child_Sort   => PrivateChild,
               Name         => Name,
               The_Package  => RawDict.Get_Package_Info_Ref (Item => Current_Region),
               Scope        => Scope,
               Context      => Context,
               Package_Item => Package_Item,
               Is_Visible   => Is_Visible);
            Item := RawDict.Get_Package_Symbol (Package_Item);
         else
            Item       := NullSymbol;
            Is_Visible := False;
         end if;

         exit when Item /= NullSymbol;

         if RawDict.GetSymbolDiscriminant (Current_Region) = Package_Symbol then
            --# accept F, 41, "Structurally this is the preferred placing for this condition";
            if CommandLineData.Content.Language_Profile in CommandLineData.Auto_Code_Generators then
               Lookup_Children
                 (Child_Sort   => Public,
                  Name         => Name,
                  The_Package  => RawDict.Get_Package_Info_Ref (Item => Current_Region),
                  Scope        => Scope,
                  Context      => Context,
                  Package_Item => Package_Item,
                  Is_Visible   => Is_Visible);
               Item := RawDict.Get_Package_Symbol (Package_Item);
            end if;
            --# end accept;
         else
            Item       := NullSymbol;
            Is_Visible := False;
         end if;

         exit when Item /= NullSymbol;

         Lookup_Context_Clauses
           (Name              => Name,
            Scope             => Current_Scope,
            Start_Pos         => Scope,
            Context           => Context,
            Full_Package_Name => Full_Package_Name,
            Item              => Item,
            Is_Visible        => Is_Visible);
         exit when Item /= NullSymbol
           or else RawDict.GetSymbolDiscriminant (Current_Region) = Package_Symbol
           or else RawDict.GetSymbolDiscriminant (Current_Region) = Generic_Unit_Symbol
           or else (RawDict.GetSymbolDiscriminant (Current_Region) = Subprogram_Symbol
                      and then Is_Main_Program (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => Current_Region)));
         Enclosing_Scope := GetEnclosingScope (Current_Scope);
         if Is_Subprogram (Current_Region) and then Get_Visibility (Scope => Enclosing_Scope) = Local then
            Stop_At := GetSimpleName (Current_Region);
         elsif RawDict.GetSymbolDiscriminant (Current_Region) = Type_Symbol
           and then (Is_Protected_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Current_Region))
                       or else Is_Task_Type (Type_Mark => RawDict.Get_Type_Info_Ref (Item => Current_Region)))
           and then Get_Visibility (Scope => Enclosing_Scope) = Local then
            Stop_At := GetSimpleName (Current_Region);
         else
            Stop_At := LexTokenManager.Null_String;
         end if;
         LookupScope
           (Name          => Name,
            Stop_At       => Stop_At,
            Scope         => Enclosing_Scope,
            Calling_Scope => Enclosing_Scope,
            Context       => Context,
            Item          => Item,
            Is_Visible    => Is_Visible);
         if In_A_Subprogram and then Is_Variable (Item) then
            Is_Visible := False;
         end if;
         exit when Item /= NullSymbol;
         Current_Scope  := Enclosing_Scope;
         Current_Region := GetRegion (Current_Scope);
      end loop;

      if Item = NullSymbol
        and then (RawDict.GetSymbolDiscriminant (Current_Region) /= Package_Symbol
                    or else RawDict.Get_Package_Info_Ref (Item => Current_Region) /= Get_Predefined_Package_Standard) then
         LookupScope
           (Name          => Name,
            Stop_At       => LexTokenManager.Null_String,
            Scope         => Predefined_Scope,
            Calling_Scope => Predefined_Scope,
            Context       => Context,
            Item          => Item,
            Is_Visible    => Is_Visible);
      end if;

   end if;

   if not Is_Visible then
      Item := NullSymbol;
   end if;

   Trace_Sym (Msg   => "Found in LookUpItem ",
              Sym   => Item,
              Scope => Scope);
   TraceMsg ("--------------------------------------------------------------------------");
   return Item;
end LookupItem;
