-------------------------------------------------------------------------------
-- (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_Proof_Function_Declaration
  (Node           : in     STree.SyntaxNode;
   Current_Scope  : in     Dictionary.Scopes;
   The_Heap       : in out Heap.HeapRecord;
   Proof_Func_Sym :    out Dictionary.Symbol)
is
   Type_Sym             : Dictionary.Symbol;
   Constraint_Node      : STree.SyntaxNode;
   Ident_Node           : STree.SyntaxNode;
   Return_Type_Node     : STree.SyntaxNode;
   Spec_Node            : STree.SyntaxNode;
   Dummy_Component_Data : ComponentManager.ComponentData;
   Ident_Str            : LexTokenManager.Lex_String;
begin
   ComponentManager.Initialise (Data => Dummy_Component_Data);
   Spec_Node := Child_Node (Current_Node => Node);
   -- ASSUME Spec_Node = function_specification
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Spec_Node) = SP_Symbols.function_specification,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Spec_Node = function_specification in Wf_Proof_Function_Declaration");
   Return_Type_Node := Last_Sibling_Of (Start_Node => Child_Node (Current_Node => Spec_Node));
   -- ASSUME Return_Type_Node = type_mark
   SystemErrors.RT_Assert
     (C       => 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_Proof_Function_Declaration");
   Constraint_Node := Next_Sibling (Current_Node => Spec_Node);
   -- ASSUME Constraint_Node = function_constraint
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Constraint_Node) = SP_Symbols.function_constraint,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Constraint_Node = function_constraint in Wf_Proof_Function_Declaration");
   -- If we are in a package or protected body we may refine a proof function
   -- definition
   if In_Package_Body (Current_Scope => Current_Scope) or else In_Protected_Body (Current_Scope => Current_Scope) then
      Ident_Node := Child_Node (Current_Node => Child_Node (Current_Node => Spec_Node));
      -- ASSUME Ident_Node = identifier
      SystemErrors.RT_Assert
        (C       => 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");

      Ident_Str := Node_Lex_String (Node => Ident_Node);

      -- Lookup in the dictionary to see if the name already exists
      Proof_Func_Sym :=
        Dictionary.LookupItem
        (Name              => Ident_Str,
         Scope             => Current_Scope,
         Context           => Dictionary.ProofContext,
         Full_Package_Name => False);

      if not Dictionary.Is_Null_Symbol (Proof_Func_Sym) then
         -- The name already exists in this scope.

         -- Is it is declared in the visible part, or
         Proof_Func_Sym :=
           Dictionary.LookupImmediateScope
           (Name    => Ident_Str,
            Scope   => Dictionary.Set_Visibility
              (The_Visibility => Dictionary.Visible,
               The_Unit       => Dictionary.GetRegion (Current_Scope)),
            Context => Dictionary.ProofContext);

         -- the private part of the unit?
         if Dictionary.Is_Null_Symbol (Proof_Func_Sym) and then Dictionary.IsPackage (Dictionary.GetRegion (Current_Scope)) then
            Proof_Func_Sym :=
              Dictionary.LookupImmediateScope
              (Name    => Ident_Str,
               Scope   => Dictionary.Set_Visibility
                 (The_Visibility => Dictionary.Privat,
                  The_Unit       => Dictionary.GetRegion (Current_Scope)),
               Context => Dictionary.ProofContext);
         end if;

         if not Dictionary.Is_Null_Symbol (Proof_Func_Sym)
           and then Dictionary.IsProofFunction (Proof_Func_Sym)
           and then not Dictionary.IsImplicitProofFunction (Proof_Func_Sym) then
            -- It is the refinement of an explicit proof function declared
            -- in the visible or private part of the unit.

            -- Check that the return type of the refinement is consistent
            Wf_Type_Mark
              (Node          => Return_Type_Node,
               Current_Scope => Current_Scope,
               Context       => Dictionary.ProofContext,
               Type_Sym      => Type_Sym);

            if not Dictionary.Types_Are_Equal
              (Left_Symbol        => Type_Sym,
               Right_Symbol       => Dictionary.GetType (Proof_Func_Sym),
               Full_Range_Subtype => False) then
               if Dictionary.IsUnknownTypeMark (Dictionary.GetType (Proof_Func_Sym)) then
                  -- remind user that return type on spec was illegal
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 841,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Return_Type_Node),
                     Id_Str    => Dictionary.GetSimpleName (Proof_Func_Sym));
               else
                  -- report inconsistency
                  ErrorHandler.Semantic_Error
                    (Err_Num   => 22,
                     Reference => ErrorHandler.No_Reference,
                     Position  => Node_Position (Node => Return_Type_Node),
                     Id_Str    => Dictionary.GetSimpleName (Proof_Func_Sym));
               end if;
            end if;

         else
            -- Name in use for something other than an explicit proof function.
            ErrorHandler.Semantic_Error
              (Err_Num   => 10,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Ident_Node),
               Id_Str    => Ident_Str);

            -- Add the proof function declaration anyway to avoid the
            -- propagation of errors.
            Dictionary.AddSubprogram
              (Name          => Ident_Str,
               Comp_Unit     => ContextManager.Ops.Current_Unit,
               Specification => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                                     End_Position   => Node_Position (Node => Ident_Node)),
               Scope         => Current_Scope,
               Context       => Dictionary.ProofContext,
               Subprogram    => Proof_Func_Sym);
            STree.Add_Node_Symbol (Node => Ident_Node,
                                   Sym  => Proof_Func_Sym);
         end if;

         -- Now enter the refined proof function constraints in to the dictionary.
         -- ASSUME Constraint_Node = function_constraint
         --# accept F, 10, Dummy_Component_Data, "As can be seen from the name, this is not needed here.";
         Wf_Subprogram_Constraint
           (Node           => Constraint_Node,
            Subprogram_Sym => Proof_Func_Sym,
            First_Seen     => False,
            Component_Data => Dummy_Component_Data,
            The_Heap       => The_Heap);
         --# end accept;

         --  If the refinement contains an implicit return - warn. See
         --  Sem.Subprogram_Specification.Wf_Subprogram_Specification
         --  for more information.
         if not Dictionary.HasImplicitReturnVariable (Dictionary.IsAbstract, Proof_Func_Sym) and then
           Dictionary.HasImplicitReturnVariable (Dictionary.IsRefined, Proof_Func_Sym) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 321,
               Position => Node_Position (Node),
               Sym      => Proof_Func_Sym,
               Scope    => Current_Scope);
         end if;

         --  Refinements cannot be checked.
         if Dictionary.HasPostcondition (Dictionary.IsAbstract, Proof_Func_Sym) and
           Dictionary.HasPostcondition (Dictionary.IsRefined, Proof_Func_Sym) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 322,
               Position => Node_Position (Node),
               Sym      => Proof_Func_Sym,
               Scope    => Current_Scope);
         end if;

         if Dictionary.HasPrecondition (Dictionary.IsAbstract, Proof_Func_Sym) and
           Dictionary.HasPrecondition (Dictionary.IsRefined, Proof_Func_Sym) then
            ErrorHandler.Semantic_Warning_Sym
              (Err_Num  => 323,
               Position => Node_Position (Node),
               Sym      => Proof_Func_Sym,
               Scope    => Current_Scope);
         end if;

      else
         -- It is a new identifier in this scope it cannot be a refinement.
         -- Assume it is a new proof function declaration
         --# accept Flow, 10, Dummy_Component_Data, "Expected ineffective assignment";
         Subprogram_Specification.Wf_Subprogram_Specification
           (Spec_Node                => Spec_Node,
            Anno_Node                => STree.NullNode,
            Constraint_Node          => Constraint_Node,
            Inherit_Node             => STree.NullNode,
            Context_Node             => STree.NullNode,
            Generic_Formal_Part_Node => STree.NullNode,
            Current_Scope            => Current_Scope,
            Generic_Unit             => Dictionary.NullSymbol,
            Current_Context          => Dictionary.ProofContext,
            Component_Data           => Dummy_Component_Data,
            The_Heap                 => The_Heap,
            Subprog_Sym              => Proof_Func_Sym);
         --# end accept;
      end if;
   else
      -- The declaration is not in a package or protected body it cannot be
      -- a refinement.  Assume a new proof function declaration.
      --# accept Flow, 10, Dummy_Component_Data, "Expected ineffective assignment";
      Subprogram_Specification.Wf_Subprogram_Specification
        (Spec_Node                => Spec_Node,
         Anno_Node                => STree.NullNode,
         Constraint_Node          => Constraint_Node,
         Inherit_Node             => STree.NullNode,
         Context_Node             => STree.NullNode,
         Generic_Formal_Part_Node => STree.NullNode,
         Current_Scope            => Current_Scope,
         Generic_Unit             => Dictionary.NullSymbol,
         Current_Context          => Dictionary.ProofContext,
         Component_Data           => Dummy_Component_Data,
         The_Heap                 => The_Heap,
         Subprog_Sym              => Proof_Func_Sym);
      --# end accept;
   end if;

end Wf_Proof_Function_Declaration;
