vhdl-prints: add an option to display comments

3 files changed, 74 insertions, 3 deletions

diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index d3aa203f4..a95e456cd 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -1007,13 +1007,23 @@ package body Ghdlprint is
 
    --  Command Reprint.
    type Command_Reprint is new Command_Lib with record
+      --  Do a semantic analysis.
       Flag_Sem : Boolean := True;
+
+      --  Reprint even in case of errors.
+      Flag_Force : Boolean := False;
+
+      --  Format the outputs, using LEVEL and REALIGN.
       Flag_Format : Boolean := False;
       Level : Format_Level := Format_Indent;
       Flag_Realign : Boolean := False;
-      Flag_Force : Boolean := False;
+
+      --  Output only lines within this range.
       First_Line : Positive := 1;
       Last_Line : Positive := Positive'Last;
+
+      --  Collect and display comments.
+      Flag_Comments : Boolean := True;
    end record;
    function Decode_Command (Cmd : Command_Reprint; Name : String)
                            return Boolean;
@@ -1081,6 +1091,9 @@ package body Ghdlprint is
             when Constraint_Error =>
                Res := Option_Err;
          end;
+      elsif Option = "--comments" then
+         Cmd.Flag_Comments := True;
+         Res := Option_Ok;
       else
          Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
       end if;
@@ -1111,6 +1124,8 @@ package body Ghdlprint is
       Vhdl.Canon.Canon_Flag_Specification_Lists := False;
       Vhdl.Canon.Canon_Flag_Associations := False;
 
+      Flags.Flag_Gather_Comments := Cmd.Flag_Comments;
+
       --  Parse all files.
       for I in Args'Range loop
          Id := Name_Table.Get_Identifier (Args (I).all);
diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index 51b042037..13115cc22 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -25,6 +25,8 @@ with Name_Table;
 with Str_Table;
 with Std_Names; use Std_Names;
 with Files_Map;
+with File_Comments;
+
 with Vhdl.Types; use Vhdl.Types;
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
@@ -1214,6 +1216,8 @@ package body Vhdl.Prints is
 
          First_Inter := Inter;
 
+         Start_Node (Ctxt, Inter);
+
          if With_Box then
             Start_Hbox (Ctxt);
          end if;
@@ -4654,6 +4658,7 @@ package body Vhdl.Prints is
                end loop;
             end;
          when Iir_Kind_Design_Unit =>
+            Start_Node (Ctxt, N);
             Disp_Design_Unit (Ctxt, N);
          when Iir_Kind_Enumeration_Type_Definition =>
             Disp_Enumeration_Type_Definition (Ctxt, N);
@@ -5164,8 +5169,14 @@ package body Vhdl.Prints is
 
    package Simple_Disp_Ctxt is
       type Simple_Ctxt is new Disp_Ctxt with record
+         --  Boxes level.
          Vnum : Natural;
          Hnum : Natural;
+
+         --  Used by comments.
+         Sfe : Source_File_Entry;
+
+         --  Previous token, to decided whether or not a blank must be added.
          Prev_Tok : Token_Type;
       end record;
 
@@ -5174,6 +5185,7 @@ package body Vhdl.Prints is
       procedure Close_Hbox (Ctxt : in out Simple_Ctxt);
       procedure Start_Vbox (Ctxt : in out Simple_Ctxt);
       procedure Close_Vbox (Ctxt : in out Simple_Ctxt);
+      procedure Start_Node (Ctxt : in out Simple_Ctxt; N : Iir);
       procedure Valign (Ctxt : in out Simple_Ctxt; Point : Valign_Type);
       procedure Disp_Token (Ctxt : in out Simple_Ctxt; Tok : Token_Type);
       procedure Start_Lit (Ctxt : in out Simple_Ctxt; Tok : Token_Type);
@@ -5188,6 +5200,7 @@ package body Vhdl.Prints is
       begin
          Ctxt := (Vnum => 0,
                   Hnum => 0,
+                  Sfe => No_Source_File_Entry,
                   Prev_Tok => Tok_Newline);
       end Init;
 
@@ -5229,6 +5242,39 @@ package body Vhdl.Prints is
          Ctxt.Vnum := Ctxt.Vnum - 1;
       end Close_Vbox;
 
+      procedure Start_Node (Ctxt : in out Simple_Ctxt; N : Iir)
+      is
+         use File_Comments;
+         Sfe : Source_File_Entry;
+         Idx : Comment_Index;
+      begin
+         if not Flag_Gather_Comments then
+            return;
+         end if;
+         Sfe := Ctxt.Sfe;
+         if Sfe = No_Source_File_Entry then
+            Sfe := Files_Map.Location_To_File (Get_Location (N));
+            Ctxt.Sfe := Sfe;
+         end if;
+         Idx := Find_First_Comment (Sfe, Uns32 (N));
+         while Idx /= No_Comment_Index loop
+            declare
+               Buf : constant File_Buffer_Acc :=
+                 Files_Map.Get_File_Source (Sfe);
+               Start, Last : Source_Ptr;
+            begin
+               --  TODO: indent
+               Get_Comment (Sfe, Idx, Start, Last);
+               Start_Hbox (Ctxt);
+               for I in Start .. Last loop
+                  Disp_Char (Ctxt, Buf (I));
+               end loop;
+               Close_Hbox (Ctxt);
+            end;
+            Idx := Get_Next_Comment (Sfe, Idx);
+         end loop;
+      end Start_Node;
+
       procedure Valign (Ctxt : in out Simple_Ctxt; Point : Valign_Type) is
       begin
          null;
diff --git a/src/vhdl/vhdl-prints.ads b/src/vhdl/vhdl-prints.ads
index 44989d401..c059ab695 100644
--- a/src/vhdl/vhdl-prints.ads
+++ b/src/vhdl/vhdl-prints.ads
@@ -37,6 +37,12 @@ package Vhdl.Prints is
    procedure Close_Hbox (Ctxt : in out Disp_Ctxt) is abstract;
    procedure Start_Vbox (Ctxt : in out Disp_Ctxt) is abstract;
    procedure Close_Vbox (Ctxt : in out Disp_Ctxt) is abstract;
+
+   --  Called before some nodes to display comments.  The nodes are:
+   --  Iir_Kind_Design_Unit
+   --  Iir_Kinds_Interface_Declaration
+   procedure Start_Node (Ctxt : in out Disp_Ctxt; N : Iir) is null;
+
    procedure Valign (Ctxt : in out Disp_Ctxt; Point : Valign_Type)
      is abstract;
    procedure Disp_Token (Ctxt : in out Disp_Ctxt; Tok : Token_Type)
@@ -60,12 +66,16 @@ package Vhdl.Prints is
    -- Mainly used to dispatch to other functions according to the kind of
    -- the node.
    procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir);
-   procedure Disp_Vhdl (N : Iir);
 
    procedure Disp_PSL_NFA (Ctxt : in out Ctxt_Class; N : PSL_NFA);
+
+   --  Standalone version of above method, create a default context.
+   --  Used for debugging.
+   procedure Disp_Vhdl (N : Iir);
    procedure Disp_PSL_NFA (N : PSL_NFA);
 
+   --  Display an expression.
+   --  Used for debugging.
    procedure Disp_Expression (Expr: Iir);
    procedure Disp_PSL_Expr (N : PSL_Node);
-   --  Display an expression.
 end Vhdl.Prints;