--  EDIF printer.
--  Copyright (C) 2019 Tristan Gingold
--
--  GHDL is free software; you can redistribute it and/or modify it under
--  the terms of the GNU General Public License as published by the Free
--  Software Foundation; either version 2, or (at your option) any later
--  version.
--
--  GHDL 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
--  along with GHDL; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.

with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
with Str_Table;
with Name_Table;

package body Edif.Disp_Edif is
   procedure Disp (N : Node; Indent : Natural);

   procedure Disp_Int32 (V : Int32)
   is
      S : constant String := Int32'Image (V);
   begin
      if S (1) = ' ' then
         Put (S (2 .. S'Last));
      else
         Put (S);
      end if;
   end Disp_Int32;

   procedure Disp_Symbol (S : Name_Id)
   is
      Img : constant String := Name_Table.Image (S);
   begin
      if Img (Img'First) not in 'a' .. 'z' then
         Put ('&');
      end if;
      Put (Img);
   end Disp_Symbol;

   procedure Disp_Indent (Indent : Natural) is
   begin
      Put ((1 .. 2 * Indent => ' '));
   end Disp_Indent;

   procedure Disp_Chain (Chain : Node; Indent : Natural)
   is
      N : Node;
   begin
      N := Chain;
      while N /= Null_Node loop
         Disp (N, Indent);
         N := Get_Chain (N);
      end loop;
   end Disp_Chain;

   procedure Disp_Keyword_Head (Name : String; Indent : Natural) is
   begin
      Disp_Indent (Indent);
      Put ('(');
      Put (Name);
      Put (' ');
   end Disp_Keyword_Head;

   procedure Disp_Keyword_Tail is
   begin
      Put (')');
      New_Line;
   end Disp_Keyword_Tail;

   procedure Disp_Keyword (Name : String; Arg : Int32; Indent : Natural) is
   begin
      Disp_Keyword_Head (Name, Indent);
      Disp_Int32 (Arg);
      Disp_Keyword_Tail;
   end Disp_Keyword;

   procedure Disp_Keyword (Name : String; Arg : Node; Indent : Natural) is
   begin
      Disp_Keyword_Head (Name, Indent);
      Disp (Arg, Indent + 1);
      Disp_Keyword_Tail;
   end Disp_Keyword;

   procedure Disp_Keyword (Name : String; Arg : Name_Id; Indent : Natural) is
   begin
      Disp_Keyword_Head (Name, Indent);
      Disp_Symbol (Arg);
      Disp_Keyword_Tail;
   end Disp_Keyword;

   procedure Disp_Decl_Head (Name : String; N : Node; Indent : Natural) is
   begin
      Disp_Keyword_Head (Name, Indent);
      Disp (Get_Name (N), Indent);
      New_Line;
   end Disp_Decl_Head;

   procedure Disp_Decl_Tail (Indent : Natural) is
   begin
      Disp_Indent (Indent);
      Disp_Keyword_Tail;
   end Disp_Decl_Tail;

   procedure Disp_Opt (N : Node; Indent : Natural) is
   begin
      if N /= Null_Node then
         Disp (N, Indent);
      end if;
   end Disp_Opt;

   procedure Disp (N : Node; Indent : Natural) is
   begin
      if N = Null_Node then
         Put ("()");
         return;
      end if;

      case Get_Kind (N) is
         when N_Keyword =>
            declare
               El : Node;
            begin
               New_Line;
               Disp_Indent (Indent);
               Put ('(');
               Put (Name_Table.Image (Get_Keyword (N)));
               El := Get_CDR (N);
               while El /= Null_Node loop
                  Put (' ');
                  Disp (Get_CAR (El), Indent + 1);
                  El := Get_CDR (El);
               end loop;
               Put (')');
            end;

         when N_Symbol =>
            Disp_Symbol (Get_Symbol (N));

         when N_Number =>
            Disp_Int32 (Get_Number (N));

         when N_String =>
            Put ('"');
            Put (Str_Table.String_String8
                   (Get_String_Id (N), Nat32 (Get_String_Len (N))));
            Put ('"');

         when N_Edif =>
            Disp_Decl_Head ("edif", N, Indent);
            Disp_Keyword ("edifversion", Get_Edif_Version (N), Indent + 1);
            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
            Disp_Keyword ("keywordmap", Get_Keyword_Map (N), Indent + 1);
            Disp_Keyword ("status", Get_Status (N), Indent + 1);
            Disp_Chain (Get_External_Chain (N), Indent + 1);
            Disp_Chain (Get_Library_Chain (N), Indent + 1);
            Disp (Get_Design (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Library =>
            Disp_Decl_Head ("library", N, Indent);
            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
            Disp_Keyword ("technology", Get_Technology (N), Indent + 1);
            Disp_Chain (Get_Cells_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_External =>
            Disp_Decl_Head ("external", N, Indent);
            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
            Disp_Keyword ("technology", Get_Technology (N), Indent + 1);
            Disp_Chain (Get_Cells_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Cell =>
            Disp_Decl_Head ("cell", N, Indent);
            Disp_Keyword ("celltype", Get_Cell_Type (N), Indent + 1);
            Disp (Get_View (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_View =>
            Disp_Decl_Head ("view", N, Indent);
            Disp_Keyword ("viewtype", Get_View_Type (N), Indent + 1);
            Disp (Get_Interface (N), Indent + 1);
            declare
               Contents : constant Node := Get_Contents_Chain (N);
            begin
               if Contents /= Null_Node then
                  Disp_Keyword_Head ("contents", Indent + 1);
                  New_Line;
                  Disp_Chain (Contents, Indent + 2);
                  Disp_Indent (Indent + 1);
                  Disp_Keyword_Tail;
               end if;
            end;
            Disp_Decl_Tail (Indent);

         when N_Interface =>
            Disp_Keyword_Head ("interface", Indent);
            New_Line;
            Disp_Chain (Get_Ports_Chain (N), Indent + 1);
            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
            Disp_Indent (Indent);
            Disp_Keyword_Tail;

         when N_Port =>
            Disp_Decl_Head ("port", N, Indent);
            Disp_Keyword_Head ("direction", Indent + 1);
            case Get_Direction (N) is
               when Dir_Input =>
                  Put ("input");
               when Dir_Output =>
                  Put ("output");
               when Dir_Inout =>
                  Put ("inout");
            end case;
            Disp_Keyword_Tail;
            Disp_Decl_Tail (Indent);

         when N_Rename =>
            Put ("(rename ");
            Disp (Get_Name (N), Indent);
            Put (' ');
            Disp (Get_String (N), Indent);
            Put (')');

         when N_Member =>
            Put ("(member ");
            Disp (Get_Name (N), Indent);
            Put (' ');
            Disp_Int32 (Get_Index (N));
            Put (')');

         when N_Array =>
            Put ("(array ");
            Disp (Get_Name (N), Indent);
            Put (' ');
            Disp_Int32 (Get_Array_Length (N));
            Put (')');

         when N_Instance =>
            Disp_Decl_Head ("instance", N, Indent);
            Disp (Get_Instance_Ref (N), Indent + 1);
            Disp_Chain (Get_Port_Instances_Chain (N), Indent + 1);
            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Net =>
            Disp_Decl_Head ("net", N, Indent);
            Disp_Chain (Get_Joined_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_View_Ref =>
            Disp_Decl_Head ("viewref", N, Indent);
            Disp (Get_Cell_Ref (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Cell_Ref =>
            Disp_Keyword_Head ("cellref", Indent);
            Disp (Get_Name (N), Indent);
            Disp_Opt (Get_Library_Ref (N), Indent + 1);
            Disp_Keyword_Tail;

         when N_Port_Ref =>
            Disp_Keyword_Head ("portref", Indent);
            Disp (Get_Port (N), Indent);
            Disp_Opt (Get_Instance_Ref (N), Indent + 1);
            Disp_Keyword_Tail;

         when N_Property =>
            Disp_Keyword_Head ("property", Indent);
            Disp (Get_Name (N), Indent);
            Put (' ');
            Disp (Get_Value (N), Indent);
            Disp_Keyword_Tail;

         when N_Port_Instance =>
            Disp_Decl_Head ("portinstance", N, Indent);
            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Design =>
            Disp_Decl_Head ("design", N, Indent);
            Disp (Get_Cell_Ref (N), Indent + 1);
            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
            Disp_Decl_Tail (Indent);

         when N_Boolean =>
            if Get_Boolean (N) then
               Put ("(true)");
            else
               Put ("(false)");
            end if;

         when others =>
            Put ("??? " & Nkind'Image (Get_Kind (N)));
      end case;
   end Disp;

   procedure Disp_Node (N : Node) is
   begin
      Disp (N, 0);
   end Disp_Node;
end Edif.Disp_Edif;
