diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-11-27 08:21:36 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-11-27 12:30:40 +0100 |
commit | 55e669e57725017cb356907abcfe7a4953563296 (patch) | |
tree | 0ca13c7f01014cb4aed75c3921057d7616018447 /src | |
parent | d2a0fe9e9c097a5130a6d6a6f2c8c76bf4394ae0 (diff) | |
download | ghdl-55e669e57725017cb356907abcfe7a4953563296.tar.gz ghdl-55e669e57725017cb356907abcfe7a4953563296.tar.bz2 ghdl-55e669e57725017cb356907abcfe7a4953563296.zip |
vhdl: rework comment gathering to handle empty lines.
Diffstat (limited to 'src')
-rw-r--r-- | src/file_comments.adb | 322 | ||||
-rw-r--r-- | src/file_comments.ads | 89 | ||||
-rw-r--r-- | src/vhdl/vhdl-comments.adb | 26 | ||||
-rw-r--r-- | src/vhdl/vhdl-comments.ads | 16 | ||||
-rw-r--r-- | src/vhdl/vhdl-formatters.adb | 4 | ||||
-rw-r--r-- | src/vhdl/vhdl-parse.adb | 78 | ||||
-rw-r--r-- | src/vhdl/vhdl-prints.adb | 2 | ||||
-rw-r--r-- | src/vhdl/vhdl-scanner.adb | 20 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_lib.adb | 7 |
9 files changed, 398 insertions, 166 deletions
diff --git a/src/file_comments.adb b/src/file_comments.adb index 8fd0f93a9..8e747f748 100644 --- a/src/file_comments.adb +++ b/src/file_comments.adb @@ -14,104 +14,255 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. --- All the variables declared in this package are set by Parse_Option function --- and can by read as soon as the command line is parsed. --- --- Since the names are not prefixed, this package is expected to be with'ed --- but not to be use'd. - with Grt.Algos; +with Simple_IO; use Simple_IO; +with Utils_IO; use Utils_IO; + package body File_Comments is - procedure Add_Comment (File : Source_File_Entry; - Start, Last : Source_Ptr) - is - pragma Assert (File > No_Source_File_Entry); + Flag_Trace : constant Boolean := False; + + Ctxt : Comment_Context; + + procedure Comment_Init_Scan (File : Source_File_Entry) is begin + Ctxt := (File => File, + State => State_Before, + Next => No_Comment_Index + 1, + Last_Node => 0, + Line_Start => Source_Ptr_Bad); + -- Create entry for FILE if not already created. - if Comments_Table.Last < File then - while Comments_Table.Last < File loop - Comments_Table.Append - (File_Comment_Record'(Comments => <>, - Next => File_Comments_Tables.First)); + if Comments_Table.Last < Ctxt.File then + while Comments_Table.Last < Ctxt.File loop + Comments_Table.Append (File_Comments_Table'(Table => null, + Priv => <>)); end loop; - File_Comments_Tables.Init (Comments_Table.Table (File).Comments, 16); + File_Comments_Tables.Init (Comments_Table.Table (Ctxt.File), 16); end if; + end Comment_Init_Scan; - -- Append a comment entry. - File_Comments_Tables.Append - (Comments_Table.Table (File).Comments, - Comment_Record'(Start => Start, Last => Last, N => 0)); - end Add_Comment; + procedure Comment_Close_Scan is + begin + Ctxt.File := No_Source_File_Entry; + end Comment_Close_Scan; - procedure Discard_Comments (File : Source_File_Entry) is + -- Gather last comments to the current node. + -- Called at the end of a block. + procedure Comment_Gather_Existing + is + Fc : File_Comments_Table renames + Comments_Table.Table (Ctxt.File); + Last : constant Comment_Index := File_Comments_Tables.Last (Fc); begin - if Comments_Table.Last < File then - -- No comments for FILE. - return; + if Flag_Trace then + Put ("Comment_Gather_Existing: "); + Put_Uns32 (Uns32 (Ctxt.Next)); + Put (".."); + Put_Uns32 (Uns32 (Last)); + Put (" -> "); + Put_Uns32 (Ctxt.Last_Node); + New_Line; end if; - raise Internal_Error; - end Discard_Comments; - procedure Save_Comments (File : Source_File_Entry; - Rng : out Comments_Range_Type) + for I in Ctxt.Next .. Last loop + pragma Assert (Fc.Table (I).N = 0); + Fc.Table (I).N := Ctxt.Last_Node; + end loop; + Ctxt.Next := Last + 1; + end Comment_Gather_Existing; + + procedure Comment_Newline (Line_Start : Source_Ptr) is + begin + case Ctxt.State is + when State_Before => + null; + when State_Block => + -- Detect empty line. + -- This can happen only after a comments has been added. + declare + Fc : File_Comments_Table renames + Comments_Table.Table (Ctxt.File); + Last : constant Comment_Index := File_Comments_Tables.Last (Fc); + begin + if Line_Start > Fc.Table (Last).Last then + -- Newline without a comment. + -- Attach existing comments. + Comment_Gather_Existing; + end if; + end; + when State_Line => + -- No comment on the same line. + -- The following comments will be attached to the next node. + Ctxt.State := State_Before; + end case; + end Comment_Newline; + + procedure Add_Comment (Start, Last : Source_Ptr; + Line_Start : Source_Ptr) is - use File_Comments_Tables; + pragma Assert (Ctxt.File /= No_Source_File_Entry); + N : Uns32; begin - if Comments_Table.Last < File then - -- No comments for FILE. - Rng := (First | Last => No_Comment_Index); - return; + if Flag_Trace then + Put ("Add_Comment, file="); + Put_Uns32 (Uns32 (Ctxt.File)); + Put (", start="); + Put_Uns32 (Uns32 (Start)); + Put (".."); + Put_Uns32 (Uns32 (Last)); + Put (" => "); + Put_Uns32 (Uns32 (File_Comments_Tables.Last + (Comments_Table.Table (Ctxt.File)) + 1)); + Put (", state="); end if; - declare - Fc : File_Comment_Record renames Comments_Table.Table (File); - begin - Rng := (First => Fc.Next, Last => Last (Fc.Comments)); - Fc.Next := Rng.Last + 1; - end; + + case Ctxt.State is + when State_Before => + -- Will be attached later. + N := 0; + if Flag_Trace then + Put ("before"); + end if; + when State_Block => + -- Will be attached on the next empty line. + N := 0; + if Flag_Trace then + Put ("block"); + end if; + when State_Line => + -- Is it on the same line ? + if Line_Start = Ctxt.Line_Start then + N := Ctxt.Last_Node; + Ctxt.Next := File_Comments_Tables.Last + (Comments_Table.Table (Ctxt.File)) + 2; + Ctxt.State := State_Block; + else + -- Not the same line, for the next node. + N := 0; + Ctxt.State := State_Before; + end if; + if Flag_Trace then + Put ("line"); + Put (" (start="); + Put_Uns32 (Uns32 (Ctxt.Line_Start)); + Put (", cmt="); + Put_Uns32 (Uns32 (Line_Start)); + Put (")"); + end if; + end case; + + if Flag_Trace then + Put (", node="); + Put_Uns32 (N); + New_Line; + end if; + + -- Append a comment entry. + File_Comments_Tables.Append + (Comments_Table.Table (Ctxt.File), + Comment_Record'(Start => Start, Last => Last, N => N)); + end Add_Comment; + + procedure Save_Comments (Rng : out Comments_Range) + is + use File_Comments_Tables; + pragma Assert (Ctxt.File /= No_Source_File_Entry); + Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File); + begin + Rng := (First => Ctxt.Next, Last => Last (Fc)); + Ctxt.Next := Rng.Last + 1; end Save_Comments; - procedure Gather_Comments (File : Source_File_Entry; - Rng : Comments_Range_Type; - N : Uns32) + procedure Gather_Comments_Before (Rng : Comments_Range; N : Uns32) is use File_Comments_Tables; + pragma Assert (Ctxt.File /= No_Source_File_Entry); begin - if Rng.Last = No_Comment_Index then - return; + if Rng.Last /= No_Comment_Index then + if Flag_Trace then + Put ("Gather_Comments_Before, file="); + Put_Uns32 (Uns32 (Ctxt.File)); + Put (", rng="); + Put_Uns32 (Uns32 (Rng.First)); + Put (".."); + Put_Uns32 (Uns32 (Rng.Last)); + Put (", node="); + Put_Uns32 (N); + New_Line; + end if; + + declare + Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File); + begin + for I in Rng.First .. Rng.Last loop + Fc.Table (I).N := N; + end loop; + + Ctxt.Next := Rng.Last + 1; + end; end if; + end Gather_Comments_Before; - pragma Assert (File <= Comments_Table.Last); - declare - Fc : File_Comment_Record renames Comments_Table.Table (File); - begin - for I in Rng.First .. Rng.Last loop - Fc.Comments.Table (I).N := N; - end loop; - end; - end Gather_Comments; + procedure Gather_Comments_Block (Rng : Comments_Range; N : Uns32) is + begin + Gather_Comments_Before (Rng, N); + Ctxt.State := State_Block; + Ctxt.Last_Node := N; + end Gather_Comments_Block; - procedure Gather_Comments (File : Source_File_Entry; N : Uns32) - is - Rng : Comments_Range_Type; + procedure Gather_Comments_Line (Rng : Comments_Range; + Pos : Source_Ptr; + N : Uns32) is begin - Save_Comments (File, Rng); - Gather_Comments (File, Rng, N); - end Gather_Comments; + Gather_Comments_Before (Rng, N); + Ctxt.State := State_Line; + Ctxt.Last_Node := N; + Ctxt.Line_Start := Pos; + end Gather_Comments_Line; - procedure Rename_Comments (File : Source_File_Entry; - Prev : Uns32; - N : Uns32) is + procedure Gather_Comments_End is begin - raise Internal_Error; - end Rename_Comments; + case Ctxt.State is + when State_Before => + -- Discard unattached comments. + declare + Fc : File_Comments_Table renames + Comments_Table.Table (Ctxt.File); + Last : Comment_Index; + begin + loop + Last := File_Comments_Tables.Last (Fc); + exit when Last = No_Comment_Index; + exit when Fc.Table (Last).N /= 0; + File_Comments_Tables.Decrement_Last (Fc); + end loop; + end; + when State_Block => + Comment_Gather_Existing; + when State_Line => + null; + end case; + Ctxt.State := State_Before; + end Gather_Comments_End; - procedure Sort_Comments_By_Node_1 (Fc : File_Comment_Record) + procedure Gather_Comments (N : Uns32) is + Rng : Comments_Range; + begin + Save_Comments (Rng); + Gather_Comments_Block (Rng, N); + end Gather_Comments; + + procedure Sort_Comments_By_Node + is + pragma Assert (Ctxt.File /= No_Source_File_Entry); + Fc : File_Comments_Table renames Comments_Table.Table (Ctxt.File); + function Lt (L, R : Positive) return Boolean is - Lc : Comment_Record renames Fc.Comments.Table (Comment_Index (L)); - Rc : Comment_Record renames Fc.Comments.Table (Comment_Index (R)); + Lc : Comment_Record renames Fc.Table (Comment_Index (L)); + Rc : Comment_Record renames Fc.Table (Comment_Index (R)); begin if Lc.N < Rc.N then return True; @@ -123,8 +274,8 @@ package body File_Comments is procedure Swap (P1 : Positive; P2 : Positive) is - L : Comment_Record renames Fc.Comments.Table (Comment_Index (P1)); - R : Comment_Record renames Fc.Comments.Table (Comment_Index (P2)); + L : Comment_Record renames Fc.Table (Comment_Index (P1)); + R : Comment_Record renames Fc.Table (Comment_Index (P2)); T : Comment_Record; begin T := L; @@ -135,16 +286,7 @@ package body File_Comments is procedure Sort is new Grt.Algos.Heap_Sort (Lt => Lt, Swap => Swap); begin - Sort (Natural (File_Comments_Tables.Last (Fc.Comments))); - end Sort_Comments_By_Node_1; - - procedure Sort_Comments_By_Node (File : Source_File_Entry) is - begin - if File > Comments_Table.Last then - -- No comments gathered, nothing to do. - return; - end if; - Sort_Comments_By_Node_1 (Comments_Table.Table (File)); + Sort (Natural (File_Comments_Tables.Last (Fc))); end Sort_Comments_By_Node; function Find_First_Comment (File : Source_File_Entry; N : Uns32) @@ -155,19 +297,19 @@ package body File_Comments is return No_Comment_Index; end if; declare - Fc : File_Comment_Record renames Comments_Table.Table (File); + Fc : File_Comments_Table renames Comments_Table.Table (File); Nd : Uns32; F, L, M : Comment_Index; begin F := File_Comments_Tables.First; - L := File_Comments_Tables.Last (Fc.Comments); + L := File_Comments_Tables.Last (Fc); while F <= L loop M := F + (L - F) / 2; - Nd := Fc.Comments.Table (M).N; + Nd := Fc.Table (M).N; if Nd = N then -- Found, but must return the first comment. while M > No_Comment_Index + 1 - and then Fc.Comments.Table (M - 1).N = N + and then Fc.Table (M - 1).N = N loop M := M - 1; end loop; @@ -188,10 +330,10 @@ package body File_Comments is Start, Last : out Source_Ptr) is pragma Assert (Comments_Table.Last >= File); - Fc : File_Comment_Record renames Comments_Table.Table (File); + Fc : File_Comments_Table renames Comments_Table.Table (File); begin - Start := Fc.Comments.Table (Idx).Start; - Last := Fc.Comments.Table (Idx).Last; + Start := Fc.Table (Idx).Start; + Last := Fc.Table (Idx).Last; end Get_Comment; function Get_Comment_Start (File : Source_File_Entry; @@ -217,10 +359,10 @@ package body File_Comments is is use File_Comments_Tables; pragma Assert (Comments_Table.Last >= File); - Fc : File_Comment_Record renames Comments_Table.Table (File); + Fc : File_Comments_Table renames Comments_Table.Table (File); begin - if Idx < Last (Fc.Comments) - and then Fc.Comments.Table (Idx + 1).N = Fc.Comments.Table (Idx).N + if Idx < Last (Fc) + and then Fc.Table (Idx + 1).N = Fc.Table (Idx).N then return Idx + 1; else diff --git a/src/file_comments.ads b/src/file_comments.ads index aa1f3806c..0afc4fcbd 100644 --- a/src/file_comments.ads +++ b/src/file_comments.ads @@ -14,56 +14,58 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. --- All the variables declared in this package are set by Parse_Option function --- and can by read as soon as the command line is parsed. --- --- Since the names are not prefixed, this package is expected to be with'ed --- but not to be use'd. - with Types; use Types; with Dyn_Tables; with Tables; package File_Comments is + -- To be called at begin/end of scan to initialize the context. + -- TODO: nested context ? + procedure Comment_Init_Scan (File : Source_File_Entry); + procedure Comment_Close_Scan; + -- Add a comment for FILE. -- This procedure is called from a scanner when a comment is scanned. -- -- For a line comment, START is the position of the token that starts the -- comment (the '--' in vhdl). LAST is the position of the last character -- of the comment (before the new line). - procedure Add_Comment (File : Source_File_Entry; - Start, Last : Source_Ptr); + -- LINE_START is the start of the current line (to detect comments in + -- the same line as a node). + procedure Add_Comment (Start, Last : Source_Ptr; + Line_Start : Source_Ptr); - -- Discard unassigned comments ? - procedure Discard_Comments (File : Source_File_Entry); + -- A newline (after a comment) has been scanned. + -- If this is a blank line, comments before the blank line are attached + -- to the previous node. + procedure Comment_Newline (Line_Start : Source_Ptr); - type Comments_Range_Type is private; + type Comments_Range is private; -- Save comments recently scanned and not yet gathered. - procedure Save_Comments (File : Source_File_Entry; - Rng : out Comments_Range_Type); + procedure Save_Comments (Rng : out Comments_Range); -- Assign node N to the saved RNG comments. -- This procedure is called by the parser when a node that could be -- annotated with a comment is parsed. - procedure Gather_Comments (File : Source_File_Entry; - Rng : Comments_Range_Type; - N : Uns32); + procedure Gather_Comments_Block (Rng : Comments_Range; + N : Uns32); + procedure Gather_Comments_Line (Rng : Comments_Range; + Pos : Source_Ptr; + N : Uns32); -- Assign node N to the last comments scanned. -- Identical to Save_Comments followed by above Gather_Comments. - procedure Gather_Comments (File : Source_File_Entry; - N : Uns32); + procedure Gather_Comments (N : Uns32); - -- Reassign comments to node N. - procedure Rename_Comments (File : Source_File_Entry; - Prev : Uns32; - N : Uns32); + -- To be called at the end of a lexical block. + -- Assign last comments to the block (if any). + procedure Gather_Comments_End; -- Sort comments; to be done once all comments have been gathered and -- before searching comments. -- Discard unassigned comments ? - procedure Sort_Comments_By_Node (File : Source_File_Entry); + procedure Sort_Comments_By_Node; type Comment_Index is new Nat32; No_Comment_Index : constant Comment_Index := 0; @@ -90,7 +92,7 @@ package File_Comments is Idx : Comment_Index) return Comment_Index; private - type Comments_Range_Type is record + type Comments_Range is record -- Range of saved comments. First, Last : Comment_Index; end record; @@ -104,21 +106,46 @@ private N : Uns32; end record; + type Comment_State is + ( + -- Keep comments, to be attached. + -- This is the initial state. + State_Before, + + -- Comments until the first newline are attached to LAST_NODE. + State_Block, + + -- If the next comment is on the same line, it will be attached to + -- LAST_NODE, and so will be the next comments. + State_Line + ); + + type Comment_Context is record + -- Current file. + File : Source_File_Entry; + + -- Current state. + State : Comment_State; + + -- Next unassigned comment. + Next : Comment_Index; + + -- Node to attach for next comments. + Last_Node : Uns32; + + Line_Start : Source_Ptr; + end record; + package File_Comments_Tables is new Dyn_Tables (Table_Component_Type => Comment_Record, Table_Index_Type => Comment_Index, Table_Low_Bound => 1); - type File_Comment_Record is record - -- Table of comments for a file. - Comments : File_Comments_Tables.Instance; - -- Next unassigned comment. - Next : Comment_Index; - end record; + subtype File_Comments_Table is File_Comments_Tables.Instance; -- Table of comments, indexed by files. package Comments_Table is new Tables - (Table_Component_Type => File_Comment_Record, + (Table_Component_Type => File_Comments_Table, Table_Index_Type => Source_File_Entry, Table_Low_Bound => No_Source_File_Entry + 1, Table_Initial => 8); diff --git a/src/vhdl/vhdl-comments.adb b/src/vhdl/vhdl-comments.adb index a1cc2e7bb..d8c64610e 100644 --- a/src/vhdl/vhdl-comments.adb +++ b/src/vhdl/vhdl-comments.adb @@ -21,24 +21,28 @@ -- but not to be use'd. with Files_Map; - -with Vhdl.Scanner; use Vhdl.Scanner; +with Vhdl.Scanner; package body Vhdl.Comments is - procedure Save_Comments (Rng : out Comments_Range_Type) is + procedure Gather_Comments_Block (Rng : Comments_Range; N : Iir) is begin - Save_Comments (Get_Current_Source_File, Rng); - end Save_Comments; + Gather_Comments_Block (Rng, Uns32 (N)); + end Gather_Comments_Block; - procedure Gather_Comments (Rng : Comments_Range_Type; N : Iir) is + procedure Gather_Comments_Block (N : Iir) is begin - Gather_Comments (Get_Current_Source_File, Rng, Uns32 (N)); - end Gather_Comments; + Gather_Comments (Uns32 (N)); + end Gather_Comments_Block; - procedure Gather_Comments (N : Iir) is + procedure Gather_Comments_Line (N : Iir) + is + Coord : Source_Coord_Type; + Rng : Comments_Range; begin - Gather_Comments (Get_Current_Source_File, Uns32 (N)); - end Gather_Comments; + Save_Comments (Rng); + Coord := Scanner.Get_Current_Coord; + Gather_Comments_Line (Rng, Coord.Line_Pos, Uns32 (N)); + end Gather_Comments_Line; function Find_First_Comment (File : Source_File_Entry; N : Node) return Comment_Index diff --git a/src/vhdl/vhdl-comments.ads b/src/vhdl/vhdl-comments.ads index 82d469284..4c4106b37 100644 --- a/src/vhdl/vhdl-comments.ads +++ b/src/vhdl/vhdl-comments.ads @@ -27,11 +27,19 @@ with Vhdl.Nodes; use Vhdl.Nodes; package Vhdl.Comments is -- Save comments and attached them to a node. - procedure Save_Comments (Rng : out Comments_Range_Type); - procedure Gather_Comments (Rng : Comments_Range_Type; N : Iir); + procedure Gather_Comments_Block (Rng : Comments_Range; N : Iir); - -- Attach previously scanned comments to node N. - procedure Gather_Comments (N : Iir); + -- General rule: + -- Previous unattached comments are attached to node N. + -- Previous attached comments from the last empty line are attached to N. + -- + -- For Gather_Comments_Block: the following comments until an empty line + -- will be attached to node N too. + -- For Gather_Comments_Line: if there is a comment on the same line, it + -- is attached to node N and so are the following comments until an + -- empty line. + procedure Gather_Comments_Block (N : Iir); + procedure Gather_Comments_Line (N : Iir); -- Return the first comment attached to node N. FILE must be the file -- of N. diff --git a/src/vhdl/vhdl-formatters.adb b/src/vhdl/vhdl-formatters.adb index b40615f99..03c72dbaa 100644 --- a/src/vhdl/vhdl-formatters.adb +++ b/src/vhdl/vhdl-formatters.adb @@ -846,9 +846,12 @@ package body Vhdl.Formatters is is use Format_Disp_Ctxt; Sfe : constant Source_File_Entry := Get_Design_File_Source (F); + Prev_Flag_Gather_Comments : constant Boolean := + Flags.Flag_Gather_Comments; begin Scanner.Flag_Comment := True; Scanner.Flag_Newline := True; + Flags.Flag_Gather_Comments := False; Set_File (Sfe); Scan; @@ -859,6 +862,7 @@ package body Vhdl.Formatters is Close_File; Scanner.Flag_Comment := False; Scanner.Flag_Newline := False; + Flags.Flag_Gather_Comments := Prev_Flag_Gather_Comments; Append_Eof (Ctxt); end Format_Init; diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index 38063b45b..421a08edc 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -18,7 +18,7 @@ with Std_Names; use Std_Names; with Flags; use Flags; with Str_Table; with Errorout; use Errorout; -with File_Comments; +with File_Comments; use File_Comments; with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils; with Vhdl.Tokens; use Vhdl.Tokens; @@ -1718,7 +1718,7 @@ package body Vhdl.Parse is -- Comments for the interface. if Flag_Gather_Comments then - Gather_Comments (First); + Gather_Comments_Line (First); end if; if Current_Token = Tok_Identifier then @@ -2586,7 +2586,7 @@ package body Vhdl.Parse is -- Comments for the enumeration literal. if Flag_Gather_Comments then - Gather_Comments (Enum_Lit); + Gather_Comments_Line (Enum_Lit); end if; -- LRM93 3.1.1 @@ -2928,7 +2928,7 @@ package body Vhdl.Parse is -- Comments attached to the first element. if Flag_Gather_Comments then - Gather_Comments (First); + Gather_Comments_Line (First); end if; -- Scan ':'. @@ -3159,7 +3159,7 @@ package body Vhdl.Parse is -- Comments attached to the type. if Flag_Gather_Comments then - Gather_Comments (Decl); + Gather_Comments_Line (Decl); end if; Def := Parse_Enumeration_Type_Definition (Parent); @@ -3207,7 +3207,7 @@ package body Vhdl.Parse is -- Comments attached to the record. if Flag_Gather_Comments then - Gather_Comments (Decl); + Gather_Comments_Block (Decl); end if; Def := Parse_Record_Type_Definition; @@ -3268,7 +3268,7 @@ package body Vhdl.Parse is -- Comments attached to the type. if Flag_Gather_Comments then - Gather_Comments (Decl); + Gather_Comments_Line (Decl); end if; end if; Set_Identifier (Decl, Ident); @@ -4310,7 +4310,7 @@ package body Vhdl.Parse is -- Comments attached to the object. if Flag_Gather_Comments then - Gather_Comments (Object); + Gather_Comments_Line (Object); end if; Scan_Identifier (Object); @@ -5737,7 +5737,7 @@ package body Vhdl.Parse is -- Comments after 'entity' but before the first generic or port are -- attached to the entity. if Flag_Gather_Comments then - Gather_Comments (Res); + Gather_Comments_Block (Res); end if; Parse_Generic_Port_Clauses (Res); @@ -8461,7 +8461,7 @@ package body Vhdl.Parse is -- Comments for the subprogram. if Flag_Gather_Comments then - Gather_Comments (Subprg); + Gather_Comments_Line (Subprg); end if; case Current_Token is @@ -8564,14 +8564,14 @@ package body Vhdl.Parse is Res: Iir; Sensitivity_List : Iir_List; Start_Loc, Begin_Loc, End_Loc : Location_Type; - Comments_Rng : File_Comments.Comments_Range_Type; + Comments : Comments_Range; begin Start_Loc := Get_Token_Location; -- Attach comments now, as 'process' may appear alone, followed -- by a comment for the next declaration. if Flag_Gather_Comments then - Save_Comments (Comments_Rng); + File_Comments.Save_Comments (Comments); end if; -- Skip 'process' @@ -8582,7 +8582,7 @@ package body Vhdl.Parse is -- Comments for the process. if Flag_Gather_Comments then - Gather_Comments (Comments_Rng, Res); + Gather_Comments_Block (Comments, Res); end if; -- Skip '(' @@ -8606,7 +8606,7 @@ package body Vhdl.Parse is -- Comments for the process. if Flag_Gather_Comments then - Gather_Comments (Comments_Rng, Res); + Gather_Comments_Block (Comments, Res); end if; end if; @@ -10596,6 +10596,12 @@ package body Vhdl.Parse is -- Skip 'architecture'. Scan; + -- Comments after 'architecture' but before the first declaration are + -- attached to the architecture. + if Flag_Gather_Comments then + Gather_Comments_Block (Res); + end if; + -- Identifier. Scan_Identifier (Res); @@ -10607,14 +10613,14 @@ package body Vhdl.Parse is -- Skip 'is'. Expect_Scan (Tok_Is); - -- Comments after 'architecture' but before the first declaration are - -- attached to the architecture. + Parse_Declarative_Part (Res, Res); + + -- Comments just before the 'begin' are attached to the last declaration + -- or the architecture (if no declarations). if Flag_Gather_Comments then - Gather_Comments (Res); + Gather_Comments_End; end if; - Parse_Declarative_Part (Res, Res); - -- Skip 'begin'. Begin_Loc := Get_Token_Location; Expect_Scan (Tok_Begin); @@ -11107,7 +11113,7 @@ package body Vhdl.Parse is -- Comments after 'context' but before the first clause are attached -- to the context. if Flag_Gather_Comments then - Gather_Comments (Res); + Gather_Comments_Block (Res); end if; Parse_Configuration_Declarative_Part (Res); @@ -11199,8 +11205,10 @@ package body Vhdl.Parse is -- package_header -- LRM08 -- package_declarative_part -- END [ PACKAGE ] [ PACKAGE_simple_name ] ; - function Parse_Package_Declaration - (Parent : Iir; Id : Name_Id; Loc : Location_Type) return Iir + function Parse_Package_Declaration (Parent : Iir; + Id : Name_Id; + Loc : Location_Type; + Comments : Comments_Range) return Iir is Res: Iir_Package_Declaration; End_Loc : Location_Type; @@ -11213,7 +11221,7 @@ package body Vhdl.Parse is -- Comments after 'package' but before the first declaration are -- attached to the package. if Flag_Gather_Comments then - Gather_Comments (Res); + Gather_Comments_Block (Comments, Res); end if; if Current_Token = Tok_Generic then @@ -11225,6 +11233,12 @@ package body Vhdl.Parse is End_Loc := Get_Token_Location; + -- Comments just before the 'end' are attached to the last declaration + -- or the package (if no declarations). + if Flag_Gather_Comments then + Gather_Comments_End; + end if; + -- Skip 'end' Expect_Scan (Tok_End); @@ -11358,6 +11372,7 @@ package body Vhdl.Parse is Id : Name_Id; Res : Iir; Start_Loc : Location_Type; + Comments : Comments_Range; begin -- Skip 'package' Start_Loc := Get_Token_Location; @@ -11380,6 +11395,10 @@ package body Vhdl.Parse is Expect (Tok_Identifier); end if; + if Flag_Gather_Comments then + File_Comments.Save_Comments (Comments); + end if; + -- Skip 'is'. Expect_Scan (Tok_Is); @@ -11387,7 +11406,7 @@ package body Vhdl.Parse is Res := Parse_Package_Instantiation_Declaration (Parent, Id, Loc); -- Note: there is no 'end' in instantiation. else - Res := Parse_Package_Declaration (Parent, Id, Loc); + Res := Parse_Package_Declaration (Parent, Id, Loc, Comments); end if; end if; @@ -11679,7 +11698,7 @@ package body Vhdl.Parse is -- Comments after 'context' but before the first clause are attached -- to the context. if Flag_Gather_Comments then - Gather_Comments (Decl); + Gather_Comments_Block (Decl); end if; Parse_Context_Clause (Decl); @@ -11802,7 +11821,7 @@ package body Vhdl.Parse is -- Attach comments to the design unit. if Flag_Gather_Comments then - Gather_Comments (Res); + Gather_Comments_Block (Res); end if; Parse_Context_Clause (Res); @@ -11849,6 +11868,10 @@ package body Vhdl.Parse is Res : Iir_Design_File; Design, Last_Design : Iir_Design_Unit; begin + if Flag_Gather_Comments then + File_Comments.Comment_Init_Scan (Get_Current_Source_File); + end if; + -- The first token. pragma Assert (Current_Token = Tok_Invalid); Scan; @@ -11872,7 +11895,8 @@ package body Vhdl.Parse is end loop; if Flag_Gather_Comments then - File_Comments.Sort_Comments_By_Node (Get_Current_Source_File); + File_Comments.Sort_Comments_By_Node; + File_Comments.Comment_Close_Scan; end if; if Last_Design = Null_Iir then diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb index 13115cc22..c77bef029 100644 --- a/src/vhdl/vhdl-prints.adb +++ b/src/vhdl/vhdl-prints.adb @@ -1615,6 +1615,8 @@ package body Vhdl.Prints is is Next_Decl : Iir; begin + Start_Node (Ctxt, Decl); + Start_Hbox (Ctxt); case Get_Kind (Decl) is when Iir_Kind_Variable_Declaration => diff --git a/src/vhdl/vhdl-scanner.adb b/src/vhdl/vhdl-scanner.adb index cee853792..5f7b735f2 100644 --- a/src/vhdl/vhdl-scanner.adb +++ b/src/vhdl/vhdl-scanner.adb @@ -2062,12 +2062,17 @@ package body Vhdl.Scanner is end Scan_Block_Comment; -- Get a new token. - procedure Scan is + procedure Scan + is + -- If true, newlines must be reported for comments. + Comment_Report_Newline : Boolean; begin if Current_Token /= Tok_Invalid then Current_Context.Prev_Token := Current_Token; end if; + Comment_Report_Newline := False; + Current_Context.Prev_Pos := Pos; << Again >> null; @@ -2095,6 +2100,9 @@ package body Vhdl.Scanner is Pos := Pos + 1; goto Again; when LF => + if Comment_Report_Newline then + Comment_Newline (Current_Context.Line_Pos); + end if; Scan_LF_Newline; if Flag_Newline then Current_Token := Tok_Newline; @@ -2102,6 +2110,9 @@ package body Vhdl.Scanner is end if; goto Again; when CR => + if Comment_Report_Newline then + Comment_Newline (Current_Context.Line_Pos); + end if; Scan_CR_Newline; if Flag_Newline then Current_Token := Tok_Newline; @@ -2165,8 +2176,11 @@ package body Vhdl.Scanner is end loop; if Flag_Gather_Comments then - Add_Comment (Current_Context.Source_File, - Current_Context.Token_Pos, Pos - 1); + Add_Comment (Current_Context.Token_Pos, Pos - 1, + Current_Context.Line_Pos); + -- Following newlines will be reported so that a blank + -- line is detected. + Comment_Report_Newline := True; end if; if Flag_Comment then diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index 56312701b..3eccac5e0 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -178,6 +178,8 @@ package body Vhdl.Sem_Lib is is use Vhdl.Scanner; Design_File : constant Iir_Design_File := Get_Design_File (Design_Unit); + Prev_Flag_Gather_Comments : constant Boolean := + Flags.Flag_Gather_Comments; Fe : Source_File_Entry; Line, Off: Natural; Pos: Source_Ptr; @@ -225,10 +227,15 @@ package body Vhdl.Sem_Lib is Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); Set_Current_Position (Pos + Source_Ptr (Off)); + Flags.Flag_Gather_Comments := False; + -- Parse Scan; Res := Vhdl.Parse.Parse_Design_Unit; Close_File; + + Flags.Flag_Gather_Comments := Prev_Flag_Gather_Comments; + if Res = Null_Iir then raise Compilation_Error; end if; |