-------------------------------------------------------------------------------
-- (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)
procedure Wf_Subprogram_Constraint
  (Node           : in     STree.SyntaxNode;
   Subprogram_Sym : in     Dictionary.Symbol;
   First_Seen     : in     Boolean;
   Component_Data : in out ComponentManager.ComponentData;
   The_Heap       : in out Heap.HeapRecord)
is

   -- look up table: if First_Seen then we are dealing with Abstract spec else Refined
   type Which_Abstractions is array (Boolean) of Dictionary.Abstractions;
   Which_Abstraction : constant Which_Abstractions :=
     Which_Abstractions'(False => Dictionary.IsRefined,
                         True  => Dictionary.IsAbstract);

   Con_Node, Child_Con_Node  : STree.SyntaxNode;
   Scope                     : Dictionary.Scopes;
   Generic_Subprogram_Sym    : Dictionary.Symbol;
   Errors_Found              : Boolean := False;
   Errors_Found_In_Predicate : Boolean := False;

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

   procedure Wf_Return_Expression
     (Node           : in     STree.SyntaxNode;
      Scope          : in     Dictionary.Scopes;
      First_Seen     : in     Boolean;
      Component_Data : in out ComponentManager.ComponentData;
      The_Heap       : in out Heap.HeapRecord;
      Errors_Found   :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     ContextManager.Ops.File_Heap;
   --#        in     ContextManager.Ops.Unit_Heap;
   --#        in     ContextManager.Ops.Unit_Stack;
   --#        in out Aggregate_Stack.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SLI.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out STree.Table;
   --# derives Aggregate_Stack.State,
   --#         Component_Data,
   --#         Dictionary.Dict,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         STree.Table,
   --#         The_Heap                   from *,
   --#                                         CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         First_Seen,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SLI.State,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.File_Heap,
   --#                                         ContextManager.Ops.Unit_Heap,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         First_Seen,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         SLI.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         STree.Table,
   --#                                         The_Heap &
   --#         Errors_Found               from CommandLineData.Content,
   --#                                         Component_Data,
   --#                                         ContextManager.Ops.Unit_Stack,
   --#                                         Dictionary.Dict,
   --#                                         First_Seen,
   --#                                         LexTokenManager.State,
   --#                                         Node,
   --#                                         Scope,
   --#                                         STree.Table,
   --#                                         The_Heap;
   --# pre Syntax_Node_Type (Node, STree.Table) = SP_Symbols.annotation_expression or
   --#   Syntax_Node_Type (Node, STree.Table) = SP_Symbols.simple_name;
   --# post STree.Table = STree.Table~;
   is
      Ret_Exp       : Exp_Record;
      Implicit_Node : STree.SyntaxNode;
      Implicit_Str  : LexTokenManager.Lex_String;
      Implicit_Var  : Dictionary.Symbol;
      Return_Type   : Dictionary.Symbol;
      Con_Node      : STree.SyntaxNode;
   begin
      if Syntax_Node_Type (Node => Node) = SP_Symbols.annotation_expression then
         -- ASSUME Node = annotation_expression
         Return_Type := Dictionary.GetType (Dictionary.GetRegion (Scope));
         Walk_Expression_P.Walk_Annotation_Expression
           (Exp_Node       => Node,
            Scope          => Scope,
            Type_Context   => Return_Type,
            Context        => Function_Return,
            Result         => Ret_Exp,
            Component_Data => Component_Data,
            The_Heap       => The_Heap);
         Errors_Found := Ret_Exp.Errors_In_Expression;

         Assignment_Check
           (Position    => Node_Position (Node => Node),
            Scope       => Scope,
            Target_Type => Return_Type,
            Exp_Result  => Ret_Exp);
         Errors_Found := Errors_Found or else Ret_Exp.Errors_In_Expression;
      elsif Syntax_Node_Type (Node => Node) = SP_Symbols.simple_name then
         -- ASSUME Node = simple_name
         Implicit_Node := Child_Node (Current_Node => Node);
         -- ASSUME Implicit_Node = identifier
         SystemErrors.RT_Assert
           (C       => Syntax_Node_Type (Node => Implicit_Node) = SP_Symbols.identifier,
            Sys_Err => SystemErrors.Invalid_Syntax_Tree,
            Msg     => "Expect Implicit_Node = identifier in Wf_Return_Expression");
         Implicit_Str := Node_Lex_String (Node => Implicit_Node);
         if Dictionary.IsDefined
           (Name              => Implicit_Str,
            Scope             => Scope,
            Context           => Dictionary.ProofContext,
            Full_Package_Name => False) then
            Errors_Found := True;
            ErrorHandler.Semantic_Error
              (Err_Num   => 10,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Node),
               Id_Str    => Implicit_Str);
         else -- valid implicit return variable so add it and then wf predicate
            Dictionary.AddImplicitReturnVariable
              (Abstraction => Which_Abstraction (First_Seen),
               Comp_Unit   => ContextManager.Ops.Current_Unit,
               Declaration => Dictionary.Location'(Start_Position => Node_Position (Node => Implicit_Node),
                                                   End_Position   => Node_Position (Node => Implicit_Node)),
               Name        => Implicit_Str,
               TheFunction => Dictionary.GetRegion (Scope),
               Variable    => Implicit_Var);
            STree.Add_Node_Symbol (Node => Implicit_Node,
                                   Sym  => Implicit_Var);
            Con_Node := Next_Sibling (Current_Node => Node);
            -- ASSUME Con_Node = predicate
            SystemErrors.RT_Assert
              (C       => Syntax_Node_Type (Node => Con_Node) = SP_Symbols.predicate,
               Sys_Err => SystemErrors.Invalid_Syntax_Tree,
               Msg     => "Expect Con_Node = predicate in Wf_Return_Expression");
            Wf_Predicate
              (Node           => Con_Node,
               Scope          => Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                            The_Unit       => Implicit_Var),
               Context        => Function_Return,
               Component_Data => Component_Data,
               The_Heap       => The_Heap,
               Errors_Found   => Errors_Found);
         end if;
      else
         Errors_Found := False;
      end if;
   end Wf_Return_Expression;

