From 44cba3374a04d84b16c93a9e6867ddc4b8a3146c Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 20 Aug 2019 05:08:05 +0200 Subject: vhdl-prints: handle verification units. --- src/vhdl/vhdl-prints.adb | 1324 ++++++++++++++++++++++++---------------------- 1 file changed, 680 insertions(+), 644 deletions(-) (limited to 'src') diff --git a/src/vhdl/vhdl-prints.adb b/src/vhdl/vhdl-prints.adb index 6023cbfe5..697386f87 100644 --- a/src/vhdl/vhdl-prints.adb +++ b/src/vhdl/vhdl-prints.adb @@ -227,6 +227,7 @@ package body Vhdl.Prints is | Iir_Kind_Architecture_Body | Iir_Kind_Configuration_Declaration | Iir_Kind_Context_Declaration + | Iir_Kinds_Verification_Unit | Iir_Kinds_Interface_Object_Declaration | Iir_Kind_Interface_Type_Declaration | Iir_Kind_Constant_Declaration @@ -3342,321 +3343,6 @@ package body Vhdl.Prints is end if; end Disp_String_Literal; - procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir) - is - Orig : Iir; - begin - case Get_Kind (Expr) is - when Iir_Kind_Integer_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - if Get_Literal_Length (Expr) /= 0 then - Disp_Literal_From_Source (Ctxt, Expr, Tok_Integer); - else - Disp_Int64 (Ctxt, Get_Value (Expr)); - end if; - end if; - when Iir_Kind_Floating_Point_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - if Get_Literal_Length (Expr) /= 0 then - Disp_Literal_From_Source (Ctxt, Expr, Tok_Real); - else - Disp_Fp64 (Ctxt, Get_Fp_Value (Expr)); - end if; - end if; - when Iir_Kind_String_Literal8 => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - declare - Expr_Type : constant Iir := Get_Type (Expr); - El_Type : Iir; - begin - if Expr_Type /= Null_Iir then - El_Type := Get_Element_Subtype (Expr_Type); - else - El_Type := Null_Iir; - end if; - Disp_String_Literal (Ctxt, Expr, El_Type); - if Flag_Disp_String_Literal_Type or Flags.List_Verbose then - OOB.Put ("[type: "); - Disp_Type (Ctxt, Expr_Type); - OOB.Put ("]"); - end if; - end; - end if; - when Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Physical_Int_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Physical_Literal (Ctxt, Expr); - end if; - when Iir_Kind_Enumeration_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Name_Of (Ctxt, Expr); - end if; - when Iir_Kind_Overflow_Literal => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Start_Lit (Ctxt, Tok_Integer); - Disp_Str (Ctxt, "*OVERFLOW*"); - Close_Lit (Ctxt); - end if; - - when Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (Ctxt, Expr); - when Iir_Kind_Aggregate => - Disp_Aggregate (Ctxt, Expr); - when Iir_Kind_Null_Literal => - Disp_Token (Ctxt, Tok_Null); - when Iir_Kind_Simple_Aggregate => - Orig := Get_Literal_Origin (Expr); - if Dump_Origin_Flag and then Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Disp_Simple_Aggregate (Ctxt, Expr); - end if; - - when Iir_Kind_Attribute_Value => - Disp_Attribute_Value (Ctxt, Expr); - when Iir_Kind_Attribute_Name => - Disp_Attribute_Name (Ctxt, Expr); - - when Iir_Kind_Element_Declaration => - Disp_Name_Of (Ctxt, Expr); - - when Iir_Kind_Signal_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Iterator_Declaration => - Disp_Name_Of (Ctxt, Expr); - return; - when Iir_Kind_Reference_Name => - declare - Name : constant Iir := Get_Referenced_Name (Expr); - begin - if Is_Valid (Name) then - Print (Ctxt, Name); - else - Print (Ctxt, Get_Named_Entity (Expr)); - end if; - end; - - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (Ctxt, Expr); - when Iir_Kinds_Monadic_Operator => - Disp_Monadic_Operator (Ctxt, Expr); - when Iir_Kind_Function_Call => - Disp_Function_Call (Ctxt, Expr); - when Iir_Kind_Parenthesis_Expression => - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Expression (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Type_Conversion => - Print (Ctxt, Get_Type_Mark (Expr)); - Disp_Token (Ctxt, Tok_Left_Paren); - Print (Ctxt, Get_Expression (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Qualified_Expression => - declare - Qexpr : constant Iir := Get_Expression (Expr); - Has_Paren : constant Boolean := - Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression - or else Get_Kind (Qexpr) = Iir_Kind_Aggregate; - begin - Print (Ctxt, Get_Type_Mark (Expr)); - Disp_Token (Ctxt, Tok_Tick); - if not Has_Paren then - Disp_Token (Ctxt, Tok_Left_Paren); - end if; - Print (Ctxt, Qexpr); - if not Has_Paren then - Disp_Token (Ctxt, Tok_Right_Paren); - end if; - end; - when Iir_Kind_Allocator_By_Expression => - Disp_Token (Ctxt, Tok_New); - Print (Ctxt, Get_Expression (Expr)); - when Iir_Kind_Allocator_By_Subtype => - Disp_Token (Ctxt, Tok_New); - Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Expr)); - - when Iir_Kind_Indexed_Name => - Disp_Indexed_Name (Ctxt, Expr); - when Iir_Kind_Slice_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Range (Ctxt, Get_Suffix (Expr)); - Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Selected_Element => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot); - Disp_Name_Of (Ctxt, Get_Named_Entity (Expr)); - when Iir_Kind_Implicit_Dereference => - Print (Ctxt, Get_Prefix (Expr)); - - when Iir_Kind_Anonymous_Signal_Declaration => - declare - Act : constant Iir := Get_Expression (Expr); - begin - if Act /= Null_Iir then - -- There is still an expression, so the anonymous signal - -- was not yet declared. - Print (Ctxt, Act); - else - -- Cannot use Disp_Identifier as the identifier is not in - -- the sources. - Disp_Ident (Ctxt, Get_Identifier (Expr)); - end if; - end; - - when Iir_Kind_Left_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Left); - when Iir_Kind_Right_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Right); - when Iir_Kind_High_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_High); - when Iir_Kind_Low_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Low); - when Iir_Kind_Ascending_Type_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Ascending); - - when Iir_Kind_Stable_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Stable, Expr); - when Iir_Kind_Quiet_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Quiet, Expr); - when Iir_Kind_Delayed_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Delayed, Expr); - when Iir_Kind_Transaction_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Transaction); - when Iir_Kind_Event_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Event); - when Iir_Kind_Active_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Active); - when Iir_Kind_Driving_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Driving); - when Iir_Kind_Driving_Value_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Driving_Value); - when Iir_Kind_Last_Value_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Value); - when Iir_Kind_Last_Active_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Active); - when Iir_Kind_Last_Event_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Last_Event); - - when Iir_Kind_Pos_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Pos, Expr); - when Iir_Kind_Val_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Val, Expr); - when Iir_Kind_Succ_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Succ, Expr); - when Iir_Kind_Pred_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Pred, Expr); - when Iir_Kind_Leftof_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Leftof, Expr); - when Iir_Kind_Rightof_Attribute => - Disp_Parametered_Type_Attribute (Ctxt, Name_Rightof, Expr); - - when Iir_Kind_Length_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Length, Expr); - when Iir_Kind_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Range, Expr); - when Iir_Kind_Reverse_Range_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Expr); - when Iir_Kind_Left_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Left, Expr); - when Iir_Kind_Right_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Right, Expr); - when Iir_Kind_Low_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Low, Expr); - when Iir_Kind_High_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_High, Expr); - when Iir_Kind_Ascending_Array_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Ascending, Expr); - - when Iir_Kind_Image_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Image, Expr); - when Iir_Kind_Value_Attribute => - Disp_Parametered_Attribute (Ctxt, Name_Value, Expr); - when Iir_Kind_Simple_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Simple_Name); - when Iir_Kind_Instance_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Instance_Name); - when Iir_Kind_Path_Name_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Path_Name); - - when Iir_Kinds_Type_And_Subtype_Definition => - Disp_Type (Ctxt, Expr); - - when Iir_Kind_Range_Expression => - Disp_Range (Ctxt, Expr); - when Iir_Kind_Subtype_Definition => - Disp_Subtype_Indication (Ctxt, Expr); - - when Iir_Kind_Selected_By_All_Name - | Iir_Kind_Dereference => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot, Tok_All); - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal => - Disp_Identifier (Ctxt, Expr); - when Iir_Kind_Operator_Symbol => - Disp_Function_Name (Ctxt, Expr); - when Iir_Kind_Selected_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Token (Ctxt, Tok_Dot); - Disp_Function_Name (Ctxt, Expr); - when Iir_Kind_Parenthesis_Name => - Print (Ctxt, Get_Prefix (Expr)); - Disp_Association_Chain (Ctxt, Get_Association_Chain (Expr)); - when Iir_Kind_Base_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Base); - when Iir_Kind_Subtype_Attribute => - Disp_Name_Attribute (Ctxt, Expr, Name_Subtype); - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kinds_Interface_Object_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Group_Template_Declaration => - Disp_Name_Of (Ctxt, Expr); - - when Iir_Kind_Signature => - Disp_Signature (Ctxt, Expr); - - when Iir_Kind_Error => - declare - Orig : constant Iir := Get_Error_Origin (Expr); - begin - if Orig /= Null_Iir then - Print (Ctxt, Orig); - else - Error_Kind ("print/error", Expr); - end if; - end; - when others => - Error_Kind ("print", Expr); - end case; - end Print; - procedure Disp_Block_Header (Ctxt : in out Ctxt_Class; Header : Iir_Block_Header) is @@ -3964,390 +3650,740 @@ package body Vhdl.Prints is Disp_PSL_NFA (Get_PSL_NFA (Stmt)); end Disp_Psl_Restrict_Directive; - procedure Disp_Simple_Simultaneous_Statement - (Ctxt : in out Ctxt_Class; Stmt : Iir) is + procedure Disp_Simple_Simultaneous_Statement + (Ctxt : in out Ctxt_Class; Stmt : Iir) is + begin + Start_Hbox (Ctxt); + Disp_Label (Ctxt, Stmt); + Print (Ctxt, Get_Simultaneous_Left (Stmt)); + Disp_Token (Ctxt, Tok_Equal_Equal); + Print (Ctxt, Get_Simultaneous_Right (Stmt)); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Simple_Simultaneous_Statement; + + procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is + begin + case Get_Kind (Stmt) is + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + Disp_Concurrent_Simple_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + Disp_Concurrent_Selected_Signal_Assignment (Ctxt, Stmt); + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + Disp_Process_Statement (Ctxt, Stmt); + when Iir_Kind_Concurrent_Assertion_Statement => + Disp_Assertion_Statement (Ctxt, Stmt); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (Ctxt, Stmt); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + Disp_Procedure_Call (Ctxt, Stmt); + when Iir_Kind_Block_Statement => + Disp_Block_Statement (Ctxt, Stmt); + when Iir_Kind_If_Generate_Statement => + Disp_If_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_Case_Generate_Statement => + Disp_Case_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_For_Generate_Statement => + Disp_For_Generate_Statement (Ctxt, Stmt); + when Iir_Kind_Psl_Default_Clock => + Disp_Psl_Default_Clock (Ctxt, Stmt); + when Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Endpoint_Declaration => + Disp_Psl_Declaration (Ctxt, Stmt); + when Iir_Kind_Psl_Assert_Directive => + Disp_Psl_Assert_Directive (Ctxt, Stmt); + when Iir_Kind_Psl_Assume_Directive => + Disp_Psl_Assume_Directive (Ctxt, Stmt); + when Iir_Kind_Psl_Cover_Directive => + Disp_Psl_Cover_Directive (Ctxt, Stmt); + when Iir_Kind_Psl_Restrict_Directive => + Disp_Psl_Restrict_Directive (Ctxt, Stmt); + when Iir_Kind_Simple_Simultaneous_Statement => + Disp_Simple_Simultaneous_Statement (Ctxt, Stmt); + when others => + Error_Kind ("disp_concurrent_statement", Stmt); + end case; + end Disp_Concurrent_Statement; + + procedure Disp_Package_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration) + is + Header : constant Iir := Get_Package_Header (Decl); + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + if Header /= Null_Iir then + Disp_Generics (Ctxt, Header); + end if; + Disp_Declaration_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Decl, Tok_Package); + end Disp_Package_Declaration; + + procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package, Tok_Body); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is); + Close_Hbox (Ctxt); + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Decl); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Decl, Tok_Package, Tok_Body); + end Disp_Package_Body; + + procedure Disp_Package_Instantiation_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir) is + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Package); + Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Is, Tok_New); + Print (Ctxt, Get_Uninstantiated_Package_Name (Decl)); + Disp_Generic_Map_Aspect (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end Disp_Package_Instantiation_Declaration; + + procedure Disp_Binding_Indication (Ctxt : in out Ctxt_Class; Bind : Iir) + is + El : Iir; + begin + El := Get_Entity_Aspect (Bind); + if El /= Null_Iir then + Disp_Token (Ctxt, Tok_Use); + Disp_Entity_Aspect (Ctxt, El); + end if; + El := Get_Generic_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Disp_Generic_Map_Aspect (Ctxt, Bind); + end if; + El := Get_Port_Map_Aspect_Chain (Bind); + if El /= Null_Iir then + Disp_Port_Map_Aspect (Ctxt, Bind); + end if; + end Disp_Binding_Indication; + + procedure Disp_Component_Configuration + (Ctxt : in out Ctxt_Class; Conf : Iir_Component_Configuration) + is + Block : Iir_Block_Configuration; + Binding : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_For); + Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Conf)); + Disp_Token (Ctxt, Tok_Colon); + Print (Ctxt, Get_Component_Name (Conf)); + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Binding := Get_Binding_Indication (Conf); + if Binding /= Null_Iir then + Start_Hbox (Ctxt); + Disp_Binding_Indication (Ctxt, Binding); + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + end if; + Block := Get_Block_Configuration (Conf); + if Block /= Null_Iir then + Disp_Block_Configuration (Ctxt, Block); + end if; + Close_Vbox (Ctxt); + + Disp_End (Ctxt, Tok_For); + end Disp_Component_Configuration; + + procedure Disp_Configuration_Items + (Ctxt : in out Ctxt_Class; Conf : Iir_Block_Configuration) + is + El : Iir; + begin + El := Get_Configuration_Item_Chain (Conf); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Block_Configuration => + Disp_Block_Configuration (Ctxt, El); + when Iir_Kind_Component_Configuration => + Disp_Component_Configuration (Ctxt, El); + when Iir_Kind_Configuration_Specification => + -- This may be created by canon. + Disp_Configuration_Specification (Ctxt, El); + Disp_Token (Ctxt, Tok_End, Tok_For); + Disp_Token (Ctxt, Tok_Semi_Colon); + when others => + Error_Kind ("disp_configuration_item_list", El); + end case; + El := Get_Chain (El); + end loop; + end Disp_Configuration_Items; + + procedure Disp_Block_Configuration + (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration) + is + Spec : Iir; + begin + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_For); + Spec := Get_Block_Specification (Block); + case Get_Kind (Spec) is + when Iir_Kind_Block_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Architecture_Body => + Disp_Name_Of (Ctxt, Spec); + when Iir_Kind_Indexed_Name => + declare + Index_List : constant Iir_Flist := Get_Index_List (Spec); + begin + Disp_Name_Of (Ctxt, Get_Prefix (Spec)); + Disp_Token (Ctxt, Tok_Left_Paren); + if Index_List = Iir_Flist_Others then + Disp_Token (Ctxt, Tok_Others); + else + Print (Ctxt, Get_Nth_Element (Index_List, 0)); + end if; + Disp_Token (Ctxt, Tok_Right_Paren); + end; + when Iir_Kind_Slice_Name => + Disp_Name_Of (Ctxt, Get_Prefix (Spec)); + Disp_Token (Ctxt, Tok_Left_Paren); + Disp_Range (Ctxt, Get_Suffix (Spec)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Simple_Name + | Iir_Kind_Parenthesis_Name => + Print (Ctxt, Spec); + when others => + Error_Kind ("disp_block_configuration", Spec); + end case; + Close_Hbox (Ctxt); + + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Block); + Disp_Configuration_Items (Ctxt, Block); + Close_Vbox (Ctxt); + Disp_End (Ctxt, Tok_For); + end Disp_Block_Configuration; + + procedure Disp_Configuration_Declaration + (Ctxt : in out Ctxt_Class; Decl: Iir_Configuration_Declaration) is begin Start_Hbox (Ctxt); - Disp_Label (Ctxt, Stmt); - Print (Ctxt, Get_Simultaneous_Left (Stmt)); - Disp_Token (Ctxt, Tok_Equal_Equal); - Print (Ctxt, Get_Simultaneous_Right (Stmt)); - Disp_Token (Ctxt, Tok_Semi_Colon); + Disp_Token (Ctxt, Tok_Configuration); + Disp_Name_Of (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Of); + Print (Ctxt, Get_Entity_Name (Decl)); + Disp_Token (Ctxt, Tok_Is); Close_Hbox (Ctxt); - end Disp_Simple_Simultaneous_Statement; - procedure Disp_Concurrent_Statement (Ctxt : in out Ctxt_Class; Stmt: Iir) is - begin - case Get_Kind (Stmt) is - when Iir_Kind_Concurrent_Simple_Signal_Assignment => - Disp_Concurrent_Simple_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Disp_Concurrent_Selected_Signal_Assignment (Ctxt, Stmt); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - Disp_Process_Statement (Ctxt, Stmt); - when Iir_Kind_Concurrent_Assertion_Statement => - Disp_Assertion_Statement (Ctxt, Stmt); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (Ctxt, Stmt); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Disp_Procedure_Call (Ctxt, Stmt); - when Iir_Kind_Block_Statement => - Disp_Block_Statement (Ctxt, Stmt); - when Iir_Kind_If_Generate_Statement => - Disp_If_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_Case_Generate_Statement => - Disp_Case_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_For_Generate_Statement => - Disp_For_Generate_Statement (Ctxt, Stmt); - when Iir_Kind_Psl_Default_Clock => - Disp_Psl_Default_Clock (Ctxt, Stmt); - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Endpoint_Declaration => - Disp_Psl_Declaration (Ctxt, Stmt); - when Iir_Kind_Psl_Assert_Directive => - Disp_Psl_Assert_Directive (Ctxt, Stmt); - when Iir_Kind_Psl_Assume_Directive => - Disp_Psl_Assume_Directive (Ctxt, Stmt); - when Iir_Kind_Psl_Cover_Directive => - Disp_Psl_Cover_Directive (Ctxt, Stmt); - when Iir_Kind_Psl_Restrict_Directive => - Disp_Psl_Restrict_Directive (Ctxt, Stmt); - when Iir_Kind_Simple_Simultaneous_Statement => - Disp_Simple_Simultaneous_Statement (Ctxt, Stmt); - when others => - Error_Kind ("disp_concurrent_statement", Stmt); - end case; - end Disp_Concurrent_Statement; + Start_Vbox (Ctxt); + Disp_Declaration_Chain (Ctxt, Decl); + Disp_Block_Configuration (Ctxt, Get_Block_Configuration (Decl)); + Close_Vbox (Ctxt); - procedure Disp_Package_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Package_Declaration) + Disp_End (Ctxt, Decl, Tok_Configuration); + end Disp_Configuration_Declaration; + + procedure Disp_Context_Items (Ctxt : in out Ctxt_Class; First : Iir) is - Header : constant Iir := Get_Package_Header (Decl); + Decl: Iir; + Next_Decl : Iir; + begin + Decl := First; + while Decl /= Null_Iir loop + Next_Decl := Get_Chain (Decl); + + case Iir_Kinds_Clause (Get_Kind (Decl)) is + when Iir_Kind_Use_Clause => + Disp_Use_Clause (Ctxt, Decl); + when Iir_Kind_Library_Clause => + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Library); + Disp_Identifier (Ctxt, Decl); + while Get_Has_Identifier_List (Decl) loop + Decl := Next_Decl; + Next_Decl := Get_Chain (Decl); + Disp_Token (Ctxt, Tok_Comma); + Disp_Identifier (Ctxt, Decl); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + Close_Hbox (Ctxt); + when Iir_Kind_Context_Reference => + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Context); + declare + Ref : Iir; + begin + Ref := Decl; + loop + Print (Ctxt, Get_Selected_Name (Ref)); + Ref := Get_Context_Reference_Chain (Ref); + exit when Ref = Null_Iir; + Disp_Token (Ctxt, Tok_Comma); + end loop; + Disp_Token (Ctxt, Tok_Semi_Colon); + end; + Close_Hbox (Ctxt); + end case; + Decl := Next_Decl; + end loop; + end Disp_Context_Items; + + procedure Disp_Context_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) is begin Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package); - Disp_Identifier (Ctxt, Decl); + Disp_Token (Ctxt, Tok_Context); + Disp_Name_Of (Ctxt, Decl); Disp_Token (Ctxt, Tok_Is); Close_Hbox (Ctxt); Start_Vbox (Ctxt); - if Header /= Null_Iir then - Disp_Generics (Ctxt, Header); - end if; - Disp_Declaration_Chain (Ctxt, Decl); + Disp_Context_Items (Ctxt, Get_Context_Items (Decl)); Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Package); - end Disp_Package_Declaration; + Disp_End (Ctxt, Decl, Tok_Context); + end Disp_Context_Declaration; - procedure Disp_Package_Body (Ctxt : in out Ctxt_Class; Decl: Iir) is + procedure Disp_Verification_Unit + (Ctxt : in out Ctxt_Class; Unit: Iir; Tok : Token_Type) + is + Hier_Name : Iir; + Item : Iir; begin Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package, Tok_Body); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); + Disp_Token (Ctxt, Tok); + Disp_Name_Of (Ctxt, Unit); + + Hier_Name := Get_Hierarchical_Name (Unit); + if Hier_Name /= Null_Iir then + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Entity_Name (Hier_Name)); + Disp_Token (Ctxt, Tok_Right_Paren); + end if; + Close_Hbox (Ctxt); + + Start_Hbox (Ctxt); + Disp_Token (Ctxt, Tok_Left_Curly); Close_Hbox (Ctxt); + Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Decl); + Item := Get_Vunit_Item_Chain (Unit); + while Item /= Null_Iir loop + Print (Ctxt, Item); + Item := Get_Chain (Item); + end loop; Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Package, Tok_Body); - end Disp_Package_Body; - procedure Disp_Package_Instantiation_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Package); - Disp_Identifier (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is, Tok_New); - Print (Ctxt, Get_Uninstantiated_Package_Name (Decl)); - Disp_Generic_Map_Aspect (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Semi_Colon); + Disp_Token (Ctxt, Tok_Right_Curly); Close_Hbox (Ctxt); - end Disp_Package_Instantiation_Declaration; + end Disp_Verification_Unit; - procedure Disp_Binding_Indication (Ctxt : in out Ctxt_Class; Bind : Iir) + procedure Disp_Design_Unit (Ctxt : in out Ctxt_Class; Unit: Iir_Design_Unit) is - El : Iir; + Decl: Iir; begin - El := Get_Entity_Aspect (Bind); - if El /= Null_Iir then - Disp_Token (Ctxt, Tok_Use); - Disp_Entity_Aspect (Ctxt, El); - end if; - El := Get_Generic_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Disp_Generic_Map_Aspect (Ctxt, Bind); - end if; - El := Get_Port_Map_Aspect_Chain (Bind); - if El /= Null_Iir then - Disp_Port_Map_Aspect (Ctxt, Bind); - end if; - end Disp_Binding_Indication; + Disp_Context_Items (Ctxt, Get_Context_Items (Unit)); - procedure Disp_Component_Configuration - (Ctxt : in out Ctxt_Class; Conf : Iir_Component_Configuration) + Decl := Get_Library_Unit (Unit); + case Iir_Kinds_Library_Unit (Get_Kind (Decl)) is + when Iir_Kind_Entity_Declaration => + Disp_Entity_Declaration (Ctxt, Decl); + when Iir_Kind_Architecture_Body => + Disp_Architecture_Body (Ctxt, Decl); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Ctxt, Decl); + when Iir_Kind_Package_Body => + Disp_Package_Body (Ctxt, Decl); + when Iir_Kind_Package_Instantiation_Declaration => + Disp_Package_Instantiation_Declaration (Ctxt, Decl); + when Iir_Kind_Configuration_Declaration => + Disp_Configuration_Declaration (Ctxt, Decl); + when Iir_Kind_Context_Declaration => + Disp_Context_Declaration (Ctxt, Decl); + when Iir_Kind_Vunit_Declaration => + Disp_Verification_Unit (Ctxt, Decl, Tok_Vunit); + when Iir_Kind_Vmode_Declaration => + Disp_Verification_Unit (Ctxt, Decl, Tok_Vmode); + when Iir_Kind_Vprop_Declaration => + Disp_Verification_Unit (Ctxt, Decl, Tok_Vprop); + end case; + end Disp_Design_Unit; + + procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir) is + begin + case Get_Kind (N) is + when Iir_Kind_Design_File => + declare + Unit : Iir; + begin + Unit := Get_First_Design_Unit (N); + while Unit /= Null_Iir loop + Disp_Vhdl (Ctxt, Unit); + Unit := Get_Chain (Unit); + end loop; + end; + when Iir_Kind_Design_Unit => + Disp_Design_Unit (Ctxt, N); + when Iir_Kind_Enumeration_Type_Definition => + Disp_Enumeration_Type_Definition (Ctxt, N); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, N); + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (Ctxt, N); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Object_Alias_Declaration => + Disp_Name_Of (Ctxt, N); + when Iir_Kind_Enumeration_Literal => + Disp_Identifier (Ctxt, N); + when Iir_Kind_Component_Instantiation_Statement => + Disp_Component_Instantiation_Statement (Ctxt, N); + when Iir_Kind_Array_Type_Definition => + Disp_Array_Type_Definition (Ctxt, N); + when Iir_Kind_Package_Declaration => + Disp_Package_Declaration (Ctxt, N); + when Iir_Kind_Wait_Statement => + Disp_Wait_Statement (Ctxt, N); + when Iir_Kind_Selected_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + Print (Ctxt, N); + when Iir_Kind_Psl_Cover_Directive => + Disp_Psl_Cover_Directive (Ctxt, N); + when others => + Error_Kind ("disp", N); + end case; + end Disp_Vhdl; + + procedure Print (Ctxt : in out Ctxt_Class; Expr: Iir) is - Block : Iir_Block_Configuration; - Binding : Iir; + Orig : Iir; begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_For); - Disp_Instantiation_List (Ctxt, Get_Instantiation_List (Conf)); - Disp_Token (Ctxt, Tok_Colon); - Print (Ctxt, Get_Component_Name (Conf)); - Close_Hbox (Ctxt); + case Get_Kind (Expr) is + when Iir_Kind_Integer_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + if Get_Literal_Length (Expr) /= 0 then + Disp_Literal_From_Source (Ctxt, Expr, Tok_Integer); + else + Disp_Int64 (Ctxt, Get_Value (Expr)); + end if; + end if; + when Iir_Kind_Floating_Point_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + if Get_Literal_Length (Expr) /= 0 then + Disp_Literal_From_Source (Ctxt, Expr, Tok_Real); + else + Disp_Fp64 (Ctxt, Get_Fp_Value (Expr)); + end if; + end if; + when Iir_Kind_String_Literal8 => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + declare + Expr_Type : constant Iir := Get_Type (Expr); + El_Type : Iir; + begin + if Expr_Type /= Null_Iir then + El_Type := Get_Element_Subtype (Expr_Type); + else + El_Type := Null_Iir; + end if; + Disp_String_Literal (Ctxt, Expr, El_Type); + if Flag_Disp_String_Literal_Type or Flags.List_Verbose then + OOB.Put ("[type: "); + Disp_Type (Ctxt, Expr_Type); + OOB.Put ("]"); + end if; + end; + end if; + when Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Physical_Int_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Physical_Literal (Ctxt, Expr); + end if; + when Iir_Kind_Enumeration_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Name_Of (Ctxt, Expr); + end if; + when Iir_Kind_Overflow_Literal => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Start_Lit (Ctxt, Tok_Integer); + Disp_Str (Ctxt, "*OVERFLOW*"); + Close_Lit (Ctxt); + end if; - Start_Vbox (Ctxt); - Binding := Get_Binding_Indication (Conf); - if Binding /= Null_Iir then - Start_Hbox (Ctxt); - Disp_Binding_Indication (Ctxt, Binding); - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - end if; - Block := Get_Block_Configuration (Conf); - if Block /= Null_Iir then - Disp_Block_Configuration (Ctxt, Block); - end if; - Close_Vbox (Ctxt); + when Iir_Kind_Object_Alias_Declaration => + Disp_Name_Of (Ctxt, Expr); + when Iir_Kind_Aggregate => + Disp_Aggregate (Ctxt, Expr); + when Iir_Kind_Null_Literal => + Disp_Token (Ctxt, Tok_Null); + when Iir_Kind_Simple_Aggregate => + Orig := Get_Literal_Origin (Expr); + if Dump_Origin_Flag and then Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Disp_Simple_Aggregate (Ctxt, Expr); + end if; - Disp_End (Ctxt, Tok_For); - end Disp_Component_Configuration; + when Iir_Kind_Attribute_Value => + Disp_Attribute_Value (Ctxt, Expr); + when Iir_Kind_Attribute_Name => + Disp_Attribute_Name (Ctxt, Expr); - procedure Disp_Configuration_Items - (Ctxt : in out Ctxt_Class; Conf : Iir_Block_Configuration) - is - El : Iir; - begin - El := Get_Configuration_Item_Chain (Conf); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Block_Configuration => - Disp_Block_Configuration (Ctxt, El); - when Iir_Kind_Component_Configuration => - Disp_Component_Configuration (Ctxt, El); - when Iir_Kind_Configuration_Specification => - -- This may be created by canon. - Disp_Configuration_Specification (Ctxt, El); - Disp_Token (Ctxt, Tok_End, Tok_For); - Disp_Token (Ctxt, Tok_Semi_Colon); - when others => - Error_Kind ("disp_configuration_item_list", El); - end case; - El := Get_Chain (El); - end loop; - end Disp_Configuration_Items; + when Iir_Kind_Element_Declaration => + Disp_Name_Of (Ctxt, Expr); - procedure Disp_Block_Configuration - (Ctxt : in out Ctxt_Class; Block: Iir_Block_Configuration) - is - Spec : Iir; - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_For); - Spec := Get_Block_Specification (Block); - case Get_Kind (Spec) is - when Iir_Kind_Block_Statement - | Iir_Kind_If_Generate_Statement - | Iir_Kind_For_Generate_Statement - | Iir_Kind_Architecture_Body => - Disp_Name_Of (Ctxt, Spec); - when Iir_Kind_Indexed_Name => + when Iir_Kind_Signal_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Iterator_Declaration => + Disp_Name_Of (Ctxt, Expr); + return; + when Iir_Kind_Reference_Name => declare - Index_List : constant Iir_Flist := Get_Index_List (Spec); + Name : constant Iir := Get_Referenced_Name (Expr); begin - Disp_Name_Of (Ctxt, Get_Prefix (Spec)); - Disp_Token (Ctxt, Tok_Left_Paren); - if Index_List = Iir_Flist_Others then - Disp_Token (Ctxt, Tok_Others); + if Is_Valid (Name) then + Print (Ctxt, Name); else - Print (Ctxt, Get_Nth_Element (Index_List, 0)); + Print (Ctxt, Get_Named_Entity (Expr)); + end if; + end; + + when Iir_Kinds_Dyadic_Operator => + Disp_Dyadic_Operator (Ctxt, Expr); + when Iir_Kinds_Monadic_Operator => + Disp_Monadic_Operator (Ctxt, Expr); + when Iir_Kind_Function_Call => + Disp_Function_Call (Ctxt, Expr); + when Iir_Kind_Parenthesis_Expression => + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Expression (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Type_Conversion => + Print (Ctxt, Get_Type_Mark (Expr)); + Disp_Token (Ctxt, Tok_Left_Paren); + Print (Ctxt, Get_Expression (Expr)); + Disp_Token (Ctxt, Tok_Right_Paren); + when Iir_Kind_Qualified_Expression => + declare + Qexpr : constant Iir := Get_Expression (Expr); + Has_Paren : constant Boolean := + Get_Kind (Qexpr) = Iir_Kind_Parenthesis_Expression + or else Get_Kind (Qexpr) = Iir_Kind_Aggregate; + begin + Print (Ctxt, Get_Type_Mark (Expr)); + Disp_Token (Ctxt, Tok_Tick); + if not Has_Paren then + Disp_Token (Ctxt, Tok_Left_Paren); + end if; + Print (Ctxt, Qexpr); + if not Has_Paren then + Disp_Token (Ctxt, Tok_Right_Paren); end if; - Disp_Token (Ctxt, Tok_Right_Paren); end; + when Iir_Kind_Allocator_By_Expression => + Disp_Token (Ctxt, Tok_New); + Print (Ctxt, Get_Expression (Expr)); + when Iir_Kind_Allocator_By_Subtype => + Disp_Token (Ctxt, Tok_New); + Disp_Subtype_Indication (Ctxt, Get_Subtype_Indication (Expr)); + + when Iir_Kind_Indexed_Name => + Disp_Indexed_Name (Ctxt, Expr); when Iir_Kind_Slice_Name => - Disp_Name_Of (Ctxt, Get_Prefix (Spec)); + Print (Ctxt, Get_Prefix (Expr)); Disp_Token (Ctxt, Tok_Left_Paren); - Disp_Range (Ctxt, Get_Suffix (Spec)); + Disp_Range (Ctxt, Get_Suffix (Expr)); Disp_Token (Ctxt, Tok_Right_Paren); - when Iir_Kind_Simple_Name - | Iir_Kind_Parenthesis_Name => - Print (Ctxt, Spec); - when others => - Error_Kind ("disp_block_configuration", Spec); - end case; - Close_Hbox (Ctxt); + when Iir_Kind_Selected_Element => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot); + Disp_Name_Of (Ctxt, Get_Named_Entity (Expr)); + when Iir_Kind_Implicit_Dereference => + Print (Ctxt, Get_Prefix (Expr)); - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Block); - Disp_Configuration_Items (Ctxt, Block); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Tok_For); - end Disp_Block_Configuration; + when Iir_Kind_Anonymous_Signal_Declaration => + declare + Act : constant Iir := Get_Expression (Expr); + begin + if Act /= Null_Iir then + -- There is still an expression, so the anonymous signal + -- was not yet declared. + Print (Ctxt, Act); + else + -- Cannot use Disp_Identifier as the identifier is not in + -- the sources. + Disp_Ident (Ctxt, Get_Identifier (Expr)); + end if; + end; + + when Iir_Kind_Left_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Left); + when Iir_Kind_Right_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Right); + when Iir_Kind_High_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_High); + when Iir_Kind_Low_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Low); + when Iir_Kind_Ascending_Type_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Ascending); - procedure Disp_Configuration_Declaration - (Ctxt : in out Ctxt_Class; Decl: Iir_Configuration_Declaration) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Configuration); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Of); - Print (Ctxt, Get_Entity_Name (Decl)); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); + when Iir_Kind_Stable_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Stable, Expr); + when Iir_Kind_Quiet_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Quiet, Expr); + when Iir_Kind_Delayed_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Delayed, Expr); + when Iir_Kind_Transaction_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Transaction); + when Iir_Kind_Event_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Event); + when Iir_Kind_Active_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Active); + when Iir_Kind_Driving_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Driving); + when Iir_Kind_Driving_Value_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Driving_Value); + when Iir_Kind_Last_Value_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Value); + when Iir_Kind_Last_Active_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Active); + when Iir_Kind_Last_Event_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Last_Event); - Start_Vbox (Ctxt); - Disp_Declaration_Chain (Ctxt, Decl); - Disp_Block_Configuration (Ctxt, Get_Block_Configuration (Decl)); - Close_Vbox (Ctxt); + when Iir_Kind_Pos_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Pos, Expr); + when Iir_Kind_Val_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Val, Expr); + when Iir_Kind_Succ_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Succ, Expr); + when Iir_Kind_Pred_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Pred, Expr); + when Iir_Kind_Leftof_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Leftof, Expr); + when Iir_Kind_Rightof_Attribute => + Disp_Parametered_Type_Attribute (Ctxt, Name_Rightof, Expr); - Disp_End (Ctxt, Decl, Tok_Configuration); - end Disp_Configuration_Declaration; + when Iir_Kind_Length_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Length, Expr); + when Iir_Kind_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Range, Expr); + when Iir_Kind_Reverse_Range_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Reverse_Range, Expr); + when Iir_Kind_Left_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Left, Expr); + when Iir_Kind_Right_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Right, Expr); + when Iir_Kind_Low_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Low, Expr); + when Iir_Kind_High_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_High, Expr); + when Iir_Kind_Ascending_Array_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Ascending, Expr); - procedure Disp_Context_Items (Ctxt : in out Ctxt_Class; First : Iir) - is - Decl: Iir; - Next_Decl : Iir; - begin - Decl := First; - while Decl /= Null_Iir loop - Next_Decl := Get_Chain (Decl); + when Iir_Kind_Image_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Image, Expr); + when Iir_Kind_Value_Attribute => + Disp_Parametered_Attribute (Ctxt, Name_Value, Expr); + when Iir_Kind_Simple_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Simple_Name); + when Iir_Kind_Instance_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Instance_Name); + when Iir_Kind_Path_Name_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Path_Name); - case Iir_Kinds_Clause (Get_Kind (Decl)) is - when Iir_Kind_Use_Clause => - Disp_Use_Clause (Ctxt, Decl); - when Iir_Kind_Library_Clause => - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Library); - Disp_Identifier (Ctxt, Decl); - while Get_Has_Identifier_List (Decl) loop - Decl := Next_Decl; - Next_Decl := Get_Chain (Decl); - Disp_Token (Ctxt, Tok_Comma); - Disp_Identifier (Ctxt, Decl); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - Close_Hbox (Ctxt); - when Iir_Kind_Context_Reference => - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Context); - declare - Ref : Iir; - begin - Ref := Decl; - loop - Print (Ctxt, Get_Selected_Name (Ref)); - Ref := Get_Context_Reference_Chain (Ref); - exit when Ref = Null_Iir; - Disp_Token (Ctxt, Tok_Comma); - end loop; - Disp_Token (Ctxt, Tok_Semi_Colon); - end; - Close_Hbox (Ctxt); - end case; - Decl := Next_Decl; - end loop; - end Disp_Context_Items; + when Iir_Kinds_Type_And_Subtype_Definition => + Disp_Type (Ctxt, Expr); - procedure Disp_Context_Declaration (Ctxt : in out Ctxt_Class; Decl: Iir) is - begin - Start_Hbox (Ctxt); - Disp_Token (Ctxt, Tok_Context); - Disp_Name_Of (Ctxt, Decl); - Disp_Token (Ctxt, Tok_Is); - Close_Hbox (Ctxt); - Start_Vbox (Ctxt); - Disp_Context_Items (Ctxt, Get_Context_Items (Decl)); - Close_Vbox (Ctxt); - Disp_End (Ctxt, Decl, Tok_Context); - end Disp_Context_Declaration; + when Iir_Kind_Range_Expression => + Disp_Range (Ctxt, Expr); + when Iir_Kind_Subtype_Definition => + Disp_Subtype_Indication (Ctxt, Expr); - procedure Disp_Verification_Unit - (Ctxt : in out Ctxt_Class; Unit: Iir; Tok : Token_Type) is - begin - -- TODO. - null; - end Disp_Verification_Unit; + when Iir_Kind_Selected_By_All_Name + | Iir_Kind_Dereference => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot, Tok_All); + when Iir_Kind_Simple_Name + | Iir_Kind_Character_Literal => + Disp_Identifier (Ctxt, Expr); + when Iir_Kind_Operator_Symbol => + Disp_Function_Name (Ctxt, Expr); + when Iir_Kind_Selected_Name => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Token (Ctxt, Tok_Dot); + Disp_Function_Name (Ctxt, Expr); + when Iir_Kind_Parenthesis_Name => + Print (Ctxt, Get_Prefix (Expr)); + Disp_Association_Chain (Ctxt, Get_Association_Chain (Expr)); + when Iir_Kind_Base_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Base); + when Iir_Kind_Subtype_Attribute => + Disp_Name_Attribute (Ctxt, Expr, Name_Subtype); + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kinds_Interface_Object_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Group_Template_Declaration => + Disp_Name_Of (Ctxt, Expr); - procedure Disp_Design_Unit (Ctxt : in out Ctxt_Class; Unit: Iir_Design_Unit) - is - Decl: Iir; - begin - Disp_Context_Items (Ctxt, Get_Context_Items (Unit)); + when Iir_Kind_Signature => + Disp_Signature (Ctxt, Expr); - Decl := Get_Library_Unit (Unit); - case Iir_Kinds_Library_Unit (Get_Kind (Decl)) is - when Iir_Kind_Entity_Declaration => - Disp_Entity_Declaration (Ctxt, Decl); - when Iir_Kind_Architecture_Body => - Disp_Architecture_Body (Ctxt, Decl); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Ctxt, Decl); - when Iir_Kind_Package_Body => - Disp_Package_Body (Ctxt, Decl); - when Iir_Kind_Package_Instantiation_Declaration => - Disp_Package_Instantiation_Declaration (Ctxt, Decl); - when Iir_Kind_Configuration_Declaration => - Disp_Configuration_Declaration (Ctxt, Decl); - when Iir_Kind_Context_Declaration => - Disp_Context_Declaration (Ctxt, Decl); - when Iir_Kind_Vunit_Declaration => - Disp_Verification_Unit (Ctxt, Decl, Tok_Vunit); - when Iir_Kind_Vmode_Declaration => - Disp_Verification_Unit (Ctxt, Decl, Tok_Vmode); - when Iir_Kind_Vprop_Declaration => - Disp_Verification_Unit (Ctxt, Decl, Tok_Vprop); - end case; - end Disp_Design_Unit; + when Iir_Kind_Psl_Default_Clock => + Disp_Psl_Default_Clock (Ctxt, Expr); + when Iir_Kind_Psl_Assert_Directive => + Disp_Psl_Assert_Directive (Ctxt, Expr); + when Iir_Kind_Psl_Assume_Directive => + Disp_Psl_Assume_Directive (Ctxt, Expr); - procedure Disp_Vhdl (Ctxt : in out Ctxt_Class; N : Iir) is - begin - case Get_Kind (N) is - when Iir_Kind_Design_File => + when Iir_Kind_Error => declare - Unit : Iir; + Orig : constant Iir := Get_Error_Origin (Expr); begin - Unit := Get_First_Design_Unit (N); - while Unit /= Null_Iir loop - Disp_Vhdl (Ctxt, Unit); - Unit := Get_Chain (Unit); - end loop; + if Orig /= Null_Iir then + Print (Ctxt, Orig); + else + Error_Kind ("print/error", Expr); + end if; end; - when Iir_Kind_Design_Unit => - Disp_Design_Unit (Ctxt, N); - when Iir_Kind_Enumeration_Type_Definition => - Disp_Enumeration_Type_Definition (Ctxt, N); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Disp_Concurrent_Conditional_Signal_Assignment (Ctxt, N); - when Iir_Kinds_Dyadic_Operator => - Disp_Dyadic_Operator (Ctxt, N); - when Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Object_Alias_Declaration => - Disp_Name_Of (Ctxt, N); - when Iir_Kind_Enumeration_Literal => - Disp_Identifier (Ctxt, N); - when Iir_Kind_Component_Instantiation_Statement => - Disp_Component_Instantiation_Statement (Ctxt, N); - when Iir_Kind_Array_Type_Definition => - Disp_Array_Type_Definition (Ctxt, N); - when Iir_Kind_Package_Declaration => - Disp_Package_Declaration (Ctxt, N); - when Iir_Kind_Wait_Statement => - Disp_Wait_Statement (Ctxt, N); - when Iir_Kind_Selected_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - Print (Ctxt, N); - when Iir_Kind_Psl_Cover_Directive => - Disp_Psl_Cover_Directive (Ctxt, N); when others => - Error_Kind ("disp", N); + Error_Kind ("print", Expr); end case; - end Disp_Vhdl; + end Print; procedure Disp_Int_Trim (Ctxt : in out Ctxt_Class; Str : String) is begin -- cgit v1.2.3