From d2990978f76425b736e01c936e878048e4801f65 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 9 Jan 2021 08:38:26 +0100 Subject: vhdl: rework formatter engine, add 'ghdl fmt' command --- src/ghdldrv/ghdlprint.adb | 127 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 104 insertions(+), 23 deletions(-) (limited to 'src/ghdldrv') 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 (""); - Disp_Text; - Put (""); when Html_Css => Put (""); - 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 (""); + when Html_Css => Put (""); 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); -- cgit v1.2.3