diff options
Diffstat (limited to 'src/vhdl/vhdl-formatters.adb')
-rw-r--r-- | src/vhdl/vhdl-formatters.adb | 207 |
1 files changed, 206 insertions, 1 deletions
diff --git a/src/vhdl/vhdl-formatters.adb b/src/vhdl/vhdl-formatters.adb index 170f2a4e3..d65105a73 100644 --- a/src/vhdl/vhdl-formatters.adb +++ b/src/vhdl/vhdl-formatters.adb @@ -83,6 +83,7 @@ package body Vhdl.Formatters is procedure Close_Hbox (Ctxt : in out Format_Ctxt); procedure Start_Vbox (Ctxt : in out Format_Ctxt); procedure Close_Vbox (Ctxt : in out Format_Ctxt); + procedure Valign (Ctxt : in out Format_Ctxt; Point : Valign_Type); procedure Disp_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type); procedure Start_Lit (Ctxt : in out Format_Ctxt; Tok : Token_Type); procedure Disp_Char (Ctxt : in out Format_Ctxt; C : Character); @@ -127,6 +128,7 @@ package body Vhdl.Formatters is Etok_Close_Vbox : constant Etoken_Type := Etok_Last + 2; Etok_Set_Vbox : constant Etoken_Type := Etok_Last + 3; Etok_No_Indent : constant Etoken_Type := Etok_Last + 4; + Etok_Valign : constant Etoken_Type := Etok_Last + 5; procedure Append_Eof (Ctxt : in out Format_Ctxt); procedure Read_Token (Ctxt : Format_Ctxt; @@ -342,6 +344,13 @@ package body Vhdl.Formatters is end loop; end Skip_Spaces; + procedure Valign (Ctxt : in out Format_Ctxt; Point : Valign_Type) is + begin + if Ctxt.Enable then + Append_Token (Ctxt, Etok_Valign, Valign_Type'Pos (Point)); + end if; + end Valign; + procedure Start_Hbox (Ctxt : in out Format_Ctxt) is begin Ctxt.Hnum := Ctxt.Hnum + 1; @@ -538,6 +547,8 @@ package body Vhdl.Formatters is Indent := Col * Indentation + 1; when Etok_No_Indent => Extra_Indent := False; + when Etok_Valign => + null; when others => raise Internal_Error; end case; @@ -548,6 +559,180 @@ package body Vhdl.Formatters is end loop; end Reindent; + -- Realign some token. + -- For objects declarations of the same region, the colon (:), the subtype + -- indication and the default value will be aligned on the same column. + procedure Realign (Ctxt : in out Format_Disp_Ctxt.Format_Ctxt; + Vbox : in out Natural) + is + use Format_Disp_Ctxt; + + type Valign_Natural is array (Valign_Type) of Natural; + type Valign_Boolean is array (Valign_Type) of Boolean; + + -- Maximum offset relative to previous alignment. + Vpos : Valign_Natural; + + -- True when the realignment was done in the current line. Used to + -- discard same alignment marker that appears later. + Vdone : Valign_Boolean; + + I : Natural; + Etok : Etoken_Type; + Tok : Token_Type; + Col : Natural; + Skip : Natural; + + Valign : Valign_Type; + + Diff_Col : Integer; + Cum_Col : Integer; + Prev_Col : Integer; + begin + I := Vbox; + + Vpos := (others => 0); + Vdone := (others => False); + Diff_Col := 0; + + -- First pass: compute the positions + loop + Read_Token (Ctxt, I, Etok, Col); + + if Etok <= Etok_Last then + Tok := Token_Type'Val (Etok); + case Tok is + when Tok_Eof => + exit; + when Tok_Invalid => + raise Internal_Error; + when Tok_Newline => + -- Restart positions. + Vdone := (others => False); + Prev_Col := 0; + I := I + 1; + when Token_Source_Type + | Tok_Block_Comment_Text => + I := I + 3; + when Tok_First_Delimiter .. Token_Type'Last + | Tok_Block_Comment_Start + | Tok_Block_Comment_End => + I := I + 1; + end case; + else + case Etok is + when Etok_Start_Vbox => + -- Nested vbox + I := I + 1; + Realign (Ctxt, I); + when Etok_Close_Vbox => + exit; + when Etok_Set_Vbox => + I := I + 1; + when Etok_No_Indent => + I := I + 1; + when Etok_Valign => + -- Ok, the serious work. + Valign := Valign_Type'Val (Col); + if not Vdone (Valign) then + -- The first presence on this line. + -- Read position of the next token. + Read_Token (Ctxt, I + 1, Etok, Col); + pragma Assert (Etok <= Etok_Last); + Vdone (Valign) := True; + Diff_Col := Col - Prev_Col; + if Vpos (Valign) < Diff_Col then + Vpos (Valign) := Diff_Col; + end if; + Prev_Col := Col; + end if; + I := I + 1; + when others => + raise Internal_Error; + end case; + end if; + end loop; + + -- Second pass: adjust the offsets + I := Vbox; + Vdone := (others => False); + Diff_Col := 0; + Skip := 0; + Cum_Col := 0; + + loop + Read_Token (Ctxt, I, Etok, Col); + + if Etok <= Etok_Last then + Tok := Token_Type'Val (Etok); + case Tok is + when Tok_Eof => + Vbox := I; + exit; + when Tok_Invalid => + raise Internal_Error; + when Tok_Newline => + Vdone := (others => False); + Diff_Col := 0; + Cum_Col := 0; + I := I + 1; + when Token_Source_Type + | Tok_Block_Comment_Text => + if Skip = 0 then + Write_Token (Ctxt, I, Col + Diff_Col); + end if; + I := I + 3; + when Tok_First_Delimiter .. Token_Type'Last + | Tok_Block_Comment_Start + | Tok_Block_Comment_End => + if Skip = 0 then + Write_Token (Ctxt, I, Col + Diff_Col); + end if; + I := I + 1; + end case; + else + case Etok is + when Etok_Start_Vbox => + -- Nested vbox + Skip := Skip + 1; + when Etok_Close_Vbox => + if Skip = 0 then + Vbox := I + 1; + exit; + else + Skip := Skip - 1; + end if; + when Etok_Set_Vbox => + null; + when Etok_No_Indent => + null; + when Etok_Valign => + -- Ok, the serious work. + if Skip = 0 then + Valign := Valign_Type'Val (Col); + if Vpos (Valign) /= 0 and then not Vdone (Valign) then + Vdone (Valign) := True; + Cum_Col := Cum_Col + Vpos (Valign); + Read_Token (Ctxt, I + 1, Etok, Col); + Diff_Col := Cum_Col - Col; + end if; + end if; + when others => + raise Internal_Error; + end case; + I := I + 1; + end if; + end loop; + end Realign; + + procedure Realign (Ctxt : in out Format_Disp_Ctxt.Format_Ctxt) + is + I : Natural; + begin + I := Format_Disp_Ctxt.Token_Table.First; + Realign (Ctxt, I); + end Realign; + type IO_Printer_Ctxt is new Format_Disp_Ctxt.Printer_Ctxt with null record; procedure Put (Ctxt : in out IO_Printer_Ctxt; C : Character) is @@ -595,12 +780,16 @@ package body Vhdl.Formatters is Put ("V"); when Etok_No_Indent => Put ("B"); + when Etok_Valign => + Put ("A"); when others => raise Internal_Error; end case; end if; - Put ('@'); + Put (':'); Put_Int32 (Nat32 (Col)); + Put ('@'); + Put_Int32 (Nat32 (I - 1)); end; end if; @@ -677,6 +866,7 @@ package body Vhdl.Formatters is procedure Format (F : Iir_Design_File; Level : Format_Level; + Flag_Realign : Boolean; First_Line : Positive := 1; Last_Line : Positive := Positive'Last) is @@ -689,11 +879,25 @@ package body Vhdl.Formatters is if Level > Format_None then Reindent (Ctxt, Level = Format_Space); end if; + + if Flag_Realign then + Realign (Ctxt); + end if; + Reprint (Ctxt, Prnt); Free (Ctxt); end Format; + procedure Dump_Fmt (Ctxt : Format_Disp_Ctxt.Format_Ctxt) + is + Prnt : IO_Printer_Ctxt; + begin + Reprint (Ctxt, Prnt); + end Dump_Fmt; + + pragma Unreferenced (Dump_Fmt); + function Allocate_Handle return Vstring_Acc is begin return new Grt.Vstrings.Vstring; @@ -743,6 +947,7 @@ package body Vhdl.Formatters is Prnt := (Format_Disp_Ctxt.Printer_Ctxt with Handle); Reindent (Ctxt, False); + Realign (Ctxt); Reprint (Ctxt, Prnt); Free (Ctxt); |