-------------------------------------------------------------------------------
-- (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 Create_Implicit_Positive_Subtype
  (String_Length    : in     Maths.Value;
   Location         : in     Dictionary.Location;
   Index_Constraint :    out Dictionary.Symbol)
is
   Constraint_Str      : E_Strings.T;
   Constraint_Lex_Str  : LexTokenManager.Lex_String;
   Upper_Bound_Lex_Str : LexTokenManager.Lex_String;
begin
   -- Create an ExaminerString of the form "Positive__n" where n is the string length
   Constraint_Str := E_Strings.Copy_String (Str => "Positive__");
   -- The value of "n" will not exceed a size that can be printed within an ExaminerString
   -- so the conversion will not truncate here.
   E_Strings.Append_Examiner_String (E_Str1 => Constraint_Str,
                                     E_Str2 => Maths.ValueToString (String_Length));
   -- Insert this name into the string table; either we add it an get the LexStr back or,
   -- if it is already there, we get the existing LexStr back
   LexTokenManager.Insert_Examiner_String (Str     => Constraint_Str,
                                           Lex_Str => Constraint_Lex_Str);
   -- Look up type in Dictionary in case it has previously been added
   -- Note that we put these implicit subtype in Standard (where Positive itself lives)
   -- and that we declare them in proof rather than Ada context
   Index_Constraint :=
     Dictionary.LookupItem
     (Name              => Constraint_Lex_Str,
      Scope             => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                      The_Unit       => Dictionary.GetPredefinedPackageStandard),
      Context           => Dictionary.ProofContext,
      Full_Package_Name => False);
   SystemErrors.RT_Assert
     (C       => Dictionary.Is_Null_Symbol (Index_Constraint) or else Dictionary.IsTypeMark (Index_Constraint),
      Sys_Err => SystemErrors.Invalid_Syntax_Tree,
      Msg     => "Expect Index_Constraint to be a type in Create_Implicit_Positive_Subtype");
   if Dictionary.Is_Null_Symbol (Index_Constraint) then
      -- not previously added, so we add a new subtype here
      Maths.StorageRep (String_Length, Upper_Bound_Lex_Str);
      Dictionary.Add_Integer_Subtype
        (Name             => Constraint_Lex_Str,
         Static           => True,
         Parent           => Dictionary.GetPredefinedIntegerType,
         Parent_Reference => Location,
         Lower            => LexTokenManager.One_Value,
         Upper            => Upper_Bound_Lex_Str,
         Comp_Unit        => ContextManager.Ops.Current_Unit,
         Declaration      => Location,
         Scope            => Dictionary.Set_Visibility (The_Visibility => Dictionary.Visible,
                                                        The_Unit       => Dictionary.GetPredefinedPackageStandard),
         Context          => Dictionary.ProofContext,
         The_Subtype      => Index_Constraint);
   end if;
end Create_Implicit_Positive_Subtype;
