-------------------------------------------------------------------------------
-- (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.Wf_Context_Clause_Package_Body)
procedure Use_Clause (Node     : in STree.SyntaxNode;
                      Comp_Sym : in Dictionary.Symbol;
                      Scope    : in Dictionary.Scopes) is
   Sym       : Dictionary.Symbol;
   Next_Node : STree.SyntaxNode;
   It        : STree.Iterator;
   Prefix_Ok : Boolean;
   OK_To_Add : Boolean := True;

   procedure Check_Prefix
     (Type_Node : in     STree.SyntaxNode;
      Comp_Sym  : in     Dictionary.Symbol;
      Scope     : in     Dictionary.Scopes;
      Prefix_Ok :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --#        in out STree.Table;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Comp_Sym,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Type_Node &
   --#         Prefix_Ok                  from CommandLineData.Content,
   --#                                         Comp_Sym,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         Type_Node &
   --#         STree.Table                from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Type_Node;
   --# pre Syntax_Node_Type (Type_Node, STree.Table) = SP_Symbols.type_mark;
   --# post STree.Table = STree.Table~;
   is
      Curr_Node  : STree.SyntaxNode;
      Last_Node  : STree.SyntaxNode;
      Sym        : Dictionary.Symbol;
      Parent_Sym : Dictionary.Symbol;
      Lib_Sym    : Dictionary.Symbol;
      Ok         : Boolean := True;
   begin
      Lib_Sym   := Dictionary.GetLibraryPackage (Scope);
      Last_Node := Child_Node (Current_Node => Child_Node (Current_Node => Type_Node));
      -- ASSUME Last_Node = dotted_simple_name OR identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Last_Node) = SP_Symbols.dotted_simple_name
           or else Syntax_Node_Type (Node => Last_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Last_Node = dotted_simple_name OR identifier in Check_Prefix");

      Curr_Node := Last_Child_Of (Start_Node => Type_Node);
      -- ASSUME Curr_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Curr_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Curr_Node = identifier in Check_Prefix");
      Parent_Sym := Dictionary.NullSymbol;
      Sym        :=
        Dictionary.LookupItem
        (Name              => Node_Lex_String (Node => Curr_Node),
         Scope             => Dictionary.GlobalScope,
         Context           => Dictionary.ProgramContext,
         Full_Package_Name => False);
      loop
         --# assert STree.Table = STree.Table~ and
         --#   Syntax_Node_Type (Curr_Node, STree.Table) = SP_Symbols.identifier;
         if Dictionary.Is_Null_Symbol (Sym) then -- not declared or not visible
            Ok := False;
            ErrorHandler.Semantic_Error
              (Err_Num   => 131,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Curr_Node),
               Id_Str    => Node_Lex_String (Node => Curr_Node));
         elsif not Dictionary.IsPackage (Sym) then
            Ok := False;
            ErrorHandler.Semantic_Error
              (Err_Num   => 18,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Curr_Node),
               Id_Str    => Node_Lex_String (Node => Curr_Node));
         end if;

         exit when not Ok;
         STree.Set_Node_Lex_String (Sym  => Sym,
                                    Node => Curr_Node);

         exit when Parent_Node (Current_Node => Curr_Node) = Last_Node or else Curr_Node = Last_Node;

         Curr_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Curr_Node));
         -- ASSUME Curr_Node = identifier
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Curr_Node) = SP_Symbols.identifier,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Curr_Node = identifier in Check_Prefix");
         Parent_Sym := Sym;
         Sym        :=
           Dictionary.LookupSelectedItem
           (Prefix   => Sym,
            Selector => Node_Lex_String (Node => Curr_Node),
            Scope    => Dictionary.GlobalScope,
            Context  => Dictionary.ProofContext);
      end loop;

      if Ok then
         -- check visibility in current scope
         if Dictionary.Packages_Are_Equal (Left_Symbol  => Sym,
                                           Right_Symbol => Lib_Sym) then -- using self
            Sym := Dictionary.NullSymbol;
            Ok  := False;
            ErrorHandler.Semantic_Error
              (Err_Num   => 130,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Curr_Node),
               Id_Str    => Node_Lex_String (Node => Curr_Node));
         else
            if Dictionary.Is_Null_Symbol (Parent_Sym)
              or else Dictionary.IsProperDescendent (Lib_Sym, Sym)
              -- using an ancestor
              or else Dictionary.IsProperDescendent (Lib_Sym, Parent_Sym)
              -- using child of ancestor
              or else Dictionary.Packages_Are_Equal (Left_Symbol  => Parent_Sym,
                                                     Right_Symbol => Lib_Sym) -- using own child
            then -- look up directly
               Sym :=
                 Dictionary.LookupItem
                 (Name              => Node_Lex_String (Node => Curr_Node),
                  Scope             => Scope,
                  Context           => Dictionary.ProgramContext,
                  Full_Package_Name => False);
            else
               Sym :=
                 Dictionary.LookupSelectedItem
                 (Prefix   => Parent_Sym,
                  Selector => Node_Lex_String (Node => Curr_Node),
                  Scope    => Scope,
                  Context  => Dictionary.ProgramContext);
            end if;
            if Dictionary.Is_Null_Symbol (Sym) then
               Ok := False;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 1,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Curr_Node),
                  Id_Str    => Node_Lex_String (Node => Curr_Node));
            elsif Dictionary.IsProperDescendent (Lib_Sym, Sym) then  -- using an ancestor
               Ok := False;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 624,
                  Reference => ErrorHandler.No_Reference,
                  Position  => Node_Position (Node => Curr_Node),
                  Id_Str    => Node_Lex_String (Node => Curr_Node));
            else
               STree.Set_Node_Lex_String (Sym  => Sym,
                                          Node => Curr_Node);
            end if;
         end if;
      end if;

      if Ok
        and then not Dictionary.Is_Withed_Locally
        (The_Withed_Symbol => Sym,
         Scope             => Dictionary.Set_Visibility
           (The_Visibility => Dictionary.Get_Visibility (Scope => Scope),
            The_Unit       => Comp_Sym)) then
         Ok := False;
         ErrorHandler.Semantic_Error
           (Err_Num   => 555,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Curr_Node),
            Id_Str    => Node_Lex_String (Node => Curr_Node));
      end if;
      Prefix_Ok := Ok;
   end Check_Prefix;

