diff options
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 17 | ||||
| -rw-r--r-- | src/vhdl/vhdl-prints.adb | 46 | ||||
| -rw-r--r-- | src/vhdl/vhdl-prints.ads | 14 |
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; |