-------------------------------------------------------------------------------
-- (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 DAG_IO;
with ExaminerConstants;
with E_Strings;
with GNAT.Traceback.Symbolic;
with SPARK_IO;
with SP_Symbols;
with Text_IO;
with SystemErrors;

use type SPARK_IO.File_Status;

package body Debug is
   --# hide Debug;

   procedure PrintMsg (Msg     : in String;
                       NewLine : in Boolean) is
   begin
      Text_IO.Put (Msg);
      if NewLine then
         Text_IO.New_Line (1);
      end if;
   end PrintMsg;

   procedure Print_Sym_Raw (Sym : in Dictionary.Symbol) is
      Str : E_Strings.T;
   begin
      if Dictionary.Is_Null_Symbol (Sym) then
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Null Symbol", 0);
      else
         Str := Dictionary.GetAnyPrefixNeeded (Sym       => Sym,
                                               Scope     => Dictionary.GlobalScope,
                                               Separator => ".");
         E_Strings.Put_String (File  => SPARK_IO.Standard_Output,
                               E_Str => Str);
         if E_Strings.Get_Length (E_Str => Str) > 0 then
            SPARK_IO.Put_Char (SPARK_IO.Standard_Output, '.');
         end if;
         E_Strings.Put_String
           (File  => SPARK_IO.Standard_Output,
            E_Str => Dictionary.GenerateSimpleName (Item      => Sym,
                                                    Separator => "."));
      end if;
   end Print_Sym_Raw;

   procedure Print_Sym (Msg : in String;
                        Sym : in Dictionary.Symbol) is
   begin
      SPARK_IO.Put_String (SPARK_IO.Standard_Output, Msg, 0);

      -- These statements put out the raw symbol number before its name
      -- SPARK_IO.Put_Char (SPARK_IO.Standard_Output, '(');
      -- Text_IO.Put (Integer'Image (Integer (Dictionary.SymbolRef (Sym))));
      -- SPARK_IO.Put_Char (SPARK_IO.Standard_Output, ')');
      -- end of numeric output lines

      Print_Sym_Raw (Sym => Sym);

      -- These statements put out the raw symbol Discriminant after its name
      -- Start of printing " (SymbolDiscriminant)"
      -- SPARK_IO.Put_Char (SPARK_IO.Standard_Output, ' ');
      -- SPARK_IO.Put_Char (SPARK_IO.Standard_Output, '(');
      -- E_Strings.PutString (SPARK_IO.Standard_Output,
      --                            Dictionary.GetSymbolDiscriminant (Sym));
      -- SPARK_IO.Put_Char (SPARK_IO.Standard_Output, ')');
      -- End of printing " (SymbolDiscriminant)"

      SPARK_IO.New_Line (SPARK_IO.Standard_Output, 1);
   end Print_Sym;

   procedure Print_Function_Sym (Msg : in String;
                                 Sym : in Dictionary.Symbol) is
      --# hide Print_Function_Sym;
   begin
      SPARK_IO.Put_String (SPARK_IO.Standard_Output, Msg, 0);

      SPARK_IO.Put_String (SPARK_IO.Standard_Output, " [", 0);
      SPARK_IO.Put_Integer
        (File  => SPARK_IO.Standard_Output,
         Item  => Integer (Dictionary.SymbolRef (Sym)),
         Base  => 10,
         Width => 4);
      SPARK_IO.Put_String (SPARK_IO.Standard_Output, "]: ", 0);

      Print_Sym_Raw (Sym);

      if Dictionary.IsProofFunction (Sym) then
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, " (Proof)", 0);
         if Dictionary.IsImplicitProofFunction (Sym) then
            SPARK_IO.Put_String (SPARK_IO.Standard_Output, " (Implicit)", 0);
         end if;
      elsif Dictionary.IsAdaFunction (Sym) then
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, " (Ada)", 0);
      end if;

      SPARK_IO.New_Line (SPARK_IO.Standard_Output, 1);
   end Print_Function_Sym;

   procedure PrintScope (Msg   : in String;
                         Scope : in Dictionary.Scopes) is
   begin
      SPARK_IO.Put_String (SPARK_IO.Standard_Output, Msg, 0);
      if Dictionary.Get_Visibility (Scope => Scope) = Dictionary.Visible then
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Visible scope of ", 0);
      elsif Dictionary.Get_Visibility (Scope => Scope) = Dictionary.Local then
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Local scope of ", 0);
      else
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Private scope of ", 0);
      end if;
      Print_Sym ("", Dictionary.GetRegion (Scope));
   end PrintScope;

   procedure PrintInt (Msg : in String;
                       I   : in Integer) is
   begin
      Text_IO.Put (Msg);
      Text_IO.Put_Line (Integer'Image (I));
   end PrintInt;

   procedure PrintBool (Msg : in String;
                        B   : in Boolean) is
   begin
      Text_IO.Put (Msg);
      Text_IO.Put_Line (Boolean'Image (B));
   end PrintBool;

   procedure Print_Lex_Str (Msg : in String;
                            L   : in LexTokenManager.Lex_String) is
   begin
      Text_IO.Put (Msg);
      E_Strings.Put_Line (File  => SPARK_IO.Standard_Output,
                          E_Str => LexTokenManager.Lex_String_To_String (Lex_Str => L));
   end Print_Lex_Str;

   -- needs DAG_IO.PrintDAG to be made visible
   procedure PrintDAG
     (Msg      : in     String;
      DAG      : in     Cells.Cell;
      The_Heap : in out Cells.Heap_Record;
      Scope    : in     Dictionary.Scopes)
   is
   begin
      Text_IO.Put (Msg);
      DAG_IO.PrintDag (The_Heap, SPARK_IO.Standard_Output, DAG, Scope, DAG_IO.Default_Wrap_Limit);
      Text_IO.New_Line;
   end PrintDAG;

   procedure Write_DAG_To_File
     (Filename : in     String;
      DAG      : in     Cells.Cell;
      The_Heap : in out Cells.Heap_Record;
      Scope    : in     Dictionary.Scopes)
   is
      Fd     : SPARK_IO.File_Type := SPARK_IO.Null_File;
      Status : SPARK_IO.File_Status;
   begin
      SPARK_IO.Create (File         => Fd,
                       Name_Length  => Filename'Length,
                       Name_Of_File => Filename,
                       Form_Of_File => "",
                       Status       => Status);
      SystemErrors.RT_Assert
        (C       => Status = SPARK_IO.Ok,
         Sys_Err => SystemErrors.Other_Internal_Error,
         Msg     => "Could not open file: " & Filename);
      DAG_IO.Print_DAG_Dot (Heap        => The_Heap,
                            Output_File => Fd,
                            Root        => DAG,
                            Scope       => Scope,
                            Wrap_Limit  => DAG_IO.No_Wrap);
      SPARK_IO.Close (Fd, Status);
      SystemErrors.RT_Assert
        (C       => Status = SPARK_IO.Ok,
         Sys_Err => SystemErrors.Other_Internal_Error,
         Msg     => "Could not close file: " & Filename);
   end Write_DAG_To_File;

   procedure Write_Heap_To_File (Filename : in     String;
                                 The_Heap : in out Cells.Heap_Record) is
      Fd     : SPARK_IO.File_Type := SPARK_IO.Null_File;
      Status : SPARK_IO.File_Status;
   begin
      SPARK_IO.Create (File         => Fd,
                       Name_Length  => Filename'Length,
                       Name_Of_File => Filename,
                       Form_Of_File => "",
                       Status       => Status);
      SystemErrors.RT_Assert
        (C       => Status = SPARK_IO.Ok,
         Sys_Err => SystemErrors.Other_Internal_Error,
         Msg     => "Could not open file: " & Filename);
      DAG_IO.Print_Heap_Dot (Heap        => The_Heap,
                             Output_File => Fd);
      SPARK_IO.Close (Fd, Status);
      SystemErrors.RT_Assert
        (C       => Status = SPARK_IO.Ok,
         Sys_Err => SystemErrors.Other_Internal_Error,
         Msg     => "Could not close file: " & Filename);
   end Write_Heap_To_File;

   procedure Print_Cell (Msg      : in     String;
                         The_Heap : in out Cells.Heap_Record;
                         The_Cell : in     Cells.Cell) is
   begin
      Text_IO.Put_Line (Msg & " (");
      Text_IO.Put_Line ("   Kind : " & Cells.Cell_Kind'Image (Cells.Get_Kind (The_Heap, The_Cell)));
      Text_IO.Put_Line ("   Op   : " & SP_Symbols.SP_Symbol'Image (Cells.Get_Op_Symbol (The_Heap, The_Cell)));
      Text_IO.Put_Line ("   A    : " & Cells.Cell_Kind'Image (Cells.Get_Kind (The_Heap, Cells.Get_A_Ptr (The_Heap, The_Cell))));
      Text_IO.Put ("          ");
      DAG_IO.PrintDag (The_Heap, SPARK_IO.Standard_Output, Cells.Get_A_Ptr (The_Heap, The_Cell), Dictionary.GlobalScope, 120);
      Text_IO.New_Line;
      Text_IO.Put_Line ("   B    : " & Cells.Cell_Kind'Image (Cells.Get_Kind (The_Heap, Cells.Get_B_Ptr (The_Heap, The_Cell))));
      Text_IO.Put ("          ");
      DAG_IO.PrintDag (The_Heap, SPARK_IO.Standard_Output, Cells.Get_B_Ptr (The_Heap, The_Cell), Dictionary.GlobalScope, 120);
      Text_IO.New_Line;
      Text_IO.Put_Line ("   C    : " & Cells.Cell_Kind'Image (Cells.Get_Kind (The_Heap, Cells.Get_C_Ptr (The_Heap, The_Cell))));
      Text_IO.Put ("          ");
      DAG_IO.PrintDag (The_Heap, SPARK_IO.Standard_Output, Cells.Get_C_Ptr (The_Heap, The_Cell), Dictionary.GlobalScope, 120);
      Text_IO.New_Line;
      Text_IO.Put_Line ("   Nat  :" & Natural'Image (Cells.Get_Natural_Value (The_Heap, The_Cell)));
      Text_IO.Put ("   Sym  : ");
      Print_Sym_Raw (Cells.Get_Symbol_Value (The_Heap, The_Cell));
      Text_IO.New_Line;
      Text_IO.Put_Line (")");
   end Print_Cell;

   procedure Print_Sym_Seq (Msg      : in String;
                            Seq      : in SeqAlgebra.Seq;
                            The_Heap : in Heap.HeapRecord) is
      X          : SeqAlgebra.MemberOfSeq;
      Str        : E_Strings.T;
      Sym        : Dictionary.Symbol;
      Later_Item : Boolean := False;
   begin
      Text_IO.Put (Msg);
      Text_IO.Put ("{ ");
      X := SeqAlgebra.FirstMember (The_Heap, Seq);
      while not SeqAlgebra.IsNullMember (X) loop
         if Later_Item then
            Text_IO.Put (", ");
         end if;
         Later_Item := True;
         Sym        :=
           Dictionary.ConvertSymbolRef (ExaminerConstants.RefType (SeqAlgebra.Value_Of_Member (The_Heap => The_Heap,
                                                                                               M        => X)));
         Str        := Dictionary.GetAnyPrefixNeeded (Sym       => Sym,
                                                      Scope     => Dictionary.GlobalScope,
                                                      Separator => ".");
         E_Strings.Put_String (File  => SPARK_IO.Standard_Output,
                               E_Str => Str);
         if E_Strings.Get_Length (E_Str => Str) > 0 then
            SPARK_IO.Put_Char (SPARK_IO.Standard_Output, '.');
         end if;
         E_Strings.Put_String
           (File  => SPARK_IO.Standard_Output,
            E_Str => Dictionary.GenerateSimpleName (Item      => Sym,
                                                    Separator => "."));

         X := SeqAlgebra.NextMember (The_Heap, X);
      end loop;
      Text_IO.Put_Line (" }");
   end Print_Sym_Seq;

   procedure PrintSeq (Msg      : in String;
                       Seq      : in SeqAlgebra.Seq;
                       The_Heap : in Heap.HeapRecord) is
      X          : SeqAlgebra.MemberOfSeq;
      Later_Item : Boolean := False;
   begin
      Text_IO.Put (Msg);
      Text_IO.Put ("{ ");
      X := SeqAlgebra.FirstMember (The_Heap, Seq);
      while not SeqAlgebra.IsNullMember (X) loop
         if Later_Item then
            Text_IO.Put (", ");
         end if;
         Later_Item := True;
         Text_IO.Put (Integer'Image (SeqAlgebra.Value_Of_Member (The_Heap => The_Heap,
                                                                 M        => X)));
         X := SeqAlgebra.NextMember (The_Heap, X);
      end loop;
      Text_IO.Put_Line (" }");
   end PrintSeq;

   procedure PrintNode (Msg : in String;
                        N   : in STree.SyntaxNode) is
   begin
      Text_IO.Put (Msg);
      Text_IO.Put_Line (SP_Symbols.SP_Symbol'Image (STree.Syntax_Node_Type (Node => N)));
   end PrintNode;

   procedure PrintTraceback (Msg   : in String;
                             Depth : in Natural) is
      Traceback : GNAT.Traceback.Tracebacks_Array (1 .. Depth);
      Unused    : Natural;
   begin
      Text_IO.Put_Line (Msg);
      GNAT.Traceback.Call_Chain (Traceback, Unused);
      SPARK_IO.Put_String (SPARK_IO.Standard_Output, GNAT.Traceback.Symbolic.Symbolic_Traceback (Traceback), 0);
   end PrintTraceback;

   procedure Dump_Stack
     (Msg      : in     String;
      Scope    : in     Dictionary.Scopes;
      VCG_Heap : in out Cells.Heap_Record;
      Stack    : in     CStacks.Stack)
   is
      Top_Ptr : CStacks.Stack := Stack;
   begin
      Debug.PrintMsg (Msg, True);
      Debug.PrintMsg ("Stack contents:", True);
      while not CStacks.IsEmpty (Top_Ptr) loop
         Debug.PrintDAG (Msg      => "--",
                         DAG      => CStacks.Top (VCG_Heap, Top_Ptr),
                         The_Heap => VCG_Heap,
                         Scope    => Scope);
         Debug.PrintMsg ("------------------", True);

         Top_Ptr := CStacks.NonDestructivePop (VCG_Heap, Top_Ptr);
      end loop;
   end Dump_Stack;

end Debug;
