From 400603edd33141740197f17e831b0a0560c9d3fe Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 2 Jun 2019 07:48:10 +0200 Subject: vhdl-formatters: Use vstrings to format into a string. --- src/vhdl/vhdl-formatters.adb | 147 +++++++++++++++++++++++++++++++++++-------- src/vhdl/vhdl-formatters.ads | 12 ++++ 2 files changed, 134 insertions(+), 25 deletions(-) (limited to 'src') diff --git a/src/vhdl/vhdl-formatters.adb b/src/vhdl/vhdl-formatters.adb index e9b9cb849..9749a3f07 100644 --- a/src/vhdl/vhdl-formatters.adb +++ b/src/vhdl/vhdl-formatters.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with Ada.Unchecked_Deallocation; with Types; use Types; with Files_Map; with Simple_IO; @@ -57,13 +58,7 @@ package body Vhdl.Formatters is end Check_Token; package Format_Disp_Ctxt is - type Format_Ctxt is new Disp_Ctxt with record - Vnum : Natural; - Hnum : Natural; - Prev_Tok : Token_Type; - Sfe : Source_File_Entry; - Source : File_Buffer_Acc; - end record; + type Format_Ctxt is new Disp_Ctxt with private; procedure Init (Ctxt : out Format_Ctxt; Sfe : Source_File_Entry); procedure Start_Hbox (Ctxt : in out Format_Ctxt); @@ -75,6 +70,14 @@ package body Vhdl.Formatters is procedure Disp_Char (Ctxt : in out Format_Ctxt; C : Character); procedure Close_Lit (Ctxt : in out Format_Ctxt); private + type Format_Ctxt is new Disp_Ctxt with record + Vnum : Natural; + Hnum : Natural; + Prev_Tok : Token_Type; + Sfe : Source_File_Entry; + Source : File_Buffer_Acc; + end record; + procedure Disp_Newline (Ctxt : in out Format_Ctxt); procedure Disp_Indent (Ctxt : in out Format_Ctxt); procedure Put (Ctxt : in out Format_Ctxt; C : Character); @@ -264,7 +267,6 @@ package body Vhdl.Formatters is Vnum : Natural; Hnum : Natural; Hfirst : Boolean; -- First token in the hbox. - Prev_Tok : Token_Type; Last_Tok : Source_Ptr; Col : Natural; Sfe : Source_File_Entry; @@ -280,6 +282,7 @@ package body Vhdl.Formatters is procedure Start_Lit (Ctxt : in out Indent_Ctxt; Tok : Token_Type); procedure Disp_Char (Ctxt : in out Indent_Ctxt; C : Character) is null; procedure Close_Lit (Ctxt : in out Indent_Ctxt) is null; + procedure Put (Ctxt : in out Indent_Ctxt; C : Character); private procedure Sync (Ctxt : in out Indent_Ctxt; Tok : Token_Type); end Indent_Disp_Ctxt; @@ -290,13 +293,25 @@ package body Vhdl.Formatters is Ctxt := (Vnum => 0, Hnum => 0, Hfirst => False, - Prev_Tok => Tok_Newline, Last_Tok => Source_Ptr_Org, Col => 0, Sfe => Sfe, Source => Files_Map.Get_File_Source (Sfe)); + + Scanner.Flag_Comment := True; + Scanner.Flag_Newline := True; + + Set_File (Sfe); + Scan; end Init; + procedure Put (Ctxt : in out Indent_Ctxt; C : Character) + is + pragma Unreferenced (Ctxt); + begin + Simple_IO.Put (C); + end Put; + procedure Disp_Spaces (Ctxt : in out Indent_Ctxt) is use Files_Map; @@ -312,8 +327,8 @@ package body Vhdl.Formatters is if Ctxt.Hnum > 0 and not Ctxt.Hfirst then Indent := Indent + 1; end if; - for I in 1 .. Indent loop - Simple_IO.Put (" "); + for I in 1 .. 2 * Indent loop + Put (Indent_Ctxt'Class (Ctxt), ' '); end loop; Ctxt.Col := 2 * Indent; else @@ -326,11 +341,11 @@ package body Vhdl.Formatters is N_Col := Ctxt.Col + Tab_Stop; N_Col := N_Col - N_Col mod Tab_Stop; while Ctxt.Col < N_Col loop - Simple_IO.Put (' '); + Put (Indent_Ctxt'Class (Ctxt), ' '); Ctxt.Col := Ctxt.Col + 1; end loop; else - Simple_IO.Put (' '); + Put (Indent_Ctxt'Class (Ctxt), ' '); Ctxt.Col := Ctxt.Col + 1; end if; P := P + 1; @@ -346,7 +361,7 @@ package body Vhdl.Formatters is begin P := Get_Token_Position; while P < Aft_Tok loop - Simple_IO.Put (Ctxt.Source (P)); + Put (Indent_Ctxt'Class (Ctxt), Ctxt.Source (P)); Ctxt.Col := Ctxt.Col + 1; P := P + 1; end loop; @@ -359,7 +374,7 @@ package body Vhdl.Formatters is when Tok_Eof => raise Internal_Error; when Tok_Newline => - Simple_IO.New_Line; + Put (Indent_Ctxt'Class (Ctxt), ASCII.LF); Ctxt.Col := 0; when Tok_Line_Comment | Tok_Block_Comment => @@ -426,19 +441,101 @@ package body Vhdl.Formatters is end Start_Lit; end Indent_Disp_Ctxt; - procedure Indent (F : Iir_Design_File) - is - use Indent_Disp_Ctxt; - Sfe : constant Source_File_Entry := Get_Design_File_Source (F); - Ctxt : Indent_Ctxt; + package Indent_Vstrings_Ctxt is + use Grt.Vstrings; + use Grt.Types; + + type Vstring_Ctxt is new Indent_Disp_Ctxt.Indent_Ctxt with private; + + procedure Init (Ctxt : out Vstring_Ctxt; + Handle : Vstring_Acc; + Sfe : Source_File_Entry); + procedure Put (Ctxt : in out Vstring_Ctxt; C : Character); + private + type Vstring_Ctxt is new Indent_Disp_Ctxt.Indent_Ctxt with record + Hand : Vstring_Acc; + end record; + end Indent_Vstrings_Ctxt; + + package body Indent_Vstrings_Ctxt is + procedure Init (Ctxt : out Vstring_Ctxt; + Handle : Vstring_Acc; + Sfe : Source_File_Entry) is + begin + Indent_Disp_Ctxt.Init (Indent_Disp_Ctxt.Indent_Ctxt (Ctxt), Sfe); + Ctxt.Hand := Handle; + end Init; + + procedure Put (Ctxt : in out Vstring_Ctxt; C : Character) is + begin + Append (Ctxt.Hand.all, C); + end Put; + end Indent_Vstrings_Ctxt; + + function Allocate_Handle return Vstring_Acc is begin - Scanner.Flag_Comment := True; - Scanner.Flag_Newline := True; + return new Grt.Vstrings.Vstring; + end Allocate_Handle; - Set_File (Sfe); - Scan; + function Get_Length (Handle : Vstring_Acc) return Natural is + begin + return Grt.Vstrings.Length (Handle.all); + end Get_Length; - Init (Ctxt, Sfe); + function Get_C_String (Handle : Vstring_Acc) + return Grt.Types.Ghdl_C_String is + begin + return Grt.Vstrings.Get_C_String (Handle.all); + end Get_C_String; + + procedure Free (Handle : Vstring_Acc) + is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Grt.Vstrings.Vstring, Vstring_Acc); + Handle1 : Vstring_Acc; + begin + Grt.Vstrings.Free (Handle.all); + Handle1 := Handle; + Deallocate (Handle1); + end Free; + + procedure Indent_String (F : Iir_Design_File; Handle : Vstring_Acc) + is + use Indent_Vstrings_Ctxt; + Sfe : constant Source_File_Entry := Get_Design_File_Source (F); + Ctxt : Vstring_Ctxt; + begin + Init (Ctxt, Handle, Sfe); Prints.Disp_Vhdl (Ctxt, F); + end Indent_String; + + procedure Indent (F : Iir_Design_File) is + begin + if False then + declare + use Indent_Disp_Ctxt; + Sfe : constant Source_File_Entry := Get_Design_File_Source (F); + Ctxt : Indent_Ctxt; + begin + Init (Ctxt, Sfe); + Prints.Disp_Vhdl (Ctxt, F); + end; + else + declare + use Grt.Types; + Handle : Vstring_Acc; + Res : Ghdl_C_String; + Len : Natural; + begin + Handle := Allocate_Handle; + Indent_String (F, Handle); + Res := Get_C_String (Handle); + Len := Get_Length (Handle); + Simple_IO.Put (Res (1 .. Len)); + Free (Handle); + end; + end if; end Indent; + + end Vhdl.Formatters; diff --git a/src/vhdl/vhdl-formatters.ads b/src/vhdl/vhdl-formatters.ads index ce651c136..e072b1bd2 100644 --- a/src/vhdl/vhdl-formatters.ads +++ b/src/vhdl/vhdl-formatters.ads @@ -16,6 +16,8 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with Grt.Vstrings; +with Grt.Types; with Vhdl.Nodes; use Vhdl.Nodes; package Vhdl.Formatters is @@ -24,4 +26,14 @@ package Vhdl.Formatters is -- Reindent the file. procedure Indent (F : Iir_Design_File); + + type Vstring_Acc is access Grt.Vstrings.Vstring; + + procedure Indent_String (F : Iir_Design_File; Handle : Vstring_Acc); + + function Allocate_Handle return Vstring_Acc; + function Get_Length (Handle : Vstring_Acc) return Natural; + function Get_C_String (Handle : Vstring_Acc) + return Grt.Types.Ghdl_C_String; + procedure Free (Handle : Vstring_Acc); end Vhdl.Formatters; -- cgit v1.2.3