vhdl: rework formatter engine, add 'ghdl fmt' command

1 files changed, 104 insertions, 23 deletions

diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 79d20c68d..cd2407443 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -19,6 +19,7 @@ with Ada.Characters.Latin_1;
 with Ada.Text_IO; use Ada.Text_IO;
 with GNAT.Directory_Operations;
 with GNAT.OS_Lib; use GNAT.OS_Lib;
+
 with Tables;
 with Types; use Types;
 with Flags;
@@ -27,21 +28,23 @@ with Files_Map;
 with Libraries;
 with Options; use Options;
 with Errorout; use Errorout;
+with Version;
+
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Tokens;
 with Vhdl.Scanner;
 with Vhdl.Parse;
 with Vhdl.Canon;
-with Version;
 with Vhdl.Xrefs;
 with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
-with Ghdlmain; use Ghdlmain;
-with Ghdllocal; use Ghdllocal;
 with Vhdl.Prints;
-with Vhdl.Formatters;
+with Vhdl.Formatters; use Vhdl.Formatters;
 with Vhdl.Elocations;
 
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
 package body Ghdlprint is
    type Html_Format_Type is (Html_2, Html_Css);
    Html_Format : Html_Format_Type := Html_2;
@@ -371,16 +374,41 @@ package body Ghdlprint is
                Line := Line + 1;
                Disp_Ln;
             when Tok_Line_Comment
-              | Tok_Block_Comment =>
+              | Tok_Block_Comment_Start =>
                Disp_Spaces;
                case Html_Format is
                   when Html_2 =>
                      Put ("<font color=green>");
-                     Disp_Text;
-                     Put ("</font>");
                   when Html_Css =>
                      Put ("<tt>");
-                     Disp_Text;
+               end case;
+               Disp_Text;
+               if Current_Token = Tok_Block_Comment_Start then
+                  loop
+                     Scan_Block_Comment;
+                     Bef_Tok := Get_Token_Position;
+                     Aft_Tok := Get_Position;
+                     case Current_Token is
+                        when Tok_Newline =>
+                           New_Line;
+                           Line := Line + 1;
+                           Disp_Ln;
+                        when Tok_Eof =>
+                           exit;
+                        when Tok_Block_Comment_Text =>
+                           Disp_Text;
+                        when Tok_Block_Comment_End =>
+                           Disp_Text;
+                           exit;
+                        when others =>
+                           raise Internal_Error;
+                     end case;
+                  end loop;
+               end if;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("</font>");
+                  when Html_Css =>
                      Put ("</tt>");
                end case;
             when Tok_Mod .. Tok_Vunit =>
@@ -450,10 +478,13 @@ package body Ghdlprint is
               | Tok_Integer
               | Tok_Integer_Letter
               | Tok_Real
-              | Tok_Equal .. Tok_Slash
-              | Tok_Invalid =>
+              | Tok_Equal .. Tok_Slash =>
                Disp_Spaces;
                Disp_Text;
+            when Tok_Invalid
+              | Tok_Block_Comment_Text
+              | Tok_Block_Comment_End =>
+               raise Internal_Error;
          end case;
          Last_Tok := Aft_Tok;
          Prev_Tok := Current_Token;
@@ -976,7 +1007,7 @@ package body Ghdlprint is
    type Command_Reprint is new Command_Lib with record
       Flag_Sem : Boolean := True;
       Flag_Format : Boolean := False;
-      Flag_Indent : Boolean := False;
+      Level : Format_Level := Format_Indent;
       Flag_Force : Boolean := False;
       First_Line : Positive := 1;
       Last_Line : Positive := Positive'Last;
@@ -1019,14 +1050,6 @@ package body Ghdlprint is
       if Option = "--no-sem" then
          Cmd.Flag_Sem := False;
          Res := Option_Ok;
-      elsif Option = "--format" then
-         Cmd.Flag_Format := True;
-         Cmd.Flag_Indent := False;
-         Res := Option_Ok;
-      elsif Option = "--indent" then
-         Cmd.Flag_Format := False;
-         Cmd.Flag_Indent := True;
-         Res := Option_Ok;
       elsif Option = "--force" then
          Cmd.Flag_Force := True;
          Res := Option_Ok;
@@ -1107,7 +1130,7 @@ package body Ghdlprint is
             end if;
 
             Next_Unit := Get_Chain (Unit);
-            if not (Cmd.Flag_Format or Cmd.Flag_Indent)
+            if not Cmd.Flag_Format
               and then (Errorout.Nbr_Errors = 0 or Cmd.Flag_Force)
             then
                Vhdl.Prints.Disp_Vhdl (Unit);
@@ -1127,14 +1150,71 @@ package body Ghdlprint is
          end if;
 
          if Cmd.Flag_Format then
-            Vhdl.Formatters.Format (Design_File);
-         elsif Cmd.Flag_Indent then
-            Vhdl.Formatters.Indent (Design_File,
+            Vhdl.Formatters.Format (Design_File,
+                                    Cmd.Level,
                                     Cmd.First_Line, Cmd.Last_Line);
          end if;
       end loop;
    end Perform_Action;
 
+   --  Command Format
+   type Command_Format is new Command_Reprint with null record;
+   function Decode_Command (Cmd : Command_Format; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Format) return String;
+   procedure Decode_Option (Cmd : in out Command_Format;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_State);
+   procedure Perform_Action (Cmd : in out Command_Format;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Format; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "fmt"
+        or else Name = "--format";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Format) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "fmt [OPTS] FILEs"
+        & ASCII.LF & "  Format FILEs"
+        & ASCII.LF & "  alias: --format";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Format;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_State)
+   is
+      pragma Assert (Option'First = 1);
+   begin
+      if Option = "--level=indent" then
+         Cmd.Level := Format_Indent;
+         Res := Option_Ok;
+      elsif Option = "--level=none" then
+         Cmd.Level := Format_None;
+         Res := Option_Ok;
+      elsif Option = "--level=space" then
+         Cmd.Level := Format_Space;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Reprint (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Format;
+                             Args : Argument_List) is
+   begin
+      Cmd.Flag_Format := True;
+      Perform_Action (Command_Reprint (Cmd), Args);
+   end Perform_Action;
+
    --  Command compare tokens.
    type Command_Compare_Tokens is new Command_Lib with null record;
    function Decode_Command (Cmd : Command_Compare_Tokens; Name : String)
@@ -1892,6 +1972,7 @@ package body Ghdlprint is
       Register_Command (new Command_Chop);
       Register_Command (new Command_Lines);
       Register_Command (new Command_Reprint);
+      Register_Command (new Command_Format);
       Register_Command (new Command_Compare_Tokens);
       Register_Command (new Command_PP_Html);
       Register_Command (new Command_Xref_Html);