-------------------------------------------------------------------------------
-- (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.WalkStatements)
procedure Wf_Loop_Param
  (Node           : in     STree.SyntaxNode;
   Scope          : in     Dictionary.Scopes;
   Table          : in out RefList.HashTable;
   Component_Data : in out ComponentManager.ComponentData)
is
   Ident_Node, Type_Node, Direction_Node, Range_Node : STree.SyntaxNode;
   Ident_Str                                         : LexTokenManager.Lex_String;
   Type_Sym                                          : Dictionary.Symbol;
   OK_To_Add                                         : Boolean;
   Range_Result                                      : Exp_Record;
   Ref_Var                                           : SeqAlgebra.Seq;
   Loop_Param_Sym                                    : Dictionary.Symbol;
   Unused                                            : Maths.Value;
   Has_Static_Range                                  : Boolean := True;
   Is_Reverse_Loop                                   : Boolean;
begin
   SeqAlgebra.CreateSeq (TheHeap, Ref_Var);
   Loop_Param_Sym := Dictionary.NullSymbol;
   Ident_Node     := Child_Node (Current_Node => 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_Loop_Param");
   Ident_Str := Node_Lex_String (Node => Ident_Node);

   Direction_Node := Next_Sibling (Current_Node => Ident_Node);
   -- ASSUME Direction_Node = forward OR backward
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Direction_Node) = SP_Symbols.forward
        or else Syntax_Node_Type (Node => Direction_Node) = SP_Symbols.backward,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Direction_Node = forward OR backward in Wf_Loop_Param");
   Is_Reverse_Loop := Syntax_Node_Type (Node => Direction_Node) = SP_Symbols.backward;

   Type_Node := Next_Sibling (Current_Node => Direction_Node);
   -- ASSUME Type_Node = type_mark
   SystemErrors.RT_Assert
     (C       => Syntax_Node_Type (Node => Type_Node) = SP_Symbols.type_mark,
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Type_Node = type_mark in Wf_Loop_Param");

   if Dictionary.IsDefined
     (Name              => Ident_Str,
      Scope             => Scope,
      Context           => Dictionary.ProofContext,
      Full_Package_Name => False) then
      OK_To_Add := False;
      ErrorHandler.Semantic_Error
        (Err_Num   => 10,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Ident_Node),
         Id_Str    => Ident_Str);
   else
      OK_To_Add := True;
   end if;

   Wf_Type_Mark (Node          => Type_Node,
                 Current_Scope => Scope,
                 Context       => Dictionary.ProgramContext,
                 Type_Sym      => Type_Sym);

   -- plant type for use by VCG
   STree.Add_Node_Symbol (Node => Type_Node,
                          Sym  => Type_Sym);

   if not Dictionary.IsUnknownTypeMark (Type_Sym)
     and then (not Dictionary.TypeIsDiscrete (Type_Sym) or else Dictionary.IsPrivateType (Type_Sym, Scope)) then
      ErrorHandler.Semantic_Error
        (Err_Num   => 46,
         Reference => ErrorHandler.No_Reference,
         Position  => Node_Position (Node => Type_Node),
         Id_Str    => LexTokenManager.Null_String);
   end if;

   Range_Node := Next_Sibling (Current_Node => Type_Node);
   -- ASSUME Range_Node = arange OR NULL
   if Syntax_Node_Type (Node => Range_Node) = SP_Symbols.arange then
      -- ASSUME Range_Node = arange
      Walk_Expression_P.Walk_Expression
        (Exp_Node                => Range_Node,
         Scope                   => Scope,
         Type_Context            => Type_Sym,
         Context_Requires_Static => False,
         Ref_Var                 => Ref_Var,
         Result                  => Range_Result,
         Component_Data          => Component_Data,
         The_Heap                => TheHeap);
      if not Dictionary.IsUnknownTypeMark (Range_Result.Type_Symbol) then
         if not Range_Result.Is_ARange then
            ErrorHandler.Semantic_Error
              (Err_Num   => 98,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Range_Node),
               Id_Str    => LexTokenManager.Null_String);
         elsif not Dictionary.CompatibleTypes (Scope, Type_Sym, Range_Result.Type_Symbol) then
            ErrorHandler.Semantic_Error
              (Err_Num   => 106,
               Reference => ErrorHandler.No_Reference,
               Position  => Node_Position (Node => Range_Node),
               Id_Str    => LexTokenManager.Null_String);
         else
            -- determine whether explicit range is statically known
            Has_Static_Range := not (Maths.HasNoValue (Range_Result.Value) or else Maths.HasNoValue (Range_Result.Range_RHS));
            -- static range check of any explicit range
            --# accept Flow, 10, Unused, "Expected ineffective assignment";
            Constraint_Check
              (Val           => Range_Result.Value,
               New_Val       => Unused,
               Is_Annotation => False,
               Typ           => Type_Sym,
               Position      => Node_Position (Node => Range_Node));
            Constraint_Check
              (Val           => Range_Result.Range_RHS,
               New_Val       => Unused,
               Is_Annotation => False,
               Typ           => Type_Sym,
               Position      => Node_Position (Node => Range_Node));
            --# end accept;
         end if;
      end if;
   elsif Range_Node /= STree.NullNode then
      SystemErrors.Fatal_Error
        (Sys_Err => SystemErrors.Invalid_Syntax_Tree,
         Msg     => "Expect Range_Node = arange OR NULL in Wf_Loop_Param");
   end if;

   if OK_To_Add then
      Dictionary.AddLoopParameter
        (TheLoop       => Dictionary.GetRegion (Scope),
         Comp_Unit     => ContextManager.Ops.Current_Unit,
         Declaration   => Dictionary.Location'(Start_Position => Node_Position (Node => Ident_Node),
                                               End_Position   => Node_Position (Node => Ident_Node)),
         Name          => Ident_Str,
         TypeMark      => Type_Sym,
         StaticRange   => Has_Static_Range,
         IsReverse     => Is_Reverse_Loop,
         TypeReference => Dictionary.Location'(Start_Position => Node_Position (Node => Node),
                                               End_Position   => Node_Position (Node => Node)));
      Loop_Param_Sym := Dictionary.GetLoopParameter (Dictionary.GetRegion (Scope));
   end if;
   -- add reference variable list to RefList hash table
   RefList.AddRelation (Table, TheHeap, Node, Loop_Param_Sym, Ref_Var);
   --# accept Flow, 33, Unused, "Expected to be neither referenced nor exported";
end Wf_Loop_Param;
