diff options
| -rw-r--r-- | src/vhdl/vhdl-formatters.adb | 30 | ||||
| -rw-r--r-- | src/vhdl/vhdl-formatters.ads | 13 | ||||
| -rw-r--r-- | src/vhdl/vhdl-prints.adb | 131 | ||||
| -rw-r--r-- | src/vhdl/vhdl-prints.ads | 20 |
4 files changed, 154 insertions, 40 deletions
diff --git a/src/vhdl/vhdl-formatters.adb b/src/vhdl/vhdl-formatters.adb index 03c72dbaa..172894fb8 100644 --- a/src/vhdl/vhdl-formatters.adb +++ b/src/vhdl/vhdl-formatters.adb @@ -14,7 +14,6 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -with Ada.Unchecked_Deallocation; with Ada.Unchecked_Conversion; with Types; use Types; @@ -28,6 +27,8 @@ with Vhdl.Tokens; use Vhdl.Tokens; with Vhdl.Scanner; use Vhdl.Scanner; with Vhdl.Prints; use Vhdl.Prints; +with Grt.Vstrings; + package body Vhdl.Formatters is -- Check token TOK with the one from the scanner. Deal with irregular -- cases. @@ -901,33 +902,6 @@ package body Vhdl.Formatters is pragma Unreferenced (Dump_Fmt); - function Allocate_Handle return Vstring_Acc is - begin - return new Grt.Vstrings.Vstring; - end Allocate_Handle; - - function Get_Length (Handle : Vstring_Acc) return Natural is - begin - return Grt.Vstrings.Length (Handle.all); - end Get_Length; - - 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 (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_Handle; - type Vstring_Printer_Ctxt is new Format_Disp_Ctxt.Printer_Ctxt with record Handle : Vstring_Acc; end record; diff --git a/src/vhdl/vhdl-formatters.ads b/src/vhdl/vhdl-formatters.ads index f2b7bf0a8..7def1ed7a 100644 --- a/src/vhdl/vhdl-formatters.ads +++ b/src/vhdl/vhdl-formatters.ads @@ -14,9 +14,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -with Grt.Vstrings; -with Grt.Types; with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Prints; package Vhdl.Formatters is type Format_Level is @@ -39,17 +38,9 @@ package Vhdl.Formatters is First_Line : Positive := 1; Last_Line : Positive := Positive'Last); - type Vstring_Acc is access Grt.Vstrings.Vstring; - -- Reindent all lines of F between [First_Line; Last_Line] to HANDLE. procedure Indent_String (F : Iir_Design_File; - Handle : Vstring_Acc; + Handle : Vhdl.Prints.Vstring_Acc; First_Line : Positive := 1; Last_Line : Positive := Positive'Last); - - 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 (Handle : Vstring_Acc); end Vhdl.Formatters; diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb index b0a9e34f6..28e0946e1 100644 --- a/src/vhdl/vhdl-prints.adb +++ b/src/vhdl/vhdl-prints.adb @@ -18,6 +18,8 @@ -- sequence of tokens displayed is the same as the sequence of tokens in the -- input file. If parenthesis are kept by the parser, the only differences -- are comments and layout. +with Ada.Unchecked_Deallocation; + with Types; use Types; with Simple_IO; with Flags; use Flags; @@ -1184,7 +1186,7 @@ package body Vhdl.Prints is -- For implicit subprogram Disp_Type (Ctxt, Get_Type (Inter)); else - Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Inter)); + Disp_Subtype_Indication (Ctxt, Ind); end if; if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then Disp_Signal_Kind (Ctxt, Inter); @@ -5380,4 +5382,131 @@ package body Vhdl.Prints is OOB.New_Line; end Disp_PSL_Expr; + package Vstring_Disp_Ctxt is + type Vstring_Ctxt is new Disp_Ctxt with record + Buf : Vstring_Acc; + + -- Previous token, to decided whether or not a blank must be added. + Prev_Tok : Token_Type; + end record; + + procedure Init (Ctxt : out Vstring_Ctxt; Buf : Vstring_Acc); + procedure Start_Hbox (Ctxt : in out Vstring_Ctxt) is null; + procedure Close_Hbox (Ctxt : in out Vstring_Ctxt) is null; + procedure Start_Vbox (Ctxt : in out Vstring_Ctxt) is null; + procedure Close_Vbox (Ctxt : in out Vstring_Ctxt) is null; + procedure Start_Node (Ctxt : in out Vstring_Ctxt; N : Iir) is null; + procedure Valign (Ctxt : in out Vstring_Ctxt; Point : Valign_Type) + is null; + procedure Disp_Token (Ctxt : in out Vstring_Ctxt; Tok : Token_Type); + procedure Start_Lit (Ctxt : in out Vstring_Ctxt; Tok : Token_Type); + procedure Disp_Char (Ctxt : in out Vstring_Ctxt; C : Character); + procedure Close_Lit (Ctxt : in out Vstring_Ctxt) is null; + private + procedure Put (Ctxt : in out Vstring_Ctxt; C : Character); + end Vstring_Disp_Ctxt; + + package body Vstring_Disp_Ctxt is + procedure Init (Ctxt : out Vstring_Ctxt; Buf : Vstring_Acc) is + begin + Ctxt := (Buf => Buf, + Prev_Tok => Tok_Newline); + end Init; + + procedure Put (Ctxt : in out Vstring_Ctxt; C : Character) is + begin + Grt.Vstrings.Append (Ctxt.Buf.all, C); + end Put; + + procedure Disp_Space (Ctxt : in out Vstring_Ctxt; Tok : Token_Type) + is + Prev_Tok : constant Token_Type := Ctxt.Prev_Tok; + begin + if Need_Space (Tok, Prev_Tok) then + Put (Ctxt, ' '); + end if; + Ctxt.Prev_Tok := Tok; + end Disp_Space; + + procedure Disp_Token (Ctxt : in out Vstring_Ctxt; Tok : Token_Type) is + begin + Disp_Space (Ctxt, Tok); + Disp_Str (Ctxt, Image (Tok)); + end Disp_Token; + + procedure Start_Lit (Ctxt : in out Vstring_Ctxt; Tok : Token_Type) is + begin + Disp_Space (Ctxt, Tok); + end Start_Lit; + + procedure Disp_Char (Ctxt : in out Vstring_Ctxt; C : Character) is + begin + Put (Ctxt, C); + end Disp_Char; + end Vstring_Disp_Ctxt; + + procedure Print_String (N : Iir; Buf : Vstring_Acc) + is + use Vstring_Disp_Ctxt; + Ctxt : Vstring_Ctxt; + begin + Init (Ctxt, Buf); + + case Get_Kind (N) is + when Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kinds_Source_Quantity_Declaration => + Disp_Object_Declaration (Ctxt, N); + when Iir_Kind_Type_Declaration => + Disp_Type_Declaration (Ctxt, N); + when Iir_Kind_Subtype_Declaration => + Disp_Subtype_Declaration (Ctxt, N); + when Iir_Kinds_Interface_Object_Declaration => + Disp_Interface_Class (Ctxt, N); + Disp_Name_Of (Ctxt, N); + -- FIXME: need first interface. + Disp_Interface_Mode_And_Type (Ctxt, N); + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Disp_Subprogram_Declaration (Ctxt, N, False); + when Iir_Kind_Element_Declaration => + Disp_Identifier (Ctxt, N); + Disp_Token (Ctxt, Tok_Colon); + Disp_Subtype_Indication + (Ctxt, Or_Else (Get_Subtype_Indication (N), Get_Type (N))); + when others => + null; + end case; + end Print_String; + + function Allocate_Handle return Vstring_Acc is + begin + return new Grt.Vstrings.Vstring; + end Allocate_Handle; + + function Get_Length (Handle : Vstring_Acc) return Natural is + begin + return Grt.Vstrings.Length (Handle.all); + end Get_Length; + + 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 (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_Handle; + end Vhdl.Prints; diff --git a/src/vhdl/vhdl-prints.ads b/src/vhdl/vhdl-prints.ads index c059ab695..b4f356fac 100644 --- a/src/vhdl/vhdl-prints.ads +++ b/src/vhdl/vhdl-prints.ads @@ -17,6 +17,8 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Vhdl.Tokens; use Vhdl.Tokens; with PSL.Types; use PSL.Types; +with Grt.Vstrings; +with Grt.Types; package Vhdl.Prints is -- Vertical alignment @@ -78,4 +80,22 @@ package Vhdl.Prints is -- Used for debugging. procedure Disp_Expression (Expr: Iir); procedure Disp_PSL_Expr (N : PSL_Node); + + -- Buffer of characters. + type Vstring_Acc is access Grt.Vstrings.Vstring; + + -- Allocate a buffer. + function Allocate_Handle return Vstring_Acc; + + -- Get the length of the buffer. + function Get_Length (Handle : Vstring_Acc) return Natural; + + -- Get the buffer as a C string. + function Get_C_String (Handle : Vstring_Acc) return Grt.Types.Ghdl_C_String; + + -- Free the buffer. + procedure Free_Handle (Handle : Vstring_Acc); + + -- Print node N into buffer BUF. + procedure Print_String (N : Iir; Buf : Vstring_Acc); end Vhdl.Prints; |