begin -- Use_Clause
   case CommandLineData.Content.Language_Profile is
      when CommandLineData.SPARK83 =>
         ErrorHandler.Semantic_Error
           (Err_Num   => 550,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => LexTokenManager.Null_String);
      when CommandLineData.SPARK95_Onwards =>
         It := Find_First_Node (Node_Kind    => SP_Symbols.type_mark,
                                From_Root    => Node,
                                In_Direction => STree.Down);
         while not STree.IsNull (It) loop
            Next_Node := Get_Node (It => It);
            --# assert STree.Table = STree.Table~ and
            --#   Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.type_mark and
            --#   Next_Node = Get_Node (It);
            -- first we must check that the prefix is a package which is locally withed
            Check_Prefix (Type_Node => Next_Node,
                          Comp_Sym  => Comp_Sym,
                          Scope     => Scope,
                          Prefix_Ok => Prefix_Ok);
            if not Prefix_Ok then
               Sym := Dictionary.GetUnknownTypeMark;
            else
               -- there's a valid package prefix so go on to check
               -- that whole thing is a suitable type mark
               Wf_Type_Mark
                 (Node          => Next_Node,
                  Current_Scope => Dictionary.GlobalScope,
                  Context       => Dictionary.ProofContext,
                  Type_Sym      => Sym);
            end if;
            -- no action if any error found during wffing of type mark
            if not Dictionary.IsUnknownTypeMark (Sym) then
               -- work entirely in terms of base types
               Sym := Dictionary.GetRootType (Sym);

               if Syntax_Node_Type (Node => Child_Node (Current_Node => Child_Node (Current_Node => Next_Node))) =
                 SP_Symbols.identifier
                 or else Dictionary.GetScope (Sym) =
                 Dictionary.Set_Visibility
                 (The_Visibility => Dictionary.Visible,
                  The_Unit       => Dictionary.GetPredefinedPackageStandard) then
                  -- from standard or there is no dotted part so all operators are already visible
                  OK_To_Add := False;
                  ErrorHandler.Semantic_Error_Sym
                    (Err_Num   => 551,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Next_Node),
                     Sym       => Sym,
                     Scope     => Scope);
               end if;

               -- check for duplicates
               if Dictionary.IsUsedLocally (Sym, Scope) then
                  OK_To_Add := False;
                  ErrorHandler.Semantic_Error_Sym
                    (Err_Num   => 552,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Next_Node),
                     Sym       => Sym,
                     Scope     => Scope);
               end if;

               -- limited private type, no operators avaiable
               if Dictionary.TypeIsLimited (Sym, Scope) then
                  OK_To_Add := False;
                  ErrorHandler.Semantic_Error_Sym
                    (Err_Num   => 554,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Next_Node),
                     Sym       => Sym,
                     Scope     => Scope);
               end if;

               if OK_To_Add then
                  Dictionary.AddUseTypeReference
                    (The_Visibility => Dictionary.Get_Visibility (Scope => Scope),
                     The_Unit       => Comp_Sym,
                     TheType        => Sym,
                     Comp_Unit      => ContextManager.Ops.Current_Unit,
                     Declaration    => Dictionary.Location'(Start_Position => Node_Position (Node => Next_Node),
                                                            End_Position   => Node_Position (Node => Next_Node)));
               end if;
            end if; -- not unknown type mark
            It := STree.NextNode (It);
         end loop;
   end case;
end Use_Clause;