begin -- Wf_Subprogram_Constraint
   Scope                  := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
                                                        The_Unit       => Subprogram_Sym);
   Generic_Subprogram_Sym := Dictionary.GetGenericOfInstantiation (Subprogram_Sym);
   Con_Node               := Child_Node (Current_Node => Node);
   -- ASSUME Con_Node = precondition OR postcondition OR return_expression OR NULL
   SystemErrors.RT_Assert
     (C       => Con_Node = STree.NullNode
        or else Syntax_Node_Type (Node => Con_Node) = SP_Symbols.precondition
        or else Syntax_Node_Type (Node => Con_Node) = SP_Symbols.postcondition
        or else Syntax_Node_Type (Node => Con_Node) = SP_Symbols.return_expression,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Con_Node = precondition OR postcondition OR return_expression OR NULL in Wf_Subprogram_Constraint");
   if Syntax_Node_Type (Node => Con_Node) = SP_Symbols.precondition then
      -- ASSUME Con_Node = precondition
      if not Dictionary.Is_Null_Symbol (Generic_Subprogram_Sym)
        and then STree.RefToNode (Dictionary.GetPrecondition (Dictionary.IsAbstract, Generic_Subprogram_Sym)) /= STree.NullNode
      then
         -- A precondition on the generic instantiation and on the generic
         -- Instantiation => Generic
         -- True          => True    : OK
         -- Pre           => True    : OK
         -- True          => Pre     : OK because the precondition of the generic will be used by the caller
         -- Pre           => Pre     : raise a warning because no VCs will be generated for this
         ErrorHandler.Semantic_Warning
           (Err_Num  => 389,
            Position => Node_Position (Node => Con_Node),
            Id_Str   => LexTokenManager.Null_String);
      end if;
      Child_Con_Node := Child_Node (Current_Node => Con_Node);
      -- ASSUME Child_Con_Node = predicate
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.predicate,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Child_Con_Node = predicate in Wf_Subprogram_Constraint");
      Dictionary.AddPrecondition
        (Which_Abstraction (First_Seen),
         Subprogram_Sym,
         STree.NodeToRef (Child_Con_Node),
         Dictionary.Location'(Start_Position => Node_Position (Node => Con_Node),
                              End_Position   => Node_Position (Node => Con_Node)));
      Wf_Predicate
        (Node           => Child_Con_Node,
         Scope          => Scope,
         Context        => Precondition,
         Component_Data => Component_Data,
         The_Heap       => The_Heap,
         Errors_Found   => Errors_Found);
      Con_Node := Next_Sibling (Current_Node => Con_Node);
   end if;
   -- ASSUME Con_Node = postcondition OR return_expression OR NULL
   if Syntax_Node_Type (Node => Con_Node) = SP_Symbols.postcondition
     or else Syntax_Node_Type (Node => Con_Node) = SP_Symbols.return_expression then
      -- ASSUME Con_Node = postcondition OR return_expression
      if not Dictionary.Is_Null_Symbol (Generic_Subprogram_Sym) then
         -- A postcondition on the generic instantiation
         -- Generic => Instantiation
         -- True    => True          : OK
         -- Post    => True          : OK
         -- True    => Post          : raise a warning because the postcondition of the generic instantiation will be used by the caller
         -- Post    => Post          : raise a warning because no VCs will be generated for this
         ErrorHandler.Semantic_Warning
           (Err_Num  => 389,
            Position => Node_Position (Node => Con_Node),
            Id_Str   => LexTokenManager.Null_String);
      end if;
      Child_Con_Node := Child_Node (Current_Node => Con_Node);
      -- ASSUME Child_Con_Node = predicate OR annotation_expression OR simple_name
      SystemErrors.RT_Assert
        (C       => Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.predicate
           or else Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.annotation_expression
           or else Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.simple_name,
         Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Child_Con_Node = predicate OR annotation_expression OR simple_name in Wf_Subprogram_Constraint");
      Dictionary.AddPostcondition
        (Which_Abstraction (First_Seen),
         Subprogram_Sym,
         STree.NodeToRef (Child_Con_Node),
         Dictionary.Location'(Start_Position => Node_Position (Node => Con_Node),
                              End_Position   => Node_Position (Node => Con_Node)));
      if Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.predicate then
         -- ASSUME Child_Con_Node = predicate
         Wf_Predicate
           (Node           => Child_Con_Node,
            Scope          => Scope,
            Context        => Postcondition,
            Component_Data => Component_Data,
            The_Heap       => The_Heap,
            Errors_Found   => Errors_Found_In_Predicate);
      elsif Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.annotation_expression
        or else Syntax_Node_Type (Node => Child_Con_Node) = SP_Symbols.simple_name then
         -- ASSUME Child_Con_Node = annotation_expression OR simple_name
         Wf_Return_Expression
           (Node           => Child_Con_Node,
            Scope          => Scope,
            First_Seen     => First_Seen,
            Component_Data => Component_Data,
            The_Heap       => The_Heap,
            Errors_Found   => Errors_Found_In_Predicate);
      end if;
      Errors_Found := Errors_Found or else Errors_Found_In_Predicate;
   elsif Con_Node /= STree.NullNode then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Con_Node = postcondition OR return_expression OR NULL in Wf_Subprogram_Constraint");
   end if;
   if Errors_Found then
      Dictionary.SetSubprogramSignatureNotWellformed (Which_Abstraction (First_Seen), Subprogram_Sym);
   end if;
end Wf_Subprogram_Constraint;
