From c1dc505cbe93ebaade1547b2e4180074bdf42a25 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sun, 20 Nov 2022 20:02:41 +0100
Subject: vhdl-prints: add an option to display comments
---
src/ghdldrv/ghdlprint.adb | 17 ++++++++++++++++-
src/vhdl/vhdl-prints.adb | 46 ++++++++++++++++++++++++++++++++++++++++++++++
src/vhdl/vhdl-prints.ads | 14 ++++++++++++--
3 files changed, 74 insertions(+), 3 deletions(-)
(limited to 'src')
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;
--
cgit v1.2.3