aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2023-01-26 18:14:16 +0100
committerTristan Gingold <tgingold@free.fr>2023-01-26 21:56:32 +0100
commitd5a56477c79d0ad8de146547554233dd62be36e8 (patch)
treef02a3934cf35a2a92d953689a4a108812eb1640e /src/vhdl
parent1c95bef128de8c1fbddf93ac61bb6ffaf1574f4a (diff)
downloadghdl-d5a56477c79d0ad8de146547554233dd62be36e8.tar.gz
ghdl-d5a56477c79d0ad8de146547554233dd62be36e8.tar.bz2
ghdl-d5a56477c79d0ad8de146547554233dd62be36e8.zip
vhdl-prints: add Print_String
Move Vstring methods from formatters to prints.
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/vhdl-formatters.adb30
-rw-r--r--src/vhdl/vhdl-formatters.ads13
-rw-r--r--src/vhdl/vhdl-prints.adb131
-rw-r--r--src/vhdl/vhdl-prints.ads20
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;