-------------------------------------------------------------------------------
-- (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 Cells;
with Debug;
with Declarations;
with ErrorHandler;
with SystemErrors;
with E_Strings;
with Fatal;
with File_Utils;
with FileSystem;
with Graph;
with LexTokenLists;
with ScreenEcho;
with SPARK_IO;

use type SPARK_IO.File_Status;
use type File_Utils.File_Types;

package body VCG is

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

   procedure ProduceVCs
     (VCG_Heap                      : in out Cells.Heap_Record;
      Start_Node                    : in     STree.SyntaxNode;
      Subprog_Sym                   : in     Dictionary.Symbol;
      Scope                         : in     Dictionary.Scopes;
      VCG_Output_File               : in     SPARK_IO.File_Type;
      DPC_Output_File               : in     SPARK_IO.File_Type;
      Output_Filename               : in     E_Strings.T;
      End_Position                  : in     LexTokenManager.Token_Position;
      Flow_Heap                     : in out Heap.HeapRecord;
      Semantic_Error_In_Subprogram  : in     Boolean;
      Data_Flow_Error_In_Subprogram : in     Boolean;
      Type_Check_Exports            : in     Boolean)
   --# global in     CommandLineData.Content;
   --#        in     STree.Table;
   --#        in out Declarations.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#           out Graph.Table;
   --#           out StmtStack.S;
   --# derives Declarations.State,
   --#         Dictionary.Dict,
   --#         Flow_Heap,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         StmtStack.S,
   --#         VCG_Heap                   from CommandLineData.Content,
   --#                                         Data_Flow_Error_In_Subprogram,
   --#                                         Declarations.State,
   --#                                         Dictionary.Dict,
   --#                                         Flow_Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Semantic_Error_In_Subprogram,
   --#                                         Start_Node,
   --#                                         STree.Table,
   --#                                         Subprog_Sym,
   --#                                         Type_Check_Exports,
   --#                                         VCG_Heap &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Data_Flow_Error_In_Subprogram,
   --#                                         Declarations.State,
   --#                                         Dictionary.Dict,
   --#                                         DPC_Output_File,
   --#                                         End_Position,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Flow_Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Semantic_Error_In_Subprogram,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Start_Node,
   --#                                         STree.Table,
   --#                                         Subprog_Sym,
   --#                                         Type_Check_Exports,
   --#                                         VCG_Heap,
   --#                                         VCG_Output_File &
   --#         Statistics.TableUsage      from *,
   --#                                         CommandLineData.Content,
   --#                                         Data_Flow_Error_In_Subprogram,
   --#                                         Declarations.State,
   --#                                         Dictionary.Dict,
   --#                                         Flow_Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Semantic_Error_In_Subprogram,
   --#                                         Start_Node,
   --#                                         STree.Table,
   --#                                         Subprog_Sym,
   --#                                         Type_Check_Exports,
   --#                                         VCG_Heap &
   --#         null                       from Output_Filename;
      is separate;

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

   procedure Full_Symbol_Name (Item      : in     Dictionary.Symbol;
                               Ancestors :    out LexTokenLists.Lists;
                               List      :    out LexTokenLists.Lists)
   --# global in Dictionary.Dict;
   --# derives Ancestors,
   --#         List      from Dictionary.Dict,
   --#                        Item;
   is
      Reverse_Prefix_List, Full_Symbol_Name_List : LexTokenLists.Lists;
      Ancestor_List                              : LexTokenLists.Lists;
      Pack_Sym                                   : Dictionary.Symbol;
      Scope                                      : Dictionary.Scopes;
      Lex_Token_Item                             : LexTokenManager.Lex_String;
   begin
      Reverse_Prefix_List := LexTokenLists.Null_List;
      Scope               := Dictionary.GetScope (Item);
      loop
         exit when Dictionary.IsGlobalScope (Scope) or else Dictionary.IsPredefinedScope (Scope);
         LexTokenLists.Append (Reverse_Prefix_List, Dictionary.GetSimpleName (Dictionary.GetRegion (Scope)));
         Scope := Dictionary.GetEnclosingScope (Scope);
      end loop;

      Full_Symbol_Name_List := LexTokenLists.Null_List;

      while LexTokenLists.Get_Length (List => Reverse_Prefix_List) > 0 loop
         LexTokenLists.Pop (List => Reverse_Prefix_List,
                            Item => Lex_Token_Item);
         LexTokenLists.Append (List => Full_Symbol_Name_List,
                               Item => Lex_Token_Item);
      end loop;

      LexTokenLists.Append (Full_Symbol_Name_List, Dictionary.GetSimpleName (Item));
      List          := Full_Symbol_Name_List;
      Ancestor_List := LexTokenLists.Null_List;
      Pack_Sym      := Dictionary.GetLibraryPackage (Dictionary.GetScope (Item));

      if not Dictionary.IsPredefinedPackageStandard (Pack_Sym) then
         Reverse_Prefix_List := LexTokenLists.Null_List;
         loop
            Pack_Sym := Dictionary.GetPackageParent (Pack_Sym);
            exit when Dictionary.Is_Null_Symbol (Pack_Sym);
            LexTokenLists.Append (Reverse_Prefix_List, Dictionary.GetSimpleName (Pack_Sym));
         end loop;

         while LexTokenLists.Get_Length (List => Reverse_Prefix_List) > 0 loop
            LexTokenLists.Pop (List => Reverse_Prefix_List,
                               Item => Lex_Token_Item);
            LexTokenLists.Append (List => Ancestor_List,
                                  Item => Lex_Token_Item);
         end loop;
      end if;
      Ancestors := Ancestor_List;
   end Full_Symbol_Name;

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

   procedure Produce_Output_Files
     (Subprog_Sym       : in     Dictionary.Symbol;
      VCG_Output_File   : in out SPARK_IO.File_Type;
      DPC_Output_File   : in out SPARK_IO.File_Type;
      Declarations_File : in out SPARK_IO.File_Type;
      Rule_File         : in out SPARK_IO.File_Type;
      Output_Filename   :    out E_Strings.T;
      OK                :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --# derives Declarations_File,
   --#         DPC_Output_File,
   --#         Rule_File,
   --#         VCG_Output_File            from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Subprog_Sym &
   --#         ErrorHandler.Error_Context from *,
   --#                                         CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys &
   --#         LexTokenManager.State      from *,
   --#                                         Dictionary.Dict,
   --#                                         Subprog_Sym &
   --#         OK,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Declarations_File,
   --#                                         Dictionary.Dict,
   --#                                         DPC_Output_File,
   --#                                         ErrorHandler.Error_Context,
   --#                                         LexTokenManager.State,
   --#                                         Rule_File,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Subprog_Sym,
   --#                                         VCG_Output_File &
   --#         Output_Filename            from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         LexTokenManager.State,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Subprog_Sym;
   is
      VCG_Extension : constant String := "vcg";
      DPC_Extension : constant String := "dpc";
      FDL_Extension : constant String := "fdl";
      RLS_Extension : constant String := "rls";

      Local_OK : Boolean;

      Unit_Name     : LexTokenLists.Lists;
      Ancestor_Name : LexTokenLists.Lists;
      Filename      : E_Strings.T;

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

      procedure Check_Windows_Filename_Length_Bug
      --# global in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     Filename;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SPARK_IO.File_Sys;
      --# derives ErrorHandler.Error_Context,
      --#         SPARK_IO.File_Sys          from CommandLineData.Content,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         Filename,
      --#                                         LexTokenManager.State,
      --#                                         SPARK_IO.File_Sys &
      --#         LexTokenManager.State      from *,
      --#                                         Filename;
      is
         Abs_Filename : E_Strings.T := E_Strings.Empty_String;
         Tmp          : LexTokenManager.Lex_String;
      begin
         --# accept F, 22, "We are aware that Use_Windows_Command_Line can't change.";
         if FileSystem.Use_Windows_Command_Line then
            --# end accept;

            --  We assemble the full name of the vcg file to be
            --  generated out of the working directory...
            E_Strings.Append_Examiner_String (Abs_Filename, FileSystem.Working_Directory);
            E_Strings.Append_Examiner_String (Abs_Filename, FileSystem.Directory_Separator);

            --  and the unit's name...
            E_Strings.Append_Examiner_String (Abs_Filename, Filename);

            --  followed by the extension.
            E_Strings.Append_Char (Abs_Filename, '.');
            E_Strings.Append_String (Abs_Filename, VCG_Extension);

            if E_Strings.Get_Length (Abs_Filename) >= 255 then
               --  This is a workaround as we can't give ErrorHandler an E_String.
               LexTokenManager.Insert_Examiner_String (Abs_Filename, Tmp);
               ErrorHandler.Semantic_Warning
                 (Err_Num  => 495,
                  Position => LexTokenManager.Token_Position'(Start_Line_No => 0,
                                                              Start_Pos     => E_Strings.Lengths'First),
                  Id_Str   => Tmp);
            end if;
         end if;
         --# accept F, 601, LexTokenManager.State, SPARK_IO.File_Sys, "False coupling through SPARK_IO.";
      end Check_Windows_Filename_Length_Bug;

      procedure Build_Filename_Nest
      --# global in     Ancestor_Name;
      --#        in     CommandLineData.Content;
      --#        in     LexTokenManager.State;
      --#        in     Unit_Name;
      --#        in out SPARK_IO.File_Sys;
      --#           out Filename;
      --#           out Local_OK;
      --# derives Filename          from Ancestor_Name,
      --#                                LexTokenManager.State,
      --#                                Unit_Name &
      --#         Local_OK,
      --#         SPARK_IO.File_Sys from Ancestor_Name,
      --#                                CommandLineData.Content,
      --#                                LexTokenManager.State,
      --#                                SPARK_IO.File_Sys,
      --#                                Unit_Name;
      is
         Pos          : LexTokenLists.Lengths;
         Str          : E_Strings.T;
         Adjusted_Dir : E_Strings.T;
      begin
         Local_OK := True;
         Filename := E_Strings.Empty_String;
         if LexTokenLists.Get_Length (List => Unit_Name) /= 1 then -- is not a main program so build nested dirs
            E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                              E_Str2 => FileSystem.Start_Of_Directory);

            Pos := 1;
            loop
               exit when Pos > LexTokenLists.Get_Length (List => Ancestor_Name);
               Str :=
                 LexTokenManager.Lex_String_To_String (Lex_Str => LexTokenLists.Get_Element (List => Ancestor_Name,
                                                                                             Pos  => Pos));
               -- Note that directories for VCG files are always created
               -- using lower-case names on all platforms.
               E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                                 E_Str2 => E_Strings.Lower_Case (E_Str => Str));
               E_Strings.Append_String (E_Str => Filename,
                                        Str   => "_");
               if Local_OK then
                  -- If the user has asked for an alterative output directory, then start
                  -- there, otherwise start at current working directory
                  Adjusted_Dir := Filename;
                  CommandLineData.Normalize_File_Name_To_Output_Directory (F => Adjusted_Dir);

                  FileSystem.Idempotent_Create_Subdirectory (Adjusted_Dir, Local_OK);
               end if;
               E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                                 E_Str2 => FileSystem.Directory_Separator);
               Pos := Pos + 1;
            end loop;

            Pos := 1;
            loop
               Str := LexTokenManager.Lex_String_To_String (Lex_Str => LexTokenLists.Get_Element (List => Unit_Name,
                                                                                                  Pos  => Pos));
               -- Note that directories for VCG files are always created
               -- using lower-case names on all platforms.
               E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                                 E_Str2 => E_Strings.Lower_Case (E_Str => Str));

               -- If the user has asked for an alterative output directory, then start
               -- there, otherwise start at current working directory. Note that we
               -- must preserve the case of the user-specified directory.
               Adjusted_Dir := Filename;
               CommandLineData.Normalize_File_Name_To_Output_Directory (F => Adjusted_Dir);

               FileSystem.Idempotent_Create_Subdirectory (Adjusted_Dir, Local_OK);

               exit when Pos = LexTokenLists.Get_Length (List => Unit_Name) - 1;
               E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                                 E_Str2 => FileSystem.Directory_Separator);
               Pos := Pos + 1;
            end loop;
            E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                              E_Str2 => FileSystem.Directory_Separator);
         end if;

         Str :=
           LexTokenManager.Lex_String_To_String
           (Lex_Str => LexTokenLists.Get_Element (List => Unit_Name,
                                                  Pos  => LexTokenLists.Get_Length (List => Unit_Name)));
         E_Strings.Append_Examiner_String (E_Str1 => Filename,
                                           E_Str2 => E_Strings.Lower_Case (E_Str => Str));
      end Build_Filename_Nest;

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

      procedure Put_Subprogram_Name
        (File      : in SPARK_IO.File_Type;
         Sym       : in Dictionary.Symbol;
         File_Type : in File_Utils.File_Types)
      --# global in     Ancestor_Name;
      --#        in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     Unit_Name;
      --#        in out SPARK_IO.File_Sys;
      --# derives SPARK_IO.File_Sys from *,
      --#                                Ancestor_Name,
      --#                                Dictionary.Dict,
      --#                                File,
      --#                                File_Type,
      --#                                LexTokenManager.State,
      --#                                Sym,
      --#                                Unit_Name;
      is
         Head_Line  : E_Strings.T;
         Page_Width : constant Natural := 78;
      begin
         if Dictionary.IsFunction (Sym) then
            Head_Line := E_Strings.Copy_String (Str => "function ");
         elsif Dictionary.IsProcedure (Sym) then
            Head_Line := E_Strings.Copy_String (Str => "procedure ");
         elsif Dictionary.IsTaskType (Sym) then
            Head_Line := E_Strings.Copy_String (Str => "task_type ");
         else
            --  Placeholder for package body initialization. We do not
            --  expect to reach this currently.
            Head_Line := E_Strings.Copy_String (Str => "initialization_of ");
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Assertion_Failure,
               Msg     => "Expected symbol to be either a function, procedure or task_type.");
         end if;

         if LexTokenLists.Get_Length (Ancestor_Name) /= 0 then
            E_Strings.Append_Examiner_String
              (E_Str1 => Head_Line,
               E_Str2 => LexTokenLists.Token_List_To_String (Token_List => Ancestor_Name));
            E_Strings.Append_String (Head_Line, ".");
         end if;
         E_Strings.Append_Examiner_String
           (E_Str1 => Head_Line,
            E_Str2 => LexTokenLists.Token_List_To_String (Token_List => Unit_Name));

         if (E_Strings.Get_Length (E_Str => Head_Line) + 1) < Page_Width then
            SPARK_IO.Set_Col (File, (Page_Width - E_Strings.Get_Length (E_Str => Head_Line)) / 2);
         end if;
         if File_Type = File_Utils.Dec_File then
            SPARK_IO.Put_Char (File, '{');
            E_Strings.Put_String (File  => File,
                                  E_Str => Head_Line);
            SPARK_IO.Put_Char (File, '}');
            SPARK_IO.New_Line (File, 1);
         elsif File_Type = File_Utils.Rule_File then
            SPARK_IO.Put_String (File, "/*", 0);
            E_Strings.Put_String (File  => File,
                                  E_Str => Head_Line);
            SPARK_IO.Put_String (File, "*/", 0);
            SPARK_IO.New_Line (File, 1);
         else
            E_Strings.Put_Line (File  => File,
                                E_Str => Head_Line);
         end if;
         SPARK_IO.New_Line (File, 2);
      end Put_Subprogram_Name;

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

      procedure Produce_VCG_Output_File
      --# global in     Ancestor_Name;
      --#        in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     Filename;
      --#        in     LexTokenManager.State;
      --#        in     Subprog_Sym;
      --#        in     Unit_Name;
      --#        in out SPARK_IO.File_Sys;
      --#        in out VCG_Output_File;
      --#           out Local_OK;
      --#           out Output_Filename;
      --# derives Local_OK,
      --#         VCG_Output_File   from Filename,
      --#                                SPARK_IO.File_Sys,
      --#                                VCG_Output_File &
      --#         Output_Filename   from Filename &
      --#         SPARK_IO.File_Sys from *,
      --#                                Ancestor_Name,
      --#                                CommandLineData.Content,
      --#                                Dictionary.Dict,
      --#                                Filename,
      --#                                LexTokenManager.State,
      --#                                Subprog_Sym,
      --#                                Unit_Name,
      --#                                VCG_Output_File;
      is
         Success : SPARK_IO.File_Status;
      begin
         Output_Filename := Filename;
         FileSystem.Check_Extension (Fn  => Output_Filename,
                                     Ext => E_Strings.Copy_String (Str => VCG_Extension));

         E_Strings.Create (File         => VCG_Output_File,
                           Name_Of_File => Output_Filename,
                           Form_Of_File => "",
                           Status       => Success);

         Local_OK := Success = SPARK_IO.Ok;
         if Local_OK then
            File_Utils.Print_A_Header
              (File        => VCG_Output_File,
               Header_Line => "Semantic Analysis of SPARK Text",
               File_Type   => File_Utils.Other_File);
            Put_Subprogram_Name (File      => VCG_Output_File,
                                 Sym       => Subprog_Sym,
                                 File_Type => File_Utils.Other_File);
         end if;
      end Produce_VCG_Output_File;

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

      procedure Produce_DPC_Output_File
      --# global in     Ancestor_Name;
      --#        in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     Filename;
      --#        in     LexTokenManager.State;
      --#        in     Subprog_Sym;
      --#        in     Unit_Name;
      --#        in out DPC_Output_File;
      --#        in out SPARK_IO.File_Sys;
      --#           out Local_OK;
      --# derives DPC_Output_File,
      --#         Local_OK          from DPC_Output_File,
      --#                                Filename,
      --#                                SPARK_IO.File_Sys &
      --#         SPARK_IO.File_Sys from *,
      --#                                Ancestor_Name,
      --#                                CommandLineData.Content,
      --#                                Dictionary.Dict,
      --#                                DPC_Output_File,
      --#                                Filename,
      --#                                LexTokenManager.State,
      --#                                Subprog_Sym,
      --#                                Unit_Name;
      is
         Success             : SPARK_IO.File_Status;
         DPC_Output_Filename : E_Strings.T;
      begin
         DPC_Output_Filename := Filename;
         FileSystem.Check_Extension (Fn  => DPC_Output_Filename,
                                     Ext => E_Strings.Copy_String (Str => DPC_Extension));

         E_Strings.Create (File         => DPC_Output_File,
                           Name_Of_File => DPC_Output_Filename,
                           Form_Of_File => "",
                           Status       => Success);

         Local_OK := Success = SPARK_IO.Ok;
         if Local_OK then
            File_Utils.Print_A_Header
              (File        => DPC_Output_File,
               Header_Line => "Semantic Analysis of SPARK Text",
               File_Type   => File_Utils.Other_File);
            Put_Subprogram_Name (File      => DPC_Output_File,
                                 Sym       => Subprog_Sym,
                                 File_Type => File_Utils.Other_File);
         end if;
      end Produce_DPC_Output_File;

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

      procedure Produce_Declarations_File
      --# global in     Ancestor_Name;
      --#        in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     Filename;
      --#        in     LexTokenManager.State;
      --#        in     Subprog_Sym;
      --#        in     Unit_Name;
      --#        in out Declarations_File;
      --#        in out SPARK_IO.File_Sys;
      --#           out Local_OK;
      --# derives Declarations_File,
      --#         Local_OK          from Declarations_File,
      --#                                Filename,
      --#                                SPARK_IO.File_Sys &
      --#         SPARK_IO.File_Sys from *,
      --#                                Ancestor_Name,
      --#                                CommandLineData.Content,
      --#                                Declarations_File,
      --#                                Dictionary.Dict,
      --#                                Filename,
      --#                                LexTokenManager.State,
      --#                                Subprog_Sym,
      --#                                Unit_Name;
      is
         Declarations_Filename : E_Strings.T;
         Success               : SPARK_IO.File_Status;
      begin
         Declarations_Filename := Filename;
         FileSystem.Check_Extension (Fn  => Declarations_Filename,
                                     Ext => E_Strings.Copy_String (Str => FDL_Extension));

         E_Strings.Create
           (File         => Declarations_File,
            Name_Of_File => Declarations_Filename,
            Form_Of_File => "",
            Status       => Success);
         Local_OK := Success = SPARK_IO.Ok;
         if Local_OK then
            File_Utils.Print_A_Header
              (File        => Declarations_File,
               Header_Line => "FDL Declarations",
               File_Type   => File_Utils.Dec_File);
         end if;
         Put_Subprogram_Name (File      => Declarations_File,
                              Sym       => Subprog_Sym,
                              File_Type => File_Utils.Dec_File);
      end Produce_Declarations_File;

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

      procedure Produce_Rule_File
      --# global in     Ancestor_Name;
      --#        in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in     Filename;
      --#        in     LexTokenManager.State;
      --#        in     Subprog_Sym;
      --#        in     Unit_Name;
      --#        in out Rule_File;
      --#        in out SPARK_IO.File_Sys;
      --#           out Local_OK;
      --# derives Local_OK,
      --#         Rule_File         from Filename,
      --#                                Rule_File,
      --#                                SPARK_IO.File_Sys &
      --#         SPARK_IO.File_Sys from *,
      --#                                Ancestor_Name,
      --#                                CommandLineData.Content,
      --#                                Dictionary.Dict,
      --#                                Filename,
      --#                                LexTokenManager.State,
      --#                                Rule_File,
      --#                                Subprog_Sym,
      --#                                Unit_Name;
      is
         Rule_Filename : E_Strings.T;
         Success       : SPARK_IO.File_Status;
      begin
         Rule_Filename := Filename;
         FileSystem.Check_Extension (Fn  => Rule_Filename,
                                     Ext => E_Strings.Copy_String (Str => RLS_Extension));

         E_Strings.Create (File         => Rule_File,
                           Name_Of_File => Rule_Filename,
                           Form_Of_File => "",
                           Status       => Success);
         Local_OK := Success = SPARK_IO.Ok;

         if Local_OK then
            File_Utils.Print_A_Header
              (File        => Rule_File,
               Header_Line => "Proof Rule Declarations",
               File_Type   => File_Utils.Rule_File);
         end if;
         Put_Subprogram_Name (File      => Rule_File,
                              Sym       => Subprog_Sym,
                              File_Type => File_Utils.Rule_File);
      end Produce_Rule_File;

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

   begin -- Produce_Output_Files
      Full_Symbol_Name (Item      => Subprog_Sym,
                        Ancestors => Ancestor_Name,
                        List      => Unit_Name);

      Build_Filename_Nest;

      --  We need to check for files with a total name longer than 255
      --  characters as this will cause problems on Windows.
      Check_Windows_Filename_Length_Bug;

      -- Filename now contains the basename of the required output file(s)
      -- without an extension.  It is also a relative to the current working
      -- directory - for example for subprogram P.Q, we end up with Filename
      -- being "p/q"
      --
      -- If the user has requested an alternative output directory, then we adjust
      -- Filename now
      CommandLineData.Normalize_File_Name_To_Output_Directory (F => Filename);

      Output_Filename := E_Strings.Empty_String;

      if Local_OK then
         Produce_Declarations_File;

         if Local_OK then
            Produce_Rule_File;

            if Local_OK and CommandLineData.Content.VCG then
               Produce_VCG_Output_File;
            end if;

            if Local_OK and CommandLineData.Content.DPC then
               Produce_DPC_Output_File;
            end if;
         end if;
      end if;

      OK := Local_OK;
      --# accept Flow, 601, VCG_Output_File, Declarations_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, VCG_Output_File, Rule_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, DPC_Output_File, Rule_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, DPC_Output_File, Declarations_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, DPC_Output_File, VCG_Output_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, Output_Filename, Rule_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, Output_Filename, Declarations_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, Rule_File, Declarations_File, "ignore data coupling between files thro' SPARK_IO" &
      --#        Flow, 601, ErrorHandler.Error_Context, Subprog_Sym, "false coupling through SPARK_IO" &
      --#        Flow, 601, VCG_Output_File, ErrorHandler.Error_Context, "false coupling through SPARK_IO" &
      --#        Flow, 601, DPC_Output_File, ErrorHandler.Error_Context, "false coupling through SPARK_IO" &
      --#        Flow, 601, Declarations_File, ErrorHandler.Error_Context, "false coupling through SPARK_IO" &
      --#        Flow, 601, Rule_File, ErrorHandler.Error_Context, "false coupling through SPARK_IO" &
      --#        Flow, 601, Output_Filename, ErrorHandler.Error_Context, "false coupling through SPARK_IO";
   end Produce_Output_Files;

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

   procedure Generate_VCs_Local
     (Start_Node                    : in     STree.SyntaxNode;
      Scope                         : in     Dictionary.Scopes;
      End_Position                  : in     LexTokenManager.Token_Position;
      Flow_Heap                     : in out Heap.HeapRecord;
      Semantic_Error_In_Subprogram  : in     Boolean;
      Data_Flow_Error_In_Subprogram : in     Boolean;
      Type_Check_Exports            : in     Boolean)
   --# global in     CommandLineData.Content;
   --#        in     STree.Table;
   --#        in out Declarations.State;
   --#        in out Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out Graph.Table;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Statistics.TableUsage;
   --#        in out StmtStack.S;
   --# derives Declarations.State,
   --#         Dictionary.Dict,
   --#         Flow_Heap,
   --#         Graph.Table,
   --#         LexTokenManager.State,
   --#         Statistics.TableUsage,
   --#         StmtStack.S                from *,
   --#                                         CommandLineData.Content,
   --#                                         Data_Flow_Error_In_Subprogram,
   --#                                         Dictionary.Dict,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Flow_Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Semantic_Error_In_Subprogram,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Start_Node,
   --#                                         STree.Table,
   --#                                         Type_Check_Exports &
   --#         ErrorHandler.Error_Context,
   --#         SPARK_IO.File_Sys          from CommandLineData.Content,
   --#                                         Data_Flow_Error_In_Subprogram,
   --#                                         Dictionary.Dict,
   --#                                         End_Position,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Flow_Heap,
   --#                                         LexTokenManager.State,
   --#                                         Scope,
   --#                                         Semantic_Error_In_Subprogram,
   --#                                         SPARK_IO.File_Sys,
   --#                                         Start_Node,
   --#                                         STree.Table,
   --#                                         Type_Check_Exports;
   is
      Subprog_Sym       : Dictionary.Symbol;
      VCG_Output_File   : SPARK_IO.File_Type;
      DPC_Output_File   : SPARK_IO.File_Type;
      Output_Filename   : E_Strings.T;
      Declarations_File : SPARK_IO.File_Type;
      Rule_File         : SPARK_IO.File_Type;
      OK                : Boolean;
      Success           : SPARK_IO.File_Status;
      VCG_Heap          : Cells.Heap_Record;

      -- In case of a fatal error, we generate a single "False" VC in the
      -- VCG or DPC file using this procedure.
      procedure Generate_False_VC (Output_File : in SPARK_IO.File_Type)
      --# global in     Dictionary.Dict;
      --#        in     LexTokenManager.State;
      --#        in     Subprog_Sym;
      --#        in out SPARK_IO.File_Sys;
      --# derives SPARK_IO.File_Sys from *,
      --#                                Dictionary.Dict,
      --#                                LexTokenManager.State,
      --#                                Output_File,
      --#                                Subprog_Sym;
      is
         Head_Line     : E_Strings.T;
         Unit_Name     : LexTokenLists.Lists;
         Ancestor_Name : LexTokenLists.Lists;
      begin
         --# accept F, 10, Ancestor_Name, "Ineffective assignment here OK";
         Full_Symbol_Name (Item      => Subprog_Sym,
                           Ancestors => Ancestor_Name,
                           List      => Unit_Name);
         --# end accept;

         -- The header of the VC has to have the correct name and prefix
         -- for POGS, so we have to deduce this here from Subprog_Sym
         if Dictionary.IsFunction (Subprog_Sym) then
            Head_Line := E_Strings.Copy_String (Str => "function_");
         elsif Dictionary.IsTaskType (Subprog_Sym) then
            Head_Line := E_Strings.Copy_String (Str => "task_type_");
         else -- must be a procedure
            Head_Line := E_Strings.Copy_String (Str => "procedure_");
         end if;

         E_Strings.Append_Examiner_String
           (E_Str1 => Head_Line,
            E_Str2 => E_Strings.Lower_Case
              (E_Str => LexTokenManager.Lex_String_To_String
                 (Lex_Str => LexTokenLists.Get_Element (List => Unit_Name,
                                                        Pos  => LexTokenLists.Get_Length (List => Unit_Name)))));
         E_Strings.Append_String (E_Str => Head_Line,
                                  Str   => "_1.");

         SPARK_IO.New_Line (Output_File, 1);
         SPARK_IO.Put_Line (Output_File, "/* False VC generated due to VCG heap exhausted */", 0);
         SPARK_IO.New_Line (Output_File, 2);
         SPARK_IO.Put_Line (Output_File, "For path(s) from start to finish:", 0);
         SPARK_IO.New_Line (Output_File, 1);
         E_Strings.Put_Line (File  => Output_File,
                             E_Str => Head_Line);
         SPARK_IO.Put_Line (Output_File, "H1:    true .", 0);
         SPARK_IO.Put_Line (Output_File, "        ->", 0);
         SPARK_IO.Put_Line (Output_File, "C1:    false .", 0);
         SPARK_IO.New_Line (Output_File, 2);
         --# accept F, 33, Ancestor_Name, "Ancestor_Name not referenced here OK";
      end Generate_False_VC;

   begin
      VCG_Output_File   := SPARK_IO.Null_File;
      DPC_Output_File   := SPARK_IO.Null_File;
      Declarations_File := SPARK_IO.Null_File;
      Rule_File         := SPARK_IO.Null_File;

      Subprog_Sym := Dictionary.GetRegion (Scope);
      Produce_Output_Files
        (Subprog_Sym       => Subprog_Sym,
         VCG_Output_File   => VCG_Output_File,
         DPC_Output_File   => DPC_Output_File,
         Declarations_File => Declarations_File,
         Rule_File         => Rule_File,
         Output_Filename   => Output_Filename,
         OK                => OK);
      if OK then
         Cells.Initialize (VCG_Heap);
         Declarations.StartProcessing (VCG_Heap);
         ProduceVCs
           (VCG_Heap                      => VCG_Heap,
            Start_Node                    => Start_Node,
            Subprog_Sym                   => Subprog_Sym,
            Scope                         => Scope,
            VCG_Output_File               => VCG_Output_File,
            DPC_Output_File               => DPC_Output_File,
            Output_Filename               => Output_Filename,
            End_Position                  => End_Position,
            Flow_Heap                     => Flow_Heap,
            Semantic_Error_In_Subprogram  => Semantic_Error_In_Subprogram,
            Data_Flow_Error_In_Subprogram => Data_Flow_Error_In_Subprogram,
            Type_Check_Exports            => Type_Check_Exports);
         Declarations.OutputDeclarations (VCG_Heap, Declarations_File, Rule_File, Scope, True, End_Position);
         Cells.Report_Usage (VCG_Heap);
      else
         -- Unable to create output files
         ErrorHandler.Semantic_Warning (406, End_Position, LexTokenManager.Null_String);
      end if;
      --# accept Flow, 10, Success, "Expected ineffective assignment to Success" &
      --#        Flow, 10, VCG_Output_File, "Expected ineffective assignment to VCG_Output_File" &
      --#        Flow, 10, DPC_Output_File, "Expected ineffective assignment to VCG_Output_File" &
      --#        Flow, 10, Declarations_File, "Expected ineffective assignment to Declarations_File" &
      --#        Flow, 10, Rule_File, "Expected ineffective assignment to Rule_File";
      SPARK_IO.Close (Declarations_File, Success);
      SPARK_IO.Close (Rule_File, Success);

      if SPARK_IO.Is_Open (VCG_Output_File) then
         SPARK_IO.Close (VCG_Output_File, Success);
      end if;

      if SPARK_IO.Is_Open (DPC_Output_File) then
         SPARK_IO.Close (DPC_Output_File, Success);
      end if;
      --# end accept;

      --# accept Flow, 33, Success, "Expected Success to be neither referenced nor exported";
   exception
      --# hide Generate_VCs_Local;
      when Fatal.Static_Limit =>
         -- Here owing to a VCG Heap/table exhausted.
         -- We need to close open files, making sure they are at least
         -- syntactically legal for the Simplifier.
         -- We insert an explicitly False VC here, so it is sure
         -- to be undischarged and picked up by POGS

         ErrorHandler.Semantic_Warning (409, End_Position, LexTokenManager.Null_String);

         if SPARK_IO.Is_Open (VCG_Output_File) then
            Generate_False_VC (Output_File => VCG_Output_File);
            SPARK_IO.Close (VCG_Output_File, Success);
         end if;

         if SPARK_IO.Is_Open (DPC_Output_File) then
            Generate_False_VC (Output_File => DPC_Output_File);
            SPARK_IO.Close (DPC_Output_File, Success);
         end if;

         if SPARK_IO.Is_Open (Rule_File) then
            SPARK_IO.Close (Rule_File, Success);
         end if;

         if SPARK_IO.Is_Open (Declarations_File) then
            -- Make sure the FDL file is termianted properly before closing it
            Declarations.PrintDeclarationTail (Declarations_File);
            SPARK_IO.Close (Declarations_File, Success);
         end if;

         -- We DONT'T re-raise here - there may be other subprograms
         -- requiring VC Generation in the enclosing unit, so we
         -- carry on.

      when others =>
         -- Any other exception reaching here.
         -- We need to close open files, then re-raise
         if SPARK_IO.Is_Open (VCG_Output_File) then
            SPARK_IO.Close (VCG_Output_File, Success);
         end if;

         if SPARK_IO.Is_Open (DPC_Output_File) then
            SPARK_IO.Close (DPC_Output_File, Success);
         end if;

         if SPARK_IO.Is_Open (Rule_File) then
            SPARK_IO.Close (Rule_File, Success);
         end if;

         if SPARK_IO.Is_Open (Declarations_File) then
            -- Make sure the FDL file is termianted properly before closing it
            Declarations.PrintDeclarationTail (Declarations_File);
            SPARK_IO.Close (Declarations_File, Success);
         end if;

         raise;
   end Generate_VCs_Local;

   procedure Generate_VCs
     (Start_Node                    : in     STree.SyntaxNode;
      Scope                         : in     Dictionary.Scopes;
      Do_VCG                        : in     Boolean;
      End_Position                  : in     LexTokenManager.Token_Position;
      Flow_Heap                     : in out Heap.HeapRecord;
      Semantic_Error_In_Subprogram  : in     Boolean;
      Data_Flow_Error_In_Subprogram : in     Boolean;
      Type_Check_Exports            : in     Boolean)
   is
      Errors_In_Subprogram_Or_Its_Signature : Boolean;
   begin
      if Do_VCG then

         Invoked := True;

         Errors_In_Subprogram_Or_Its_Signature := Semantic_Error_In_Subprogram or
           (not Dictionary.SubprogramSignatureIsWellformed
              (Dictionary.IsAbstract,
               Dictionary.GetRegion (Scope)));

         if Errors_In_Subprogram_Or_Its_Signature then
            ErrorHandler.Semantic_Warning (408, End_Position, LexTokenManager.Null_String);
         end if;

         Generate_VCs_Local
           (Start_Node                    => Start_Node,
            Scope                         => Scope,
            End_Position                  => End_Position,
            Flow_Heap                     => Flow_Heap,
            Semantic_Error_In_Subprogram  => Errors_In_Subprogram_Or_Its_Signature,
            Data_Flow_Error_In_Subprogram => Data_Flow_Error_In_Subprogram,
            Type_Check_Exports            => Type_Check_Exports);

      end if;
   end Generate_VCs;

end VCG;
