vhdl-formatters: add realignment

4 files changed, 234 insertions, 6 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);
diff --git a/src/vhdl/vhdl-formatters.ads b/src/vhdl/vhdl-formatters.ads
index 86c7c60e3..414fac73e 100644
--- a/src/vhdl/vhdl-formatters.ads
+++ b/src/vhdl/vhdl-formatters.ads
@@ -35,12 +35,9 @@ package Vhdl.Formatters is
      );
 
    --  Format/pretty print the file F.
-   --  If FLAG_REINDENT is true, lines are reindented.  Otherwise the output is
-   --  the same as the input except keywords are converted to lower case.
-   --  If FLAG_RESPACE is true (which implies FLAG_REINDENT), spaces between
-   --   tokens are adjusted.
    procedure Format (F : Iir_Design_File;
                      Level : Format_Level;
+                     Flag_Realign : Boolean;
                      First_Line : Positive := 1;
                      Last_Line : Positive := Positive'Last);
 
diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb
index 047870a0f..d79a8c1e1 100644
--- a/src/vhdl/vhdl-prints.adb
+++ b/src/vhdl/vhdl-prints.adb
@@ -1161,6 +1161,7 @@ package body Vhdl.Prints is
       Default: constant Iir := Get_Default_Value (Obj);
    begin
       if Default /= Null_Iir then
+         Valign (Ctxt, Valign_Assign);
          Disp_Token (Ctxt, Tok_Assign);
          Print (Ctxt, Default);
       end if;
@@ -1171,10 +1172,12 @@ package body Vhdl.Prints is
    is
       Ind : constant Iir := Get_Subtype_Indication (Inter);
    begin
+      Valign (Ctxt, Valign_Colon);
       Disp_Token (Ctxt, Tok_Colon);
       if Get_Has_Mode (Inter) then
          Disp_Mode (Ctxt, Get_Mode (Inter));
       end if;
+      Valign (Ctxt, Valign_Typemark);
       if Ind = Null_Iir then
          --  For implicit subprogram
          Disp_Type (Ctxt, Get_Type (Inter));
@@ -1636,7 +1639,9 @@ package body Vhdl.Prints is
          Disp_Token (Ctxt, Tok_Comma);
          Disp_Name_Of (Ctxt, Next_Decl);
       end loop;
+      Valign (Ctxt, Valign_Colon);
       Disp_Token (Ctxt, Tok_Colon);
+      Valign (Ctxt, Valign_Typemark);
       Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Decl));
       if Get_Kind (Decl) = Iir_Kind_Signal_Declaration then
          Disp_Signal_Kind (Ctxt, Decl);
@@ -1697,7 +1702,7 @@ package body Vhdl.Prints is
       end if;
 
       Inter := Get_Interface_Declaration_Chain (Subprg);
-      Disp_Interface_Chain (Ctxt, Inter, False);
+      Disp_Interface_Chain (Ctxt, Inter, True);
 
       case Get_Kind (Subprg) is
          when Iir_Kind_Function_Declaration
@@ -5038,6 +5043,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 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);
       procedure Disp_Char (Ctxt : in out Simple_Ctxt; C : Character);
@@ -5092,6 +5098,11 @@ package body Vhdl.Prints is
          Ctxt.Vnum := Ctxt.Vnum - 1;
       end Close_Vbox;
 
+      procedure Valign (Ctxt : in out Simple_Ctxt; Point : Valign_Type) is
+      begin
+         null;
+      end Valign;
+
       procedure Disp_Space (Ctxt : in out Simple_Ctxt; Tok : Token_Type)
       is
          Prev_Tok : constant Token_Type := Ctxt.Prev_Tok;
diff --git a/src/vhdl/vhdl-prints.ads b/src/vhdl/vhdl-prints.ads
index 285d1354e..e0b1e6653 100644
--- a/src/vhdl/vhdl-prints.ads
+++ b/src/vhdl/vhdl-prints.ads
@@ -21,11 +21,26 @@ with Vhdl.Tokens; use Vhdl.Tokens;
 with PSL.Types; use PSL.Types;
 
 package Vhdl.Prints is
+   --  Vertical alignment
+   type Valign_Type is
+     (
+      --  Align the colon (which separates identifier from mode or subtype).
+      Valign_Colon,
+
+      --  Align the assign token (either for declarations or assignments).
+      Valign_Assign,
+
+      --  Align the subtype indication.
+      Valign_Typemark
+     );
+
    type Disp_Ctxt is abstract tagged null record;
    procedure Start_Hbox (Ctxt : in out Disp_Ctxt) is abstract;
    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;
+   procedure Valign (Ctxt : in out Disp_Ctxt; Point : Valign_Type)
+     is abstract;
    procedure Disp_Token (Ctxt : in out Disp_Ctxt; Tok : Token_Type)
       is abstract;
    procedure Start_Lit (Ctxt : in out Disp_Ctxt; Tok : Token_Type)