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

with SLI;

separate (Sem)
package body Subprogram_Specification is

   procedure Wf_Subprogram_Specification_From_Body
     (Node          : in     STree.SyntaxNode;
      Hidden        : in     Boolean;
      Current_Scope : in out Dictionary.Scopes;
      Subprog_Sym   :    out Dictionary.Symbol;
      First_Seen    :    out Boolean)
   is
      Ident_Node, Return_Type_Node     : STree.SyntaxNode;
      Ident_Str                        : LexTokenManager.Lex_String;
      Type_Sym, First_Sym_Found        : Dictionary.Symbol;
      Grand_Parent, Great_Grand_Parent : SP_Symbols.SP_Symbol;
      Adding_Proper_Body               : Boolean;

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

      procedure Do_Add
        (Add_Subprog, Add_Body, Hidden : in     Boolean;
         Ident_Node                    : in     STree.SyntaxNode;
         Node_Pos                      : in     LexTokenManager.Token_Position;
         First_Seen                    : in out Boolean;
         Current_Scope                 : in out Dictionary.Scopes;
         Subprog_Sym                   : in out Dictionary.Symbol)
      --# global in     ContextManager.Ops.Unit_Stack;
      --#        in     LexTokenManager.State;
      --#        in out Dictionary.Dict;
      --#        in out SPARK_IO.File_Sys;
      --#        in out STree.Table;
      --# derives Current_Scope     from *,
      --#                                Add_Body,
      --#                                Add_Subprog,
      --#                                ContextManager.Ops.Unit_Stack,
      --#                                Dictionary.Dict,
      --#                                Ident_Node,
      --#                                Node_Pos,
      --#                                STree.Table,
      --#                                Subprog_Sym &
      --#         Dictionary.Dict   from *,
      --#                                Add_Body,
      --#                                Add_Subprog,
      --#                                ContextManager.Ops.Unit_Stack,
      --#                                Current_Scope,
      --#                                Hidden,
      --#                                Ident_Node,
      --#                                Node_Pos,
      --#                                STree.Table,
      --#                                Subprog_Sym &
      --#         First_Seen        from *,
      --#                                Add_Subprog &
      --#         SPARK_IO.File_Sys from *,
      --#                                Add_Body,
      --#                                Add_Subprog,
      --#                                ContextManager.Ops.Unit_Stack,
      --#                                Current_Scope,
      --#                                Dictionary.Dict,
      --#                                Hidden,
      --#                                Ident_Node,
      --#                                LexTokenManager.State,
      --#                                Node_Pos,
      --#                                STree.Table,
      --#                                Subprog_Sym &
      --#         STree.Table,
      --#         Subprog_Sym       from *,
      --#                                Add_Subprog,
      --#                                ContextManager.Ops.Unit_Stack,
      --#                                Current_Scope,
      --#                                Dictionary.Dict,
      --#                                Ident_Node,
      --#                                Node_Pos,
      --#                                STree.Table;
      --# pre STree.Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
      --# post STree.Table = STree.Table~;
      is
      begin
         if Add_Subprog then
            Dictionary.AddSubprogram
              (Name          => STree.Node_Lex_String (Node => Ident_Node),
               Comp_Unit     => ContextManager.Ops.Current_Unit,
               Specification => Dictionary.Location'(Start_Position => Node_Pos,
                                                     End_Position   => Node_Pos),
               Scope         => Current_Scope,
               Context       => Dictionary.ProgramContext,
               Subprogram    => Subprog_Sym);
            STree.Add_Node_Symbol (Node => Ident_Node,
                                   Sym  => Subprog_Sym);
         else
            First_Seen := False;
         end if;

         if Add_Body then
            Dictionary.AddBody
              (CompilationUnit => Subprog_Sym,
               Comp_Unit       => ContextManager.Ops.Current_Unit,
               TheBody         => Dictionary.Location'(Start_Position => Node_Pos,
                                                       End_Position   => Node_Pos),
               Hidden          => Hidden);
            Current_Scope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                        The_Unit       => Subprog_Sym);
         else
            Dictionary.AddBodyStub
              (CompilationUnit => Subprog_Sym,
               Comp_Unit       => ContextManager.Ops.Current_Unit,
               BodyStub        => Dictionary.Location'(Start_Position => Node_Pos,
                                                       End_Position   => Node_Pos));
         end if;
      end Do_Add;

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

      procedure Check_For_Child (Ident_Node    : in STree.SyntaxNode;
                                 Current_Scope : in Dictionary.Scopes)
      --# 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,
      --#                                         Current_Scope,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Ident_Node,
      --#                                         LexTokenManager.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         STree.Table;
      --# pre STree.Syntax_Node_Type (Ident_Node, STree.Table) = SP_Symbols.identifier;
      is
      begin
         if Dictionary.IsPackage (Dictionary.GetRegion (Current_Scope))
           and then not Dictionary.IsEmbeddedPackage (Dictionary.GetRegion (Current_Scope))
           and then not Dictionary.Is_Null_Symbol
           (Dictionary.LookupSelectedItem
              (Prefix   => Dictionary.GetRegion (Current_Scope),
               Selector => STree.Node_Lex_String (Node => Ident_Node),
               Scope    => Dictionary.GlobalScope,
               Context  => Dictionary.ProofContext)) then
            -- name exists as child
            ErrorHandler.Semantic_Error
              (Err_Num   => 10,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Ident_Node),
               Id_Str    => STree.Node_Lex_String (Node => Ident_Node));
         end if;
      end Check_For_Child;

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

      function Declared_In_Same_Or_Related_Scope (Sym           : Dictionary.Symbol;
                                                  Current_Scope : Dictionary.Scopes) return Boolean
      --# global in Dictionary.Dict;
      --  return true if Sym is declared in Current_Scope or in the
      --  visible/private scope of the region associate with Current_Scope
      is
      begin
         return Dictionary.GetScope (Sym) = Current_Scope
           or else Dictionary.GetScope (Sym) =
           Dictionary.Set_Visibility
           (The_Visibility => Dictionary.Visible,
            The_Unit       => Dictionary.GetRegion (Current_Scope))
           or else Dictionary.GetScope (Sym) =
           Dictionary.Set_Visibility
           (The_Visibility => Dictionary.Privat,
            The_Unit       => Dictionary.GetRegion (Current_Scope));
      end Declared_In_Same_Or_Related_Scope;

   begin -- Wf_Subprogram_Specification_From_Body
      Ident_Node := STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Node));
      -- ASSUME Ident_Node = identifier
      SystemErrors.RT_Assert
        (C       => STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Ident_Node = identifier in Wf_Subprogram_Specification_From_Body");
      Ident_Str          := STree.Node_Lex_String (Node => Ident_Node);
      Grand_Parent       :=
        STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Node)));
      Great_Grand_Parent :=
        STree.Syntax_Node_Type
        (Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => STree.Parent_Node (Current_Node => Node))));
      Adding_Proper_Body := Great_Grand_Parent = SP_Symbols.abody or else Sem.In_Protected_Body (Current_Scope => Current_Scope);
      -- in prot bod we can't be adding a stub
      First_Seen  := True; -- default value in case all checks below fail
      Subprog_Sym :=
        Dictionary.LookupItem
        (Name              => Ident_Str,
         Scope             => Current_Scope,
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);

      if Dictionary.Is_Null_Symbol (Subprog_Sym) then
         if STree.Syntax_Node_Type (Node => STree.Parent_Node (Current_Node => Node)) = SP_Symbols.body_stub then
            Check_For_Child (Ident_Node    => Ident_Node,
                             Current_Scope => Current_Scope);
            Do_Add
              (Add_Subprog   => True,
               Add_Body      => False,
               Hidden        => Hidden,
               Ident_Node    => Ident_Node,
               Node_Pos      => STree.Node_Position (Node => Node),
               First_Seen    => First_Seen,
               Current_Scope => Current_Scope,
               Subprog_Sym   => Subprog_Sym);
         elsif Grand_Parent = SP_Symbols.main_program_declaration then
            Do_Add
              (Add_Subprog   => True,
               Add_Body      => True,
               Hidden        => Hidden,
               Ident_Node    => Ident_Node,
               Node_Pos      => STree.Node_Position (Node => Node),
               First_Seen    => First_Seen,
               Current_Scope => Current_Scope,
               Subprog_Sym   => Subprog_Sym);
         elsif Grand_Parent = SP_Symbols.generic_subprogram_body then
            Subprog_Sym := Dictionary.NullSymbol;
            ErrorHandler.Semantic_Error
              (Err_Num   => 641,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Ident_Node),
               Id_Str    => Ident_Str);
         elsif Great_Grand_Parent /= SP_Symbols.subunit then
            Do_Add
              (Add_Subprog   => True,
               Add_Body      => True,
               Hidden        => Hidden,
               Ident_Node    => Ident_Node,
               Node_Pos      => STree.Node_Position (Node => Node),
               First_Seen    => First_Seen,
               Current_Scope => Current_Scope,
               Subprog_Sym   => Subprog_Sym);
         else -- no stub for subunit
            Subprog_Sym := Dictionary.NullSymbol;
            ErrorHandler.Semantic_Error
              (Err_Num   => 15,
               Reference => ErrorHandler.No_Reference,
               Position  => STree.Node_Position (Node => Ident_Node),
               Id_Str    => Ident_Str);
         end if;
      else -- symbol found so further checks needed

         --  if the Subprog_Sym is an implicit proof function associated
         --  with the declaration of an Ada function then we want to
         --  recover the associated Ada function before proceding (since
         --  that is the thing we are going to add a body to).  The
         --  GetAdaFunction call is guarded to meet its precondition.
         if Dictionary.IsImplicitProofFunction (Subprog_Sym) then
            Subprog_Sym := Dictionary.GetAdaFunction (Subprog_Sym);
         end if;

         if Great_Grand_Parent = SP_Symbols.subunit then
            if Dictionary.Is_Subprogram (Subprog_Sym)
              and then Dictionary.HasBodyStub (Subprog_Sym)
              and then not Dictionary.HasBody (Subprog_Sym) then
               STree.Set_Node_Lex_String (Sym  => Subprog_Sym,
                                          Node => Ident_Node);
               Do_Add
                 (Add_Subprog   => False,
                  Add_Body      => True,
                  Hidden        => Hidden,
                  Ident_Node    => Ident_Node,
                  Node_Pos      => STree.Node_Position (Node => Node),
                  First_Seen    => First_Seen,
                  Current_Scope => Current_Scope,
                  Subprog_Sym   => Subprog_Sym);
            else
               Subprog_Sym := Dictionary.NullSymbol;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Ident_Node),
                  Id_Str    => Ident_Str);
            end if;
         elsif Grand_Parent = SP_Symbols.generic_subprogram_body then
            if Dictionary.Is_Subprogram (Subprog_Sym) and then not Dictionary.HasBody (Subprog_Sym) then
               STree.Set_Node_Lex_String (Sym  => Subprog_Sym,
                                          Node => Ident_Node);
               Do_Add
                 (Add_Subprog   => False,
                  Add_Body      => True,
                  Hidden        => Hidden,
                  Ident_Node    => Ident_Node,
                  Node_Pos      => STree.Node_Position (Node => Node),
                  First_Seen    => First_Seen,
                  Current_Scope => Current_Scope,
                  Subprog_Sym   => Subprog_Sym);
            else
               Subprog_Sym := Dictionary.NullSymbol;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 13,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Ident_Node),
                  Id_Str    => Ident_Str);
            end if;
         elsif -- a place where completion of declaration may be allowed
           (Sem.In_Package_Body (Current_Scope => Current_Scope)
              -- another place where completion of declaration may be allowed
              or else Sem.In_Protected_Body (Current_Scope => Current_Scope))
           and then
           --  check that we are in a place where the the declaration can
           --  be legally completed (i.e. if subprog declared in a
           --  package spec it can only be completed in the package body
           --  (ditto protected type/body)
           Declared_In_Same_Or_Related_Scope (Sym           => Subprog_Sym,
                                              Current_Scope => Current_Scope) then
            First_Sym_Found := Subprog_Sym;
            Subprog_Sym     :=
              Dictionary.LookupImmediateScope
              (Name    => Ident_Str,
               Scope   => Dictionary.Set_Visibility
                 (The_Visibility => Dictionary.Visible,
                  The_Unit       => Dictionary.GetRegion (Current_Scope)),
               Context => Dictionary.ProgramContext);
            --  Above looked for declaration in spec vis part, if not
            --  found, try again in private part
            if Dictionary.Is_Null_Symbol (Subprog_Sym) and then Dictionary.IsPackage (Dictionary.GetRegion (Current_Scope)) then
               Subprog_Sym :=
                 Dictionary.LookupImmediateScope
                 (Name    => Ident_Str,
                  Scope   => Dictionary.Set_Visibility
                    (The_Visibility => Dictionary.Privat,
                     The_Unit       => Dictionary.GetRegion (Current_Scope)),
                  Context => Dictionary.ProgramContext);
            end if;

            if Dictionary.Is_Null_Symbol (Subprog_Sym) then -- something definitely wrong
               if not Dictionary.Is_Subprogram (First_Sym_Found) or else Dictionary.IsProofFunction (First_Sym_Found) then
                  -- Name in use for something other than a subprogram or in use for an explicit proof function.
                  -- Report "illegal redec" rather than "already has body" for these cases
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 10,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Ident_Node),
                     Id_Str    => Ident_Str);
                  -- add anyway to prevent scope problems later
                  Do_Add
                    (Add_Subprog   => True,
                     Add_Body      => Adding_Proper_Body,
                     Hidden        => Hidden,
                     Ident_Node    => Ident_Node,
                     Node_Pos      => STree.Node_Position (Node => Node),
                     First_Seen    => First_Seen,
                     Current_Scope => Current_Scope,
                     Subprog_Sym   => Subprog_Sym);
               else -- it is a subprogram which must be a duplicate
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 13,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Ident_Node),
                     Id_Str    => Ident_Str);
                  if Adding_Proper_Body then
                     if Dictionary.HasBody (First_Sym_Found) then
                        -- add complete duplicate subprogram to dict
                        Do_Add
                          (Add_Subprog   => True,
                           Add_Body      => True,
                           Hidden        => Hidden,
                           Ident_Node    => Ident_Node,
                           Node_Pos      => STree.Node_Position (Node => Node),
                           First_Seen    => First_Seen,
                           Current_Scope => Current_Scope,
                           Subprog_Sym   => Subprog_Sym);
                     else
                        -- add body to duplicate procedure stub in dict
                        Subprog_Sym := First_Sym_Found;
                        Do_Add
                          (Add_Subprog   => False,
                           Add_Body      => True,
                           Hidden        => Hidden,
                           Ident_Node    => Ident_Node,
                           Node_Pos      => STree.Node_Position (Node => Node),
                           First_Seen    => First_Seen,
                           Current_Scope => Current_Scope,
                           Subprog_Sym   => Subprog_Sym);
                     end if;
                  end if;
               end if;
            else -- Subprog_Sym was found in package's visible part
               if not Dictionary.Is_Subprogram (First_Sym_Found) then
                  -- name in use for something other than a subprogram
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 10,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Ident_Node),
                     Id_Str    => Ident_Str);
                  -- add anyway to prevent scope problems later
                  Do_Add
                    (Add_Subprog   => True,
                     Add_Body      => Adding_Proper_Body,
                     Hidden        => Hidden,
                     Ident_Node    => Ident_Node,
                     Node_Pos      => STree.Node_Position (Node => Node),
                     First_Seen    => First_Seen,
                     Current_Scope => Current_Scope,
                     Subprog_Sym   => Subprog_Sym);
               else -- it is a subprogram which may be a duplicate
                  if Dictionary.HasBody (Subprog_Sym) then
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 13,
                        Reference => ErrorHandler.No_Reference,
                        Position  => STree.Node_Position (Node => Ident_Node),
                        Id_Str    => Ident_Str);
                     if Adding_Proper_Body then
                        -- add complete duplicate procedure to dict
                        Do_Add
                          (Add_Subprog   => True,
                           Add_Body      => True,
                           Hidden        => Hidden,
                           Ident_Node    => Ident_Node,
                           Node_Pos      => STree.Node_Position (Node => Node),
                           First_Seen    => First_Seen,
                           Current_Scope => Current_Scope,
                           Subprog_Sym   => Subprog_Sym);
                     end if;
                  elsif Dictionary.HasBodyStub (Subprog_Sym) then
                     ErrorHandler.Semantic_Error
                       (Err_Num   => 13,
                        Reference => ErrorHandler.No_Reference,
                        Position  => STree.Node_Position (Node => Ident_Node),
                        Id_Str    => Ident_Str);
                     if Adding_Proper_Body then
                        -- add body to duplicate procedure stub in dict
                        Do_Add
                          (Add_Subprog   => False,
                           Add_Body      => True,
                           Hidden        => Hidden,
                           Ident_Node    => Ident_Node,
                           Node_Pos      => STree.Node_Position (Node => Node),
                           First_Seen    => First_Seen,
                           Current_Scope => Current_Scope,
                           Subprog_Sym   => Subprog_Sym);
                     end if;
                  else -- the non-error case of pre-declaration of subprogram
                     STree.Set_Node_Lex_String (Sym  => Subprog_Sym,
                                                Node => Ident_Node);
                     Do_Add
                       (Add_Subprog   => False,
                        Add_Body      => Adding_Proper_Body,
                        Hidden        => Hidden,
                        Ident_Node    => Ident_Node,
                        Node_Pos      => STree.Node_Position (Node => Node),
                        First_Seen    => First_Seen,
                        Current_Scope => Current_Scope,
                        Subprog_Sym   => Subprog_Sym);
                  end if;
               end if;
            end if;
         else -- not in a package so duplicate is definitely error
            if Dictionary.Is_Subprogram (Subprog_Sym) and then Dictionary.HasBody (Subprog_Sym) then
               ErrorHandler.Semantic_Error
                 (Err_Num   => 13,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Ident_Node),
                  Id_Str    => Ident_Str);
            else
               ErrorHandler.Semantic_Error
                 (Err_Num   => 10,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Ident_Node),
                  Id_Str    => Ident_Str);
            end if;
            if Adding_Proper_Body then
               Do_Add
                 (Add_Subprog   => True,
                  Add_Body      => True,
                  Hidden        => Hidden,
                  Ident_Node    => Ident_Node,
                  Node_Pos      => STree.Node_Position (Node => Node),
                  First_Seen    => First_Seen,
                  Current_Scope => Current_Scope,
                  Subprog_Sym   => Subprog_Sym);
            else
               Subprog_Sym := Dictionary.NullSymbol;
            end if;
         end if;
      end if;

      if STree.Syntax_Node_Type (Node => Node) = SP_Symbols.function_specification
        and then not Dictionary.Is_Null_Symbol (Subprog_Sym) then
         -- ASSUME Node = function_specification
         Return_Type_Node := STree.Last_Sibling_Of (Start_Node => STree.Child_Node (Current_Node => Node));
         -- ASSUME Return_Type_Node = type_mark
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Return_Type_Node) = SP_Symbols.type_mark,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Node = Return_Type_Node = type_mark in Wf_Subprogram_Specification_From_Body");
         Sem.Wf_Type_Mark
           (Node          => Return_Type_Node,
            Current_Scope => Current_Scope,
            Context       => Dictionary.ProgramContext,
            Type_Sym      => Type_Sym);
         if First_Seen then
            if Dictionary.Is_Unconstrained_Array_Type_Mark (Type_Sym, Current_Scope) then
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 39,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Return_Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            elsif Dictionary.IsPredefinedSuspensionObjectType (Type_Sym) or else Dictionary.IsProtectedTypeMark (Type_Sym) then
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 905,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Return_Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
            Dictionary.AddReturnType
              (TheFunction   => Subprog_Sym,
               TypeMark      => Type_Sym,
               Comp_Unit     => ContextManager.Ops.Current_Unit,
               TypeReference => Dictionary.Location'(Start_Position => STree.Node_Position (Node => Return_Type_Node),
                                                     End_Position   => STree.Node_Position (Node => Return_Type_Node)));
         else -- not First_Seen so check consistency of return type
            if not Dictionary.Types_Are_Equal
              (Left_Symbol        => Type_Sym,
               Right_Symbol       => Dictionary.GetType (Subprog_Sym),
               Full_Range_Subtype => False) then
               if Dictionary.IsUnknownTypeMark (Dictionary.GetType (Subprog_Sym)) then
                  -- remind user that return type on spec was illegal
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 841,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Return_Type_Node),
                     Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               else
                  -- report inconsistency
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 22,
                     Reference => ErrorHandler.No_Reference,
                     Position  => STree.Node_Position (Node => Return_Type_Node),
                     Id_Str    => Dictionary.GetSimpleName (Subprog_Sym));
               end if;
            end if;
         end if;
      end if;
   end Wf_Subprogram_Specification_From_Body;

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

   procedure Wf_Subprogram_Specification
     (Spec_Node                : in     STree.SyntaxNode;
      Anno_Node                : in     STree.SyntaxNode;
      Constraint_Node          : in     STree.SyntaxNode;
      Inherit_Node             : in     STree.SyntaxNode;
      Context_Node             : in     STree.SyntaxNode;
      Generic_Formal_Part_Node : in     STree.SyntaxNode;
      Current_Scope            : in     Dictionary.Scopes;
      Current_Context          : in     Dictionary.Contexts;
      Generic_Unit             : in     Dictionary.Symbol;
      Component_Data           : in out ComponentManager.ComponentData;
      The_Heap                 : in out Heap.HeapRecord;
      Subprog_Sym              :    out Dictionary.Symbol)
   is
      Formal_Part_Node : STree.SyntaxNode;

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

      procedure Wf_Subprogram_Specification_From_Declaration
        (Spec_Node                : in     STree.SyntaxNode;
         Inherit_Node             : in     STree.SyntaxNode;
         Context_Node             : in     STree.SyntaxNode;
         Generic_Formal_Part_Node : in     STree.SyntaxNode;
         Current_Scope            : in     Dictionary.Scopes;
         Current_Context          : in     Dictionary.Contexts;
         Generic_Unit             : in     Dictionary.Symbol;
         Subprog_Sym              :    out Dictionary.Symbol)
      --# global in     CommandLineData.Content;
      --#        in     ContextManager.Ops.File_Heap;
      --#        in     ContextManager.Ops.Unit_Heap;
      --#        in     ContextManager.Ops.Unit_Stack;
      --#        in     LexTokenManager.State;
      --#        in out Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out SLI.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out STree.Table;
      --# derives Dictionary.Dict,
      --#         STree.Table                from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Context_Node,
      --#                                         Current_Context,
      --#                                         Current_Scope,
      --#                                         Dictionary.Dict,
      --#                                         Generic_Formal_Part_Node,
      --#                                         Generic_Unit,
      --#                                         Inherit_Node,
      --#                                         LexTokenManager.State,
      --#                                         Spec_Node,
      --#                                         STree.Table &
      --#         ErrorHandler.Error_Context,
      --#         SLI.State,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         ContextManager.Ops.File_Heap,
      --#                                         ContextManager.Ops.Unit_Heap,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Context_Node,
      --#                                         Current_Context,
      --#                                         Current_Scope,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Generic_Formal_Part_Node,
      --#                                         Generic_Unit,
      --#                                         Inherit_Node,
      --#                                         LexTokenManager.State,
      --#                                         SLI.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         Spec_Node,
      --#                                         STree.Table &
      --#         Subprog_Sym                from CommandLineData.Content,
      --#                                         ContextManager.Ops.Unit_Stack,
      --#                                         Current_Context,
      --#                                         Current_Scope,
      --#                                         Dictionary.Dict,
      --#                                         Generic_Unit,
      --#                                         LexTokenManager.State,
      --#                                         Spec_Node,
      --#                                         STree.Table;
      --# pre (STree.Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.function_specification or
      --#        STree.Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.procedure_specification or
      --#        STree.Syntax_Node_Type (Spec_Node, STree.Table) = SP_Symbols.entry_specification) and
      --#   (STree.Syntax_Node_Type (Context_Node, STree.Table) = SP_Symbols.context_clause or Context_Node = STree.NullNode) and
      --#   (STree.Syntax_Node_Type (Inherit_Node, STree.Table) = SP_Symbols.inherit_clause or Inherit_Node = STree.NullNode) and
      --#   (STree.Syntax_Node_Type (Generic_Formal_Part_Node, STree.Table) = SP_Symbols.generic_formal_part or
      --#      Generic_Formal_Part_Node = STree.NullNode);
      --# post STree.Table = STree.Table~;
      is
         Return_Type_Node : STree.SyntaxNode;
         Ident_Node       : STree.SyntaxNode;
         Type_Sym         : Dictionary.Symbol;
         Ok               : Boolean;
      begin
         Ident_Node := STree.Child_Node (Current_Node => STree.Child_Node (Current_Node => Spec_Node));
         -- ASSUME Ident_Node = identifier
         SystemErrors.RT_Assert
           (C       => STree.Syntax_Node_Type (Node => Ident_Node) = SP_Symbols.identifier,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Ident_Node = identifier in Wf_Subprogram_Specification_From_Declaration");
         Sem.Check_Valid_Ident (Ident_Node    => Ident_Node,
                                Current_Scope => Current_Scope,
                                Ok            => Ok);
         if Ok then
            if Dictionary.Is_Null_Symbol (Generic_Unit) then
               Dictionary.AddSubprogram
                 (Name          => STree.Node_Lex_String (Node => Ident_Node),
                  Comp_Unit     => ContextManager.Ops.Current_Unit,
                  Specification => Dictionary.Location'(Start_Position => STree.Node_Position (Node => Spec_Node),
                                                        End_Position   => STree.Node_Position (Node => Spec_Node)),
                  Scope         => Current_Scope,
                  Context       => Current_Context,
                  Subprogram    => Subprog_Sym);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Subprog_Sym);
               if STree.Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.entry_specification then
                  Dictionary.SetSubprogramIsEntry (Subprog_Sym);
               end if;
            else
               Dictionary.AddSubprogram
                 (Name          => STree.Node_Lex_String (Node => Ident_Node),
                  Comp_Unit     => ContextManager.Ops.Current_Unit,
                  Specification => Dictionary.Location'(Start_Position => STree.Node_Position (Node => Spec_Node),
                                                        End_Position   => STree.Node_Position (Node => Spec_Node)),
                  Scope         => Dictionary.GetEnclosingScope (Current_Scope),
                  Context       => Current_Context,
                  Subprogram    => Subprog_Sym);
               STree.Add_Node_Symbol (Node => Ident_Node,
                                      Sym  => Subprog_Sym);
               Dictionary.Set_Subprogram_Generic_Unit (Subprogram   => Subprog_Sym,
                                                       Generic_Unit => Generic_Unit);
               Dictionary.Set_Generic_Unit_Owning_Subprogram (Generic_Unit => Generic_Unit,
                                                              Subprogram   => Subprog_Sym);
               -- ASSUME Inherit_Node = inherit_clause OR NULL
               if STree.Syntax_Node_Type (Node => Inherit_Node) = SP_Symbols.inherit_clause then
                  -- ASSUME Inherit_Node = inherit_clause
                  Sem.Wf_Inherit_Clause
                    (Node     => Inherit_Node,
                     Comp_Sym => Subprog_Sym,
                     Scope    => Dictionary.GetEnclosingScope (Current_Scope));
               end if;
               -- ASSUME Context_Node = context_clause OR NULL
               if STree.Syntax_Node_Type (Node => Context_Node) = SP_Symbols.context_clause then
                  -- ASSUME Context_Node = context_clause
                  Sem.Wf_Context_Clause
                    (Node     => Context_Node,
                     Comp_Sym => Subprog_Sym,
                     Scope    => Dictionary.GetEnclosingScope (Current_Scope));
               end if;
               -- ASSUME Generic_Formal_Part_Node = generic_formal_part OR NULL
               if STree.Syntax_Node_Type (Node => Generic_Formal_Part_Node) = SP_Symbols.generic_formal_part then
                  -- ASSUME Generic_Formal_Part_Node = generic_formal_part
                  Sem.Wf_Generic_Formal_Part
                    (Node                         => Generic_Formal_Part_Node,
                     Generic_Ident_Node_Pos       => STree.Node_Position (Node => Ident_Node),
                     Generic_Unit                 => Generic_Unit,
                     Package_Or_Subprogram_Symbol => Subprog_Sym);
               end if;
            end if;
         else
            Subprog_Sym := Dictionary.NullSymbol;
         end if;
         if STree.Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.function_specification then
            -- ASSUME Spec_Node = function_specification
            Return_Type_Node := STree.Last_Sibling_Of (Start_Node => STree.Child_Node (Current_Node => Spec_Node));
            -- ASSUME Return_Type_Node = type_mark
            SystemErrors.RT_Assert
              (C       => STree.Syntax_Node_Type (Node => Return_Type_Node) = SP_Symbols.type_mark,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Return_Type_Node = type_mark in Wf_Subprogram_Specification_From_Declaration");
            Sem.Wf_Type_Mark
              (Node          => Return_Type_Node,
               Current_Scope => Current_Scope,
               Context       => Current_Context,
               Type_Sym      => Type_Sym);
            if Dictionary.Is_Unconstrained_Array_Type_Mark (Type_Sym, Current_Scope) then
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 39,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Return_Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            elsif Dictionary.IsPredefinedSuspensionObjectType (Type_Sym) or else Dictionary.IsProtectedTypeMark (Type_Sym) then
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 905,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Return_Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            elsif Current_Context = Dictionary.ProgramContext
              and then Dictionary.TypeIsTagged (Type_Sym)
              and then (Dictionary.GetScope (Type_Sym) = Current_Scope) then
               -- attempt to declare primitive function with controlling return result
               Type_Sym := Dictionary.GetUnknownTypeMark;
               ErrorHandler.Semantic_Error
                 (Err_Num   => 840,
                  Reference => ErrorHandler.No_Reference,
                  Position  => STree.Node_Position (Node => Return_Type_Node),
                  Id_Str    => LexTokenManager.Null_String);
            end if;
            if not Dictionary.Is_Null_Symbol (Subprog_Sym) then
               Dictionary.AddReturnType
                 (TheFunction   => Subprog_Sym,
                  TypeMark      => Type_Sym,
                  Comp_Unit     => ContextManager.Ops.Current_Unit,
                  TypeReference => Dictionary.Location'(Start_Position => STree.Node_Position (Node => Return_Type_Node),
                                                        End_Position   => STree.Node_Position (Node => Return_Type_Node)));
               -- mark signature as not wellformed if wf_type_mark has returned the unknown type
               if Dictionary.IsUnknownTypeMark (Type_Sym) then
                  Dictionary.SetSubprogramSignatureNotWellformed (Dictionary.IsAbstract, Subprog_Sym);
               end if;
            end if;
         end if;
      end Wf_Subprogram_Specification_From_Declaration;

   begin -- Wf_Subprogram_Specification
      Wf_Subprogram_Specification_From_Declaration
        (Spec_Node                => Spec_Node,
         Inherit_Node             => Inherit_Node,
         Context_Node             => Context_Node,
         Generic_Formal_Part_Node => Generic_Formal_Part_Node,
         Current_Scope            => Current_Scope,
         Current_Context          => Current_Context,
         Generic_Unit             => Generic_Unit,
         Subprog_Sym              => Subprog_Sym);
      if not Dictionary.Is_Null_Symbol (Subprog_Sym) then
         Formal_Part_Node := STree.Next_Sibling (Current_Node => STree.Child_Node (Current_Node => Spec_Node));
         -- ASSUME Formal_Part_Node = formal_part OR type_mark OR NULL
         if STree.Syntax_Node_Type (Node => Formal_Part_Node) = SP_Symbols.formal_part then
            -- ASSUME Formal_Part_Node = formal_part
            Sem.Wf_Formal_Part
              (Node             => Formal_Part_Node,
               Current_Scope    => Current_Scope,
               Subprog_Sym      => Subprog_Sym,
               First_Occurrence => True,
               Context          => Current_Context);
         elsif Formal_Part_Node /= STree.NullNode
           and then STree.Syntax_Node_Type (Node => Formal_Part_Node) /= SP_Symbols.type_mark then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Formal_Part_Node = formal_part OR type_mark OR NULL in Wf_Subprogram_Specification");
         end if;
         if STree.Syntax_Node_Type (Node => Anno_Node) = SP_Symbols.procedure_annotation
           or else STree.Syntax_Node_Type (Node => Anno_Node) = SP_Symbols.function_annotation then
            -- ASSUME Anno_Node = procedure_annotation OR function_annotation
            Sem.Wf_Subprogram_Annotation
              (Node          => Anno_Node,
               Current_Scope => Current_Scope,
               Subprog_Sym   => Subprog_Sym,
               First_Seen    => True,
               The_Heap      => The_Heap);
         end if;

         -- Synthesise 'all from all' dependency if necessary.
         if (STree.Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.procedure_specification
               or else STree.Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.entry_specification)
           and then Sem.Needs_Synthetic_Dependency (Proc_Task_Or_Entry => Subprog_Sym) then
            Sem.Dependency_Relation.Create_Full_Subprog_Dependency
              (Node_Pos    => STree.Node_Position (Node => STree.Parent_Node (Current_Node => Spec_Node)),
               Subprog_Sym => Subprog_Sym,
               Abstraction => Dictionary.IsAbstract,
               The_Heap    => The_Heap);
         end if;

         if STree.Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.procedure_constraint
           or else STree.Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.function_constraint then
            -- ASSUME Constraint_Node = procedure_constraint OR function_constraint
            Sem.Wf_Subprogram_Constraint
              (Node           => Constraint_Node,
               Subprogram_Sym => Subprog_Sym,
               First_Seen     => True,
               Component_Data => Component_Data,
               The_Heap       => The_Heap);
         end if;
      end if;

      --  Special checks for proof functions.
      if not Dictionary.Is_Null_Symbol (Subprog_Sym) and then
        Dictionary.IsProofFunction (Subprog_Sym) and then
        Dictionary.HasPostcondition (Dictionary.IsAbstract, Subprog_Sym)
      then

         --  If the return is not a boolean then warn about
         --  potential confusion about infinite numbers. For
         --  example consider the following proof function:
         --
         --     --# function A (X : Integer) return Integer;
         --     --# return X + 1;
         --
         --  Since we always assume that a function return
         --  something in-type, the following check can be proven,
         --  but it then inserts effectively `false' in all
         --  subsequent hypotheses!
         --
         --     --# check A (Integer'Last);
         --
         --  Please see Build_Annotation_Expression for more
         --  information.
         if not Dictionary.TypeIsBoolean (Dictionary.GetType (Subprog_Sym)) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 320,
               Position => Sem.Node_Position (Spec_Node),
               Sym      => Subprog_Sym,
               Scope    => Current_Scope);
         end if;

         --  Implicit returns are always tricky. It is easy to
         --  introduce a false hypotheses as we don't have a function
         --  body to catch this:
         --
         --     --# function F return Boolean;
         --     --# return B => False;
         if Dictionary.HasImplicitReturnVariable (Dictionary.IsAbstract, Subprog_Sym) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 321,
               Position => Sem.Node_Position (Constraint_Node),
               Sym      => Subprog_Sym,
               Scope    => Current_Scope);
         end if;
      end if;
   end Wf_Subprogram_Specification;

end Subprogram_Specification;
