-------------------------------------------------------------------------------
-- (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)
procedure Wf_Subunit (Node  : in     STree.SyntaxNode;
                      Scope : in out Dictionary.Scopes) is
   Next_Node, Child_Next_Node : STree.SyntaxNode;
   Sym                        : Dictionary.Symbol;
   Parent                     : Dictionary.Symbol;
   Ok                         : Boolean;

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

   procedure Check_Sym (Node : in     STree.SyntaxNode;
                        Sym  : in     Dictionary.Symbol;
                        Ok   :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in     STree.Table;
   --#        in out ErrorHandler.Error_Context;
   --#        in out SPARK_IO.File_Sys;
   --# derives ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         Sym &
   --#         Ok                         from Dictionary.Dict,
   --#                                         Sym;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.identifier;
   is
   begin
      if Dictionary.Is_Null_Symbol (Sym) or else not Dictionary.IsCompilationUnit (Sym) then
         Ok := False;
         ErrorHandler.Semantic_Error
           (Err_Num   => 14,
            Reference => ErrorHandler.No_Reference,
            Position  => Node_Position (Node => Node),
            Id_Str    => Node_Lex_String (Node => Node));
      else
         Ok := True;
      end if;
   end Check_Sym;

begin -- Wf_Subunit
   Next_Node := Parent_Node (Current_Node => Last_Child_Of (Start_Node => Node));
   -- ASSUME Next_Node = simple_name
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Next_Node) = SP_Symbols.simple_name,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Next_Node = simple_name in Wf_Subunit");
   -- Next_Node is now bottom simple_name in tree
   Child_Next_Node := Child_Node (Current_Node => Next_Node);
   -- ASSUME Child_Next_Node = identifier
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Child_Next_Node) = SP_Symbols.identifier,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Child_Next_Node = identifier in Wf_Subunit");
   Sym :=
     Dictionary.LookupItem
     (Name              => Node_Lex_String (Node => Child_Next_Node),
      Scope             => Dictionary.GlobalScope,
      Context           => Dictionary.ProgramContext,
      Full_Package_Name => False);
   Check_Sym (Node => Child_Next_Node,
              Sym  => Sym,
              Ok   => Ok);
   loop
      --# assert Syntax_Node_Type (Next_Node, STree.Table) = SP_Symbols.simple_name and
      --#   Syntax_Node_Type (Child_Next_Node, STree.Table) = SP_Symbols.identifier and
      --#   STree.Table = STree.Table~;

      exit when not Ok;
      STree.Set_Node_Lex_String (Sym  => Sym,
                                 Node => Child_Next_Node);
      Next_Node := Next_Sibling (Current_Node => Parent_Node (Current_Node => Next_Node));
      exit when Syntax_Node_Type (Node => Next_Node) /= SP_Symbols.simple_name;

      Child_Next_Node := Child_Node (Current_Node => Next_Node);
      -- ASSUME Child_Next_Node = identifier
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Child_Next_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Child_Next_Node = identifier in Wf_Subunit");

      Parent := Sym;
      Sym    :=
        Dictionary.LookupSelectedItem
        (Prefix   => Parent,
         Selector => Node_Lex_String (Node => Child_Next_Node),
         Scope    => Dictionary.GlobalScope,
         Context  => Dictionary.ProofContext);
      if Dictionary.Is_Null_Symbol (Sym) then
         Sym :=
           Dictionary.LookupImmediateScope
           (Name    => Node_Lex_String (Node => Child_Next_Node),
            Scope   => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                  The_Unit       => Parent),
            Context => Dictionary.ProgramContext);
      end if;
      -- The above look up may return the symbol of an implicit proof function associated with an
      -- Ada function.  If so, we want to process the subunit in the context of the Ada function
      if Dictionary.IsProofFunction (Sym) then
         Sym := Dictionary.GetAdaFunction (Sym);
      end if;
      Check_Sym (Node => Child_Next_Node,
                 Sym  => Sym,
                 Ok   => Ok);
   end loop;

   if Ok then
      Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                          The_Unit       => Sym);
   end if;
end Wf_Subunit;
