-- VHDL regeneration from internal nodes.
-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <gnu.org/licenses>.
-- Re-print a tree as VHDL sources. Except for comments and parenthesis, the
-- 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 Types; use Types;
with Simple_IO;
with Flags; use Flags;
with Name_Table;
with Str_Table;
with Std_Names; use Std_Names;
with Files_Map;
with Vhdl.Types; use Vhdl.Types;
with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package;
with PSL.Priorities; use PSL.Priorities;
with PSL.Nodes; use PSL.Nodes;
with PSL.Prints;
with PSL.NFAs;
with PSL.Errors;
package body Vhdl.Prints is
-- If True, display extra parenthesis to make priority of operators
-- explicit.
Flag_Parenthesis : constant Boolean := False;
-- If set, disp after a string literal the type enclosed into brackets.
Flag_Disp_String_Literal_Type: constant Boolean := False;
-- If set, disp implicit declarations.
Flag_Implicit : constant Boolean := False;
procedure Disp_Type (Ctxt : in out Ctxt_Class; A_Type: Iir);
procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir);
procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir);
procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir);
procedure Disp_Concurrent_Statement_Chain
(Ctxt : in out Ctxt_Class; Parent: Iir);
procedure Disp_Simultaneous_Statement_Chain
(Ctxt : in out Ctxt_Class; Chain: Iir);
procedure Disp_Declaration_Chain
(Ctxt : in out Ctxt_Class; Parent : Iir);
procedure Disp_Process_Statement (Ctxt : in out Ctxt_Class; Process: Iir);
procedure Disp_Sequential_Statements
(Ctxt : in out Ctxt_Class; First : Iir);
procedure Disp_Choice (Ctxt : in out Ctxt_Class; Choice: in out Iir);
procedure Disp_Association_Chain (Ctxt : in out Ctxt_Class; Chain : Iir);
procedure Disp_Block_Configuration
(Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration);
procedure Disp_Subprogram_Declaration
(Ctxt : in out Ctxt_Class; Subprg: Iir; Implicit : Boolean := False);
procedure Disp_Binding_Indication
(Ctxt : in out Ctxt_Class; Bind : Iir);
procedure Disp_Subtype_Indication
(Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False);
procedure Disp_Subnature_Indication (Ctxt : in out Ctxt_Class; Ind : Iir);
procedure Disp_Parametered_Attribute
(Ctxt : in out Ctxt_Class; Name : Name_Id; Expr : Iir);
procedure Disp_String_Literal
(Ctxt : in out Ctxt_Class; Str : Iir; El_Type : Iir);
procedure Disp_Package_Declaration
(Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration);
procedure Disp_Package_Instantiation_Declaration
(Ctxt : in out Ctxt_Class; Decl: Iir);
procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir);
procedure Disp_Attribute_Name (Ctxt : in out Ctxt_Class; Attr : Iir);
procedure Print_Property (Ctxt : in out Ctxt_Class;
Prop : PSL_Node;
Parent_Prio : Priority := Prio_Lowest);
procedure Print_Sequence (Ctxt : in out Ctxt_Class;
Seq : PSL_Node;
Parent_Prio : Priority := Prio_Lowest);
procedure Disp_Int64 (Ctxt : in out Ctxt_Class; Val: Int64);
procedure Disp_Int32 (Ctxt : in out Ctxt_Class; Val: Iir_Int32);
procedure Disp_Fp64 (Ctxt : in out Ctxt_Class; Val: Fp64);
package OOB is
procedure Put (Str : String);
procedure New_Line;
end OOB;
package body OOB is
procedure Put (Str : String) is
begin
Simple_IO.Put_Err (Str);
end Put;
procedure Put (C : Character) is
begin
Put ((1 => C));
end Put;
procedure New_Line is
begin
Put (ASCII.LF);
end New_Line;
end OOB;
procedure Disp_Token (Ctxt : in out Ctxt_Class; Tok1, Tok2 : Token_Type) is
begin
Disp_Token (Ctxt, Tok1);
Disp_Token (Ctxt, Tok2);
end Disp_Token;
procedure Disp_Ident (Ctxt : in out Ctxt_Class; Id: Name_Id) is
begin
if Name_Table.Is_Character (Id) then
Start_Lit (Ctxt, Tok_Character);
Disp_Char (Ctxt, ''');
Disp_Char (Ctxt, Name_Table.Get_Character (Id));
Disp_Char (Ctxt, ''');
Close_Lit (Ctxt);
else
Start_Lit (Ctxt, Tok_Identifier);
if Id = Null_Identifier then
Disp_Str (Ctxt, "<anonymous>");
else
Disp_Str (Ctxt, Name_Table.Image (Id));
end if;
Close_Lit (Ctxt);
end if;
end Disp_Ident;
function Or_Else (L, R : Iir) return Iir is
begin
if L /= Null_Iir then
return L;
end if;
pragma Assert (R /= Null_Iir);
return R;
end Or_Else;
-- Disp a literal from the sources (so using exactely the same characters).
procedure Disp_From_Source
(Ctxt : in out Ctxt_Class;
Loc : Location_Type; Len : Int32; Tok : Token_Type)
is
use Files_Map;
pragma Assert (Len > 0);
File : Source_File_Entry;
Pos : Source_Ptr;
Buf : File_Buffer_Acc;
begin
Location_To_File_Pos (Loc, File, Pos);
Buf := Get_File_Source (File);
Start_Lit (Ctxt, Tok);
for I in 1 .. Len loop
Disp_Char (Ctxt, Buf (Pos));
Pos := Pos + 1;
end loop;
Close_Lit (Ctxt);
end Disp_From_Source;
procedure Disp_Identifier (Ctxt : in out Ctxt_Class; Node : Iir)
is
use Name_Table;
Id : constant Name_Id := Get_Identifier (Node);
Loc : constant Location_Type := Get_Location (Node);
begin
-- Try to display the one from the sources.
if Id /= Null_Identifier
and then not Is_Character (Id)
and then Loc /= No_Location
and then Loc /= Std_Package.Std_Location
then
Disp_From_Source
(Ctxt, Loc, Int32 (Get_Name_Length (Id)), Tok_Identifier);
else
Disp_Ident (Ctxt, Id);
end if;
end Disp_Identifier;
procedure Disp_Literal_From_Source
(Ctxt : in out Ctxt_Class; Lit : Iir; Tok : Token_Type) is
begin
Disp_From_Source
(Ctxt, Get_Location (Lit), Get_Literal_Length (Lit), Tok);
end Disp_Literal_From_Source;
procedure Disp_Function_Name (Ctxt : in out Ctxt_Class; Func: Iir)
is
use Name_Table;
Id : constant Name_Id := Get_Identifier (Func);
begin
case Id is
when Name_Id_Operators
| Name_Word_Operators
| Name_Logical_Operators
| Name_Xnor
| Name_Shift_Operators =>
Start_Lit (Ctxt, Tok_String);
Disp_Char (Ctxt, '"');
Disp_Str (Ctxt, Image (Id));
Disp_Char (Ctxt, '"');
Close_Lit (Ctxt);
when others =>
Disp_Ident (Ctxt, Id);
end case;
end Disp_Function_Name;
-- Disp the name of DECL.
procedure Disp_Name_Of (Ctxt : in out Ctxt_Class; Decl: Iir) is
begin
case Get_Kind (Decl) is
when Iir_Kind_Component_Declaration
| Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
| Iir_Kind_Configuration_Declaration
| Iir_Kind_Context_Declaration
| Iir_Kinds_Verification_Unit
| Iir_Kinds_Interface_Object_Declaration
| Iir_Kind_Interface_Terminal_Declaration
| Iir_Kind_Interface_Type_Declaration
| Iir_Kind_Constant_Declaration
| Iir_Kind_Signal_Declaration
| Iir_Kind_Guard_Signal_Declaration
| Iir_Kind_Anonymous_Signal_Declaration
| Iir_Kind_Variable_Declaration
| Iir_Kind_File_Declaration
| Iir_Kind_Type_Declaration
| Iir_Kind_Subtype_Declaration
| Iir_Kind_Element_Declaration
| Iir_Kind_Record_Element_Constraint
| Iir_Kind_Package_Declaration
| Iir_Kind_Object_Alias_Declaration
| Iir_Kind_Non_Object_Alias_Declaration
| Iir_Kind_Iterator_Declaration
| Iir_Kind_Library_Declaration
| Iir_Kind_Unit_Declaration
| Iir_Kind_Nature_Declaration
| Iir_Kind_Subnature_Declaration
| Iir_Kind_Terminal_Declaration
| Iir_Kinds_Quantity_Declaration
| Iir_Kind_Group_Template_Declaration
| Iir_Kind_Character_Literal
| Iir_Kinds_Process_Statement =>
Disp_Identifier (Ctxt, Decl);
when Iir_Kind_Anonymous_Type_Declaration =>
Start_Lit (Ctxt, Tok_Identifier);
Disp_Char (Ctxt, '<');
Disp_Str (Ctxt, Name_Table.Image (Get_Identifier (Decl)));
Disp_Char (Ctxt, '>');
Close_Lit (Ctxt);
when Iir_Kind_Function_Declaration =>
Disp_Function_Name (Ctxt, Decl);
when Iir_Kind_Procedure_Declaration =>
Disp_Identifier (Ctxt, Decl);
when Iir_Kind_Physical_Subtype_Definition
| Iir_Kind_Enumeration_Type_Definition
| Iir_Kind_Physical_Type_Definition
| Iir_Kind_Record_Type_Definition
| Iir_Kind_Protected_Type_Declaration =>
-- Used for 'end' DECL_NAME.
Disp_Identifier (Ctxt, Get_Type_Declarator (Decl));
when Iir_Kind_Record_Nature_Definition =>
Disp_Identifier (Ctxt, Get_Nature_Declarator (Decl));
when Iir_Kind_Component_Instantiation_Statement =>
Disp_Ident (Ctxt, Get_Label (Decl));
when Iir_Kind_Design_Unit =>
Disp_Name_Of (Ctxt, Get_Library_Unit (Decl));
when Iir_Kind_Enumeration_Literal
| Iir_Kind_Simple_Name =>
Disp_Identifier (Ctxt, Decl);
when Iir_Kind_Block_Statement
| Iir_Kind_If_Generate_Statement
| Iir_Kind_Case_Generate_Statement
| Iir_Kind_For_Generate_Statement
| Iir_Kind_Simultaneous_Procedural_Statement =>
Disp_Ident (Ctxt, Get_Label (Decl));
when Iir_Kind_Package_Body =>
Disp_Identifier (Ctxt, Decl);
when Iir_Kind_Procedure_Body
| Iir_Kind_Function_Body =>
Disp_Function_Name (Ctxt, Get_Subprogram_Specification (Decl));
when Iir_Kind_Protected_Type_Body =>
Disp_Identifier (Ctxt, Decl);
when others =>
Error_Kind ("disp_name_of", Decl);
end case;
end Disp_Name_Of;
procedure Disp_Name_Attribute
(Ctxt : in out Ctxt_Class; Attr : Iir; Name : Name_Id) is
begin
Print (Ctxt, Get_Prefix (Attr));
Disp_Token (Ctxt, Tok_Tick);
Disp_Ident (Ctxt, Name);
end Disp_Name_Attribute;
procedure Disp_Range (Ctxt : in out Ctxt_Class; Rng : Iir) is
begin
case Get_Kind (Rng) is
when Iir_Kind_Range_Expression =>
declare
Origin : constant Iir := Get_Range_Origin (Rng);
begin
if Dump_Origin_Flag and then Origin /= Null_Iir then
Print (Ctxt, Origin);
else
Print (Ctxt, Or_Else (Get_Left_Limit_Expr (Rng),
Get_Left_Limit (Rng)));
if Get_Direction (Rng) = Dir_To then
Disp_Token (Ctxt, Tok_To);
else
Disp_Token (Ctxt, Tok_Downto);
end if;
Print (Ctxt, Or_Else (Get_Right_Limit_Expr (Rng),
Get_Right_Limit (Rng)));
end if;
end;
when Iir_Kind_Range_Array_Attribute =>
Disp_Parametered_Attribute (Ctxt, Name_Range, Rng);
when Iir_Kind_Reverse_Range_Array_Attribute =>
Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Rng);
when Iir_Kind_Simple_Name
| Iir_Kind_Selected_Name
| Iir_Kind_Attribute_Name
| Iir_Kind_Parenthesis_Name =>
Print (Ctxt, Rng);
when others =>
Disp_Subtype_Indication (Ctxt, Rng);
-- Disp_Name_Of (Get_Type_Declarator (Decl));
end case;
end Disp_Range;
procedure Disp_After_End
(Ctxt : in out Ctxt_Class;
Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is
begin
if Get_End_Has_Reserved_Id (Decl) then
Disp_Token (Ctxt, Tok1);
if Tok2 /= Tok_Invalid then
Disp_Token (Ctxt, Tok2);
end if;
end if;
if Get_End_Has_Identifier (Decl) then
Disp_Name_Of (Ctxt, Decl);
end if;
end Disp_After_End;
procedure Disp_End_No_Close
(Ctxt : in out Ctxt_Class;
Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_End);
Disp_After_End (Ctxt, Decl, Tok1, Tok2);
end Disp_End_No_Close;
procedure Disp_End
(Ctxt : in out Ctxt_Class;
Decl : Iir; Tok1 : Token_Type; Tok2 : Token_Type := Tok_Invalid) is
begin
Disp_End_No_Close (Ctxt, Decl, Tok1, Tok2);
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
end Disp_End;
procedure Disp_End (Ctxt : in out Ctxt_Class; Tok1 : Token_Type) is
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_End);
Disp_Token (Ctxt, Tok1);
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
end Disp_End;
procedure Disp_End_Label_No_Close
(Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_End);
Disp_Token (Ctxt, Tok);
if Get_End_Has_Identifier (Stmt) then
Disp_Ident (Ctxt, Get_Label (Stmt));
end if;
Disp_Token (Ctxt, Tok_Semi_Colon);
end Disp_End_Label_No_Close;
procedure Disp_End_Label
(Ctxt : in out Ctxt_Class; Stmt : Iir; Tok : Token_Type) is
begin
Disp_End_Label_No_Close (Ctxt, Stmt, Tok);
Close_Hbox (Ctxt);
end Disp_End_Label;
procedure Disp_Use_Clause (Ctxt : in out Ctxt_Class; Clause: Iir_Use_Clause)
is
Name : Iir;
begin
Start_Hbox (Ctxt);
Disp_Token (Ctxt, Tok_Use);
Name := Clause;
loop
Print (Ctxt, Get_Selected_Name (Name));
Name := Get_Use_Clause_Chain (Name);
exit when Name = Null_Iir;
Disp_Token (Ctxt, Tok_Comma);
end loop;
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
end Disp_Use_Clause;
-- Disp the resolution function (if any) of type definition DEF.
procedure Disp_Resolution_Indication
(Ctxt : in out Ctxt_Class; Subtype_Def: Iir)
is
procedure Inner (Ind : Iir) is
begin
case Get_Kind (Ind) is
when Iir_Kinds_Denoting_Name =>
Print (Ctxt, Ind);
when Iir_Kind_Array_Element_Resolution =>
declare
Res : constant Iir := Get_Resolution_Indication (Ind);
begin
Disp_Token (Ctxt, Tok_Left_Paren);
if Is_Valid (Res) then
Inner (Res);
else
Print (Ctxt, Get_Resolution_Indication
(Get_Element_Subtype_Indication (Ind)));
end if;
Disp_Token (Ctxt, Tok_Right_Paren);
end;
when others =>
Error_Kind ("disp_resolution_indication", Ind);
end case;
end Inner;
Ind : Iir;
begin
case Get_Kind (Subtype_Def) is
when Iir_Kind_Access_Subtype_Definition =>
-- No resolution indication on access subtype.
return;
when others =>
Ind := Get_Resolution_Indication (Subtype_Def);
if Ind = Null_Iir then
-- No resolution indication.
return;
end if;
end case;
if False then
declare
Type_Mark : constant Iir := Get_Denoted_Type_Mark (Subtype_Def);
begin
if Get_Kind (Type_Mark) in Iir_Kinds_Subtype_Definition
and then Get_Resolution_Indication (Type_Mark) = Ind
then
-- Resolution indication was inherited from the type_mark.
return;
end if;
end;
end if;
Inner (Ind);
end Disp_Resolution_Indication;
procedure Disp_Element_Constraint
(Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir);
procedure Disp_Discrete_Range
(Ctxt : in out Ctxt_Class; Iterator: Iir) is
begin
if Get_Kind (Iterator) in Iir_Kinds_Subtype_Definition then
Disp_Subtype_Indication (Ctxt, Iterator);
else
Disp_Range (Ctxt, Iterator);
end if;
end Disp_Discrete_Range;
procedure Disp_Array_Sub_Definition_Indexes
(Ctxt : in out Ctxt_Class; Def : Iir)
is
Indexes : Iir_Flist;
Index : Iir;
begin
Indexes := Get_Index_Constraint_List (Def);
if Indexes = Null_Iir_Flist then
Indexes := Get_Index_Subtype_List (Def);
end if;
Disp_Token (Ctxt, Tok_Left_Paren);
for I in Flist_First .. Flist_Last (Indexes) loop
Index := Get_Nth_Element (Indexes, I);
if I /= 0 then
Disp_Token (Ctxt, Tok_Comma);
end if;
Disp_Discrete_Range (Ctxt, Index);
end loop;
Disp_Token (Ctxt, Tok_Right_Paren);
end Disp_Array_Sub_Definition_Indexes;
procedure Disp_Array_Element_Constraint
(Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) is
begin
if not Get_Has_Array_Constraint_Flag (Def)
and then not Get_Has_Element_Constraint_Flag (Def)
then
return;
end if;
if Get_Has_Array_Constraint_Flag (Def) then
if Get_Index_Constraint_List (Def) = Null_Iir_Flist then
Disp_Token (Ctxt, Tok_Left_Paren);
Disp_Token (Ctxt, Tok_Open);
Disp_Token (Ctxt, Tok_Right_Paren);
else
Disp_Array_Sub_Definition_Indexes (Ctxt, Def);
end if;
end if;
if Get_Has_Element_Constraint_Flag (Def) then
Disp_Element_Constraint (Ctxt, Get_Array_Element_Constraint (Def),
Get_Element_Subtype (Type_Mark));
end if;
end Disp_Array_Element_Constraint;
procedure Disp_Record_Element_Constraint
(Ctxt : in out Ctxt_Class; Def : Iir)
is
El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def);
El : Iir;
Has_El : Boolean := False;
begin
for I in Flist_First .. Flist_Last (El_List) loop
El := Get_Nth_Element (El_List, I);
if Get_Kind (El) = Iir_Kind_Record_Element_Constraint
and then Get_Parent (El) = Def
then
if Has_El then
Disp_Token (Ctxt, Tok_Comma);
else
Disp_Token (Ctxt, Tok_Left_Paren);
Has_El := True;
end if;
Disp_Name_Of (Ctxt, El);
Disp_Element_Constraint (Ctxt, Get_Type (El),
Get_Base_Type (Get_Type (El)));
end if;
end loop;
if Has_El then
Disp_Token (Ctxt, Tok_Right_Paren);
end if;
end Disp_Record_Element_Constraint;
procedure Disp_Element_Constraint
(Ctxt : in out Ctxt_Class; Def : Iir; Type_Mark : Iir) is
begin
case Get_Kind (Def) is
when Iir_Kind_Record_Subtype_Definition =>
Disp_Record_Element_Constraint (Ctxt, Def);
when Iir_Kind_Array_Subtype_Definition =>
Disp_Array_Element_Constraint (Ctxt, Def, Type_Mark);
when others =>
Error_Kind ("disp_element_constraint", Def);
end case;
end Disp_Element_Constraint;
procedure Disp_Tolerance_Opt (Ctxt : in out Ctxt_Class; N : Iir)
is
Tol : constant Iir := Get_Tolerance (N);
begin
if Tol /= Null_Iir then
Disp_Token (Ctxt, Tok_Tolerance);
Print (Ctxt, Tol);
end if;
end Disp_Tolerance_Opt;
procedure Disp_Subtype_Indication
(Ctxt : in out Ctxt_Class; Def : Iir; Full_Decl : Boolean := False)
is
Type_Mark : Iir;
Base_Type : Iir;
Decl : Iir;
begin
case Get_Kind (Def) is
when Iir_Kinds_Denoting_Name
| Iir_Kind_Subtype_Attribute
| Iir_Kind_Attribute_Name =>
Print (Ctxt, Def);
return;
when others =>
null;
end case;
Decl := Get_Type_Declarator (Def);
if not Full_Decl and then Decl /= Null_Iir then
Disp_Name_Of (Ctxt, Decl);
return;
end if;
-- Resolution function name.
Disp_Resolution_Indication (Ctxt, Def);
-- type mark.
Type_Mark := Get_Subtype_Type_Mark (Def);
if Type_Mark /= Null_Iir then
Print (Ctxt, Type_Mark);
Type_Mark := Get_Type (Type_Mark);
end if;
case Get_Kind (Def) is
when Iir_Kind_Array_Subtype_Definition =>
Disp_Array_Element_Constraint
(Ctxt, Def, Or_Else (Type_Mark, Def));
when Iir_Kind_Subtype_Definition =>
declare
Rng : constant Iir := Get_Range_Constraint (Def);
begin
if Rng /= Null_Iir then
Disp_Token (Ctxt, Tok_Range);
Print (Ctxt, Get_Range_Constraint (Def));
end if;
Disp_Tolerance_Opt (Ctxt, Def);
end;
when others =>
Base_Type := Get_Base_Type (Def);
case Get_Kind (Base_Type) is
when Iir_Kind_Integer_Type_Definition
| Iir_Kind_Enumeration_Type_Definition
| Iir_Kind_Floating_Type_Definition
| Iir_Kind_Physical_Type_Definition =>
if Type_Mark = Null_Iir
or else Get_Range_Constraint (Def)
/= Get_Range_Constraint (Type_Mark)
then
if Type_Mark /= Null_Iir then
Disp_Token (Ctxt, Tok_Range);
end if;
Print (Ctxt, Get_Range_Constraint (Def));
end if;
if Get_Kind (Base_Type) = Iir_Kind_Floating_Type_Definition
then
Disp_Tolerance_Opt (Ctxt, Def);
end if;
when Iir_Kind_Access_Type_Definition =>
declare
Des_Ind : constant Iir :=
Get_Designated_Subtype_Indication (Def);
begin
if Des_Ind /= Null_Iir then
pragma Assert (Get_Kind (Des_Ind)
= Iir_Kind_Array_Subtype_Definition);
Disp_Array_Element_Constraint
(Ctxt, Des_Ind, Get_Designated_Type (Base_Type));
end if;
end;
when Iir_Kind_Array_Type_Definition =>
Disp_Array_Element_Constraint
(Ctxt, Def, Or_Else (Type_Mark, Def));
when Iir_Kind_Record_Type_Definition =>
Disp_Record_Element_Constraint (Ctxt, Def);
when others =>
Error_Kind ("disp_subtype_indication", Base_Type);
end case;
end case;
end Disp_Subtype_Indication;
procedure Disp_Enumeration_Type_Definition
(Ctxt : in out Ctxt_Class; Def: Iir_Enumeration_Type_Definition)
is
Lits : constant Iir_Flist := Get_Enumeration_Literal_List (Def);
A_Lit: Iir;
begin
Disp_Token (Ctxt, Tok_Left_Paren);
for I in Flist_First .. Flist_Last (Lits) loop
A_Lit := Get_Nth_Element (Lits, I);
if I > 0 then
Disp_Token (Ctxt, Tok_Comma);
end if;
Disp_Name_Of (Ctxt, A_Lit);
end loop;
Disp_Token (Ctxt, Tok_Right_Paren);
end Disp_Enumeration_Type_Definition;
procedure Disp_Array_Definition_Indexes
(Ctxt : in out Ctxt_Class; Def: Iir)
is
Indexes : Iir_Flist;
Index: Iir;
begin
Indexes := Get_Index_Subtype_Definition_List (Def);
if Indexes = Null_Iir_Flist then
Indexes := Get_Index_Subtype_List (Def);
end if;
Disp_Token (Ctxt, Tok_Array, Tok_Left_Paren);
for I in Flist_First .. Flist_Last (Indexes) loop
Index := Get_Nth_Element (Indexes, I);
if I /= 0 then
Disp_Token (Ctxt, Tok_Comma);
end if;
Print (Ctxt, Index);
Disp_Token (Ctxt, Tok_Range, Tok_Box);
end loop;
Disp_Token (Ctxt, Tok_Right_Paren, Tok_Of);
end Disp_Array_Definition_Indexes;
procedure Disp_Array_Type_Definition
(Ctxt : in out Ctxt_Class; Def: Iir_Array_Type_Definition) is
begin
Disp_Array_Definition_Indexes (Ctxt, Def);
Disp_Subtype_Indication (Ctxt, Get_Element_Subtype_Indication (Def));
end Disp_Array_Type_Definition;
procedure Disp_Physical_Literal (Ctxt : in out Ctxt_Class; Lit: Iir)
is
Len : constant Int32 := Get_Literal_Length (Lit);
Unit : Iir;
begin
case Iir_Kinds_Physical_Literal (Get_Kind (Lit)) is
when Iir_Kind_Physical_Int_Literal =>
if Len /= 0 then
Disp_Literal_From_Source (Ctxt, Lit, Tok_Integer);
else
Disp_Int64 (Ctxt, Get_Value (Lit));
end if;
when Iir_Kind_Physical_Fp_Literal =>
if Len /= 0 then
Disp_Literal_From_Source (Ctxt, Lit, Tok_Real);
else
Disp_Fp64 (Ctxt, Get_Fp_Value (Lit));
end if;
end case;
Unit := Get_Unit_Name (Lit);
if Is_Valid (Unit) then
-- No unit in range_constraint of physical type declaration.
Print (Ctxt, Unit);
end if;
end Disp_Physical_Literal;
procedure Disp_Record_Type_Definition
(Ctxt : in out Ctxt_Class; Def: Iir_Record_Type_Definition)
is
List : constant Iir_Flist := Get_Elements_Declaration_List (Def);
El: Iir_Element_Declaration;
El_Subtype : Iir;
Reindent : Boolean;
begin
Disp_Token (Ctxt, Tok_Record);
Close_Hbox (Ctxt);
Reindent := True;
Start_Vbox (Ctxt);
for I in Flist_First .. Flist_Last (List) loop
El := Get_Nth_Element (List, I);
if Reindent then
El_Subtype := Get_Subtype_Indication (El);
Start_Hbox (Ctxt);
end if;
Disp_Identifier (Ctxt, El);
if Get_Has_Identifier_List (El) then
Disp_Token (Ctxt, Tok_Comma);
Reindent := False;
else
Disp_Token (Ctxt, Tok_Colon);
Disp_Subtype_Indication (Ctxt, Or_Else (El_Subtype,
Get_Type (El)));
Disp_Token (Ctxt, Tok_Semi_Colon);
Close_Hbox (Ctxt);
Reindent := True;
end if;
end loop;
Close_Vbox (Ctxt);
Disp_End_No_Close (Ctxt, Def, Tok_Record);
end Disp_Record_Type_Definition;
procedure Disp_Designator_List (Ctxt : in out Ctxt_Class; List: Iir_List)
is
El : Iir;
It : List_Iterator;
Is_First : Boolean;
begin
case List is
when Null_Iir_List =>
null;
when Iir_List_All =>
Disp_Token (Ctxt, Tok_All);