diff options
| author | Tristan Gingold <tgingold@free.fr> | 2014-10-22 13:15:33 +0200 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2014-10-22 13:15:33 +0200 |
| commit | e00d31baa0e7190b959cfb03df03b260e402da05 (patch) | |
| tree | 9ed433cdd9d38d6432e3dc016d1b942fbf97519c | |
| parent | 0e199cbea1070c016d29348cd659b9e6ca688afb (diff) | |
| download | ghdl-e00d31baa0e7190b959cfb03df03b260e402da05.tar.gz ghdl-e00d31baa0e7190b959cfb03df03b260e402da05.tar.bz2 ghdl-e00d31baa0e7190b959cfb03df03b260e402da05.zip | |
Rework for support of generic packages.
| -rw-r--r-- | canon.adb | 4 | ||||
| -rw-r--r-- | disp_tree.adb | 3064 | ||||
| -rw-r--r-- | disp_vhdl.adb | 157 | ||||
| -rw-r--r-- | errorout.adb | 6 | ||||
| -rw-r--r-- | evaluation.adb | 16 | ||||
| -rw-r--r-- | evaluation.ads | 4 | ||||
| -rw-r--r-- | ieee-vital_timing.adb | 2 | ||||
| -rw-r--r-- | iirs.adb | 6037 | ||||
| -rw-r--r-- | iirs.adb.in | 16 | ||||
| -rw-r--r-- | iirs.ads | 215 | ||||
| -rw-r--r-- | iirs_utils.adb | 66 | ||||
| -rw-r--r-- | iirs_utils.ads | 21 | ||||
| -rw-r--r-- | nodes_gc.adb | 669 | ||||
| -rw-r--r-- | nodes_meta.adb | 9352 | ||||
| -rw-r--r-- | nodes_meta.adb.in | 76 | ||||
| -rw-r--r-- | nodes_meta.ads | 821 | ||||
| -rw-r--r-- | nodes_meta.ads.in | 66 | ||||
| -rw-r--r-- | parse.adb | 206 | ||||
| -rw-r--r-- | sem.adb | 41 | ||||
| -rw-r--r-- | sem_assocs.adb | 2 | ||||
| -rw-r--r-- | sem_decls.adb | 18 | ||||
| -rw-r--r-- | sem_expr.adb | 10 | ||||
| -rw-r--r-- | sem_inst.adb | 423 | ||||
| -rw-r--r-- | sem_inst.ads | 26 | ||||
| -rw-r--r-- | sem_names.adb | 33 | ||||
| -rw-r--r-- | sem_specs.adb | 4 | ||||
| -rw-r--r-- | sem_stmts.adb | 2 | ||||
| -rw-r--r-- | sem_types.adb | 189 | ||||
| -rw-r--r-- | std_package.adb | 6 | ||||
| -rw-r--r-- | translate/gcc/dist-common.sh | 2 | ||||
| -rw-r--r-- | translate/translation.adb | 807 | ||||
| -rw-r--r-- | xtools/Makefile | 10 | ||||
| -rwxr-xr-x | xtools/pnodes.py | 408 |
33 files changed, 13595 insertions, 9184 deletions
@@ -2624,9 +2624,7 @@ package body Canon is Set_Generic_Map_Aspect_Chain (El, Canon_Association_Chain_And_Actuals - (Get_Generic_Chain - (Get_Package_Header - (Get_Named_Entity (Get_Uninstantiated_Name (El)))), + (Get_Generic_Chain (El), Get_Generic_Map_Aspect_Chain (El), El)); when others => Error_Kind ("canonicalize2", El); diff --git a/disp_tree.adb b/disp_tree.adb index 8078ecbdf..fbaaa939b 100644 --- a/disp_tree.adb +++ b/disp_tree.adb @@ -25,6 +25,7 @@ with Tokens; with Errorout; with Files_Map; with PSL.Dump_Tree; +with Nodes_Meta; -- Do not add a use clause for iirs_utils, as it may crash for ill-formed -- trees, which is annoying while debugging. @@ -346,566 +347,29 @@ package body Disp_Tree is begin Put_Indent (Indent); Put (Str); + Put (": "); end Header; - -- Subprograms - procedure Disp_Header (N : Iir) is + procedure Disp_Header (N : Iir) + is + use Nodes_Meta; + K : Iir_Kind; begin if N = Null_Iir then Put_Line ("*null*"); return; end if; - case Get_Kind (N) is - when Iir_Kind_Unused => - Put ("unused"); - when Iir_Kind_Error => - Put ("error"); - when Iir_Kind_Design_File => - Put ("design_file"); - when Iir_Kind_Design_Unit => - Put ("design_unit " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Library_Clause => - Put ("library_clause " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Use_Clause => - Put ("use_clause"); - when Iir_Kind_Integer_Literal => - Put ("integer_literal"); - when Iir_Kind_Floating_Point_Literal => - Put ("floating_point_literal"); - when Iir_Kind_Null_Literal => - Put ("null_literal"); - when Iir_Kind_String_Literal => - Put ("string_literal"); - when Iir_Kind_Physical_Int_Literal => - Put ("physical_int_literal"); - when Iir_Kind_Physical_Fp_Literal => - Put ("physical_fp_literal"); - when Iir_Kind_Bit_String_Literal => - Put ("bit_string_literal"); - when Iir_Kind_Simple_Aggregate => - Put ("simple_aggregate"); - when Iir_Kind_Overflow_Literal => - Put ("overflow_literal"); - when Iir_Kind_Waveform_Element => - Put ("waveform_element"); - when Iir_Kind_Conditional_Waveform => - Put ("conditional_waveform"); - when Iir_Kind_Association_Element_By_Expression => - Put ("association_element_by_expression"); - when Iir_Kind_Association_Element_By_Individual => - Put ("association_element_by_individual"); - when Iir_Kind_Association_Element_Open => - Put ("association_element_open"); - when Iir_Kind_Choice_By_Others => - Put ("choice_by_others"); - when Iir_Kind_Choice_By_Expression => - Put ("choice_by_expression"); - when Iir_Kind_Choice_By_Range => - Put ("choice_by_range"); - when Iir_Kind_Choice_By_None => - Put ("choice_by_none"); - when Iir_Kind_Choice_By_Name => - Put ("choice_by_name"); - when Iir_Kind_Entity_Aspect_Entity => - Put ("entity_aspect_entity"); - when Iir_Kind_Entity_Aspect_Configuration => - Put ("entity_aspect_configuration"); - when Iir_Kind_Entity_Aspect_Open => - Put ("entity_aspect_open"); - when Iir_Kind_Block_Configuration => - Put ("block_configuration"); - when Iir_Kind_Block_Header => - Put ("block_header"); - when Iir_Kind_Component_Configuration => - Put ("component_configuration"); - when Iir_Kind_Binding_Indication => - Put ("binding_indication"); - when Iir_Kind_Entity_Class => - Put ("entity_class"); - when Iir_Kind_Attribute_Value => - Put ("attribute_value"); - when Iir_Kind_Signature => - Put ("signature"); - when Iir_Kind_Aggregate_Info => - Put ("aggregate_info"); - when Iir_Kind_Procedure_Call => - Put ("procedure_call"); - when Iir_Kind_Record_Element_Constraint => - Put ("record_element_constraint " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Attribute_Specification => - Put ("attribute_specification"); - when Iir_Kind_Disconnection_Specification => - Put ("disconnection_specification"); - when Iir_Kind_Configuration_Specification => - Put ("configuration_specification"); - when Iir_Kind_Access_Type_Definition => - Put ("access_type_definition"); - when Iir_Kind_Incomplete_Type_Definition => - Put ("incomplete_type_definition"); - when Iir_Kind_File_Type_Definition => - Put ("file_type_definition"); - when Iir_Kind_Protected_Type_Declaration => - Put ("protected_type_declaration"); - when Iir_Kind_Record_Type_Definition => - Put ("record_type_definition"); - when Iir_Kind_Array_Type_Definition => - Put ("array_type_definition"); - when Iir_Kind_Array_Subtype_Definition => - Put ("array_subtype_definition"); - when Iir_Kind_Record_Subtype_Definition => - Put ("record_subtype_definition"); - when Iir_Kind_Access_Subtype_Definition => - Put ("access_subtype_definition"); - when Iir_Kind_Physical_Subtype_Definition => - Put ("physical_subtype_definition"); - when Iir_Kind_Floating_Subtype_Definition => - Put ("floating_subtype_definition"); - when Iir_Kind_Integer_Subtype_Definition => - Put ("integer_subtype_definition"); - when Iir_Kind_Enumeration_Subtype_Definition => - Put ("enumeration_subtype_definition"); - when Iir_Kind_Enumeration_Type_Definition => - Put ("enumeration_type_definition"); - when Iir_Kind_Integer_Type_Definition => - Put ("integer_type_definition"); - when Iir_Kind_Floating_Type_Definition => - Put ("floating_type_definition"); - when Iir_Kind_Physical_Type_Definition => - Put ("physical_type_definition"); - when Iir_Kind_Range_Expression => - Put ("range_expression"); - when Iir_Kind_Protected_Type_Body => - Put ("protected_type_body " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Subtype_Definition => - Put ("subtype_definition"); - when Iir_Kind_Scalar_Nature_Definition => - Put ("scalar_nature_definition"); - when Iir_Kind_Overload_List => - Put ("overload_list"); - when Iir_Kind_Type_Declaration => - Put ("type_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Anonymous_Type_Declaration => - Put ("anonymous_type_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Subtype_Declaration => - Put ("subtype_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Nature_Declaration => - Put ("nature_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Subnature_Declaration => - Put ("subnature_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Package_Declaration => - Put ("package_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Package_Instantiation_Declaration => - Put ("package_instantiation_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Package_Body => - Put ("package_body " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Configuration_Declaration => - Put ("configuration_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Entity_Declaration => - Put ("entity_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Architecture_Body => - Put ("architecture_body " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Package_Header => - Put ("package_header"); - when Iir_Kind_Unit_Declaration => - Put ("unit_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Library_Declaration => - Put ("library_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Component_Declaration => - Put ("component_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Attribute_Declaration => - Put ("attribute_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Group_Template_Declaration => - Put ("group_template_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Group_Declaration => - Put ("group_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Element_Declaration => - Put ("element_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Non_Object_Alias_Declaration => - Put ("non_object_alias_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Psl_Declaration => - Put ("psl_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Terminal_Declaration => - Put ("terminal_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Free_Quantity_Declaration => - Put ("free_quantity_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Across_Quantity_Declaration => - Put ("across_quantity_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Through_Quantity_Declaration => - Put ("through_quantity_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Enumeration_Literal => - Put ("enumeration_literal " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Function_Declaration => - Put ("function_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Implicit_Function_Declaration => - Put ("implicit_function_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Implicit_Procedure_Declaration => - Put ("implicit_procedure_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Procedure_Declaration => - Put ("procedure_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Function_Body => - Put ("function_body"); - when Iir_Kind_Procedure_Body => - Put ("procedure_body"); - when Iir_Kind_Object_Alias_Declaration => - Put ("object_alias_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_File_Declaration => - Put ("file_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Guard_Signal_Declaration => - Put ("guard_signal_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Signal_Declaration => - Put ("signal_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Variable_Declaration => - Put ("variable_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Constant_Declaration => - Put ("constant_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Iterator_Declaration => - Put ("iterator_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Constant_Interface_Declaration => - Put ("constant_interface_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Variable_Interface_Declaration => - Put ("variable_interface_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Signal_Interface_Declaration => - Put ("signal_interface_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_File_Interface_Declaration => - Put ("file_interface_declaration " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Identity_Operator => - Put ("identity_operator"); - when Iir_Kind_Negation_Operator => - Put ("negation_operator"); - when Iir_Kind_Absolute_Operator => - Put ("absolute_operator"); - when Iir_Kind_Not_Operator => - Put ("not_operator"); - when Iir_Kind_Condition_Operator => - Put ("condition_operator"); - when Iir_Kind_Reduction_And_Operator => - Put ("reduction_and_operator"); - when Iir_Kind_Reduction_Or_Operator => - Put ("reduction_or_operator"); - when Iir_Kind_Reduction_Nand_Operator => - Put ("reduction_nand_operator"); - when Iir_Kind_Reduction_Nor_Operator => - Put ("reduction_nor_operator"); - when Iir_Kind_Reduction_Xor_Operator => - Put ("reduction_xor_operator"); - when Iir_Kind_Reduction_Xnor_Operator => - Put ("reduction_xnor_operator"); - when Iir_Kind_And_Operator => - Put ("and_operator"); - when Iir_Kind_Or_Operator => - Put ("or_operator"); - when Iir_Kind_Nand_Operator => - Put ("nand_operator"); - when Iir_Kind_Nor_Operator => - Put ("nor_operator"); - when Iir_Kind_Xor_Operator => - Put ("xor_operator"); - when Iir_Kind_Xnor_Operator => - Put ("xnor_operator"); - when Iir_Kind_Equality_Operator => - Put ("equality_operator"); - when Iir_Kind_Inequality_Operator => - Put ("inequality_operator"); - when Iir_Kind_Less_Than_Operator => - Put ("less_than_operator"); - when Iir_Kind_Less_Than_Or_Equal_Operator => - Put ("less_than_or_equal_operator"); - when Iir_Kind_Greater_Than_Operator => - Put ("greater_than_operator"); - when Iir_Kind_Greater_Than_Or_Equal_Operator => - Put ("greater_than_or_equal_operator"); - when Iir_Kind_Match_Equality_Operator => - Put ("match_equality_operator"); - when Iir_Kind_Match_Inequality_Operator => - Put ("match_inequality_operator"); - when Iir_Kind_Match_Less_Than_Operator => - Put ("match_less_than_operator"); - when Iir_Kind_Match_Less_Than_Or_Equal_Operator => - Put ("match_less_than_or_equal_operator"); - when Iir_Kind_Match_Greater_Than_Operator => - Put ("match_greater_than_operator"); - when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => - Put ("match_greater_than_or_equal_operator"); - when Iir_Kind_Sll_Operator => - Put ("sll_operator"); - when Iir_Kind_Sla_Operator => - Put ("sla_operator"); - when Iir_Kind_Srl_Operator => - Put ("srl_operator"); - when Iir_Kind_Sra_Operator => - Put ("sra_operator"); - when Iir_Kind_Rol_Operator => - Put ("rol_operator"); - when Iir_Kind_Ror_Operator => - Put ("ror_operator"); - when Iir_Kind_Addition_Operator => - Put ("addition_operator"); - when Iir_Kind_Substraction_Operator => - Put ("substraction_operator"); - when Iir_Kind_Concatenation_Operator => - Put ("concatenation_operator"); - when Iir_Kind_Multiplication_Operator => - Put ("multiplication_operator"); - when Iir_Kind_Division_Operator => - Put ("division_operator"); - when Iir_Kind_Modulus_Operator => - Put ("modulus_operator"); - when Iir_Kind_Remainder_Operator => - Put ("remainder_operator"); - when Iir_Kind_Exponentiation_Operator => - Put ("exponentiation_operator"); - when Iir_Kind_Function_Call => - Put ("function_call"); - when Iir_Kind_Aggregate => - Put ("aggregate"); - when Iir_Kind_Parenthesis_Expression => - Put ("parenthesis_expression"); - when Iir_Kind_Qualified_Expression => - Put ("qualified_expression"); - when Iir_Kind_Type_Conversion => - Put ("type_conversion"); - when Iir_Kind_Allocator_By_Expression => - Put ("allocator_by_expression"); - when Iir_Kind_Allocator_By_Subtype => - Put ("allocator_by_subtype"); - when Iir_Kind_Selected_Element => - Put ("selected_element"); - when Iir_Kind_Dereference => - Put ("dereference"); - when Iir_Kind_Implicit_Dereference => - Put ("implicit_dereference"); - when Iir_Kind_Slice_Name => - Put ("slice_name"); - when Iir_Kind_Indexed_Name => - Put ("indexed_name"); - when Iir_Kind_Psl_Expression => - Put ("psl_expression"); - when Iir_Kind_Sensitized_Process_Statement => - Put ("sensitized_process_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Process_Statement => - Put ("process_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Put ("concurrent_conditional_signal_assignment " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Put ("concurrent_selected_signal_assignment " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Concurrent_Assertion_Statement => - Put ("concurrent_assertion_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Psl_Default_Clock => - Put ("psl_default_clock " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Psl_Assert_Statement => - Put ("psl_assert_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Psl_Cover_Statement => - Put ("psl_cover_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Put ("concurrent_procedure_call_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Block_Statement => - Put ("block_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Generate_Statement => - Put ("generate_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Component_Instantiation_Statement => - Put ("component_instantiation_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Simple_Simultaneous_Statement => - Put ("simple_simultaneous_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Signal_Assignment_Statement => - Put ("signal_assignment_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Null_Statement => - Put ("null_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Assertion_Statement => - Put ("assertion_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Report_Statement => - Put ("report_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Wait_Statement => - Put ("wait_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Variable_Assignment_Statement => - Put ("variable_assignment_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Return_Statement => - Put ("return_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_For_Loop_Statement => - Put ("for_loop_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_While_Loop_Statement => - Put ("while_loop_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Next_Statement => - Put ("next_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Exit_Statement => - Put ("exit_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Case_Statement => - Put ("case_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Procedure_Call_Statement => - Put ("procedure_call_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_If_Statement => - Put ("if_statement " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Elsif => - Put ("elsif"); - when Iir_Kind_Character_Literal => - Put ("character_literal " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Simple_Name => - Put ("simple_name " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Selected_Name => - Put ("selected_name " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Operator_Symbol => - Put ("operator_symbol " & - Image_Name_Id (Get_Identifier (N))); - when Iir_Kind_Selected_By_All_Name => - Put ("selected_by_all_name"); - when Iir_Kind_Parenthesis_Name => - Put ("parenthesis_name"); - when Iir_Kind_Base_Attribute => - Put ("base_attribute"); - when Iir_Kind_Left_Type_Attribute => - Put ("left_type_attribute"); - when Iir_Kind_Right_Type_Attribute => - Put ("right_type_attribute"); - when Iir_Kind_High_Type_Attribute => - Put ("high_type_attribute"); - when Iir_Kind_Low_Type_Attribute => - Put ("low_type_attribute"); - when Iir_Kind_Ascending_Type_Attribute => - Put ("ascending_type_attribute"); - when Iir_Kind_Image_Attribute => - Put ("image_attribute"); - when Iir_Kind_Value_Attribute => - Put ("value_attribute"); - when Iir_Kind_Pos_Attribute => - Put ("pos_attribute"); - when Iir_Kind_Val_Attribute => - Put ("val_attribute"); - when Iir_Kind_Succ_Attribute => - Put ("succ_attribute"); - when Iir_Kind_Pred_Attribute => - Put ("pred_attribute"); - when Iir_Kind_Leftof_Attribute => - Put ("leftof_attribute"); - when Iir_Kind_Rightof_Attribute => - Put ("rightof_attribute"); - when Iir_Kind_Delayed_Attribute => - Put ("delayed_attribute"); - when Iir_Kind_Stable_Attribute => - Put ("stable_attribute"); - when Iir_Kind_Quiet_Attribute => - Put ("quiet_attribute"); - when Iir_Kind_Transaction_Attribute => - Put ("transaction_attribute"); - when Iir_Kind_Event_Attribute => - Put ("event_attribute"); - when Iir_Kind_Active_Attribute => - Put ("active_attribute"); - when Iir_Kind_Last_Event_Attribute => - Put ("last_event_attribute"); - when Iir_Kind_Last_Active_Attribute => - Put ("last_active_attribute"); - when Iir_Kind_Last_Value_Attribute => - Put ("last_value_attribute"); - when Iir_Kind_Driving_Attribute => - Put ("driving_attribute"); - when Iir_Kind_Driving_Value_Attribute => - Put ("driving_value_attribute"); - when Iir_Kind_Behavior_Attribute => - Put ("behavior_attribute"); - when Iir_Kind_Structure_Attribute => - Put ("structure_attribute"); - when Iir_Kind_Simple_Name_Attribute => - Put ("simple_name_attribute"); - when Iir_Kind_Instance_Name_Attribute => - Put ("instance_name_attribute"); - when Iir_Kind_Path_Name_Attribute => - Put ("path_name_attribute"); - when Iir_Kind_Left_Array_Attribute => - Put ("left_array_attribute"); - when Iir_Kind_Right_Array_Attribute => - Put ("right_array_attribute"); - when Iir_Kind_High_Array_Attribute => - Put ("high_array_attribute"); - when Iir_Kind_Low_Array_Attribute => - Put ("low_array_attribute"); - when Iir_Kind_Length_Array_Attribute => - Put ("length_array_attribute"); - when Iir_Kind_Ascending_Array_Attribute => - Put ("ascending_array_attribute"); - when Iir_Kind_Range_Array_Attribute => - Put ("range_array_attribute"); - when Iir_Kind_Reverse_Range_Array_Attribute => - Put ("reverse_range_array_attribute"); - when Iir_Kind_Attribute_Name => - Put ("attribute_name " & - Image_Name_Id (Get_Identifier (N))); - end case; + K := Get_Kind (N); + Put (Get_Iir_Image (K)); + if Has_Identifier (K) then + Put (' '); + Put (Image_Name_Id (Get_Identifier (N))); + end if; + Put (' '); Disp_Iir_Number (N); + New_Line; end Disp_Header; @@ -921,7 +385,7 @@ package body Disp_Tree is return; end if; - Header ("location: ", Indent); + Header ("location", Indent); Put_Line (Image_Location_Type (Get_Location (N))); -- Protect against infinite recursions. @@ -931,2405 +395,109 @@ package body Disp_Tree is return; end if; - case Get_Kind (N) is - when Iir_Kind_Unused - | Iir_Kind_Entity_Aspect_Open - | Iir_Kind_Behavior_Attribute - | Iir_Kind_Structure_Attribute => - null; - when Iir_Kind_Error => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("error_origin: ", Indent); - Disp_Iir (Get_Error_Origin (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Design_File => - Header ("library: ", Indent); - Disp_Iir (Get_Library (N), Sub_Indent, True); - Header ("file_dependence_list: ", Indent); - Disp_Iir_List (Get_File_Dependence_List (N), Sub_Indent); - Header ("design_file_directory: ", Indent); - Put_Line (Image_Name_Id (Get_Design_File_Directory (N))); - Header ("design_file_filename: ", Indent); - Put_Line (Image_Name_Id (Get_Design_File_Filename (N))); - Header ("analysis_time_stamp: ", Indent); - Put_Line (Image_Time_Stamp_Id (Get_Analysis_Time_Stamp (N))); - Header ("file_time_stamp: ", Indent); - Put_Line (Image_Time_Stamp_Id (Get_File_Time_Stamp (N))); - Header ("first_design_unit: ", Indent); - Disp_Chain (Get_First_Design_Unit (N), Sub_Indent); - Header ("last_design_unit: ", Indent); - Disp_Iir (Get_Last_Design_Unit (N), Sub_Indent, True); - Header ("elab_flag: ", Indent); - Put_Line (Image_Boolean (Get_Elab_Flag (N))); - when Iir_Kind_Design_Unit => - Header ("design_file: ", Indent); - Disp_Iir (Get_Design_File (N), Sub_Indent, True); - Header ("context_items: ", Indent); - Disp_Chain (Get_Context_Items (N), Sub_Indent); - Header ("date: ", Indent); - Put_Line (Date_Type'Image (Get_Date (N))); - Header ("design_unit_source_line: ", Indent); - Put_Line (Int32'Image (Get_Design_Unit_Source_Line (N))); - Header ("design_unit_source_col: ", Indent); - Put_Line (Int32'Image (Get_Design_Unit_Source_Col (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("design_unit_source_pos: ", Indent); - Put_Line (Source_Ptr'Image (Get_Design_Unit_Source_Pos (N))); - Header ("library_unit: ", Indent); - Disp_Iir (Get_Library_Unit (N), Sub_Indent); - Header ("end_location: ", Indent); - Put_Line (Image_Location_Type (Get_End_Location (N))); - Header ("hash_chain: ", Indent); - Disp_Iir (Get_Hash_Chain (N), Sub_Indent, True); - Header ("dependence_list: ", Indent); - Disp_Iir_List (Get_Dependence_List (N), Sub_Indent, True); - Header ("analysis_checks_list: ", Indent); - Disp_Iir_List (Get_Analysis_Checks_List (N), Sub_Indent); - Header ("elab_flag: ", Indent); - Put_Line (Image_Boolean (Get_Elab_Flag (N))); - Header ("date_state: ", Indent); - Put_Line (Image_Date_State_Type (Get_Date_State (N))); - when Iir_Kind_Library_Clause => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("library_declaration: ", Indent); - Disp_Iir (Get_Library_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - when Iir_Kind_Use_Clause => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("selected_name: ", Indent); - Disp_Iir (Get_Selected_Name (N), Sub_Indent); - Header ("use_clause_chain: ", Indent); - Disp_Iir (Get_Use_Clause_Chain (N), Sub_Indent); - when Iir_Kind_Integer_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("value: ", Indent); - Put_Line (Iir_Int64'Image (Get_Value (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Floating_Point_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("fp_value: ", Indent); - Put_Line (Iir_Fp64'Image (Get_Fp_Value (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Null_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_String_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("string_id: ", Indent); - Put_Line (Image_String_Id (Get_String_Id (N))); - Header ("string_length: ", Indent); - Put_Line (Int32'Image (Get_String_Length (N))); - Header ("literal_subtype: ", Indent); - Disp_Iir (Get_Literal_Subtype (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Physical_Int_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("unit_name: ", Indent); - Disp_Iir (Get_Unit_Name (N), Sub_Indent); - Header ("value: ", Indent); - Put_Line (Iir_Int64'Image (Get_Value (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Physical_Fp_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("unit_name: ", Indent); - Disp_Iir (Get_Unit_Name (N), Sub_Indent); - Header ("fp_value: ", Indent); - Put_Line (Iir_Fp64'Image (Get_Fp_Value (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Bit_String_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("string_id: ", Indent); - Put_Line (Image_String_Id (Get_String_Id (N))); - Header ("string_length: ", Indent); - Put_Line (Int32'Image (Get_String_Length (N))); - Header ("literal_subtype: ", Indent); - Disp_Iir (Get_Literal_Subtype (N), Sub_Indent); - Header ("bit_string_0: ", Indent); - Disp_Iir (Get_Bit_String_0 (N), Sub_Indent); - Header ("bit_string_1: ", Indent); - Disp_Iir (Get_Bit_String_1 (N), Sub_Indent); - Header ("bit_string_base: ", Indent); - Put_Line (Base_Type'Image (Get_Bit_String_Base (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Simple_Aggregate => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("simple_aggregate_list: ", Indent); - Disp_Iir_List (Get_Simple_Aggregate_List (N), Sub_Indent); - Header ("literal_subtype: ", Indent); - Disp_Iir (Get_Literal_Subtype (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Overflow_Literal => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Waveform_Element => - Header ("we_value: ", Indent); - Disp_Iir (Get_We_Value (N), Sub_Indent); - Header ("time: ", Indent); - Disp_Iir (Get_Time (N), Sub_Indent); - when Iir_Kind_Conditional_Waveform => - Header ("condition: ", Indent); - Disp_Iir (Get_Condition (N), Sub_Indent); - Header ("waveform_chain: ", Indent); - Disp_Chain (Get_Waveform_Chain (N), Sub_Indent); - when Iir_Kind_Association_Element_By_Expression => - Header ("formal: ", Indent); - Disp_Iir (Get_Formal (N), Sub_Indent); - Header ("actual: ", Indent); - Disp_Iir (Get_Actual (N), Sub_Indent); - Header ("in_conversion: ", Indent); - Disp_Iir (Get_In_Conversion (N), Sub_Indent); - Header ("out_conversion: ", Indent); - Disp_Iir (Get_Out_Conversion (N), Sub_Indent); - Header ("whole_association_flag: ", Indent); - Put_Line (Image_Boolean (Get_Whole_Association_Flag (N))); - Header ("collapse_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Collapse_Signal_Flag (N))); - when Iir_Kind_Association_Element_By_Individual => - Header ("formal: ", Indent); - Disp_Iir (Get_Formal (N), Sub_Indent); - Header ("actual_type: ", Indent); - Disp_Iir (Get_Actual_Type (N), Sub_Indent); - Header ("individual_association_chain: ", Indent); - Disp_Chain (Get_Individual_Association_Chain (N), Sub_Indent); - Header ("whole_association_flag: ", Indent); - Put_Line (Image_Boolean (Get_Whole_Association_Flag (N))); - Header ("collapse_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Collapse_Signal_Flag (N))); - when Iir_Kind_Association_Element_Open => - Header ("formal: ", Indent); - Disp_Iir (Get_Formal (N), Sub_Indent); - Header ("whole_association_flag: ", Indent); - Put_Line (Image_Boolean (Get_Whole_Association_Flag (N))); - Header ("collapse_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Collapse_Signal_Flag (N))); - Header ("artificial_flag: ", Indent); - Put_Line (Image_Boolean (Get_Artificial_Flag (N))); - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_None => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("associated_expr: ", Indent); - Disp_Iir (Get_Associated_Expr (N), Sub_Indent); - Header ("associated_chain: ", Indent); - Disp_Chain (Get_Associated_Chain (N), Sub_Indent); - Header ("same_alternative_flag: ", Indent); - Put_Line (Image_Boolean (Get_Same_Alternative_Flag (N))); - when Iir_Kind_Choice_By_Expression => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("associated_expr: ", Indent); - Disp_Iir (Get_Associated_Expr (N), Sub_Indent); - Header ("associated_chain: ", Indent); - Disp_Chain (Get_Associated_Chain (N), Sub_Indent); - Header ("choice_expression: ", Indent); - Disp_Iir (Get_Choice_Expression (N), Sub_Indent); - Header ("same_alternative_flag: ", Indent); - Put_Line (Image_Boolean (Get_Same_Alternative_Flag (N))); - Header ("choice_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Choice_Staticness (N))); - when Iir_Kind_Choice_By_Range => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("associated_expr: ", Indent); - Disp_Iir (Get_Associated_Expr (N), Sub_Indent); - Header ("associated_chain: ", Indent); - Disp_Chain (Get_Associated_Chain (N), Sub_Indent); - Header ("choice_range: ", Indent); - Disp_Iir (Get_Choice_Range (N), Sub_Indent); - Header ("same_alternative_flag: ", Indent); - Put_Line (Image_Boolean (Get_Same_Alternative_Flag (N))); - Header ("choice_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Choice_Staticness (N))); - when Iir_Kind_Choice_By_Name => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("associated_expr: ", Indent); - Disp_Iir (Get_Associated_Expr (N), Sub_Indent); - Header ("associated_chain: ", Indent); - Disp_Chain (Get_Associated_Chain (N), Sub_Indent); - Header ("choice_name: ", Indent); - Disp_Iir (Get_Choice_Name (N), Sub_Indent); - Header ("same_alternative_flag: ", Indent); - Put_Line (Image_Boolean (Get_Same_Alternative_Flag (N))); - when Iir_Kind_Entity_Aspect_Entity => - Header ("entity_name: ", Indent); - Disp_Iir (Get_Entity_Name (N), Sub_Indent); - Header ("architecture: ", Indent); - Disp_Iir (Get_Architecture (N), Sub_Indent); - when Iir_Kind_Entity_Aspect_Configuration => - Header ("configuration_name: ", Indent); - Disp_Iir (Get_Configuration_Name (N), Sub_Indent); - when Iir_Kind_Block_Configuration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("configuration_item_chain: ", Indent); - Disp_Chain (Get_Configuration_Item_Chain (N), Sub_Indent); - Header ("prev_block_configuration: ", Indent); - Disp_Iir (Get_Prev_Block_Configuration (N), Sub_Indent, True); - Header ("block_specification: ", Indent); - Disp_Iir (Get_Block_Specification (N), Sub_Indent); - when Iir_Kind_Block_Header => - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("port_chain: ", Indent); - Disp_Chain (Get_Port_Chain (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("port_map_aspect_chain: ", Indent); - Disp_Chain (Get_Port_Map_Aspect_Chain (N), Sub_Indent); - when Iir_Kind_Component_Configuration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("instantiation_list: ", Indent); - Disp_Iir_List (Get_Instantiation_List (N), Sub_Indent); - Header ("binding_indication: ", Indent); - Disp_Iir (Get_Binding_Indication (N), Sub_Indent); - Header ("component_name: ", Indent); - Disp_Iir (Get_Component_Name (N), Sub_Indent); - Header ("block_configuration: ", Indent); - Disp_Iir (Get_Block_Configuration (N), Sub_Indent); - when Iir_Kind_Binding_Indication => - Header ("default_entity_aspect: ", Indent); - Disp_Iir (Get_Default_Entity_Aspect (N), Sub_Indent); - Header ("entity_aspect: ", Indent); - Disp_Iir (Get_Entity_Aspect (N), Sub_Indent); - Header ("default_generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Default_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("default_port_map_aspect_chain: ", Indent); - Disp_Chain (Get_Default_Port_Map_Aspect_Chain (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("port_map_aspect_chain: ", Indent); - Disp_Chain (Get_Port_Map_Aspect_Chain (N), Sub_Indent); - when Iir_Kind_Entity_Class => - Header ("entity_class: ", Indent); - Put_Line (Image_Token_Type (Get_Entity_Class (N))); - when Iir_Kind_Attribute_Value => - Header ("spec_chain: ", Indent); - Disp_Iir (Get_Spec_Chain (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("designated_entity: ", Indent); - Disp_Iir (Get_Designated_Entity (N), Sub_Indent, True); - Header ("attribute_specification: ", Indent); - Disp_Iir (Get_Attribute_Specification (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Signature => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type_marks_list: ", Indent); - Disp_Iir_List (Get_Type_Marks_List (N), Sub_Indent); - Header ("return_type_mark: ", Indent); - Disp_Iir (Get_Return_Type_Mark (N), Sub_Indent); - when Iir_Kind_Aggregate_Info => - Header ("sub_aggregate_info: ", Indent); - Disp_Iir (Get_Sub_Aggregate_Info (N), Sub_Indent); - Header ("aggr_low_limit: ", Indent); - Disp_Iir (Get_Aggr_Low_Limit (N), Sub_Indent); - Header ("aggr_high_limit: ", Indent); - Disp_Iir (Get_Aggr_High_Limit (N), Sub_Indent); - Header ("aggr_min_length: ", Indent); - Put_Line (Iir_Int32'Image (Get_Aggr_Min_Length (N))); - Header ("aggr_others_flag: ", Indent); - Put_Line (Image_Boolean (Get_Aggr_Others_Flag (N))); - Header ("aggr_dynamic_flag: ", Indent); - Put_Line (Image_Boolean (Get_Aggr_Dynamic_Flag (N))); - Header ("aggr_named_flag: ", Indent); - Put_Line (Image_Boolean (Get_Aggr_Named_Flag (N))); - when Iir_Kind_Procedure_Call => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("parameter_association_chain: ", Indent); - Disp_Chain (Get_Parameter_Association_Chain (N), Sub_Indent); - Header ("implementation: ", Indent); - Disp_Iir (Get_Implementation (N), Sub_Indent, True); - Header ("method_object: ", Indent); - Disp_Iir (Get_Method_Object (N), Sub_Indent); - when Iir_Kind_Record_Element_Constraint => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("element_declaration: ", Indent); - Disp_Iir (Get_Element_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("element_position: ", Indent); - Put_Line (Iir_Index32'Image (Get_Element_Position (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Attribute_Specification => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("entity_name_list: ", Indent); - Disp_Iir_List (Get_Entity_Name_List (N), Sub_Indent); - Header ("entity_class: ", Indent); - Put_Line (Image_Token_Type (Get_Entity_Class (N))); - Header ("attribute_value_spec_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Spec_Chain (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("attribute_designator: ", Indent); - Disp_Iir (Get_Attribute_Designator (N), Sub_Indent); - Header ("attribute_specification_chain: ", Indent); - Disp_Iir (Get_Attribute_Specification_Chain (N), Sub_Indent); - when Iir_Kind_Disconnection_Specification => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("signal_list: ", Indent); - Disp_Iir_List (Get_Signal_List (N), Sub_Indent); - Header ("type_mark: ", Indent); - Disp_Iir (Get_Type_Mark (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - when Iir_Kind_Configuration_Specification => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("instantiation_list: ", Indent); - Disp_Iir_List (Get_Instantiation_List (N), Sub_Indent); - Header ("binding_indication: ", Indent); - Disp_Iir (Get_Binding_Indication (N), Sub_Indent); - Header ("component_name: ", Indent); - Disp_Iir (Get_Component_Name (N), Sub_Indent); - when Iir_Kind_Access_Type_Definition => - Header ("designated_type: ", Indent); - Disp_Iir (Get_Designated_Type (N), Sub_Indent, True); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("designated_subtype_indication: ", Indent); - Disp_Iir (Get_Designated_Subtype_Indication (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Incomplete_Type_Definition => - Header ("incomplete_type_list: ", Indent); - Disp_Iir_List (Get_Incomplete_Type_List (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_File_Type_Definition => - Header ("file_type_mark: ", Indent); - Disp_Iir (Get_File_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("text_file_flag: ", Indent); - Put_Line (Image_Boolean (Get_Text_File_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Protected_Type_Declaration => - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("protected_type_body: ", Indent); - Disp_Iir (Get_Protected_Type_Body (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Record_Type_Definition => - Header ("elements_declaration_list: ", Indent); - Disp_Iir_List (Get_Elements_Declaration_List (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - Header ("constraint_state: ", Indent); - Put_Line (Image_Iir_Constraint (Get_Constraint_State (N))); - when Iir_Kind_Array_Type_Definition => - Header ("element_subtype_indication: ", Indent); - Disp_Iir (Get_Element_Subtype_Indication (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("index_subtype_list: ", Indent); - Disp_Iir_List (Get_Index_Subtype_List (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("index_constraint_flag: ", Indent); - Put_Line (Image_Boolean (Get_Index_Constraint_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - Header ("constraint_state: ", Indent); - Put_Line (Image_Iir_Constraint (Get_Constraint_State (N))); - when Iir_Kind_Array_Subtype_Definition => - Header ("element_subtype_indication: ", Indent); - Disp_Iir (Get_Element_Subtype_Indication (N), Sub_Indent); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolution_function: ", Indent); - Disp_Iir (Get_Resolution_Function (N), Sub_Indent); - Header ("index_subtype_list: ", Indent); - Disp_Iir_List (Get_Index_Subtype_List (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("index_constraint_flag: ", Indent); - Put_Line (Image_Boolean (Get_Index_Constraint_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - Header ("constraint_state: ", Indent); - Put_Line (Image_Iir_Constraint (Get_Constraint_State (N))); - when Iir_Kind_Record_Subtype_Definition => - Header ("elements_declaration_list: ", Indent); - Disp_Iir_List (Get_Elements_Declaration_List (N), Sub_Indent); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolution_function: ", Indent); - Disp_Iir (Get_Resolution_Function (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - Header ("constraint_state: ", Indent); - Put_Line (Image_Iir_Constraint (Get_Constraint_State (N))); - when Iir_Kind_Access_Subtype_Definition => - Header ("designated_type: ", Indent); - Disp_Iir (Get_Designated_Type (N), Sub_Indent, True); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("designated_subtype_indication: ", Indent); - Disp_Iir (Get_Designated_Subtype_Indication (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - Header ("range_constraint: ", Indent); - Disp_Iir (Get_Range_Constraint (N), Sub_Indent); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolution_function: ", Indent); - Disp_Iir (Get_Resolution_Function (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Floating_Subtype_Definition => - Header ("range_constraint: ", Indent); - Disp_Iir (Get_Range_Constraint (N), Sub_Indent); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolution_function: ", Indent); - Disp_Iir (Get_Resolution_Function (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Enumeration_Type_Definition => - Header ("range_constraint: ", Indent); - Disp_Iir (Get_Range_Constraint (N), Sub_Indent); - Header ("enumeration_literal_list: ", Indent); - Disp_Iir_List (Get_Enumeration_Literal_List (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("only_characters_flag: ", Indent); - Put_Line (Image_Boolean (Get_Only_Characters_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition => - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Physical_Type_Definition => - Header ("unit_chain: ", Indent); - Disp_Chain (Get_Unit_Chain (N), Sub_Indent); - Header ("type_declarator: ", Indent); - Disp_Iir (Get_Type_Declarator (N), Sub_Indent, True); - Header ("base_type: ", Indent); - Disp_Iir (Get_Base_Type (N), Sub_Indent, True); - Header ("resolved_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolved_Flag (N))); - Header ("signal_type_flag: ", Indent); - Put_Line (Image_Boolean (Get_Signal_Type_Flag (N))); - Header ("has_signal_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Signal_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - Header ("type_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Type_Staticness (N))); - when Iir_Kind_Range_Expression => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("left_limit: ", Indent); - Disp_Iir (Get_Left_Limit (N), Sub_Indent); - Header ("right_limit: ", Indent); - Disp_Iir (Get_Right_Limit (N), Sub_Indent); - Header ("range_origin: ", Indent); - Disp_Iir (Get_Range_Origin (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("direction: ", Indent); - Put_Line (Image_Iir_Direction (Get_Direction (N))); - when Iir_Kind_Protected_Type_Body => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("protected_type_declaration: ", Indent); - Disp_Iir (Get_Protected_Type_Declaration (N), Sub_Indent); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Subtype_Definition => - Header ("range_constraint: ", Indent); - Disp_Iir (Get_Range_Constraint (N), Sub_Indent); - Header ("subtype_type_mark: ", Indent); - Disp_Iir (Get_Subtype_Type_Mark (N), Sub_Indent); - Header ("resolution_function: ", Indent); - Disp_Iir (Get_Resolution_Function (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - when Iir_Kind_Scalar_Nature_Definition => - Header ("reference: ", Indent); - Disp_Iir (Get_Reference (N), Sub_Indent); - Header ("nature_declarator: ", Indent); - Disp_Iir (Get_Nature_Declarator (N), Sub_Indent); - Header ("across_type: ", Indent); - Disp_Iir (Get_Across_Type (N), Sub_Indent); - Header ("through_type: ", Indent); - Disp_Iir (Get_Through_Type (N), Sub_Indent); - when Iir_Kind_Overload_List => - Header ("overload_list: ", Indent); - Disp_Iir_List (Get_Overload_List (N), Sub_Indent, True); - when Iir_Kind_Type_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type_definition: ", Indent); - Disp_Iir (Get_Type_Definition (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Anonymous_Type_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type_definition: ", Indent); - Disp_Iir (Get_Type_Definition (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("subtype_definition: ", Indent); - Disp_Iir (Get_Subtype_Definition (N), Sub_Indent); - when Iir_Kind_Subtype_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("nature: ", Indent); - Disp_Iir (Get_Nature (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Package_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("package_body: ", Indent); - Disp_Iir (Get_Package_Body (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("package_header: ", Indent); - Disp_Iir (Get_Package_Header (N), Sub_Indent); - Header ("need_body: ", Indent); - Put_Line (Image_Boolean (Get_Need_Body (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Package_Instantiation_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("package_body: ", Indent); - Disp_Iir (Get_Package_Body (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("uninstantiated_name: ", Indent); - Disp_Iir (Get_Uninstantiated_Name (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Package_Body => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("package: ", Indent); - Disp_Iir (Get_Package (N), Sub_Indent, True); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Configuration_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("entity_name: ", Indent); - Disp_Iir (Get_Entity_Name (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("block_configuration: ", Indent); - Disp_Iir (Get_Block_Configuration (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Entity_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("concurrent_statement_chain: ", Indent); - Disp_Chain (Get_Concurrent_Statement_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("port_chain: ", Indent); - Disp_Chain (Get_Port_Chain (N), Sub_Indent); - Header ("has_begin: ", Indent); - Put_Line (Image_Boolean (Get_Has_Begin (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Architecture_Body => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("entity_name: ", Indent); - Disp_Iir (Get_Entity_Name (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("concurrent_statement_chain: ", Indent); - Disp_Chain (Get_Concurrent_Statement_Chain (N), Sub_Indent); - Header ("default_configuration_declaration: ", Indent); - Disp_Iir (Get_Default_Configuration_Declaration (N), Sub_Indent); - Header ("foreign_flag: ", Indent); - Put_Line (Image_Boolean (Get_Foreign_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Package_Header => - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - when Iir_Kind_Unit_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("physical_literal: ", Indent); - Disp_Iir (Get_Physical_Literal (N), Sub_Indent); - Header ("physical_unit_value: ", Indent); - Disp_Iir (Get_Physical_Unit_Value (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Library_Declaration => - Header ("design_file_chain: ", Indent); - Disp_Chain (Get_Design_File_Chain (N), Sub_Indent); - Header ("date: ", Indent); - Put_Line (Date_Type'Image (Get_Date (N))); - Header ("library_directory: ", Indent); - Put_Line (Image_Name_Id (Get_Library_Directory (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Component_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("port_chain: ", Indent); - Disp_Chain (Get_Port_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_is: ", Indent); - Put_Line (Image_Boolean (Get_Has_Is (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Attribute_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("type_mark: ", Indent); - Disp_Iir (Get_Type_Mark (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Group_Template_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("entity_class_entry_chain: ", Indent); - Disp_Chain (Get_Entity_Class_Entry_Chain (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Group_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("group_constituent_list: ", Indent); - Disp_Iir_List (Get_Group_Constituent_List (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("group_template_name: ", Indent); - Disp_Iir (Get_Group_Template_Name (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Element_Declaration => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("element_position: ", Indent); - Put_Line (Iir_Index32'Image (Get_Element_Position (N))); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - when Iir_Kind_Non_Object_Alias_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("name: ", Indent); - Disp_Iir (Get_Name (N), Sub_Indent); - Header ("alias_signature: ", Indent); - Disp_Iir (Get_Alias_Signature (N), Sub_Indent); - Header ("implicit_alias_flag: ", Indent); - Put_Line (Image_Boolean (Get_Implicit_Alias_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Psl_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("psl_declaration: ", Indent); - Disp_PSL_Node (Get_Psl_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("psl_clock: ", Indent); - Disp_PSL_Node (Get_PSL_Clock (N), Sub_Indent); - Header ("psl_nfa: ", Indent); - Disp_PSL_NFA (Get_PSL_NFA (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Terminal_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("nature: ", Indent); - Disp_Iir (Get_Nature (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - when Iir_Kind_Free_Quantity_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - Header ("plus_terminal: ", Indent); - Disp_Iir (Get_Plus_Terminal (N), Sub_Indent); - Header ("minus_terminal: ", Indent); - Disp_Iir (Get_Minus_Terminal (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Enumeration_Literal => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("enum_pos: ", Indent); - Put_Line (Iir_Int32'Image (Get_Enum_Pos (N))); - Header ("subprogram_hash: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Hash (N))); - Header ("literal_origin: ", Indent); - Disp_Iir (Get_Literal_Origin (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("enumeration_decl: ", Indent); - Disp_Iir (Get_Enumeration_Decl (N), Sub_Indent, True); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Function_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("return_type: ", Indent); - Disp_Iir (Get_Return_Type (N), Sub_Indent, True); - Header ("subprogram_depth: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Depth (N))); - Header ("subprogram_hash: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Hash (N))); - Header ("overload_number: ", Indent); - Put_Line (Iir_Int32'Image (Get_Overload_Number (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("interface_declaration_chain: ", Indent); - Disp_Chain (Get_Interface_Declaration_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("return_type_mark: ", Indent); - Disp_Iir (Get_Return_Type_Mark (N), Sub_Indent); - Header ("subprogram_body: ", Indent); - Disp_Iir (Get_Subprogram_Body (N), Sub_Indent, True); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("pure_flag: ", Indent); - Put_Line (Image_Boolean (Get_Pure_Flag (N))); - Header ("foreign_flag: ", Indent); - Put_Line (Image_Boolean (Get_Foreign_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("resolution_function_flag: ", Indent); - Put_Line (Image_Boolean (Get_Resolution_Function_Flag (N))); - Header ("has_pure: ", Indent); - Put_Line (Image_Boolean (Get_Has_Pure (N))); - Header ("has_body: ", Indent); - Put_Line (Image_Boolean (Get_Has_Body (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - Header ("all_sensitized_state: ", Indent); - Put_Line (Image_Iir_All_Sensitized (Get_All_Sensitized_State (N))); - when Iir_Kind_Implicit_Function_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("return_type: ", Indent); - Disp_Iir (Get_Return_Type (N), Sub_Indent, True); - Header ("type_reference: ", Indent); - Disp_Iir (Get_Type_Reference (N), Sub_Indent, True); - Header ("subprogram_hash: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Hash (N))); - Header ("overload_number: ", Indent); - Put_Line (Iir_Int32'Image (Get_Overload_Number (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("interface_declaration_chain: ", Indent); - Disp_Chain (Get_Interface_Declaration_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("implicit_definition: ", Indent); - Put_Line (Image_Iir_Predefined_Functions - (Get_Implicit_Definition (N))); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("pure_flag: ", Indent); - Put_Line (Image_Boolean (Get_Pure_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - when Iir_Kind_Implicit_Procedure_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type_reference: ", Indent); - Disp_Iir (Get_Type_Reference (N), Sub_Indent, True); - Header ("subprogram_hash: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Hash (N))); - Header ("overload_number: ", Indent); - Put_Line (Iir_Int32'Image (Get_Overload_Number (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("interface_declaration_chain: ", Indent); - Disp_Chain (Get_Interface_Declaration_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("implicit_definition: ", Indent); - Put_Line (Image_Iir_Predefined_Functions - (Get_Implicit_Definition (N))); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - when Iir_Kind_Procedure_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("subprogram_depth: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Depth (N))); - Header ("subprogram_hash: ", Indent); - Put_Line (Iir_Int32'Image (Get_Subprogram_Hash (N))); - Header ("overload_number: ", Indent); - Put_Line (Iir_Int32'Image (Get_Overload_Number (N))); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("interface_declaration_chain: ", Indent); - Disp_Chain (Get_Interface_Declaration_Chain (N), Sub_Indent); - Header ("generic_chain: ", Indent); - Disp_Chain (Get_Generic_Chain (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("return_type_mark: ", Indent); - Disp_Iir (Get_Return_Type_Mark (N), Sub_Indent); - Header ("subprogram_body: ", Indent); - Disp_Iir (Get_Subprogram_Body (N), Sub_Indent, True); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("passive_flag: ", Indent); - Put_Line (Image_Boolean (Get_Passive_Flag (N))); - Header ("foreign_flag: ", Indent); - Put_Line (Image_Boolean (Get_Foreign_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_body: ", Indent); - Put_Line (Image_Boolean (Get_Has_Body (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - Header ("purity_state: ", Indent); - Put_Line (Image_Iir_Pure_State (Get_Purity_State (N))); - Header ("all_sensitized_state: ", Indent); - Put_Line (Image_Iir_All_Sensitized (Get_All_Sensitized_State (N))); - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("impure_depth: ", Indent); - Put_Line (Iir_Int32'Image (Get_Impure_Depth (N))); - Header ("subprogram_specification: ", Indent); - Disp_Iir (Get_Subprogram_Specification (N), Sub_Indent, True); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Object_Alias_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("name: ", Indent); - Disp_Iir (Get_Name (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("after_drivers_flag: ", Indent); - Put_Line (Image_Boolean (Get_After_Drivers_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_File_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("file_logical_name: ", Indent); - Disp_Iir (Get_File_Logical_Name (N), Sub_Indent); - Header ("file_open_kind: ", Indent); - Disp_Iir (Get_File_Open_Kind (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - Header ("has_mode: ", Indent); - Put_Line (Image_Boolean (Get_Has_Mode (N))); - Header ("mode: ", Indent); - Put_Line (Image_Iir_Mode (Get_Mode (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Guard_Signal_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("guard_expression: ", Indent); - Disp_Iir (Get_Guard_Expression (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("guard_sensitivity_list: ", Indent); - Disp_Iir_List (Get_Guard_Sensitivity_List (N), Sub_Indent); - Header ("block_statement: ", Indent); - Disp_Iir (Get_Block_Statement (N), Sub_Indent); - Header ("has_active_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Active_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - Header ("signal_kind: ", Indent); - Put_Line (Image_Iir_Signal_Kind (Get_Signal_Kind (N))); - when Iir_Kind_Signal_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("signal_driver: ", Indent); - Disp_Iir (Get_Signal_Driver (N), Sub_Indent); - Header ("has_disconnect_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Disconnect_Flag (N))); - Header ("has_active_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Active_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("after_drivers_flag: ", Indent); - Put_Line (Image_Boolean (Get_After_Drivers_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - Header ("signal_kind: ", Indent); - Put_Line (Image_Iir_Signal_Kind (Get_Signal_Kind (N))); - when Iir_Kind_Variable_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("shared_flag: ", Indent); - Put_Line (Image_Boolean (Get_Shared_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Constant_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("deferred_declaration: ", Indent); - Disp_Iir (Get_Deferred_Declaration (N), Sub_Indent); - Header ("deferred_declaration_flag: ", Indent); - Put_Line (Image_Boolean (Get_Deferred_Declaration_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Iterator_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("discrete_range: ", Indent); - Disp_Iir (Get_Discrete_Range (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("has_identifier_list: ", Indent); - Put_Line (Image_Boolean (Get_Has_Identifier_List (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("after_drivers_flag: ", Indent); - Put_Line (Image_Boolean (Get_After_Drivers_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("mode: ", Indent); - Put_Line (Image_Iir_Mode (Get_Mode (N))); - Header ("lexical_layout: ", Indent); - Put_Line (Image_Iir_Lexical_Layout_Type - (Get_Lexical_Layout (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Signal_Interface_Declaration => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("default_value: ", Indent); - Disp_Iir (Get_Default_Value (N), Sub_Indent); - Header ("has_disconnect_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Disconnect_Flag (N))); - Header ("has_active_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Active_Flag (N))); - Header ("open_flag: ", Indent); - Put_Line (Image_Boolean (Get_Open_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("after_drivers_flag: ", Indent); - Put_Line (Image_Boolean (Get_After_Drivers_Flag (N))); - Header ("use_flag: ", Indent); - Put_Line (Image_Boolean (Get_Use_Flag (N))); - Header ("mode: ", Indent); - Put_Line (Image_Iir_Mode (Get_Mode (N))); - Header ("lexical_layout: ", Indent); - Put_Line (Image_Iir_Lexical_Layout_Type - (Get_Lexical_Layout (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - Header ("signal_kind: ", Indent); - Put_Line (Image_Iir_Signal_Kind (Get_Signal_Kind (N))); - when Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("operand: ", Indent); - Disp_Iir (Get_Operand (N), Sub_Indent); - Header ("implementation: ", Indent); - Disp_Iir (Get_Implementation (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("left: ", Indent); - Disp_Iir (Get_Left (N), Sub_Indent); - Header ("implementation: ", Indent); - Disp_Iir (Get_Implementation (N), Sub_Indent, True); - Header ("right: ", Indent); - Disp_Iir (Get_Right (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Function_Call => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("parameter_association_chain: ", Indent); - Disp_Chain (Get_Parameter_Association_Chain (N), Sub_Indent); - Header ("implementation: ", Indent); - Disp_Iir (Get_Implementation (N), Sub_Indent, True); - Header ("method_object: ", Indent); - Disp_Iir (Get_Method_Object (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Aggregate => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("aggregate_info: ", Indent); - Disp_Iir (Get_Aggregate_Info (N), Sub_Indent); - Header ("association_choices_chain: ", Indent); - Disp_Chain (Get_Association_Choices_Chain (N), Sub_Indent); - Header ("literal_subtype: ", Indent); - Disp_Iir (Get_Literal_Subtype (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("value_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Value_Staticness (N))); - when Iir_Kind_Parenthesis_Expression => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Qualified_Expression => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("type_mark: ", Indent); - Disp_Iir (Get_Type_Mark (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Type_Conversion => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("type_conversion_subtype: ", Indent); - Disp_Iir (Get_Type_Conversion_Subtype (N), Sub_Indent); - Header ("type_mark: ", Indent); - Disp_Iir (Get_Type_Mark (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Allocator_By_Expression => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("allocator_designated_type: ", Indent); - Disp_Iir (Get_Allocator_Designated_Type (N), Sub_Indent, True); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Allocator_By_Subtype => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("allocator_designated_type: ", Indent); - Disp_Iir (Get_Allocator_Designated_Type (N), Sub_Indent, True); - Header ("subtype_indication: ", Indent); - Disp_Iir (Get_Subtype_Indication (N), Sub_Indent); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Selected_Element => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("selected_element: ", Indent); - Disp_Iir (Get_Selected_Element (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Slice_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("suffix: ", Indent); - Disp_Iir (Get_Suffix (N), Sub_Indent); - Header ("slice_subtype: ", Indent); - Disp_Iir (Get_Slice_Subtype (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Indexed_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("index_list: ", Indent); - Disp_Iir_List (Get_Index_List (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Psl_Expression => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("psl_expression: ", Indent); - Disp_PSL_Node (Get_Psl_Expression (N), Sub_Indent); - when Iir_Kind_Sensitized_Process_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("sensitivity_list: ", Indent); - Disp_Iir_List (Get_Sensitivity_List (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("process_origin: ", Indent); - Disp_Iir (Get_Process_Origin (N), Sub_Indent); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("end_has_postponed: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Postponed (N))); - Header ("passive_flag: ", Indent); - Put_Line (Image_Boolean (Get_Passive_Flag (N))); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("has_is: ", Indent); - Put_Line (Image_Boolean (Get_Has_Is (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - when Iir_Kind_Process_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("callees_list: ", Indent); - Disp_Iir_List (Get_Callees_List (N), Sub_Indent); - Header ("process_origin: ", Indent); - Disp_Iir (Get_Process_Origin (N), Sub_Indent); - Header ("seen_flag: ", Indent); - Put_Line (Image_Boolean (Get_Seen_Flag (N))); - Header ("end_has_postponed: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Postponed (N))); - Header ("passive_flag: ", Indent); - Put_Line (Image_Boolean (Get_Passive_Flag (N))); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("has_is: ", Indent); - Put_Line (Image_Boolean (Get_Has_Is (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - Header ("wait_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Wait_State (N))); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("target: ", Indent); - Disp_Iir (Get_Target (N), Sub_Indent); - Header ("delay_mechanism: ", Indent); - Put_Line (Image_Iir_Delay_Mechanism (Get_Delay_Mechanism (N))); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("reject_time_expression: ", Indent); - Disp_Iir (Get_Reject_Time_Expression (N), Sub_Indent); - Header ("conditional_waveform_chain: ", Indent); - Disp_Chain (Get_Conditional_Waveform_Chain (N), Sub_Indent); - Header ("guard: ", Indent); - Disp_Iir (Get_Guard (N), Sub_Indent); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("guarded_target_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Guarded_Target_State (N))); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("target: ", Indent); - Disp_Iir (Get_Target (N), Sub_Indent); - Header ("delay_mechanism: ", Indent); - Put_Line (Image_Iir_Delay_Mechanism (Get_Delay_Mechanism (N))); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("reject_time_expression: ", Indent); - Disp_Iir (Get_Reject_Time_Expression (N), Sub_Indent); - Header ("selected_waveform_chain: ", Indent); - Disp_Chain (Get_Selected_Waveform_Chain (N), Sub_Indent); - Header ("guard: ", Indent); - Disp_Iir (Get_Guard (N), Sub_Indent); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("guarded_target_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Guarded_Target_State (N))); - when Iir_Kind_Concurrent_Assertion_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("assertion_condition: ", Indent); - Disp_Iir (Get_Assertion_Condition (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("severity_expression: ", Indent); - Disp_Iir (Get_Severity_Expression (N), Sub_Indent); - Header ("report_expression: ", Indent); - Disp_Iir (Get_Report_Expression (N), Sub_Indent); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Psl_Default_Clock => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("psl_boolean: ", Indent); - Disp_PSL_Node (Get_Psl_Boolean (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("psl_property: ", Indent); - Disp_PSL_Node (Get_Psl_Property (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("severity_expression: ", Indent); - Disp_Iir (Get_Severity_Expression (N), Sub_Indent); - Header ("report_expression: ", Indent); - Disp_Iir (Get_Report_Expression (N), Sub_Indent); - Header ("psl_clock: ", Indent); - Disp_PSL_Node (Get_PSL_Clock (N), Sub_Indent); - Header ("psl_nfa: ", Indent); - Disp_PSL_NFA (Get_PSL_NFA (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("procedure_call: ", Indent); - Disp_Iir (Get_Procedure_Call (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("postponed_flag: ", Indent); - Put_Line (Image_Boolean (Get_Postponed_Flag (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Block_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("concurrent_statement_chain: ", Indent); - Disp_Chain (Get_Concurrent_Statement_Chain (N), Sub_Indent); - Header ("block_block_configuration: ", Indent); - Disp_Iir (Get_Block_Block_Configuration (N), Sub_Indent); - Header ("block_header: ", Indent); - Disp_Iir (Get_Block_Header (N), Sub_Indent); - Header ("guard_decl: ", Indent); - Disp_Iir (Get_Guard_Decl (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Generate_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("declaration_chain: ", Indent); - Disp_Chain (Get_Declaration_Chain (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("concurrent_statement_chain: ", Indent); - Disp_Chain (Get_Concurrent_Statement_Chain (N), Sub_Indent); - Header ("generation_scheme: ", Indent); - Disp_Iir (Get_Generation_Scheme (N), Sub_Indent); - Header ("generate_block_configuration: ", Indent); - Disp_Iir (Get_Generate_Block_Configuration (N), Sub_Indent); - Header ("has_begin: ", Indent); - Put_Line (Image_Boolean (Get_Has_Begin (N))); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_reserved_id: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Reserved_Id (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Component_Instantiation_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("instantiated_unit: ", Indent); - Disp_Iir (Get_Instantiated_Unit (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("default_binding_indication: ", Indent); - Disp_Iir (Get_Default_Binding_Indication (N), Sub_Indent); - Header ("component_configuration: ", Indent); - Disp_Iir (Get_Component_Configuration (N), Sub_Indent); - Header ("configuration_specification: ", Indent); - Disp_Iir (Get_Configuration_Specification (N), Sub_Indent); - Header ("generic_map_aspect_chain: ", Indent); - Disp_Chain (Get_Generic_Map_Aspect_Chain (N), Sub_Indent); - Header ("port_map_aspect_chain: ", Indent); - Disp_Chain (Get_Port_Map_Aspect_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Simple_Simultaneous_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("simultaneous_left: ", Indent); - Disp_Iir (Get_Simultaneous_Left (N), Sub_Indent); - Header ("simultaneous_right: ", Indent); - Disp_Iir (Get_Simultaneous_Right (N), Sub_Indent); - Header ("tolerance: ", Indent); - Disp_Iir (Get_Tolerance (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Signal_Assignment_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("target: ", Indent); - Disp_Iir (Get_Target (N), Sub_Indent); - Header ("delay_mechanism: ", Indent); - Put_Line (Image_Iir_Delay_Mechanism (Get_Delay_Mechanism (N))); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("waveform_chain: ", Indent); - Disp_Chain (Get_Waveform_Chain (N), Sub_Indent); - Header ("reject_time_expression: ", Indent); - Disp_Iir (Get_Reject_Time_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("guarded_target_state: ", Indent); - Put_Line (Image_Tri_State_Type (Get_Guarded_Target_State (N))); - when Iir_Kind_Null_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Assertion_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("assertion_condition: ", Indent); - Disp_Iir (Get_Assertion_Condition (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("severity_expression: ", Indent); - Disp_Iir (Get_Severity_Expression (N), Sub_Indent); - Header ("report_expression: ", Indent); - Disp_Iir (Get_Report_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Report_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("severity_expression: ", Indent); - Disp_Iir (Get_Severity_Expression (N), Sub_Indent); - Header ("report_expression: ", Indent); - Disp_Iir (Get_Report_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Wait_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("timeout_clause: ", Indent); - Disp_Iir (Get_Timeout_Clause (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("condition_clause: ", Indent); - Disp_Iir (Get_Condition_Clause (N), Sub_Indent); - Header ("sensitivity_list: ", Indent); - Disp_Iir_List (Get_Sensitivity_List (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Variable_Assignment_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("target: ", Indent); - Disp_Iir (Get_Target (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Return_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_For_Loop_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("parameter_specification: ", Indent); - Disp_Iir (Get_Parameter_Specification (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("is_within_flag: ", Indent); - Put_Line (Image_Boolean (Get_Is_Within_Flag (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_While_Loop_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("condition: ", Indent); - Disp_Iir (Get_Condition (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("condition: ", Indent); - Disp_Iir (Get_Condition (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("loop_label: ", Indent); - Disp_Iir (Get_Loop_Label (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_Case_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("case_statement_alternative_chain: ", Indent); - Disp_Chain (Get_Case_Statement_Alternative_Chain (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("expression: ", Indent); - Disp_Iir (Get_Expression (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Procedure_Call_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("procedure_call: ", Indent); - Disp_Iir (Get_Procedure_Call (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - when Iir_Kind_If_Statement => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("condition: ", Indent); - Disp_Iir (Get_Condition (N), Sub_Indent); - Header ("label: ", Indent); - Put_Line (Image_Name_Id (Get_Label (N))); - Header ("attribute_value_chain: ", Indent); - Disp_Iir (Get_Attribute_Value_Chain (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("else_clause: ", Indent); - Disp_Iir (Get_Else_Clause (N), Sub_Indent); - Header ("visible_flag: ", Indent); - Put_Line (Image_Boolean (Get_Visible_Flag (N))); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Elsif => - Header ("parent: ", Indent); - Disp_Iir (Get_Parent (N), Sub_Indent, True); - Header ("condition: ", Indent); - Disp_Iir (Get_Condition (N), Sub_Indent); - Header ("sequential_statement_chain: ", Indent); - Disp_Chain (Get_Sequential_Statement_Chain (N), Sub_Indent); - Header ("else_clause: ", Indent); - Disp_Iir (Get_Else_Clause (N), Sub_Indent); - Header ("end_has_identifier: ", Indent); - Put_Line (Image_Boolean (Get_End_Has_Identifier (N))); - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("alias_declaration: ", Indent); - Disp_Iir (Get_Alias_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Selected_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("alias_declaration: ", Indent); - Disp_Iir (Get_Alias_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Operator_Symbol => - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("alias_declaration: ", Indent); - Disp_Iir (Get_Alias_Declaration (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - when Iir_Kind_Selected_By_All_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - when Iir_Kind_Parenthesis_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("association_chain: ", Indent); - Disp_Chain (Get_Association_Chain (N), Sub_Indent); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - when Iir_Kind_Base_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - when Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("parameter: ", Indent); - Disp_Iir (Get_Parameter (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("parameter: ", Indent); - Disp_Iir (Get_Parameter (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("has_active_flag: ", Indent); - Put_Line (Image_Boolean (Get_Has_Active_Flag (N))); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Simple_Name_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("simple_name_identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Simple_Name_Identifier (N))); - Header ("simple_name_subtype: ", Indent); - Disp_Iir (Get_Simple_Name_Subtype (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("index_subtype: ", Indent); - Disp_Iir (Get_Index_Subtype (N), Sub_Indent); - Header ("parameter: ", Indent); - Disp_Iir (Get_Parameter (N), Sub_Indent); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - when Iir_Kind_Attribute_Name => - Header ("prefix: ", Indent); - Disp_Iir (Get_Prefix (N), Sub_Indent); - Header ("type: ", Indent); - Disp_Iir (Get_Type (N), Sub_Indent, True); - Header ("attribute_signature: ", Indent); - Disp_Iir (Get_Attribute_Signature (N), Sub_Indent); - Header ("identifier: ", Indent); - Put_Line (Image_Name_Id (Get_Identifier (N))); - Header ("named_entity: ", Indent); - Disp_Iir (Get_Named_Entity (N), Sub_Indent, True); - Header ("base_name: ", Indent); - Disp_Iir (Get_Base_Name (N), Sub_Indent, True); - Header ("expr_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Expr_Staticness (N))); - Header ("name_staticness: ", Indent); - Put_Line (Image_Iir_Staticness (Get_Name_Staticness (N))); - end case; + declare + use Nodes_Meta; + Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); + F : Fields_Enum; + begin + for I in Fields'Range loop + F := Fields (I); + Header (Get_Field_Image (F), Indent); + case Get_Field_Type (F) is + when Type_Iir => + case Get_Field_Attribute (F) is + when Attr_None => + Disp_Iir (Get_Iir (N, F), Sub_Indent); + when Attr_Ref => + Disp_Iir (Get_Iir (N, F), Sub_Indent, True); + when Attr_Maybe_Ref => + Disp_Iir (Get_Iir (N, F), Sub_Indent, Get_Is_Ref (N)); + when Attr_Chain => + Disp_Chain (Get_Iir (N, F), Sub_Indent); + when Attr_Chain_Next => + Disp_Iir_Number (Get_Iir (N, F)); + New_Line; + when Attr_Of_Ref => + raise Internal_Error; + end case; + when Type_Iir_List => + Disp_Iir_List (Get_Iir_List (N, F), Sub_Indent, + Get_Field_Attribute (F) = Attr_Of_Ref); + when Type_PSL_NFA => + Disp_PSL_NFA (Get_PSL_NFA (N, F), Sub_Indent); + when Type_String_Id => + Put_Line (Image_String_Id (Get_String_Id (N, F))); + when Type_PSL_Node => + Disp_PSL_Node (Get_PSL_Node (N, F), Sub_Indent); + when Type_Source_Ptr => + Put_Line (Source_Ptr'Image (Get_Source_Ptr (N, F))); + when Type_Date_Type => + Put_Line (Date_Type'Image (Get_Date_Type (N, F))); + when Type_Base_Type => + Put_Line (Base_Type'Image (Get_Base_Type (N, F))); + when Type_Iir_Constraint => + Put_Line (Image_Iir_Constraint + (Get_Iir_Constraint (N, F))); + when Type_Iir_Mode => + Put_Line (Image_Iir_Mode (Get_Iir_Mode (N, F))); + when Type_Iir_Index32 => + Put_Line (Iir_Index32'Image (Get_Iir_Index32 (N, F))); + when Type_Iir_Int64 => + Put_Line (Iir_Int64'Image (Get_Iir_Int64 (N, F))); + when Type_Boolean => + Put_Line (Image_Boolean + (Get_Boolean (N, F))); + when Type_Iir_Staticness => + Put_Line (Image_Iir_Staticness + (Get_Iir_Staticness (N, F))); + when Type_Date_State_Type => + Put_Line (Image_Date_State_Type + (Get_Date_State_Type (N, F))); + when Type_Iir_All_Sensitized => + Put_Line (Image_Iir_All_Sensitized + (Get_Iir_All_Sensitized (N, F))); + when Type_Iir_Signal_Kind => + Put_Line (Image_Iir_Signal_Kind + (Get_Iir_Signal_Kind (N, F))); + when Type_Tri_State_Type => + Put_Line (Image_Tri_State_Type + (Get_Tri_State_Type (N, F))); + when Type_Iir_Pure_State => + Put_Line (Image_Iir_Pure_State + (Get_Iir_Pure_State (N, F))); + when Type_Iir_Delay_Mechanism => + Put_Line (Image_Iir_Delay_Mechanism + (Get_Iir_Delay_Mechanism (N, F))); + when Type_Iir_Lexical_Layout_Type => + Put_Line (Image_Iir_Lexical_Layout_Type + (Get_Iir_Lexical_Layout_Type (N, F))); + when Type_Iir_Predefined_Functions => + Put_Line (Image_Iir_Predefined_Functions + (Get_Iir_Predefined_Functions (N, F))); + when Type_Iir_Direction => + Put_Line (Image_Iir_Direction + (Get_Iir_Direction (N, F))); + when Type_Location_Type => + Put_Line (Image_Location_Type + (Get_Location_Type (N, F))); + when Type_Iir_Int32 => + Put_Line (Iir_Int32'Image (Get_Iir_Int32 (N, F))); + when Type_Int32 => + Put_Line (Int32'Image (Get_Int32 (N, F))); + when Type_Iir_Fp64 => + Put_Line (Iir_Fp64'Image (Get_Iir_Fp64 (N, F))); + when Type_Time_Stamp_Id => + Put_Line (Image_Time_Stamp_Id + (Get_Time_Stamp_Id (N, F))); + when Type_Token_Type => + Put_Line (Image_Token_Type (Get_Token_Type (N, F))); + when Type_Name_Id => + Put_Line (Image_Name_Id (Get_Name_Id (N, F))); + end case; + end loop; + end; end Disp_Iir; - procedure Disp_Tree_For_Psl (N : Int32) is begin Disp_Tree_Flat (Iir (N), 1); diff --git a/disp_vhdl.adb b/disp_vhdl.adb index fd3d71062..018db271a 100644 --- a/disp_vhdl.adb +++ b/disp_vhdl.adb @@ -373,68 +373,50 @@ package body Disp_Vhdl is end Disp_Use_Clause; -- Disp the resolution function (if any) of type definition DEF. - procedure Disp_Resolution_Function (Subtype_Def: Iir) + procedure Disp_Resolution_Indication (Subtype_Def: Iir) is - -- Return TRUE iff subtype indication DEF has a resolution function - -- that differ from its type mark. - function Has_Own_Resolution_Function (Def : Iir) return Boolean is + procedure Inner (Ind : Iir) is begin - -- Only subtype indications may have their own resolution functions. - if Get_Kind (Def) not in Iir_Kinds_Subtype_Definition then - return False; - end if; - - -- A resolution function is present. - if Get_Resolution_Function (Def) /= Null_Iir then - return True; - end if; - - case Get_Kind (Def) is - when Iir_Kind_Array_Subtype_Definition => - declare - El_Def : constant Iir := Get_Element_Subtype (Def); - begin - if El_Def /= Get_Element_Subtype (Get_Base_Type (Def)) then - return Has_Own_Resolution_Function (El_Def); - else - return False; - end if; - end; + case Get_Kind (Ind) is + when Iir_Kinds_Denoting_Name => + Disp_Name (Ind); + when Iir_Kind_Array_Element_Resolution => + Put ("("); + Inner (Get_Resolution_Indication (Ind)); + Put (")"); when others => - Error_Kind ("disp_resolution_function(1)", Def); + Error_Kind ("disp_resolution_indication", Ind); end case; - end Has_Own_Resolution_Function; + end Inner; - procedure Inner (Def : Iir) - is - Decl: Iir; - begin - if Get_Kind (Def) in Iir_Kinds_Subtype_Definition then - Decl := Get_Resolution_Function (Def); - if Decl /= Null_Iir then - Disp_Name (Decl); - else - case Get_Kind (Def) is - when Iir_Kind_Array_Subtype_Definition => - Put ('('); - Inner (Get_Element_Subtype (Def)); - Put (')'); - when others => - Error_Kind ("disp_resolution_function(2)", Def); - end case; + 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; + + 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 Inner; + end; - begin - if not Get_Resolved_Flag (Subtype_Def) then - return; - end if; - if Has_Own_Resolution_Function (Subtype_Def) then - Inner (Subtype_Def); - Put (' '); - end if; - end Disp_Resolution_Function; + Inner (Ind); + Put (" "); + end Disp_Resolution_Indication; procedure Disp_Integer_Subtype_Definition (Def: Iir_Integer_Subtype_Definition) @@ -452,7 +434,7 @@ package body Disp_Vhdl is Put (" "); end if; end if; - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); Put ("range "); Disp_Expression (Get_Range_Constraint (Def)); Put (";"); @@ -474,7 +456,7 @@ package body Disp_Vhdl is Put (" "); end if; end if; - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); Put ("range "); Disp_Expression (Get_Range_Constraint (Def)); Put (";"); @@ -494,21 +476,19 @@ package body Disp_Vhdl is return; end if; - if Get_Constraint_State (Type_Mark) /= Fully_Constrained then + if Get_Constraint_State (Type_Mark) /= Fully_Constrained + and then Has_Index + then Put (" ("); - if Has_Index then - for I in Natural loop - Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); - exit when Index = Null_Iir; - if I /= 0 then - Put (", "); - end if; - --Disp_Expression (Get_Range_Constraint (Index)); - Disp_Range (Index); - end loop; - else - Put ("open"); - end if; + for I in Natural loop + Index := Get_Nth_Element (Get_Index_Subtype_List (Def), I); + exit when Index = Null_Iir; + if I /= 0 then + Put (", "); + end if; + --Disp_Expression (Get_Range_Constraint (Index)); + Disp_Range (Index); + end loop; Put (")"); end if; @@ -586,7 +566,7 @@ package body Disp_Vhdl is end if; -- Resolution function name. - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); -- type mark. Type_Mark := Get_Subtype_Type_Mark (Def); @@ -674,7 +654,7 @@ package body Disp_Vhdl is (Def: Iir_Enumeration_Subtype_Definition) is begin - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); Put ("range "); Disp_Range (Def); Put (";"); @@ -689,12 +669,11 @@ package body Disp_Vhdl is end if; end Disp_Discrete_Range; - procedure Disp_Array_Subtype_Definition - (Def: Iir_Array_Subtype_Definition) + procedure Disp_Array_Subtype_Definition (Def: Iir_Array_Subtype_Definition) is Index: Iir; begin - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); Put ("array ("); for I in Natural loop @@ -747,7 +726,7 @@ package body Disp_Vhdl is procedure Disp_Physical_Subtype_Definition (Def: Iir_Physical_Subtype_Definition) is begin - Disp_Resolution_Function (Def); + Disp_Resolution_Indication (Def); Put ("range "); Disp_Expression (Get_Range_Constraint (Def)); end Disp_Physical_Subtype_Definition; @@ -1141,9 +1120,8 @@ package body Disp_Vhdl is end Disp_Generics; procedure Disp_Entity_Declaration (Decl: Iir_Entity_Declaration) is - Start: Count; + Start: constant Count := Col; begin - Start := Col; Put ("entity "); Disp_Name_Of (Decl); Put_Line (" is"); @@ -1224,7 +1202,7 @@ package body Disp_Vhdl is List : Iir_List; El : Iir; begin - Disp_Name (Get_Prefix (Sig)); + Disp_Name (Get_Signature_Prefix (Sig)); Put (" ["); List := Get_Type_Marks_List (Sig); if List /= Null_Iir_List then @@ -2941,11 +2919,17 @@ package body Disp_Vhdl is end case; end Disp_Concurrent_Statement; - procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration) is + procedure Disp_Package_Declaration (Decl: Iir_Package_Declaration) + is + Header : constant Iir := Get_Package_Header (Decl); begin Put ("package "); Disp_Identifier (Decl); Put_Line (" is"); + if Header /= Null_Iir then + Disp_Generics (Header); + New_Line; + end if; Disp_Declaration_Chain (Decl, Col + Indentation); Disp_End (Decl, "package"); end Disp_Package_Declaration; @@ -2960,6 +2944,17 @@ package body Disp_Vhdl is Disp_End (Decl, "package body"); end Disp_Package_Body; + procedure Disp_Package_Instantiation_Declaration (Decl: Iir) is + begin + Put ("package "); + Disp_Identifier (Decl); + Put_Line (" is new "); + Disp_Name (Get_Uninstantiated_Name (Decl)); + Put (" "); + Disp_Generic_Map_Aspect (Decl); + Put_Line (";"); + end Disp_Package_Instantiation_Declaration; + procedure Disp_Binding_Indication (Bind : Iir; Indent : Count) is El : Iir; @@ -3131,6 +3126,8 @@ package body Disp_Vhdl is Disp_Package_Declaration (Decl); when Iir_Kind_Package_Body => Disp_Package_Body (Decl); + when Iir_Kind_Package_Instantiation_Declaration => + Disp_Package_Instantiation_Declaration (Decl); when Iir_Kind_Configuration_Declaration => Disp_Configuration_Declaration (Decl); when others => diff --git a/errorout.adb b/errorout.adb index 839346528..4dde4562d 100644 --- a/errorout.adb +++ b/errorout.adb @@ -388,6 +388,12 @@ package body Errorout is return Disp_Identifier (Node, "element"); when Iir_Kind_Record_Element_Constraint => return "record element constraint"; + when Iir_Kind_Array_Element_Resolution => + return "array element resolution"; + when Iir_Kind_Record_Resolution => + return "record resolution"; + when Iir_Kind_Record_Element_Resolution => + return "record element resolution"; when Iir_Kind_Null_Literal => return "null literal"; when Iir_Kind_Overflow_Literal => diff --git a/evaluation.adb b/evaluation.adb index a20d2c68f..dd16b2276 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -288,6 +288,22 @@ package body Evaluation is return Res; end Build_Constant_Range; + function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir + is + Orig_Type : constant Iir := Get_Base_Type (Get_Type (Origin)); + begin + case Get_Kind (Orig_Type) is + when Iir_Kind_Integer_Type_Definition => + if Is_Pos then + return Build_Integer (Iir_Int64'Last, Origin); + else + return Build_Integer (Iir_Int64'First, Origin); + end if; + when others => + Error_Kind ("build_extreme_value", Orig_Type); + end case; + end Build_Extreme_Value; + -- A_RANGE is a range expression, whose type, location, expr_staticness, -- left_limit and direction are set. -- Type of A_RANGE must have a range_constraint. diff --git a/evaluation.ads b/evaluation.ads index 76a40207b..66ec2a1cc 100644 --- a/evaluation.ads +++ b/evaluation.ads @@ -122,6 +122,10 @@ package Evaluation is -- EXPR must be of a discrete subtype. function Eval_Pos (Expr : Iir) return Iir_Int64; + -- Replace ORIGIN (an overflow literal) with extreme positive value (if + -- IS_POS is true) or extreme negative value. + function Build_Extreme_Value (Is_Pos : Boolean; Origin : Iir) return Iir; + -- Create an array subtype from LEN and BASE_TYPE, according to rules -- of LRM93 7.3.2.2. (which are the same as LRM93 7.2.4). function Create_Unidim_Array_By_Length diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb index 361d0f663..c86f1db06 100644 --- a/ieee-vital_timing.adb +++ b/ieee-vital_timing.adb @@ -272,7 +272,7 @@ package body Ieee.Vital_Timing is Base_Type := Get_Base_Type (Atype); Type_Decl := Get_Type_Declarator (Atype); if Base_Type = Std_Logic_Vector_Type then - if Get_Resolution_Function (Atype) /= Null_Iir then + if Get_Resolution_Indication (Atype) /= Null_Iir then Error_Vital ("VITAL array port type cannot override resolution function", Decl); @@ -17,9 +17,9 @@ -- 02111-1307, USA. with Ada.Unchecked_Conversion; with Ada.Text_IO; -with Errorout; use Errorout; with Nodes; use Nodes; with Lists; use Lists; +with Nodes_Meta; use Nodes_Meta; package body Iirs is function Is_Null (Node : Iir) return Boolean is @@ -36,20 +36,6 @@ package body Iirs is -- General subprograms that operate on every iir -- --------------------------------------------------- - -- This is the procedure to call when an internal consistancy test has - -- failed. - -- The main idea is the consistancy test *MUST* have no side effect, - -- except calling this procedure. To speed up, this procedure could - -- be a no-op. - procedure Failed (Func: String := ""; Node : Iir := Null_Iir) - is - begin - if Func /= "" then - Error_Kind (Func, Node); - end if; - raise Internal_Error; - end Failed; - function Get_Format (Kind : Iir_Kind) return Format_Type; function Create_Iir (Kind : Iir_Kind) return Iir @@ -271,6 +257,9 @@ package body Iirs is | Iir_Kind_Aggregate_Info | Iir_Kind_Procedure_Call | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Array_Element_Resolution + | Iir_Kind_Record_Resolution + | Iir_Kind_Record_Element_Resolution | Iir_Kind_Disconnection_Specification | Iir_Kind_Configuration_Specification | Iir_Kind_Access_Type_Definition @@ -485,7547 +474,4025 @@ package body Iirs is end case; end Get_Format; - procedure Check_Kind_For_First_Design_Unit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("First_Design_Unit", Target); - end case; - end Check_Kind_For_First_Design_Unit; - function Get_First_Design_Unit (Design : Iir) return Iir is begin - Check_Kind_For_First_Design_Unit (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_First_Design_Unit (Get_Kind (Design))); return Get_Field5 (Design); end Get_First_Design_Unit; procedure Set_First_Design_Unit (Design : Iir; Chain : Iir) is begin - Check_Kind_For_First_Design_Unit (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_First_Design_Unit (Get_Kind (Design))); Set_Field5 (Design, Chain); end Set_First_Design_Unit; - procedure Check_Kind_For_Last_Design_Unit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("Last_Design_Unit", Target); - end case; - end Check_Kind_For_Last_Design_Unit; - function Get_Last_Design_Unit (Design : Iir) return Iir is begin - Check_Kind_For_Last_Design_Unit (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Last_Design_Unit (Get_Kind (Design))); return Get_Field6 (Design); end Get_Last_Design_Unit; procedure Set_Last_Design_Unit (Design : Iir; Chain : Iir) is begin - Check_Kind_For_Last_Design_Unit (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Last_Design_Unit (Get_Kind (Design))); Set_Field6 (Design, Chain); end Set_Last_Design_Unit; - procedure Check_Kind_For_Library_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Library_Clause => - null; - when others => - Failed ("Library_Declaration", Target); - end case; - end Check_Kind_For_Library_Declaration; - function Get_Library_Declaration (Design : Iir) return Iir is begin - Check_Kind_For_Library_Declaration (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Library_Declaration (Get_Kind (Design))); return Get_Field1 (Design); end Get_Library_Declaration; procedure Set_Library_Declaration (Design : Iir; Library : Iir) is begin - Check_Kind_For_Library_Declaration (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Library_Declaration (Get_Kind (Design))); Set_Field1 (Design, Library); end Set_Library_Declaration; - procedure Check_Kind_For_File_Time_Stamp (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("File_Time_Stamp", Target); - end case; - end Check_Kind_For_File_Time_Stamp; - function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is begin - Check_Kind_For_File_Time_Stamp (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_File_Time_Stamp (Get_Kind (Design))); return Iir_To_Time_Stamp_Id (Get_Field4 (Design)); end Get_File_Time_Stamp; procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is begin - Check_Kind_For_File_Time_Stamp (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_File_Time_Stamp (Get_Kind (Design))); Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp)); end Set_File_Time_Stamp; - procedure Check_Kind_For_Analysis_Time_Stamp (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("Analysis_Time_Stamp", Target); - end case; - end Check_Kind_For_Analysis_Time_Stamp; - function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is begin - Check_Kind_For_Analysis_Time_Stamp (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design))); return Iir_To_Time_Stamp_Id (Get_Field3 (Design)); end Get_Analysis_Time_Stamp; procedure Set_Analysis_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is begin - Check_Kind_For_Analysis_Time_Stamp (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Analysis_Time_Stamp (Get_Kind (Design))); Set_Field3 (Design, Time_Stamp_Id_To_Iir (Stamp)); end Set_Analysis_Time_Stamp; - procedure Check_Kind_For_Library (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("Library", Target); - end case; - end Check_Kind_For_Library; - function Get_Library (File : Iir_Design_File) return Iir is begin - Check_Kind_For_Library (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Library (Get_Kind (File))); return Get_Field0 (File); end Get_Library; procedure Set_Library (File : Iir_Design_File; Lib : Iir) is begin - Check_Kind_For_Library (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Library (Get_Kind (File))); Set_Field0 (File, Lib); end Set_Library; - procedure Check_Kind_For_File_Dependence_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("File_Dependence_List", Target); - end case; - end Check_Kind_For_File_Dependence_List; - function Get_File_Dependence_List (File : Iir_Design_File) return Iir_List - is + is begin - Check_Kind_For_File_Dependence_List (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_File_Dependence_List (Get_Kind (File))); return Iir_To_Iir_List (Get_Field1 (File)); end Get_File_Dependence_List; procedure Set_File_Dependence_List (File : Iir_Design_File; Lst : Iir_List) - is + is begin - Check_Kind_For_File_Dependence_List (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_File_Dependence_List (Get_Kind (File))); Set_Field1 (File, Iir_List_To_Iir (Lst)); end Set_File_Dependence_List; - procedure Check_Kind_For_Design_File_Filename (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("Design_File_Filename", Target); - end case; - end Check_Kind_For_Design_File_Filename; - function Get_Design_File_Filename (File : Iir_Design_File) return Name_Id - is + is begin - Check_Kind_For_Design_File_Filename (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Design_File_Filename (Get_Kind (File))); return Name_Id'Val (Get_Field12 (File)); end Get_Design_File_Filename; procedure Set_Design_File_Filename (File : Iir_Design_File; Name : Name_Id) - is + is begin - Check_Kind_For_Design_File_Filename (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Design_File_Filename (Get_Kind (File))); Set_Field12 (File, Name_Id'Pos (Name)); end Set_Design_File_Filename; - procedure Check_Kind_For_Design_File_Directory (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File => - null; - when others => - Failed ("Design_File_Directory", Target); - end case; - end Check_Kind_For_Design_File_Directory; - function Get_Design_File_Directory (File : Iir_Design_File) return Name_Id - is + is begin - Check_Kind_For_Design_File_Directory (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Design_File_Directory (Get_Kind (File))); return Name_Id'Val (Get_Field11 (File)); end Get_Design_File_Directory; procedure Set_Design_File_Directory (File : Iir_Design_File; Dir : Name_Id) - is + is begin - Check_Kind_For_Design_File_Directory (File); + pragma Assert (File /= Null_Iir); + pragma Assert (Has_Design_File_Directory (Get_Kind (File))); Set_Field11 (File, Name_Id'Pos (Dir)); end Set_Design_File_Directory; - procedure Check_Kind_For_Design_File (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Design_File", Target); - end case; - end Check_Kind_For_Design_File; - function Get_Design_File (Unit : Iir_Design_Unit) return Iir is begin - Check_Kind_For_Design_File (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Design_File (Get_Kind (Unit))); return Get_Field0 (Unit); end Get_Design_File; procedure Set_Design_File (Unit : Iir_Design_Unit; File : Iir) is begin - Check_Kind_For_Design_File (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Design_File (Get_Kind (Unit))); Set_Field0 (Unit, File); end Set_Design_File; - procedure Check_Kind_For_Design_File_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Library_Declaration => - null; - when others => - Failed ("Design_File_Chain", Target); - end case; - end Check_Kind_For_Design_File_Chain; - function Get_Design_File_Chain (Library : Iir) return Iir is begin - Check_Kind_For_Design_File_Chain (Library); + pragma Assert (Library /= Null_Iir); + pragma Assert (Has_Design_File_Chain (Get_Kind (Library))); return Get_Field1 (Library); end Get_Design_File_Chain; procedure Set_Design_File_Chain (Library : Iir; Chain : Iir) is begin - Check_Kind_For_Design_File_Chain (Library); + pragma Assert (Library /= Null_Iir); + pragma Assert (Has_Design_File_Chain (Get_Kind (Library))); Set_Field1 (Library, Chain); end Set_Design_File_Chain; - procedure Check_Kind_For_Library_Directory (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Library_Declaration => - null; - when others => - Failed ("Library_Directory", Target); - end case; - end Check_Kind_For_Library_Directory; - function Get_Library_Directory (Library : Iir) return Name_Id is begin - Check_Kind_For_Library_Directory (Library); + pragma Assert (Library /= Null_Iir); + pragma Assert (Has_Library_Directory (Get_Kind (Library))); return Name_Id'Val (Get_Field11 (Library)); end Get_Library_Directory; procedure Set_Library_Directory (Library : Iir; Dir : Name_Id) is begin - Check_Kind_For_Library_Directory (Library); + pragma Assert (Library /= Null_Iir); + pragma Assert (Has_Library_Directory (Get_Kind (Library))); Set_Field11 (Library, Name_Id'Pos (Dir)); end Set_Library_Directory; - procedure Check_Kind_For_Date (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit - | Iir_Kind_Library_Declaration => - null; - when others => - Failed ("Date", Target); - end case; - end Check_Kind_For_Date; - function Get_Date (Target : Iir) return Date_Type is begin - Check_Kind_For_Date (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Date (Get_Kind (Target))); return Date_Type'Val (Get_Field10 (Target)); end Get_Date; procedure Set_Date (Target : Iir; Date : Date_Type) is begin - Check_Kind_For_Date (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Date (Get_Kind (Target))); Set_Field10 (Target, Date_Type'Pos (Date)); end Set_Date; - procedure Check_Kind_For_Context_Items (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Context_Items", Target); - end case; - end Check_Kind_For_Context_Items; - function Get_Context_Items (Design_Unit : Iir) return Iir is begin - Check_Kind_For_Context_Items (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Context_Items (Get_Kind (Design_Unit))); return Get_Field1 (Design_Unit); end Get_Context_Items; procedure Set_Context_Items (Design_Unit : Iir; Items_Chain : Iir) is begin - Check_Kind_For_Context_Items (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Context_Items (Get_Kind (Design_Unit))); Set_Field1 (Design_Unit, Items_Chain); end Set_Context_Items; - procedure Check_Kind_For_Dependence_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Dependence_List", Target); - end case; - end Check_Kind_For_Dependence_List; - function Get_Dependence_List (Unit : Iir) return Iir_List is begin - Check_Kind_For_Dependence_List (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Dependence_List (Get_Kind (Unit))); return Iir_To_Iir_List (Get_Field8 (Unit)); end Get_Dependence_List; procedure Set_Dependence_List (Unit : Iir; List : Iir_List) is begin - Check_Kind_For_Dependence_List (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Dependence_List (Get_Kind (Unit))); Set_Field8 (Unit, Iir_List_To_Iir (List)); end Set_Dependence_List; - procedure Check_Kind_For_Analysis_Checks_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Analysis_Checks_List", Target); - end case; - end Check_Kind_For_Analysis_Checks_List; - function Get_Analysis_Checks_List (Unit : Iir) return Iir_List is begin - Check_Kind_For_Analysis_Checks_List (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit))); return Iir_To_Iir_List (Get_Field9 (Unit)); end Get_Analysis_Checks_List; procedure Set_Analysis_Checks_List (Unit : Iir; List : Iir_List) is begin - Check_Kind_For_Analysis_Checks_List (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Analysis_Checks_List (Get_Kind (Unit))); Set_Field9 (Unit, Iir_List_To_Iir (List)); end Set_Analysis_Checks_List; - procedure Check_Kind_For_Date_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Date_State", Target); - end case; - end Check_Kind_For_Date_State; - function Get_Date_State (Unit : Iir_Design_Unit) return Date_State_Type is begin - Check_Kind_For_Date_State (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Date_State (Get_Kind (Unit))); return Date_State_Type'Val (Get_State1 (Unit)); end Get_Date_State; procedure Set_Date_State (Unit : Iir_Design_Unit; State : Date_State_Type) - is + is begin - Check_Kind_For_Date_State (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Date_State (Get_Kind (Unit))); Set_State1 (Unit, Date_State_Type'Pos (State)); end Set_Date_State; - procedure Check_Kind_For_Guarded_Target_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - null; - when others => - Failed ("Guarded_Target_State", Target); - end case; - end Check_Kind_For_Guarded_Target_State; - function Get_Guarded_Target_State (Stmt : Iir) return Tri_State_Type is begin - Check_Kind_For_Guarded_Target_State (Stmt); + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt))); return Tri_State_Type'Val (Get_State3 (Stmt)); end Get_Guarded_Target_State; procedure Set_Guarded_Target_State (Stmt : Iir; State : Tri_State_Type) is begin - Check_Kind_For_Guarded_Target_State (Stmt); + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Guarded_Target_State (Get_Kind (Stmt))); Set_State3 (Stmt, Tri_State_Type'Pos (State)); end Set_Guarded_Target_State; - procedure Check_Kind_For_Library_Unit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Library_Unit", Target); - end case; - end Check_Kind_For_Library_Unit; - function Get_Library_Unit (Design_Unit : Iir_Design_Unit) return Iir is begin - Check_Kind_For_Library_Unit (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit))); return Get_Field5 (Design_Unit); end Get_Library_Unit; procedure Set_Library_Unit (Design_Unit : Iir_Design_Unit; Lib_Unit : Iir) - is + is begin - Check_Kind_For_Library_Unit (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Library_Unit (Get_Kind (Design_Unit))); Set_Field5 (Design_Unit, Lib_Unit); end Set_Library_Unit; - procedure Check_Kind_For_Hash_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Hash_Chain", Target); - end case; - end Check_Kind_For_Hash_Chain; - function Get_Hash_Chain (Design_Unit : Iir_Design_Unit) return Iir is begin - Check_Kind_For_Hash_Chain (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit))); return Get_Field7 (Design_Unit); end Get_Hash_Chain; procedure Set_Hash_Chain (Design_Unit : Iir_Design_Unit; Chain : Iir) is begin - Check_Kind_For_Hash_Chain (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Hash_Chain (Get_Kind (Design_Unit))); Set_Field7 (Design_Unit, Chain); end Set_Hash_Chain; - procedure Check_Kind_For_Design_Unit_Source_Pos (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Design_Unit_Source_Pos", Target); - end case; - end Check_Kind_For_Design_Unit_Source_Pos; - function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr - is + is begin - Check_Kind_For_Design_Unit_Source_Pos (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit))); return Iir_To_Source_Ptr (Get_Field4 (Design_Unit)); end Get_Design_Unit_Source_Pos; procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr) - is + is begin - Check_Kind_For_Design_Unit_Source_Pos (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Pos (Get_Kind (Design_Unit))); Set_Field4 (Design_Unit, Source_Ptr_To_Iir (Pos)); end Set_Design_Unit_Source_Pos; - procedure Check_Kind_For_Design_Unit_Source_Line (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Design_Unit_Source_Line", Target); - end case; - end Check_Kind_For_Design_Unit_Source_Line; - function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32 is begin - Check_Kind_For_Design_Unit_Source_Line (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit))); return Iir_To_Int32 (Get_Field11 (Design_Unit)); end Get_Design_Unit_Source_Line; procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32) is begin - Check_Kind_For_Design_Unit_Source_Line (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Line (Get_Kind (Design_Unit))); Set_Field11 (Design_Unit, Int32_To_Iir (Line)); end Set_Design_Unit_Source_Line; - procedure Check_Kind_For_Design_Unit_Source_Col (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("Design_Unit_Source_Col", Target); - end case; - end Check_Kind_For_Design_Unit_Source_Col; - function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32 is begin - Check_Kind_For_Design_Unit_Source_Col (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit))); return Iir_To_Int32 (Get_Field12 (Design_Unit)); end Get_Design_Unit_Source_Col; procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32) is begin - Check_Kind_For_Design_Unit_Source_Col (Design_Unit); + pragma Assert (Design_Unit /= Null_Iir); + pragma Assert (Has_Design_Unit_Source_Col (Get_Kind (Design_Unit))); Set_Field12 (Design_Unit, Int32_To_Iir (Line)); end Set_Design_Unit_Source_Col; - procedure Check_Kind_For_Value (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Integer_Literal - | Iir_Kind_Physical_Int_Literal => - null; - when others => - Failed ("Value", Target); - end case; - end Check_Kind_For_Value; - function Get_Value (Lit : Iir) return Iir_Int64 is begin - Check_Kind_For_Value (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Value (Get_Kind (Lit))); return Get_Int64 (Lit); end Get_Value; procedure Set_Value (Lit : Iir; Val : Iir_Int64) is begin - Check_Kind_For_Value (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Value (Get_Kind (Lit))); Set_Int64 (Lit, Val); end Set_Value; - procedure Check_Kind_For_Enum_Pos (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Literal => - null; - when others => - Failed ("Enum_Pos", Target); - end case; - end Check_Kind_For_Enum_Pos; - function Get_Enum_Pos (Lit : Iir) return Iir_Int32 is begin - Check_Kind_For_Enum_Pos (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Enum_Pos (Get_Kind (Lit))); return Iir_Int32'Val (Get_Field10 (Lit)); end Get_Enum_Pos; procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32) is begin - Check_Kind_For_Enum_Pos (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Enum_Pos (Get_Kind (Lit))); Set_Field10 (Lit, Iir_Int32'Pos (Val)); end Set_Enum_Pos; - procedure Check_Kind_For_Physical_Literal (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Unit_Declaration => - null; - when others => - Failed ("Physical_Literal", Target); - end case; - end Check_Kind_For_Physical_Literal; - function Get_Physical_Literal (Unit : Iir) return Iir is begin - Check_Kind_For_Physical_Literal (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Physical_Literal (Get_Kind (Unit))); return Get_Field6 (Unit); end Get_Physical_Literal; procedure Set_Physical_Literal (Unit : Iir; Lit : Iir) is begin - Check_Kind_For_Physical_Literal (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Physical_Literal (Get_Kind (Unit))); Set_Field6 (Unit, Lit); end Set_Physical_Literal; - procedure Check_Kind_For_Physical_Unit_Value (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Unit_Declaration => - null; - when others => - Failed ("Physical_Unit_Value", Target); - end case; - end Check_Kind_For_Physical_Unit_Value; - function Get_Physical_Unit_Value (Unit : Iir) return Iir is begin - Check_Kind_For_Physical_Unit_Value (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit))); return Get_Field7 (Unit); end Get_Physical_Unit_Value; procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir) is begin - Check_Kind_For_Physical_Unit_Value (Unit); + pragma Assert (Unit /= Null_Iir); + pragma Assert (Has_Physical_Unit_Value (Get_Kind (Unit))); Set_Field7 (Unit, Lit); end Set_Physical_Unit_Value; - procedure Check_Kind_For_Fp_Value (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Floating_Point_Literal - | Iir_Kind_Physical_Fp_Literal => - null; - when others => - Failed ("Fp_Value", Target); - end case; - end Check_Kind_For_Fp_Value; - function Get_Fp_Value (Lit : Iir) return Iir_Fp64 is begin - Check_Kind_For_Fp_Value (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Fp_Value (Get_Kind (Lit))); return Get_Fp64 (Lit); end Get_Fp_Value; procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64) is begin - Check_Kind_For_Fp_Value (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Fp_Value (Get_Kind (Lit))); Set_Fp64 (Lit, Val); end Set_Fp_Value; - procedure Check_Kind_For_Enumeration_Decl (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Literal => - null; - when others => - Failed ("Enumeration_Decl", Target); - end case; - end Check_Kind_For_Enumeration_Decl; - function Get_Enumeration_Decl (Target : Iir) return Iir is begin - Check_Kind_For_Enumeration_Decl (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Enumeration_Decl (Get_Kind (Target))); return Get_Field6 (Target); end Get_Enumeration_Decl; procedure Set_Enumeration_Decl (Target : Iir; Lit : Iir) is begin - Check_Kind_For_Enumeration_Decl (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Enumeration_Decl (Get_Kind (Target))); Set_Field6 (Target, Lit); end Set_Enumeration_Decl; - procedure Check_Kind_For_Simple_Aggregate_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Simple_Aggregate => - null; - when others => - Failed ("Simple_Aggregate_List", Target); - end case; - end Check_Kind_For_Simple_Aggregate_List; - function Get_Simple_Aggregate_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Simple_Aggregate_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field3 (Target)); end Get_Simple_Aggregate_List; procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Simple_Aggregate_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Aggregate_List (Get_Kind (Target))); Set_Field3 (Target, Iir_List_To_Iir (List)); end Set_Simple_Aggregate_List; - procedure Check_Kind_For_Bit_String_Base (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Bit_String_Literal => - null; - when others => - Failed ("Bit_String_Base", Target); - end case; - end Check_Kind_For_Bit_String_Base; - function Get_Bit_String_Base (Lit : Iir) return Base_Type is begin - Check_Kind_For_Bit_String_Base (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); return Base_Type'Val (Get_Field8 (Lit)); end Get_Bit_String_Base; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is begin - Check_Kind_For_Bit_String_Base (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); Set_Field8 (Lit, Base_Type'Pos (Base)); end Set_Bit_String_Base; - procedure Check_Kind_For_Bit_String_0 (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Bit_String_Literal => - null; - when others => - Failed ("Bit_String_0", Target); - end case; - end Check_Kind_For_Bit_String_0; - function Get_Bit_String_0 (Lit : Iir) return Iir is begin - Check_Kind_For_Bit_String_0 (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); return Get_Field6 (Lit); end Get_Bit_String_0; procedure Set_Bit_String_0 (Lit : Iir; El : Iir) is begin - Check_Kind_For_Bit_String_0 (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_0 (Get_Kind (Lit))); Set_Field6 (Lit, El); end Set_Bit_String_0; - procedure Check_Kind_For_Bit_String_1 (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Bit_String_Literal => - null; - when others => - Failed ("Bit_String_1", Target); - end case; - end Check_Kind_For_Bit_String_1; - function Get_Bit_String_1 (Lit : Iir) return Iir is begin - Check_Kind_For_Bit_String_1 (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); return Get_Field7 (Lit); end Get_Bit_String_1; procedure Set_Bit_String_1 (Lit : Iir; El : Iir) is begin - Check_Kind_For_Bit_String_1 (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Bit_String_1 (Get_Kind (Lit))); Set_Field7 (Lit, El); end Set_Bit_String_1; - procedure Check_Kind_For_Literal_Origin (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Enumeration_Literal => - null; - when others => - Failed ("Literal_Origin", Target); - end case; - end Check_Kind_For_Literal_Origin; - function Get_Literal_Origin (Lit : Iir) return Iir is begin - Check_Kind_For_Literal_Origin (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Literal_Origin (Get_Kind (Lit))); return Get_Field2 (Lit); end Get_Literal_Origin; procedure Set_Literal_Origin (Lit : Iir; Orig : Iir) is begin - Check_Kind_For_Literal_Origin (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Literal_Origin (Get_Kind (Lit))); Set_Field2 (Lit, Orig); end Set_Literal_Origin; - procedure Check_Kind_For_Range_Origin (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Range_Expression => - null; - when others => - Failed ("Range_Origin", Target); - end case; - end Check_Kind_For_Range_Origin; - function Get_Range_Origin (Lit : Iir) return Iir is begin - Check_Kind_For_Range_Origin (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Range_Origin (Get_Kind (Lit))); return Get_Field4 (Lit); end Get_Range_Origin; procedure Set_Range_Origin (Lit : Iir; Orig : Iir) is begin - Check_Kind_For_Range_Origin (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Range_Origin (Get_Kind (Lit))); Set_Field4 (Lit, Orig); end Set_Range_Origin; - procedure Check_Kind_For_Literal_Subtype (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Aggregate => - null; - when others => - Failed ("Literal_Subtype", Target); - end case; - end Check_Kind_For_Literal_Subtype; - function Get_Literal_Subtype (Lit : Iir) return Iir is begin - Check_Kind_For_Literal_Subtype (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); return Get_Field5 (Lit); end Get_Literal_Subtype; procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir) is begin - Check_Kind_For_Literal_Subtype (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Literal_Subtype (Get_Kind (Lit))); Set_Field5 (Lit, Atype); end Set_Literal_Subtype; - procedure Check_Kind_For_Entity_Class (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Specification => - null; - when others => - Failed ("Entity_Class", Target); - end case; - end Check_Kind_For_Entity_Class; - function Get_Entity_Class (Target : Iir) return Token_Type is begin - Check_Kind_For_Entity_Class (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Class (Get_Kind (Target))); return Iir_To_Token_Type (Get_Field3 (Target)); end Get_Entity_Class; procedure Set_Entity_Class (Target : Iir; Kind : Token_Type) is begin - Check_Kind_For_Entity_Class (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Class (Get_Kind (Target))); Set_Field3 (Target, Token_Type_To_Iir (Kind)); end Set_Entity_Class; - procedure Check_Kind_For_Entity_Name_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Specification => - null; - when others => - Failed ("Entity_Name_List", Target); - end case; - end Check_Kind_For_Entity_Name_List; - function Get_Entity_Name_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Entity_Name_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Name_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field1 (Target)); end Get_Entity_Name_List; procedure Set_Entity_Name_List (Target : Iir; Names : Iir_List) is begin - Check_Kind_For_Entity_Name_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Name_List (Get_Kind (Target))); Set_Field1 (Target, Iir_List_To_Iir (Names)); end Set_Entity_Name_List; - procedure Check_Kind_For_Attribute_Designator (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Specification => - null; - when others => - Failed ("Attribute_Designator", Target); - end case; - end Check_Kind_For_Attribute_Designator; - function Get_Attribute_Designator (Target : Iir) return Iir is begin - Check_Kind_For_Attribute_Designator (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Designator (Get_Kind (Target))); return Get_Field6 (Target); end Get_Attribute_Designator; procedure Set_Attribute_Designator (Target : Iir; Designator : Iir) is begin - Check_Kind_For_Attribute_Designator (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Designator (Get_Kind (Target))); Set_Field6 (Target, Designator); end Set_Attribute_Designator; - procedure Check_Kind_For_Attribute_Specification_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Specification => - null; - when others => - Failed ("Attribute_Specification_Chain", Target); - end case; - end Check_Kind_For_Attribute_Specification_Chain; - function Get_Attribute_Specification_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Attribute_Specification_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target))); return Get_Field7 (Target); end Get_Attribute_Specification_Chain; procedure Set_Attribute_Specification_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Attribute_Specification_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Specification_Chain (Get_Kind (Target))); Set_Field7 (Target, Chain); end Set_Attribute_Specification_Chain; - procedure Check_Kind_For_Attribute_Specification (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Value => - null; - when others => - Failed ("Attribute_Specification", Target); - end case; - end Check_Kind_For_Attribute_Specification; - function Get_Attribute_Specification (Val : Iir) return Iir is begin - Check_Kind_For_Attribute_Specification (Val); + pragma Assert (Val /= Null_Iir); + pragma Assert (Has_Attribute_Specification (Get_Kind (Val))); return Get_Field4 (Val); end Get_Attribute_Specification; procedure Set_Attribute_Specification (Val : Iir; Attr : Iir) is begin - Check_Kind_For_Attribute_Specification (Val); + pragma Assert (Val /= Null_Iir); + pragma Assert (Has_Attribute_Specification (Get_Kind (Val))); Set_Field4 (Val, Attr); end Set_Attribute_Specification; - procedure Check_Kind_For_Signal_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Disconnection_Specification => - null; - when others => - Failed ("Signal_List", Target); - end case; - end Check_Kind_For_Signal_List; - function Get_Signal_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Signal_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field3 (Target)); end Get_Signal_List; procedure Set_Signal_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Signal_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_List (Get_Kind (Target))); Set_Field3 (Target, Iir_List_To_Iir (List)); end Set_Signal_List; - procedure Check_Kind_For_Designated_Entity (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Value => - null; - when others => - Failed ("Designated_Entity", Target); - end case; - end Check_Kind_For_Designated_Entity; - function Get_Designated_Entity (Val : Iir_Attribute_Value) return Iir is begin - Check_Kind_For_Designated_Entity (Val); + pragma Assert (Val /= Null_Iir); + pragma Assert (Has_Designated_Entity (Get_Kind (Val))); return Get_Field3 (Val); end Get_Designated_Entity; procedure Set_Designated_Entity (Val : Iir_Attribute_Value; Entity : Iir) - is + is begin - Check_Kind_For_Designated_Entity (Val); + pragma Assert (Val /= Null_Iir); + pragma Assert (Has_Designated_Entity (Get_Kind (Val))); Set_Field3 (Val, Entity); end Set_Designated_Entity; - procedure Check_Kind_For_Formal (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => - null; - when others => - Failed ("Formal", Target); - end case; - end Check_Kind_For_Formal; - function Get_Formal (Target : Iir) return Iir is begin - Check_Kind_For_Formal (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Formal (Get_Kind (Target))); return Get_Field1 (Target); end Get_Formal; procedure Set_Formal (Target : Iir; Formal : Iir) is begin - Check_Kind_For_Formal (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Formal (Get_Kind (Target))); Set_Field1 (Target, Formal); end Set_Formal; - procedure Check_Kind_For_Actual (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression => - null; - when others => - Failed ("Actual", Target); - end case; - end Check_Kind_For_Actual; - function Get_Actual (Target : Iir) return Iir is begin - Check_Kind_For_Actual (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Actual (Get_Kind (Target))); return Get_Field3 (Target); end Get_Actual; procedure Set_Actual (Target : Iir; Actual : Iir) is begin - Check_Kind_For_Actual (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Actual (Get_Kind (Target))); Set_Field3 (Target, Actual); end Set_Actual; - procedure Check_Kind_For_In_Conversion (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression => - null; - when others => - Failed ("In_Conversion", Target); - end case; - end Check_Kind_For_In_Conversion; - function Get_In_Conversion (Target : Iir) return Iir is begin - Check_Kind_For_In_Conversion (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_In_Conversion (Get_Kind (Target))); return Get_Field4 (Target); end Get_In_Conversion; procedure Set_In_Conversion (Target : Iir; Conv : Iir) is begin - Check_Kind_For_In_Conversion (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_In_Conversion (Get_Kind (Target))); Set_Field4 (Target, Conv); end Set_In_Conversion; - procedure Check_Kind_For_Out_Conversion (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression => - null; - when others => - Failed ("Out_Conversion", Target); - end case; - end Check_Kind_For_Out_Conversion; - function Get_Out_Conversion (Target : Iir) return Iir is begin - Check_Kind_For_Out_Conversion (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Out_Conversion (Get_Kind (Target))); return Get_Field5 (Target); end Get_Out_Conversion; procedure Set_Out_Conversion (Target : Iir; Conv : Iir) is begin - Check_Kind_For_Out_Conversion (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Out_Conversion (Get_Kind (Target))); Set_Field5 (Target, Conv); end Set_Out_Conversion; - procedure Check_Kind_For_Whole_Association_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => - null; - when others => - Failed ("Whole_Association_Flag", Target); - end case; - end Check_Kind_For_Whole_Association_Flag; - function Get_Whole_Association_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Whole_Association_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target))); return Get_Flag1 (Target); end Get_Whole_Association_Flag; procedure Set_Whole_Association_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Whole_Association_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Whole_Association_Flag (Get_Kind (Target))); Set_Flag1 (Target, Flag); end Set_Whole_Association_Flag; - procedure Check_Kind_For_Collapse_Signal_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => - null; - when others => - Failed ("Collapse_Signal_Flag", Target); - end case; - end Check_Kind_For_Collapse_Signal_Flag; - function Get_Collapse_Signal_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Collapse_Signal_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target))); return Get_Flag2 (Target); end Get_Collapse_Signal_Flag; procedure Set_Collapse_Signal_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Collapse_Signal_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Collapse_Signal_Flag (Get_Kind (Target))); Set_Flag2 (Target, Flag); end Set_Collapse_Signal_Flag; - procedure Check_Kind_For_Artificial_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_Open => - null; - when others => - Failed ("Artificial_Flag", Target); - end case; - end Check_Kind_For_Artificial_Flag; - function Get_Artificial_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Artificial_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Artificial_Flag (Get_Kind (Target))); return Get_Flag3 (Target); end Get_Artificial_Flag; procedure Set_Artificial_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Artificial_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Artificial_Flag (Get_Kind (Target))); Set_Flag3 (Target, Flag); end Set_Artificial_Flag; - procedure Check_Kind_For_Open_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signal_Interface_Declaration => - null; - when others => - Failed ("Open_Flag", Target); - end case; - end Check_Kind_For_Open_Flag; - function Get_Open_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Open_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Open_Flag (Get_Kind (Target))); return Get_Flag3 (Target); end Get_Open_Flag; procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Open_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Open_Flag (Get_Kind (Target))); Set_Flag3 (Target, Flag); end Set_Open_Flag; - procedure Check_Kind_For_After_Drivers_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Object_Alias_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - null; - when others => - Failed ("After_Drivers_Flag", Target); - end case; - end Check_Kind_For_After_Drivers_Flag; - function Get_After_Drivers_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_After_Drivers_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target))); return Get_Flag5 (Target); end Get_After_Drivers_Flag; procedure Set_After_Drivers_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_After_Drivers_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_After_Drivers_Flag (Get_Kind (Target))); Set_Flag5 (Target, Flag); end Set_After_Drivers_Flag; - procedure Check_Kind_For_We_Value (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Waveform_Element => - null; - when others => - Failed ("We_Value", Target); - end case; - end Check_Kind_For_We_Value; - function Get_We_Value (We : Iir_Waveform_Element) return Iir is begin - Check_Kind_For_We_Value (We); + pragma Assert (We /= Null_Iir); + pragma Assert (Has_We_Value (Get_Kind (We))); return Get_Field1 (We); end Get_We_Value; procedure Set_We_Value (We : Iir_Waveform_Element; An_Iir : Iir) is begin - Check_Kind_For_We_Value (We); + pragma Assert (We /= Null_Iir); + pragma Assert (Has_We_Value (Get_Kind (We))); Set_Field1 (We, An_Iir); end Set_We_Value; - procedure Check_Kind_For_Time (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Waveform_Element => - null; - when others => - Failed ("Time", Target); - end case; - end Check_Kind_For_Time; - function Get_Time (We : Iir_Waveform_Element) return Iir is begin - Check_Kind_For_Time (We); + pragma Assert (We /= Null_Iir); + pragma Assert (Has_Time (Get_Kind (We))); return Get_Field3 (We); end Get_Time; procedure Set_Time (We : Iir_Waveform_Element; An_Iir : Iir) is begin - Check_Kind_For_Time (We); + pragma Assert (We /= Null_Iir); + pragma Assert (Has_Time (Get_Kind (We))); Set_Field3 (We, An_Iir); end Set_Time; - procedure Check_Kind_For_Associated_Expr (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - null; - when others => - Failed ("Associated_Expr", Target); - end case; - end Check_Kind_For_Associated_Expr; - function Get_Associated_Expr (Target : Iir) return Iir is begin - Check_Kind_For_Associated_Expr (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Associated_Expr (Get_Kind (Target))); return Get_Field3 (Target); end Get_Associated_Expr; procedure Set_Associated_Expr (Target : Iir; Associated : Iir) is begin - Check_Kind_For_Associated_Expr (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Associated_Expr (Get_Kind (Target))); Set_Field3 (Target, Associated); end Set_Associated_Expr; - procedure Check_Kind_For_Associated_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - null; - when others => - Failed ("Associated_Chain", Target); - end case; - end Check_Kind_For_Associated_Chain; - function Get_Associated_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Associated_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Associated_Chain (Get_Kind (Target))); return Get_Field4 (Target); end Get_Associated_Chain; procedure Set_Associated_Chain (Target : Iir; Associated : Iir) is begin - Check_Kind_For_Associated_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Associated_Chain (Get_Kind (Target))); Set_Field4 (Target, Associated); end Set_Associated_Chain; - procedure Check_Kind_For_Choice_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Name => - null; - when others => - Failed ("Choice_Name", Target); - end case; - end Check_Kind_For_Choice_Name; - function Get_Choice_Name (Choice : Iir) return Iir is begin - Check_Kind_For_Choice_Name (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Name (Get_Kind (Choice))); return Get_Field5 (Choice); end Get_Choice_Name; procedure Set_Choice_Name (Choice : Iir; Name : Iir) is begin - Check_Kind_For_Choice_Name (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Name (Get_Kind (Choice))); Set_Field5 (Choice, Name); end Set_Choice_Name; - procedure Check_Kind_For_Choice_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Expression => - null; - when others => - Failed ("Choice_Expression", Target); - end case; - end Check_Kind_For_Choice_Expression; - function Get_Choice_Expression (Choice : Iir) return Iir is begin - Check_Kind_For_Choice_Expression (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Expression (Get_Kind (Choice))); return Get_Field5 (Choice); end Get_Choice_Expression; procedure Set_Choice_Expression (Choice : Iir; Name : Iir) is begin - Check_Kind_For_Choice_Expression (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Expression (Get_Kind (Choice))); Set_Field5 (Choice, Name); end Set_Choice_Expression; - procedure Check_Kind_For_Choice_Range (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Range => - null; - when others => - Failed ("Choice_Range", Target); - end case; - end Check_Kind_For_Choice_Range; - function Get_Choice_Range (Choice : Iir) return Iir is begin - Check_Kind_For_Choice_Range (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Range (Get_Kind (Choice))); return Get_Field5 (Choice); end Get_Choice_Range; procedure Set_Choice_Range (Choice : Iir; Name : Iir) is begin - Check_Kind_For_Choice_Range (Choice); + pragma Assert (Choice /= Null_Iir); + pragma Assert (Has_Choice_Range (Get_Kind (Choice))); Set_Field5 (Choice, Name); end Set_Choice_Range; - procedure Check_Kind_For_Same_Alternative_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name => - null; - when others => - Failed ("Same_Alternative_Flag", Target); - end case; - end Check_Kind_For_Same_Alternative_Flag; - function Get_Same_Alternative_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Same_Alternative_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target))); return Get_Flag1 (Target); end Get_Same_Alternative_Flag; procedure Set_Same_Alternative_Flag (Target : Iir; Val : Boolean) is begin - Check_Kind_For_Same_Alternative_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Same_Alternative_Flag (Get_Kind (Target))); Set_Flag1 (Target, Val); end Set_Same_Alternative_Flag; - procedure Check_Kind_For_Architecture (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Aspect_Entity => - null; - when others => - Failed ("Architecture", Target); - end case; - end Check_Kind_For_Architecture; - function Get_Architecture (Target : Iir_Entity_Aspect_Entity) return Iir is begin - Check_Kind_For_Architecture (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Architecture (Get_Kind (Target))); return Get_Field3 (Target); end Get_Architecture; procedure Set_Architecture (Target : Iir_Entity_Aspect_Entity; Arch : Iir) - is + is begin - Check_Kind_For_Architecture (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Architecture (Get_Kind (Target))); Set_Field3 (Target, Arch); end Set_Architecture; - procedure Check_Kind_For_Block_Specification (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Configuration => - null; - when others => - Failed ("Block_Specification", Target); - end case; - end Check_Kind_For_Block_Specification; - function Get_Block_Specification (Target : Iir) return Iir is begin - Check_Kind_For_Block_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Specification (Get_Kind (Target))); return Get_Field5 (Target); end Get_Block_Specification; procedure Set_Block_Specification (Target : Iir; Block : Iir) is begin - Check_Kind_For_Block_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Specification (Get_Kind (Target))); Set_Field5 (Target, Block); end Set_Block_Specification; - procedure Check_Kind_For_Prev_Block_Configuration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Configuration => - null; - when others => - Failed ("Prev_Block_Configuration", Target); - end case; - end Check_Kind_For_Prev_Block_Configuration; - function Get_Prev_Block_Configuration (Target : Iir) return Iir is begin - Check_Kind_For_Prev_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target))); return Get_Field4 (Target); end Get_Prev_Block_Configuration; procedure Set_Prev_Block_Configuration (Target : Iir; Block : Iir) is begin - Check_Kind_For_Prev_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Prev_Block_Configuration (Get_Kind (Target))); Set_Field4 (Target, Block); end Set_Prev_Block_Configuration; - procedure Check_Kind_For_Configuration_Item_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Configuration => - null; - when others => - Failed ("Configuration_Item_Chain", Target); - end case; - end Check_Kind_For_Configuration_Item_Chain; - function Get_Configuration_Item_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Configuration_Item_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target))); return Get_Field3 (Target); end Get_Configuration_Item_Chain; procedure Set_Configuration_Item_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Configuration_Item_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Item_Chain (Get_Kind (Target))); Set_Field3 (Target, Chain); end Set_Configuration_Item_Chain; - procedure Check_Kind_For_Attribute_Value_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - null; - when others => - Failed ("Attribute_Value_Chain", Target); - end case; - end Check_Kind_For_Attribute_Value_Chain; - function Get_Attribute_Value_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Attribute_Value_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target))); return Get_Field4 (Target); end Get_Attribute_Value_Chain; procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Attribute_Value_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Value_Chain (Get_Kind (Target))); Set_Field4 (Target, Chain); end Set_Attribute_Value_Chain; - procedure Check_Kind_For_Spec_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Value => - null; - when others => - Failed ("Spec_Chain", Target); - end case; - end Check_Kind_For_Spec_Chain; - function Get_Spec_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Spec_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Spec_Chain (Get_Kind (Target))); return Get_Field0 (Target); end Get_Spec_Chain; procedure Set_Spec_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Spec_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Spec_Chain (Get_Kind (Target))); Set_Field0 (Target, Chain); end Set_Spec_Chain; - procedure Check_Kind_For_Attribute_Value_Spec_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Specification => - null; - when others => - Failed ("Attribute_Value_Spec_Chain", Target); - end case; - end Check_Kind_For_Attribute_Value_Spec_Chain; - function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Attribute_Value_Spec_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target))); return Get_Field4 (Target); end Get_Attribute_Value_Spec_Chain; procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Attribute_Value_Spec_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Attribute_Value_Spec_Chain (Get_Kind (Target))); Set_Field4 (Target, Chain); end Set_Attribute_Value_Spec_Chain; - procedure Check_Kind_For_Entity_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Aspect_Entity - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Architecture_Body => - null; - when others => - Failed ("Entity_Name", Target); - end case; - end Check_Kind_For_Entity_Name; - function Get_Entity_Name (Arch : Iir) return Iir is begin - Check_Kind_For_Entity_Name (Arch); + pragma Assert (Arch /= Null_Iir); + pragma Assert (Has_Entity_Name (Get_Kind (Arch))); return Get_Field2 (Arch); end Get_Entity_Name; procedure Set_Entity_Name (Arch : Iir; Entity : Iir) is begin - Check_Kind_For_Entity_Name (Arch); + pragma Assert (Arch /= Null_Iir); + pragma Assert (Has_Entity_Name (Get_Kind (Arch))); Set_Field2 (Arch, Entity); end Set_Entity_Name; - procedure Check_Kind_For_Package (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Package_Body => - null; - when others => - Failed ("Package", Target); - end case; - end Check_Kind_For_Package; - function Get_Package (Package_Body : Iir) return Iir is begin - Check_Kind_For_Package (Package_Body); + pragma Assert (Package_Body /= Null_Iir); + pragma Assert (Has_Package (Get_Kind (Package_Body))); return Get_Field4 (Package_Body); end Get_Package; procedure Set_Package (Package_Body : Iir; Decl : Iir) is begin - Check_Kind_For_Package (Package_Body); + pragma Assert (Package_Body /= Null_Iir); + pragma Assert (Has_Package (Get_Kind (Package_Body))); Set_Field4 (Package_Body, Decl); end Set_Package; - procedure Check_Kind_For_Package_Body (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration => - null; - when others => - Failed ("Package_Body", Target); - end case; - end Check_Kind_For_Package_Body; - function Get_Package_Body (Pkg : Iir) return Iir is begin - Check_Kind_For_Package_Body (Pkg); + pragma Assert (Pkg /= Null_Iir); + pragma Assert (Has_Package_Body (Get_Kind (Pkg))); return Get_Field2 (Pkg); end Get_Package_Body; procedure Set_Package_Body (Pkg : Iir; Decl : Iir) is begin - Check_Kind_For_Package_Body (Pkg); + pragma Assert (Pkg /= Null_Iir); + pragma Assert (Has_Package_Body (Get_Kind (Pkg))); Set_Field2 (Pkg, Decl); end Set_Package_Body; - procedure Check_Kind_For_Need_Body (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Package_Declaration => - null; - when others => - Failed ("Need_Body", Target); - end case; - end Check_Kind_For_Need_Body; - function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is begin - Check_Kind_For_Need_Body (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Need_Body (Get_Kind (Decl))); return Get_Flag1 (Decl); end Get_Need_Body; procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean) is begin - Check_Kind_For_Need_Body (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Need_Body (Get_Kind (Decl))); Set_Flag1 (Decl, Flag); end Set_Need_Body; - procedure Check_Kind_For_Block_Configuration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Declaration => - null; - when others => - Failed ("Block_Configuration", Target); - end case; - end Check_Kind_For_Block_Configuration; - function Get_Block_Configuration (Target : Iir) return Iir is begin - Check_Kind_For_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Configuration (Get_Kind (Target))); return Get_Field5 (Target); end Get_Block_Configuration; procedure Set_Block_Configuration (Target : Iir; Block : Iir) is begin - Check_Kind_For_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Configuration (Get_Kind (Target))); Set_Field5 (Target, Block); end Set_Block_Configuration; - procedure Check_Kind_For_Concurrent_Statement_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - null; - when others => - Failed ("Concurrent_Statement_Chain", Target); - end case; - end Check_Kind_For_Concurrent_Statement_Chain; - function Get_Concurrent_Statement_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Concurrent_Statement_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target))); return Get_Field5 (Target); end Get_Concurrent_Statement_Chain; procedure Set_Concurrent_Statement_Chain (Target : Iir; First : Iir) is begin - Check_Kind_For_Concurrent_Statement_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Concurrent_Statement_Chain (Get_Kind (Target))); Set_Field5 (Target, First); end Set_Concurrent_Statement_Chain; - procedure Check_Kind_For_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Waveform_Element - | Iir_Kind_Conditional_Waveform - | Iir_Kind_Association_Element_By_Expression - | Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Entity_Class - | Iir_Kind_Attribute_Value - | Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - null; - when others => - Failed ("Chain", Target); - end case; - end Check_Kind_For_Chain; - function Get_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Chain (Get_Kind (Target))); return Get_Field2 (Target); end Get_Chain; procedure Set_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Chain (Get_Kind (Target))); Set_Field2 (Target, Chain); end Set_Chain; - procedure Check_Kind_For_Port_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Header - | Iir_Kind_Entity_Declaration - | Iir_Kind_Component_Declaration => - null; - when others => - Failed ("Port_Chain", Target); - end case; - end Check_Kind_For_Port_Chain; - function Get_Port_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Port_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Port_Chain (Get_Kind (Target))); return Get_Field7 (Target); end Get_Port_Chain; procedure Set_Port_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Port_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Port_Chain (Get_Kind (Target))); Set_Field7 (Target, Chain); end Set_Port_Chain; - procedure Check_Kind_For_Generic_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Header - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Generic_Chain", Target); - end case; - end Check_Kind_For_Generic_Chain; - function Get_Generic_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Generic_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generic_Chain (Get_Kind (Target))); return Get_Field6 (Target); end Get_Generic_Chain; procedure Set_Generic_Chain (Target : Iir; Generics : Iir) is begin - Check_Kind_For_Generic_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generic_Chain (Get_Kind (Target))); Set_Field6 (Target, Generics); end Set_Generic_Chain; - procedure Check_Kind_For_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Attribute_Value - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Range_Expression - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Unit_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Psl_Expression - | Iir_Kind_Return_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Base_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Type", Target); - end case; - end Check_Kind_For_Type; - function Get_Type (Target : Iir) return Iir is begin - Check_Kind_For_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type (Get_Kind (Target))); return Get_Field1 (Target); end Get_Type; procedure Set_Type (Target : Iir; Atype : Iir) is begin - Check_Kind_For_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type (Get_Kind (Target))); Set_Field1 (Target, Atype); end Set_Type; - procedure Check_Kind_For_Subtype_Indication (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Allocator_By_Subtype => - null; - when others => - Failed ("Subtype_Indication", Target); - end case; - end Check_Kind_For_Subtype_Indication; - function Get_Subtype_Indication (Target : Iir) return Iir is begin - Check_Kind_For_Subtype_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Indication (Get_Kind (Target))); return Get_Field5 (Target); end Get_Subtype_Indication; procedure Set_Subtype_Indication (Target : Iir; Atype : Iir) is begin - Check_Kind_For_Subtype_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Indication (Get_Kind (Target))); Set_Field5 (Target, Atype); end Set_Subtype_Indication; - procedure Check_Kind_For_Discrete_Range (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Iterator_Declaration => - null; - when others => - Failed ("Discrete_Range", Target); - end case; - end Check_Kind_For_Discrete_Range; - function Get_Discrete_Range (Target : Iir) return Iir is begin - Check_Kind_For_Discrete_Range (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Discrete_Range (Get_Kind (Target))); return Get_Field6 (Target); end Get_Discrete_Range; procedure Set_Discrete_Range (Target : Iir; Rng : Iir) is begin - Check_Kind_For_Discrete_Range (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Discrete_Range (Get_Kind (Target))); Set_Field6 (Target, Rng); end Set_Discrete_Range; - procedure Check_Kind_For_Type_Definition (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration => - null; - when others => - Failed ("Type_Definition", Target); - end case; - end Check_Kind_For_Type_Definition; - function Get_Type_Definition (Decl : Iir) return Iir is begin - Check_Kind_For_Type_Definition (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Type_Definition (Get_Kind (Decl))); return Get_Field1 (Decl); end Get_Type_Definition; procedure Set_Type_Definition (Decl : Iir; Atype : Iir) is begin - Check_Kind_For_Type_Definition (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Type_Definition (Get_Kind (Decl))); Set_Field1 (Decl, Atype); end Set_Type_Definition; - procedure Check_Kind_For_Subtype_Definition (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Anonymous_Type_Declaration => - null; - when others => - Failed ("Subtype_Definition", Target); - end case; - end Check_Kind_For_Subtype_Definition; - function Get_Subtype_Definition (Target : Iir) return Iir is begin - Check_Kind_For_Subtype_Definition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Definition (Get_Kind (Target))); return Get_Field4 (Target); end Get_Subtype_Definition; procedure Set_Subtype_Definition (Target : Iir; Def : Iir) is begin - Check_Kind_For_Subtype_Definition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Definition (Get_Kind (Target))); Set_Field4 (Target, Def); end Set_Subtype_Definition; - procedure Check_Kind_For_Nature (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Terminal_Declaration => - null; - when others => - Failed ("Nature", Target); - end case; - end Check_Kind_For_Nature; - function Get_Nature (Target : Iir) return Iir is begin - Check_Kind_For_Nature (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Nature (Get_Kind (Target))); return Get_Field1 (Target); end Get_Nature; procedure Set_Nature (Target : Iir; Nature : Iir) is begin - Check_Kind_For_Nature (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Nature (Get_Kind (Target))); Set_Field1 (Target, Nature); end Set_Nature; - procedure Check_Kind_For_Mode (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - null; - when others => - Failed ("Mode", Target); - end case; - end Check_Kind_For_Mode; - function Get_Mode (Target : Iir) return Iir_Mode is begin - Check_Kind_For_Mode (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Mode (Get_Kind (Target))); return Iir_Mode'Val (Get_Odigit1 (Target)); end Get_Mode; procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is begin - Check_Kind_For_Mode (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Mode (Get_Kind (Target))); Set_Odigit1 (Target, Iir_Mode'Pos (Mode)); end Set_Mode; - procedure Check_Kind_For_Signal_Kind (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => - null; - when others => - Failed ("Signal_Kind", Target); - end case; - end Check_Kind_For_Signal_Kind; - function Get_Signal_Kind (Target : Iir) return Iir_Signal_Kind is begin - Check_Kind_For_Signal_Kind (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_Kind (Get_Kind (Target))); return Iir_Signal_Kind'Val (Get_State3 (Target)); end Get_Signal_Kind; procedure Set_Signal_Kind (Target : Iir; Signal_Kind : Iir_Signal_Kind) is begin - Check_Kind_For_Signal_Kind (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_Kind (Get_Kind (Target))); Set_State3 (Target, Iir_Signal_Kind'Pos (Signal_Kind)); end Set_Signal_Kind; - procedure Check_Kind_For_Base_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Value - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Base_Name", Target); - end case; - end Check_Kind_For_Base_Name; - function Get_Base_Name (Target : Iir) return Iir is begin - Check_Kind_For_Base_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Base_Name (Get_Kind (Target))); return Get_Field5 (Target); end Get_Base_Name; procedure Set_Base_Name (Target : Iir; Name : Iir) is begin - Check_Kind_For_Base_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Base_Name (Get_Kind (Target))); Set_Field5 (Target, Name); end Set_Base_Name; - procedure Check_Kind_For_Interface_Declaration_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Interface_Declaration_Chain", Target); - end case; - end Check_Kind_For_Interface_Declaration_Chain; - function Get_Interface_Declaration_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Interface_Declaration_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target))); return Get_Field5 (Target); end Get_Interface_Declaration_Chain; procedure Set_Interface_Declaration_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Interface_Declaration_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Interface_Declaration_Chain (Get_Kind (Target))); Set_Field5 (Target, Chain); end Set_Interface_Declaration_Chain; - procedure Check_Kind_For_Subprogram_Specification (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - null; - when others => - Failed ("Subprogram_Specification", Target); - end case; - end Check_Kind_For_Subprogram_Specification; - function Get_Subprogram_Specification (Target : Iir) return Iir is begin - Check_Kind_For_Subprogram_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Specification (Get_Kind (Target))); return Get_Field4 (Target); end Get_Subprogram_Specification; procedure Set_Subprogram_Specification (Target : Iir; Spec : Iir) is begin - Check_Kind_For_Subprogram_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Specification (Get_Kind (Target))); Set_Field4 (Target, Spec); end Set_Subprogram_Specification; - procedure Check_Kind_For_Sequential_Statement_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - null; - when others => - Failed ("Sequential_Statement_Chain", Target); - end case; - end Check_Kind_For_Sequential_Statement_Chain; - function Get_Sequential_Statement_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Sequential_Statement_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target))); return Get_Field5 (Target); end Get_Sequential_Statement_Chain; procedure Set_Sequential_Statement_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Sequential_Statement_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Sequential_Statement_Chain (Get_Kind (Target))); Set_Field5 (Target, Chain); end Set_Sequential_Statement_Chain; - procedure Check_Kind_For_Subprogram_Body (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Subprogram_Body", Target); - end case; - end Check_Kind_For_Subprogram_Body; - function Get_Subprogram_Body (Target : Iir) return Iir is begin - Check_Kind_For_Subprogram_Body (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Body (Get_Kind (Target))); return Get_Field9 (Target); end Get_Subprogram_Body; procedure Set_Subprogram_Body (Target : Iir; A_Body : Iir) is begin - Check_Kind_For_Subprogram_Body (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Body (Get_Kind (Target))); Set_Field9 (Target, A_Body); end Set_Subprogram_Body; - procedure Check_Kind_For_Overload_Number (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Overload_Number", Target); - end case; - end Check_Kind_For_Overload_Number; - function Get_Overload_Number (Target : Iir) return Iir_Int32 is begin - Check_Kind_For_Overload_Number (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Overload_Number (Get_Kind (Target))); return Iir_Int32'Val (Get_Field12 (Target)); end Get_Overload_Number; procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32) is begin - Check_Kind_For_Overload_Number (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Overload_Number (Get_Kind (Target))); Set_Field12 (Target, Iir_Int32'Pos (Val)); end Set_Overload_Number; - procedure Check_Kind_For_Subprogram_Depth (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Subprogram_Depth", Target); - end case; - end Check_Kind_For_Subprogram_Depth; - function Get_Subprogram_Depth (Target : Iir) return Iir_Int32 is begin - Check_Kind_For_Subprogram_Depth (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Depth (Get_Kind (Target))); return Iir_Int32'Val (Get_Field10 (Target)); end Get_Subprogram_Depth; procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32) is begin - Check_Kind_For_Subprogram_Depth (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Depth (Get_Kind (Target))); Set_Field10 (Target, Iir_Int32'Pos (Depth)); end Set_Subprogram_Depth; - procedure Check_Kind_For_Subprogram_Hash (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Subprogram_Hash", Target); - end case; - end Check_Kind_For_Subprogram_Hash; - function Get_Subprogram_Hash (Target : Iir) return Iir_Int32 is begin - Check_Kind_For_Subprogram_Hash (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Hash (Get_Kind (Target))); return Iir_Int32'Val (Get_Field11 (Target)); end Get_Subprogram_Hash; procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32) is begin - Check_Kind_For_Subprogram_Hash (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subprogram_Hash (Get_Kind (Target))); Set_Field11 (Target, Iir_Int32'Pos (Val)); end Set_Subprogram_Hash; - procedure Check_Kind_For_Impure_Depth (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - null; - when others => - Failed ("Impure_Depth", Target); - end case; - end Check_Kind_For_Impure_Depth; - function Get_Impure_Depth (Target : Iir) return Iir_Int32 is begin - Check_Kind_For_Impure_Depth (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Impure_Depth (Get_Kind (Target))); return Iir_To_Iir_Int32 (Get_Field3 (Target)); end Get_Impure_Depth; procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32) is begin - Check_Kind_For_Impure_Depth (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Impure_Depth (Get_Kind (Target))); Set_Field3 (Target, Iir_Int32_To_Iir (Depth)); end Set_Impure_Depth; - procedure Check_Kind_For_Return_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - null; - when others => - Failed ("Return_Type", Target); - end case; - end Check_Kind_For_Return_Type; - function Get_Return_Type (Target : Iir) return Iir is begin - Check_Kind_For_Return_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Return_Type (Get_Kind (Target))); return Get_Field1 (Target); end Get_Return_Type; procedure Set_Return_Type (Target : Iir; Decl : Iir) is begin - Check_Kind_For_Return_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Return_Type (Get_Kind (Target))); Set_Field1 (Target, Decl); end Set_Return_Type; - procedure Check_Kind_For_Implicit_Definition (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; - when others => - Failed ("Implicit_Definition", Target); - end case; - end Check_Kind_For_Implicit_Definition; - function Get_Implicit_Definition (D : Iir) return Iir_Predefined_Functions - is + is begin - Check_Kind_For_Implicit_Definition (D); + pragma Assert (D /= Null_Iir); + pragma Assert (Has_Implicit_Definition (Get_Kind (D))); return Iir_Predefined_Functions'Val (Get_Field9 (D)); end Get_Implicit_Definition; procedure Set_Implicit_Definition (D : Iir; Def : Iir_Predefined_Functions) - is + is begin - Check_Kind_For_Implicit_Definition (D); + pragma Assert (D /= Null_Iir); + pragma Assert (Has_Implicit_Definition (Get_Kind (D))); Set_Field9 (D, Iir_Predefined_Functions'Pos (Def)); end Set_Implicit_Definition; - procedure Check_Kind_For_Type_Reference (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; - when others => - Failed ("Type_Reference", Target); - end case; - end Check_Kind_For_Type_Reference; - function Get_Type_Reference (Target : Iir) return Iir is begin - Check_Kind_For_Type_Reference (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Reference (Get_Kind (Target))); return Get_Field10 (Target); end Get_Type_Reference; procedure Set_Type_Reference (Target : Iir; Decl : Iir) is begin - Check_Kind_For_Type_Reference (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Reference (Get_Kind (Target))); Set_Field10 (Target, Decl); end Set_Type_Reference; - procedure Check_Kind_For_Default_Value (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - null; - when others => - Failed ("Default_Value", Target); - end case; - end Check_Kind_For_Default_Value; - function Get_Default_Value (Target : Iir) return Iir is begin - Check_Kind_For_Default_Value (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Value (Get_Kind (Target))); return Get_Field6 (Target); end Get_Default_Value; procedure Set_Default_Value (Target : Iir; Value : Iir) is begin - Check_Kind_For_Default_Value (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Value (Get_Kind (Target))); Set_Field6 (Target, Value); end Set_Default_Value; - procedure Check_Kind_For_Deferred_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Constant_Declaration => - null; - when others => - Failed ("Deferred_Declaration", Target); - end case; - end Check_Kind_For_Deferred_Declaration; - function Get_Deferred_Declaration (Target : Iir) return Iir is begin - Check_Kind_For_Deferred_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Deferred_Declaration (Get_Kind (Target))); return Get_Field7 (Target); end Get_Deferred_Declaration; procedure Set_Deferred_Declaration (Target : Iir; Decl : Iir) is begin - Check_Kind_For_Deferred_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Deferred_Declaration (Get_Kind (Target))); Set_Field7 (Target, Decl); end Set_Deferred_Declaration; - procedure Check_Kind_For_Deferred_Declaration_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Constant_Declaration => - null; - when others => - Failed ("Deferred_Declaration_Flag", Target); - end case; - end Check_Kind_For_Deferred_Declaration_Flag; - function Get_Deferred_Declaration_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Deferred_Declaration_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target))); return Get_Flag1 (Target); end Get_Deferred_Declaration_Flag; procedure Set_Deferred_Declaration_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Deferred_Declaration_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Deferred_Declaration_Flag (Get_Kind (Target))); Set_Flag1 (Target, Flag); end Set_Deferred_Declaration_Flag; - procedure Check_Kind_For_Shared_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Variable_Declaration => - null; - when others => - Failed ("Shared_Flag", Target); - end case; - end Check_Kind_For_Shared_Flag; - function Get_Shared_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Shared_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Shared_Flag (Get_Kind (Target))); return Get_Flag2 (Target); end Get_Shared_Flag; procedure Set_Shared_Flag (Target : Iir; Shared : Boolean) is begin - Check_Kind_For_Shared_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Shared_Flag (Get_Kind (Target))); Set_Flag2 (Target, Shared); end Set_Shared_Flag; - procedure Check_Kind_For_Design_Unit (Target : Iir) is + function Get_Design_Unit (Target : Iir) return Iir is begin - case Get_Kind (Target) is - when Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body => - null; - when others => - Failed ("Design_Unit", Target); - end case; - end Check_Kind_For_Design_Unit; - - function Get_Design_Unit (Target : Iir) return Iir_Design_Unit is - begin - Check_Kind_For_Design_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Design_Unit (Get_Kind (Target))); return Get_Field0 (Target); end Get_Design_Unit; - procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit) is + procedure Set_Design_Unit (Target : Iir; Unit : Iir) is begin - Check_Kind_For_Design_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Design_Unit (Get_Kind (Target))); Set_Field0 (Target, Unit); end Set_Design_Unit; - procedure Check_Kind_For_Block_Statement (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Guard_Signal_Declaration => - null; - when others => - Failed ("Block_Statement", Target); - end case; - end Check_Kind_For_Block_Statement; - function Get_Block_Statement (Target : Iir) return Iir is begin - Check_Kind_For_Block_Statement (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Statement (Get_Kind (Target))); return Get_Field7 (Target); end Get_Block_Statement; procedure Set_Block_Statement (Target : Iir; Block : Iir) is begin - Check_Kind_For_Block_Statement (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Statement (Get_Kind (Target))); Set_Field7 (Target, Block); end Set_Block_Statement; - procedure Check_Kind_For_Signal_Driver (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signal_Declaration => - null; - when others => - Failed ("Signal_Driver", Target); - end case; - end Check_Kind_For_Signal_Driver; - function Get_Signal_Driver (Target : Iir_Signal_Declaration) return Iir is begin - Check_Kind_For_Signal_Driver (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_Driver (Get_Kind (Target))); return Get_Field7 (Target); end Get_Signal_Driver; procedure Set_Signal_Driver (Target : Iir_Signal_Declaration; Driver : Iir) - is + is begin - Check_Kind_For_Signal_Driver (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Signal_Driver (Get_Kind (Target))); Set_Field7 (Target, Driver); end Set_Signal_Driver; - procedure Check_Kind_For_Declaration_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Configuration - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - null; - when others => - Failed ("Declaration_Chain", Target); - end case; - end Check_Kind_For_Declaration_Chain; - function Get_Declaration_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Declaration_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Declaration_Chain (Get_Kind (Target))); return Get_Field1 (Target); end Get_Declaration_Chain; procedure Set_Declaration_Chain (Target : Iir; Decls : Iir) is begin - Check_Kind_For_Declaration_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Declaration_Chain (Get_Kind (Target))); Set_Field1 (Target, Decls); end Set_Declaration_Chain; - procedure Check_Kind_For_File_Logical_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Declaration => - null; - when others => - Failed ("File_Logical_Name", Target); - end case; - end Check_Kind_For_File_Logical_Name; - function Get_File_Logical_Name (Target : Iir_File_Declaration) return Iir - is + is begin - Check_Kind_For_File_Logical_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Logical_Name (Get_Kind (Target))); return Get_Field6 (Target); end Get_File_Logical_Name; procedure Set_File_Logical_Name (Target : Iir_File_Declaration; Name : Iir) - is + is begin - Check_Kind_For_File_Logical_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Logical_Name (Get_Kind (Target))); Set_Field6 (Target, Name); end Set_File_Logical_Name; - procedure Check_Kind_For_File_Open_Kind (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Declaration => - null; - when others => - Failed ("File_Open_Kind", Target); - end case; - end Check_Kind_For_File_Open_Kind; - function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir is begin - Check_Kind_For_File_Open_Kind (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Open_Kind (Get_Kind (Target))); return Get_Field7 (Target); end Get_File_Open_Kind; procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir) is begin - Check_Kind_For_File_Open_Kind (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Open_Kind (Get_Kind (Target))); Set_Field7 (Target, Kind); end Set_File_Open_Kind; - procedure Check_Kind_For_Element_Position (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Record_Element_Constraint - | Iir_Kind_Element_Declaration => - null; - when others => - Failed ("Element_Position", Target); - end case; - end Check_Kind_For_Element_Position; - function Get_Element_Position (Target : Iir) return Iir_Index32 is begin - Check_Kind_For_Element_Position (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Element_Position (Get_Kind (Target))); return Iir_Index32'Val (Get_Field4 (Target)); end Get_Element_Position; procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32) is begin - Check_Kind_For_Element_Position (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Element_Position (Get_Kind (Target))); Set_Field4 (Target, Iir_Index32'Pos (Pos)); end Set_Element_Position; - procedure Check_Kind_For_Element_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Record_Element_Constraint => - null; - when others => - Failed ("Element_Declaration", Target); - end case; - end Check_Kind_For_Element_Declaration; - function Get_Element_Declaration (Target : Iir) return Iir is begin - Check_Kind_For_Element_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Element_Declaration (Get_Kind (Target))); return Get_Field2 (Target); end Get_Element_Declaration; procedure Set_Element_Declaration (Target : Iir; El : Iir) is begin - Check_Kind_For_Element_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Element_Declaration (Get_Kind (Target))); Set_Field2 (Target, El); end Set_Element_Declaration; - procedure Check_Kind_For_Selected_Element (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Selected_Element => - null; - when others => - Failed ("Selected_Element", Target); - end case; - end Check_Kind_For_Selected_Element; - function Get_Selected_Element (Target : Iir) return Iir is begin - Check_Kind_For_Selected_Element (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Element (Get_Kind (Target))); return Get_Field2 (Target); end Get_Selected_Element; procedure Set_Selected_Element (Target : Iir; El : Iir) is begin - Check_Kind_For_Selected_Element (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Element (Get_Kind (Target))); Set_Field2 (Target, El); end Set_Selected_Element; - procedure Check_Kind_For_Use_Clause_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Use_Clause => - null; - when others => - Failed ("Use_Clause_Chain", Target); - end case; - end Check_Kind_For_Use_Clause_Chain; - function Get_Use_Clause_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Use_Clause_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target))); return Get_Field3 (Target); end Get_Use_Clause_Chain; procedure Set_Use_Clause_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Use_Clause_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Use_Clause_Chain (Get_Kind (Target))); Set_Field3 (Target, Chain); end Set_Use_Clause_Chain; - procedure Check_Kind_For_Selected_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Use_Clause => - null; - when others => - Failed ("Selected_Name", Target); - end case; - end Check_Kind_For_Selected_Name; - function Get_Selected_Name (Target : Iir_Use_Clause) return Iir is begin - Check_Kind_For_Selected_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Name (Get_Kind (Target))); return Get_Field1 (Target); end Get_Selected_Name; procedure Set_Selected_Name (Target : Iir_Use_Clause; Name : Iir) is begin - Check_Kind_For_Selected_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Name (Get_Kind (Target))); Set_Field1 (Target, Name); end Set_Selected_Name; - procedure Check_Kind_For_Type_Declarator (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Type_Declarator", Target); - end case; - end Check_Kind_For_Type_Declarator; - function Get_Type_Declarator (Def : Iir) return Iir is begin - Check_Kind_For_Type_Declarator (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Type_Declarator (Get_Kind (Def))); return Get_Field3 (Def); end Get_Type_Declarator; procedure Set_Type_Declarator (Def : Iir; Decl : Iir) is begin - Check_Kind_For_Type_Declarator (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Type_Declarator (Get_Kind (Def))); Set_Field3 (Def, Decl); end Set_Type_Declarator; - procedure Check_Kind_For_Enumeration_Literal_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Type_Definition => - null; - when others => - Failed ("Enumeration_Literal_List", Target); - end case; - end Check_Kind_For_Enumeration_Literal_List; - function Get_Enumeration_Literal_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Enumeration_Literal_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field2 (Target)); end Get_Enumeration_Literal_List; procedure Set_Enumeration_Literal_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Enumeration_Literal_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Enumeration_Literal_List (Get_Kind (Target))); Set_Field2 (Target, Iir_List_To_Iir (List)); end Set_Enumeration_Literal_List; - procedure Check_Kind_For_Entity_Class_Entry_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Group_Template_Declaration => - null; - when others => - Failed ("Entity_Class_Entry_Chain", Target); - end case; - end Check_Kind_For_Entity_Class_Entry_Chain; - function Get_Entity_Class_Entry_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Entity_Class_Entry_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target))); return Get_Field1 (Target); end Get_Entity_Class_Entry_Chain; procedure Set_Entity_Class_Entry_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Entity_Class_Entry_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Class_Entry_Chain (Get_Kind (Target))); Set_Field1 (Target, Chain); end Set_Entity_Class_Entry_Chain; - procedure Check_Kind_For_Group_Constituent_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Group_Declaration => - null; - when others => - Failed ("Group_Constituent_List", Target); - end case; - end Check_Kind_For_Group_Constituent_List; - function Get_Group_Constituent_List (Group : Iir) return Iir_List is begin - Check_Kind_For_Group_Constituent_List (Group); + pragma Assert (Group /= Null_Iir); + pragma Assert (Has_Group_Constituent_List (Get_Kind (Group))); return Iir_To_Iir_List (Get_Field1 (Group)); end Get_Group_Constituent_List; procedure Set_Group_Constituent_List (Group : Iir; List : Iir_List) is begin - Check_Kind_For_Group_Constituent_List (Group); + pragma Assert (Group /= Null_Iir); + pragma Assert (Has_Group_Constituent_List (Get_Kind (Group))); Set_Field1 (Group, Iir_List_To_Iir (List)); end Set_Group_Constituent_List; - procedure Check_Kind_For_Unit_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Unit_Chain", Target); - end case; - end Check_Kind_For_Unit_Chain; - function Get_Unit_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Unit_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Unit_Chain (Get_Kind (Target))); return Get_Field1 (Target); end Get_Unit_Chain; procedure Set_Unit_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Unit_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Unit_Chain (Get_Kind (Target))); Set_Field1 (Target, Chain); end Set_Unit_Chain; - procedure Check_Kind_For_Primary_Unit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Primary_Unit", Target); - end case; - end Check_Kind_For_Primary_Unit; - function Get_Primary_Unit (Target : Iir) return Iir is begin - Check_Kind_For_Primary_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Primary_Unit (Get_Kind (Target))); return Get_Field1 (Target); end Get_Primary_Unit; procedure Set_Primary_Unit (Target : Iir; Unit : Iir) is begin - Check_Kind_For_Primary_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Primary_Unit (Get_Kind (Target))); Set_Field1 (Target, Unit); end Set_Primary_Unit; - procedure Check_Kind_For_Identifier (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Identifier", Target); - end case; - end Check_Kind_For_Identifier; - function Get_Identifier (Target : Iir) return Name_Id is begin - Check_Kind_For_Identifier (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Identifier (Get_Kind (Target))); return Iir_To_Name_Id (Get_Field3 (Target)); end Get_Identifier; procedure Set_Identifier (Target : Iir; Identifier : Name_Id) is begin - Check_Kind_For_Identifier (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Identifier (Get_Kind (Target))); Set_Field3 (Target, Name_Id_To_Iir (Identifier)); end Set_Identifier; - procedure Check_Kind_For_Label (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - null; - when others => - Failed ("Label", Target); - end case; - end Check_Kind_For_Label; - function Get_Label (Target : Iir) return Name_Id is begin - Check_Kind_For_Label (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Label (Get_Kind (Target))); return Iir_To_Name_Id (Get_Field3 (Target)); end Get_Label; procedure Set_Label (Target : Iir; Label : Name_Id) is begin - Check_Kind_For_Label (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Label (Get_Kind (Target))); Set_Field3 (Target, Name_Id_To_Iir (Label)); end Set_Label; - procedure Check_Kind_For_Visible_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Record_Element_Constraint - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Library_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Element_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement => - null; - when others => - Failed ("Visible_Flag", Target); - end case; - end Check_Kind_For_Visible_Flag; - function Get_Visible_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Visible_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Visible_Flag (Get_Kind (Target))); return Get_Flag4 (Target); end Get_Visible_Flag; procedure Set_Visible_Flag (Target : Iir; Flag : Boolean) is begin - Check_Kind_For_Visible_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Visible_Flag (Get_Kind (Target))); Set_Flag4 (Target, Flag); end Set_Visible_Flag; - procedure Check_Kind_For_Range_Constraint (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Subtype_Definition => - null; - when others => - Failed ("Range_Constraint", Target); - end case; - end Check_Kind_For_Range_Constraint; - function Get_Range_Constraint (Target : Iir) return Iir is begin - Check_Kind_For_Range_Constraint (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Range_Constraint (Get_Kind (Target))); return Get_Field1 (Target); end Get_Range_Constraint; procedure Set_Range_Constraint (Target : Iir; Constraint : Iir) is begin - Check_Kind_For_Range_Constraint (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Range_Constraint (Get_Kind (Target))); Set_Field1 (Target, Constraint); end Set_Range_Constraint; - procedure Check_Kind_For_Direction (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Range_Expression => - null; - when others => - Failed ("Direction", Target); - end case; - end Check_Kind_For_Direction; - function Get_Direction (Decl : Iir) return Iir_Direction is begin - Check_Kind_For_Direction (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Direction (Get_Kind (Decl))); return Iir_Direction'Val (Get_State2 (Decl)); end Get_Direction; procedure Set_Direction (Decl : Iir; Dir : Iir_Direction) is begin - Check_Kind_For_Direction (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Direction (Get_Kind (Decl))); Set_State2 (Decl, Iir_Direction'Pos (Dir)); end Set_Direction; - procedure Check_Kind_For_Left_Limit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Range_Expression => - null; - when others => - Failed ("Left_Limit", Target); - end case; - end Check_Kind_For_Left_Limit; - function Get_Left_Limit (Decl : Iir_Range_Expression) return Iir is begin - Check_Kind_For_Left_Limit (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Left_Limit (Get_Kind (Decl))); return Get_Field2 (Decl); end Get_Left_Limit; procedure Set_Left_Limit (Decl : Iir_Range_Expression; Limit : Iir) is begin - Check_Kind_For_Left_Limit (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Left_Limit (Get_Kind (Decl))); Set_Field2 (Decl, Limit); end Set_Left_Limit; - procedure Check_Kind_For_Right_Limit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Range_Expression => - null; - when others => - Failed ("Right_Limit", Target); - end case; - end Check_Kind_For_Right_Limit; - function Get_Right_Limit (Decl : Iir_Range_Expression) return Iir is begin - Check_Kind_For_Right_Limit (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Right_Limit (Get_Kind (Decl))); return Get_Field3 (Decl); end Get_Right_Limit; procedure Set_Right_Limit (Decl : Iir_Range_Expression; Limit : Iir) is begin - Check_Kind_For_Right_Limit (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Right_Limit (Get_Kind (Decl))); Set_Field3 (Decl, Limit); end Set_Right_Limit; - procedure Check_Kind_For_Base_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Base_Type", Target); - end case; - end Check_Kind_For_Base_Type; - function Get_Base_Type (Decl : Iir) return Iir is begin - Check_Kind_For_Base_Type (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Base_Type (Get_Kind (Decl))); return Get_Field4 (Decl); end Get_Base_Type; procedure Set_Base_Type (Decl : Iir; Base_Type : Iir) is begin - Check_Kind_For_Base_Type (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Base_Type (Get_Kind (Decl))); Set_Field4 (Decl, Base_Type); end Set_Base_Type; - procedure Check_Kind_For_Resolution_Function (Target : Iir) is + function Get_Resolution_Indication (Decl : Iir) return Iir is begin - case Get_Kind (Target) is - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Subtype_Definition => - null; - when others => - Failed ("Resolution_Function", Target); - end case; - end Check_Kind_For_Resolution_Function; + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Resolution_Indication (Get_Kind (Decl))); + return Get_Field5 (Decl); + end Get_Resolution_Indication; - function Get_Resolution_Function (Decl : Iir) return Iir is + procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir) is begin - Check_Kind_For_Resolution_Function (Decl); - return Get_Field5 (Decl); - end Get_Resolution_Function; + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Resolution_Indication (Get_Kind (Decl))); + Set_Field5 (Decl, Ind); + end Set_Resolution_Indication; - procedure Set_Resolution_Function (Decl : Iir; Func : Iir) is + function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir is begin - Check_Kind_For_Resolution_Function (Decl); - Set_Field5 (Decl, Func); - end Set_Resolution_Function; + pragma Assert (Res /= Null_Iir); + pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res))); + return Get_Field1 (Res); + end Get_Record_Element_Resolution_Chain; - procedure Check_Kind_For_Tolerance (Target : Iir) is + procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir) is begin - case Get_Kind (Target) is - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Subtype_Definition - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Simple_Simultaneous_Statement => - null; - when others => - Failed ("Tolerance", Target); - end case; - end Check_Kind_For_Tolerance; + pragma Assert (Res /= Null_Iir); + pragma Assert (Has_Record_Element_Resolution_Chain (Get_Kind (Res))); + Set_Field1 (Res, Chain); + end Set_Record_Element_Resolution_Chain; function Get_Tolerance (Def : Iir) return Iir is begin - Check_Kind_For_Tolerance (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Tolerance (Get_Kind (Def))); return Get_Field7 (Def); end Get_Tolerance; procedure Set_Tolerance (Def : Iir; Tol : Iir) is begin - Check_Kind_For_Tolerance (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Tolerance (Get_Kind (Def))); Set_Field7 (Def, Tol); end Set_Tolerance; - procedure Check_Kind_For_Plus_Terminal (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - null; - when others => - Failed ("Plus_Terminal", Target); - end case; - end Check_Kind_For_Plus_Terminal; - function Get_Plus_Terminal (Def : Iir) return Iir is begin - Check_Kind_For_Plus_Terminal (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Plus_Terminal (Get_Kind (Def))); return Get_Field8 (Def); end Get_Plus_Terminal; procedure Set_Plus_Terminal (Def : Iir; Terminal : Iir) is begin - Check_Kind_For_Plus_Terminal (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Plus_Terminal (Get_Kind (Def))); Set_Field8 (Def, Terminal); end Set_Plus_Terminal; - procedure Check_Kind_For_Minus_Terminal (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - null; - when others => - Failed ("Minus_Terminal", Target); - end case; - end Check_Kind_For_Minus_Terminal; - function Get_Minus_Terminal (Def : Iir) return Iir is begin - Check_Kind_For_Minus_Terminal (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Minus_Terminal (Get_Kind (Def))); return Get_Field9 (Def); end Get_Minus_Terminal; procedure Set_Minus_Terminal (Def : Iir; Terminal : Iir) is begin - Check_Kind_For_Minus_Terminal (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Minus_Terminal (Get_Kind (Def))); Set_Field9 (Def, Terminal); end Set_Minus_Terminal; - procedure Check_Kind_For_Simultaneous_Left (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Simple_Simultaneous_Statement => - null; - when others => - Failed ("Simultaneous_Left", Target); - end case; - end Check_Kind_For_Simultaneous_Left; - function Get_Simultaneous_Left (Def : Iir) return Iir is begin - Check_Kind_For_Simultaneous_Left (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Simultaneous_Left (Get_Kind (Def))); return Get_Field5 (Def); end Get_Simultaneous_Left; procedure Set_Simultaneous_Left (Def : Iir; Expr : Iir) is begin - Check_Kind_For_Simultaneous_Left (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Simultaneous_Left (Get_Kind (Def))); Set_Field5 (Def, Expr); end Set_Simultaneous_Left; - procedure Check_Kind_For_Simultaneous_Right (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Simple_Simultaneous_Statement => - null; - when others => - Failed ("Simultaneous_Right", Target); - end case; - end Check_Kind_For_Simultaneous_Right; - function Get_Simultaneous_Right (Def : Iir) return Iir is begin - Check_Kind_For_Simultaneous_Right (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Simultaneous_Right (Get_Kind (Def))); return Get_Field6 (Def); end Get_Simultaneous_Right; procedure Set_Simultaneous_Right (Def : Iir; Expr : Iir) is begin - Check_Kind_For_Simultaneous_Right (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Simultaneous_Right (Get_Kind (Def))); Set_Field6 (Def, Expr); end Set_Simultaneous_Right; - procedure Check_Kind_For_Text_File_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Type_Definition => - null; - when others => - Failed ("Text_File_Flag", Target); - end case; - end Check_Kind_For_Text_File_Flag; - function Get_Text_File_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Text_File_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Text_File_Flag (Get_Kind (Atype))); return Get_Flag4 (Atype); end Get_Text_File_Flag; procedure Set_Text_File_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Text_File_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Text_File_Flag (Get_Kind (Atype))); Set_Flag4 (Atype, Flag); end Set_Text_File_Flag; - procedure Check_Kind_For_Only_Characters_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Type_Definition => - null; - when others => - Failed ("Only_Characters_Flag", Target); - end case; - end Check_Kind_For_Only_Characters_Flag; - function Get_Only_Characters_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Only_Characters_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype))); return Get_Flag4 (Atype); end Get_Only_Characters_Flag; procedure Set_Only_Characters_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Only_Characters_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Only_Characters_Flag (Get_Kind (Atype))); Set_Flag4 (Atype, Flag); end Set_Only_Characters_Flag; - procedure Check_Kind_For_Type_Staticness (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Type_Staticness", Target); - end case; - end Check_Kind_For_Type_Staticness; - function Get_Type_Staticness (Atype : Iir) return Iir_Staticness is begin - Check_Kind_For_Type_Staticness (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Type_Staticness (Get_Kind (Atype))); return Iir_Staticness'Val (Get_State1 (Atype)); end Get_Type_Staticness; procedure Set_Type_Staticness (Atype : Iir; Static : Iir_Staticness) is begin - Check_Kind_For_Type_Staticness (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Type_Staticness (Get_Kind (Atype))); Set_State1 (Atype, Iir_Staticness'Pos (Static)); end Set_Type_Staticness; - procedure Check_Kind_For_Constraint_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition => - null; - when others => - Failed ("Constraint_State", Target); - end case; - end Check_Kind_For_Constraint_State; - function Get_Constraint_State (Atype : Iir) return Iir_Constraint is begin - Check_Kind_For_Constraint_State (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Constraint_State (Get_Kind (Atype))); return Iir_Constraint'Val (Get_State2 (Atype)); end Get_Constraint_State; procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint) is begin - Check_Kind_For_Constraint_State (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Constraint_State (Get_Kind (Atype))); Set_State2 (Atype, Iir_Constraint'Pos (State)); end Set_Constraint_State; - procedure Check_Kind_For_Index_Subtype_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - null; - when others => - Failed ("Index_Subtype_List", Target); - end case; - end Check_Kind_For_Index_Subtype_List; - function Get_Index_Subtype_List (Decl : Iir) return Iir_List is begin - Check_Kind_For_Index_Subtype_List (Decl); - return Iir_To_Iir_List (Get_Field6 (Decl)); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl))); + return Iir_To_Iir_List (Get_Field9 (Decl)); end Get_Index_Subtype_List; procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List) is begin - Check_Kind_For_Index_Subtype_List (Decl); - Set_Field6 (Decl, Iir_List_To_Iir (List)); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Index_Subtype_List (Get_Kind (Decl))); + Set_Field9 (Decl, Iir_List_To_Iir (List)); end Set_Index_Subtype_List; - procedure Check_Kind_For_Index_List (Target : Iir) is + function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List is begin - case Get_Kind (Target) is - when Iir_Kind_Indexed_Name => - null; - when others => - Failed ("Index_List", Target); - end case; - end Check_Kind_For_Index_List; + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def))); + return Iir_To_Iir_List (Get_Field6 (Def)); + end Get_Index_Subtype_Definition_List; - function Get_Index_List (Decl : Iir) return Iir_List is + procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List) is begin - Check_Kind_For_Index_List (Decl); - return Iir_To_Iir_List (Get_Field2 (Decl)); - end Get_Index_List; + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Index_Subtype_Definition_List (Get_Kind (Def))); + Set_Field6 (Def, Iir_List_To_Iir (Idx)); + end Set_Index_Subtype_Definition_List; - procedure Set_Index_List (Decl : Iir; List : Iir_List) is + function Get_Element_Subtype_Indication (Decl : Iir) return Iir is begin - Check_Kind_For_Index_List (Decl); - Set_Field2 (Decl, Iir_List_To_Iir (List)); - end Set_Index_List; + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl))); + return Get_Field2 (Decl); + end Get_Element_Subtype_Indication; - procedure Check_Kind_For_Element_Subtype_Indication (Target : Iir) is + procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir) is begin - case Get_Kind (Target) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - null; - when others => - Failed ("Element_Subtype_Indication", Target); - end case; - end Check_Kind_For_Element_Subtype_Indication; + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Element_Subtype_Indication (Get_Kind (Decl))); + Set_Field2 (Decl, Sub_Type); + end Set_Element_Subtype_Indication; - function Get_Element_Subtype_Indication (Decl : Iir) return Iir is + function Get_Element_Subtype (Decl : Iir) return Iir is begin - Check_Kind_For_Element_Subtype_Indication (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Element_Subtype (Get_Kind (Decl))); return Get_Field1 (Decl); - end Get_Element_Subtype_Indication; + end Get_Element_Subtype; - procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir) is + procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir) is begin - Check_Kind_For_Element_Subtype_Indication (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Element_Subtype (Get_Kind (Decl))); Set_Field1 (Decl, Sub_Type); - end Set_Element_Subtype_Indication; + end Set_Element_Subtype; - procedure Check_Kind_For_Elements_Declaration_List (Target : Iir) is + function Get_Index_Constraint_List (Def : Iir) return Iir_List is begin - case Get_Kind (Target) is - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => - null; - when others => - Failed ("Elements_Declaration_List", Target); - end case; - end Check_Kind_For_Elements_Declaration_List; + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Index_Constraint_List (Get_Kind (Def))); + return Iir_To_Iir_List (Get_Field6 (Def)); + end Get_Index_Constraint_List; + + procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List) is + begin + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Index_Constraint_List (Get_Kind (Def))); + Set_Field6 (Def, Iir_List_To_Iir (List)); + end Set_Index_Constraint_List; + + function Get_Array_Element_Constraint (Def : Iir) return Iir is + begin + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def))); + return Get_Field8 (Def); + end Get_Array_Element_Constraint; + + procedure Set_Array_Element_Constraint (Def : Iir; El : Iir) is + begin + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Array_Element_Constraint (Get_Kind (Def))); + Set_Field8 (Def, El); + end Set_Array_Element_Constraint; function Get_Elements_Declaration_List (Decl : Iir) return Iir_List is begin - Check_Kind_For_Elements_Declaration_List (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl))); return Iir_To_Iir_List (Get_Field1 (Decl)); end Get_Elements_Declaration_List; procedure Set_Elements_Declaration_List (Decl : Iir; List : Iir_List) is begin - Check_Kind_For_Elements_Declaration_List (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Elements_Declaration_List (Get_Kind (Decl))); Set_Field1 (Decl, Iir_List_To_Iir (List)); end Set_Elements_Declaration_List; - procedure Check_Kind_For_Designated_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition => - null; - when others => - Failed ("Designated_Type", Target); - end case; - end Check_Kind_For_Designated_Type; - function Get_Designated_Type (Target : Iir) return Iir is begin - Check_Kind_For_Designated_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Designated_Type (Get_Kind (Target))); return Get_Field1 (Target); end Get_Designated_Type; procedure Set_Designated_Type (Target : Iir; Dtype : Iir) is begin - Check_Kind_For_Designated_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Designated_Type (Get_Kind (Target))); Set_Field1 (Target, Dtype); end Set_Designated_Type; - procedure Check_Kind_For_Designated_Subtype_Indication (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Access_Type_Definition - | Iir_Kind_Access_Subtype_Definition => - null; - when others => - Failed ("Designated_Subtype_Indication", Target); - end case; - end Check_Kind_For_Designated_Subtype_Indication; - function Get_Designated_Subtype_Indication (Target : Iir) return Iir is begin - Check_Kind_For_Designated_Subtype_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target))); return Get_Field5 (Target); end Get_Designated_Subtype_Indication; procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir) is begin - Check_Kind_For_Designated_Subtype_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Designated_Subtype_Indication (Get_Kind (Target))); Set_Field5 (Target, Dtype); end Set_Designated_Subtype_Indication; - procedure Check_Kind_For_Reference (Target : Iir) is + function Get_Index_List (Decl : Iir) return Iir_List is begin - case Get_Kind (Target) is - when Iir_Kind_Scalar_Nature_Definition => - null; - when others => - Failed ("Reference", Target); - end case; - end Check_Kind_For_Reference; + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Index_List (Get_Kind (Decl))); + return Iir_To_Iir_List (Get_Field2 (Decl)); + end Get_Index_List; + + procedure Set_Index_List (Decl : Iir; List : Iir_List) is + begin + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Index_List (Get_Kind (Decl))); + Set_Field2 (Decl, Iir_List_To_Iir (List)); + end Set_Index_List; function Get_Reference (Def : Iir) return Iir is begin - Check_Kind_For_Reference (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Reference (Get_Kind (Def))); return Get_Field2 (Def); end Get_Reference; procedure Set_Reference (Def : Iir; Ref : Iir) is begin - Check_Kind_For_Reference (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Reference (Get_Kind (Def))); Set_Field2 (Def, Ref); end Set_Reference; - procedure Check_Kind_For_Nature_Declarator (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Scalar_Nature_Definition => - null; - when others => - Failed ("Nature_Declarator", Target); - end case; - end Check_Kind_For_Nature_Declarator; - function Get_Nature_Declarator (Def : Iir) return Iir is begin - Check_Kind_For_Nature_Declarator (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Nature_Declarator (Get_Kind (Def))); return Get_Field3 (Def); end Get_Nature_Declarator; procedure Set_Nature_Declarator (Def : Iir; Decl : Iir) is begin - Check_Kind_For_Nature_Declarator (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Nature_Declarator (Get_Kind (Def))); Set_Field3 (Def, Decl); end Set_Nature_Declarator; - procedure Check_Kind_For_Across_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Scalar_Nature_Definition => - null; - when others => - Failed ("Across_Type", Target); - end case; - end Check_Kind_For_Across_Type; - function Get_Across_Type (Def : Iir) return Iir is begin - Check_Kind_For_Across_Type (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Across_Type (Get_Kind (Def))); return Get_Field7 (Def); end Get_Across_Type; procedure Set_Across_Type (Def : Iir; Atype : Iir) is begin - Check_Kind_For_Across_Type (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Across_Type (Get_Kind (Def))); Set_Field7 (Def, Atype); end Set_Across_Type; - procedure Check_Kind_For_Through_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Scalar_Nature_Definition => - null; - when others => - Failed ("Through_Type", Target); - end case; - end Check_Kind_For_Through_Type; - function Get_Through_Type (Def : Iir) return Iir is begin - Check_Kind_For_Through_Type (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Through_Type (Get_Kind (Def))); return Get_Field8 (Def); end Get_Through_Type; procedure Set_Through_Type (Def : Iir; Atype : Iir) is begin - Check_Kind_For_Through_Type (Def); + pragma Assert (Def /= Null_Iir); + pragma Assert (Has_Through_Type (Get_Kind (Def))); Set_Field8 (Def, Atype); end Set_Through_Type; - procedure Check_Kind_For_Target (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Variable_Assignment_Statement => - null; - when others => - Failed ("Target", Target); - end case; - end Check_Kind_For_Target; - function Get_Target (Target : Iir) return Iir is begin - Check_Kind_For_Target (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Target (Get_Kind (Target))); return Get_Field1 (Target); end Get_Target; procedure Set_Target (Target : Iir; Atarget : Iir) is begin - Check_Kind_For_Target (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Target (Get_Kind (Target))); Set_Field1 (Target, Atarget); end Set_Target; - procedure Check_Kind_For_Waveform_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Conditional_Waveform - | Iir_Kind_Signal_Assignment_Statement => - null; - when others => - Failed ("Waveform_Chain", Target); - end case; - end Check_Kind_For_Waveform_Chain; - function Get_Waveform_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Waveform_Chain (Get_Kind (Target))); return Get_Field5 (Target); end Get_Waveform_Chain; procedure Set_Waveform_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Waveform_Chain (Get_Kind (Target))); Set_Field5 (Target, Chain); end Set_Waveform_Chain; - procedure Check_Kind_For_Guard (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment => - null; - when others => - Failed ("Guard", Target); - end case; - end Check_Kind_For_Guard; - function Get_Guard (Target : Iir) return Iir is begin - Check_Kind_For_Guard (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard (Get_Kind (Target))); return Get_Field8 (Target); end Get_Guard; procedure Set_Guard (Target : Iir; Guard : Iir) is begin - Check_Kind_For_Guard (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard (Get_Kind (Target))); Set_Field8 (Target, Guard); end Set_Guard; - procedure Check_Kind_For_Delay_Mechanism (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - null; - when others => - Failed ("Delay_Mechanism", Target); - end case; - end Check_Kind_For_Delay_Mechanism; - function Get_Delay_Mechanism (Target : Iir) return Iir_Delay_Mechanism is begin - Check_Kind_For_Delay_Mechanism (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Delay_Mechanism (Get_Kind (Target))); return Iir_Delay_Mechanism'Val (Get_Field12 (Target)); end Get_Delay_Mechanism; procedure Set_Delay_Mechanism (Target : Iir; Kind : Iir_Delay_Mechanism) is begin - Check_Kind_For_Delay_Mechanism (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Delay_Mechanism (Get_Kind (Target))); Set_Field12 (Target, Iir_Delay_Mechanism'Pos (Kind)); end Set_Delay_Mechanism; - procedure Check_Kind_For_Reject_Time_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Signal_Assignment_Statement => - null; - when others => - Failed ("Reject_Time_Expression", Target); - end case; - end Check_Kind_For_Reject_Time_Expression; - function Get_Reject_Time_Expression (Target : Iir) return Iir is begin - Check_Kind_For_Reject_Time_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target))); return Get_Field6 (Target); end Get_Reject_Time_Expression; procedure Set_Reject_Time_Expression (Target : Iir; Expr : Iir) is begin - Check_Kind_For_Reject_Time_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Reject_Time_Expression (Get_Kind (Target))); Set_Field6 (Target, Expr); end Set_Reject_Time_Expression; - procedure Check_Kind_For_Sensitivity_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Wait_Statement => - null; - when others => - Failed ("Sensitivity_List", Target); - end case; - end Check_Kind_For_Sensitivity_List; - function Get_Sensitivity_List (Wait : Iir) return Iir_List is begin - Check_Kind_For_Sensitivity_List (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Sensitivity_List (Get_Kind (Wait))); return Iir_To_Iir_List (Get_Field6 (Wait)); end Get_Sensitivity_List; procedure Set_Sensitivity_List (Wait : Iir; List : Iir_List) is begin - Check_Kind_For_Sensitivity_List (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Sensitivity_List (Get_Kind (Wait))); Set_Field6 (Wait, Iir_List_To_Iir (List)); end Set_Sensitivity_List; - procedure Check_Kind_For_Process_Origin (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Process_Origin", Target); - end case; - end Check_Kind_For_Process_Origin; - function Get_Process_Origin (Proc : Iir) return Iir is begin - Check_Kind_For_Process_Origin (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Process_Origin (Get_Kind (Proc))); return Get_Field8 (Proc); end Get_Process_Origin; procedure Set_Process_Origin (Proc : Iir; Orig : Iir) is begin - Check_Kind_For_Process_Origin (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Process_Origin (Get_Kind (Proc))); Set_Field8 (Proc, Orig); end Set_Process_Origin; - procedure Check_Kind_For_Condition_Clause (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Wait_Statement => - null; - when others => - Failed ("Condition_Clause", Target); - end case; - end Check_Kind_For_Condition_Clause; - function Get_Condition_Clause (Wait : Iir_Wait_Statement) return Iir is begin - Check_Kind_For_Condition_Clause (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Condition_Clause (Get_Kind (Wait))); return Get_Field5 (Wait); end Get_Condition_Clause; procedure Set_Condition_Clause (Wait : Iir_Wait_Statement; Cond : Iir) is begin - Check_Kind_For_Condition_Clause (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Condition_Clause (Get_Kind (Wait))); Set_Field5 (Wait, Cond); end Set_Condition_Clause; - procedure Check_Kind_For_Timeout_Clause (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Wait_Statement => - null; - when others => - Failed ("Timeout_Clause", Target); - end case; - end Check_Kind_For_Timeout_Clause; - function Get_Timeout_Clause (Wait : Iir_Wait_Statement) return Iir is begin - Check_Kind_For_Timeout_Clause (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Timeout_Clause (Get_Kind (Wait))); return Get_Field1 (Wait); end Get_Timeout_Clause; procedure Set_Timeout_Clause (Wait : Iir_Wait_Statement; Timeout : Iir) is begin - Check_Kind_For_Timeout_Clause (Wait); + pragma Assert (Wait /= Null_Iir); + pragma Assert (Has_Timeout_Clause (Get_Kind (Wait))); Set_Field1 (Wait, Timeout); end Set_Timeout_Clause; - procedure Check_Kind_For_Postponed_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement => - null; - when others => - Failed ("Postponed_Flag", Target); - end case; - end Check_Kind_For_Postponed_Flag; - function Get_Postponed_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Postponed_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Postponed_Flag (Get_Kind (Target))); return Get_Flag3 (Target); end Get_Postponed_Flag; procedure Set_Postponed_Flag (Target : Iir; Value : Boolean) is begin - Check_Kind_For_Postponed_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Postponed_Flag (Get_Kind (Target))); Set_Flag3 (Target, Value); end Set_Postponed_Flag; - procedure Check_Kind_For_Callees_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Callees_List", Target); - end case; - end Check_Kind_For_Callees_List; - function Get_Callees_List (Proc : Iir) return Iir_List is begin - Check_Kind_For_Callees_List (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Callees_List (Get_Kind (Proc))); return Iir_To_Iir_List (Get_Field7 (Proc)); end Get_Callees_List; procedure Set_Callees_List (Proc : Iir; List : Iir_List) is begin - Check_Kind_For_Callees_List (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Callees_List (Get_Kind (Proc))); Set_Field7 (Proc, Iir_List_To_Iir (List)); end Set_Callees_List; - procedure Check_Kind_For_Passive_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Passive_Flag", Target); - end case; - end Check_Kind_For_Passive_Flag; - function Get_Passive_Flag (Proc : Iir) return Boolean is begin - Check_Kind_For_Passive_Flag (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Passive_Flag (Get_Kind (Proc))); return Get_Flag2 (Proc); end Get_Passive_Flag; procedure Set_Passive_Flag (Proc : Iir; Flag : Boolean) is begin - Check_Kind_For_Passive_Flag (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Passive_Flag (Get_Kind (Proc))); Set_Flag2 (Proc, Flag); end Set_Passive_Flag; - procedure Check_Kind_For_Resolution_Function_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration => - null; - when others => - Failed ("Resolution_Function_Flag", Target); - end case; - end Check_Kind_For_Resolution_Function_Flag; - function Get_Resolution_Function_Flag (Func : Iir) return Boolean is begin - Check_Kind_For_Resolution_Function_Flag (Func); + pragma Assert (Func /= Null_Iir); + pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func))); return Get_Flag7 (Func); end Get_Resolution_Function_Flag; procedure Set_Resolution_Function_Flag (Func : Iir; Flag : Boolean) is begin - Check_Kind_For_Resolution_Function_Flag (Func); + pragma Assert (Func /= Null_Iir); + pragma Assert (Has_Resolution_Function_Flag (Get_Kind (Func))); Set_Flag7 (Func, Flag); end Set_Resolution_Function_Flag; - procedure Check_Kind_For_Wait_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Wait_State", Target); - end case; - end Check_Kind_For_Wait_State; - function Get_Wait_State (Proc : Iir) return Tri_State_Type is begin - Check_Kind_For_Wait_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Wait_State (Get_Kind (Proc))); return Tri_State_Type'Val (Get_State1 (Proc)); end Get_Wait_State; procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type) is begin - Check_Kind_For_Wait_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Wait_State (Get_Kind (Proc))); Set_State1 (Proc, Tri_State_Type'Pos (State)); end Set_Wait_State; - procedure Check_Kind_For_All_Sensitized_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("All_Sensitized_State", Target); - end case; - end Check_Kind_For_All_Sensitized_State; - function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized is begin - Check_Kind_For_All_Sensitized_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc))); return Iir_All_Sensitized'Val (Get_State3 (Proc)); end Get_All_Sensitized_State; procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized) - is + is begin - Check_Kind_For_All_Sensitized_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_All_Sensitized_State (Get_Kind (Proc))); Set_State3 (Proc, Iir_All_Sensitized'Pos (State)); end Set_All_Sensitized_State; - procedure Check_Kind_For_Seen_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Seen_Flag", Target); - end case; - end Check_Kind_For_Seen_Flag; - function Get_Seen_Flag (Proc : Iir) return Boolean is begin - Check_Kind_For_Seen_Flag (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Seen_Flag (Get_Kind (Proc))); return Get_Flag1 (Proc); end Get_Seen_Flag; procedure Set_Seen_Flag (Proc : Iir; Flag : Boolean) is begin - Check_Kind_For_Seen_Flag (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Seen_Flag (Get_Kind (Proc))); Set_Flag1 (Proc, Flag); end Set_Seen_Flag; - procedure Check_Kind_For_Pure_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - null; - when others => - Failed ("Pure_Flag", Target); - end case; - end Check_Kind_For_Pure_Flag; - function Get_Pure_Flag (Func : Iir) return Boolean is begin - Check_Kind_For_Pure_Flag (Func); + pragma Assert (Func /= Null_Iir); + pragma Assert (Has_Pure_Flag (Get_Kind (Func))); return Get_Flag2 (Func); end Get_Pure_Flag; procedure Set_Pure_Flag (Func : Iir; Flag : Boolean) is begin - Check_Kind_For_Pure_Flag (Func); + pragma Assert (Func /= Null_Iir); + pragma Assert (Has_Pure_Flag (Get_Kind (Func))); Set_Flag2 (Func, Flag); end Set_Pure_Flag; - procedure Check_Kind_For_Foreign_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Architecture_Body - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Foreign_Flag", Target); - end case; - end Check_Kind_For_Foreign_Flag; - function Get_Foreign_Flag (Decl : Iir) return Boolean is begin - Check_Kind_For_Foreign_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Foreign_Flag (Get_Kind (Decl))); return Get_Flag3 (Decl); end Get_Foreign_Flag; procedure Set_Foreign_Flag (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Foreign_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Foreign_Flag (Get_Kind (Decl))); Set_Flag3 (Decl, Flag); end Set_Foreign_Flag; - procedure Check_Kind_For_Resolved_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Resolved_Flag", Target); - end case; - end Check_Kind_For_Resolved_Flag; - function Get_Resolved_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Resolved_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Resolved_Flag (Get_Kind (Atype))); return Get_Flag1 (Atype); end Get_Resolved_Flag; procedure Set_Resolved_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Resolved_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Resolved_Flag (Get_Kind (Atype))); Set_Flag1 (Atype, Flag); end Set_Resolved_Flag; - procedure Check_Kind_For_Signal_Type_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Access_Type_Definition - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_File_Type_Definition - | Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Signal_Type_Flag", Target); - end case; - end Check_Kind_For_Signal_Type_Flag; - function Get_Signal_Type_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Signal_Type_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype))); return Get_Flag2 (Atype); end Get_Signal_Type_Flag; procedure Set_Signal_Type_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Signal_Type_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Signal_Type_Flag (Get_Kind (Atype))); Set_Flag2 (Atype, Flag); end Set_Signal_Type_Flag; - procedure Check_Kind_For_Has_Signal_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Incomplete_Type_Definition - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition => - null; - when others => - Failed ("Has_Signal_Flag", Target); - end case; - end Check_Kind_For_Has_Signal_Flag; - function Get_Has_Signal_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Has_Signal_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype))); return Get_Flag3 (Atype); end Get_Has_Signal_Flag; procedure Set_Has_Signal_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Signal_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Has_Signal_Flag (Get_Kind (Atype))); Set_Flag3 (Atype, Flag); end Set_Has_Signal_Flag; - procedure Check_Kind_For_Purity_State (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Purity_State", Target); - end case; - end Check_Kind_For_Purity_State; - function Get_Purity_State (Proc : Iir) return Iir_Pure_State is begin - Check_Kind_For_Purity_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Purity_State (Get_Kind (Proc))); return Iir_Pure_State'Val (Get_State2 (Proc)); end Get_Purity_State; procedure Set_Purity_State (Proc : Iir; State : Iir_Pure_State) is begin - Check_Kind_For_Purity_State (Proc); + pragma Assert (Proc /= Null_Iir); + pragma Assert (Has_Purity_State (Get_Kind (Proc))); Set_State2 (Proc, Iir_Pure_State'Pos (State)); end Set_Purity_State; - procedure Check_Kind_For_Elab_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit => - null; - when others => - Failed ("Elab_Flag", Target); - end case; - end Check_Kind_For_Elab_Flag; - function Get_Elab_Flag (Design : Iir) return Boolean is begin - Check_Kind_For_Elab_Flag (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Elab_Flag (Get_Kind (Design))); return Get_Flag3 (Design); end Get_Elab_Flag; procedure Set_Elab_Flag (Design : Iir; Flag : Boolean) is begin - Check_Kind_For_Elab_Flag (Design); + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Elab_Flag (Get_Kind (Design))); Set_Flag3 (Design, Flag); end Set_Elab_Flag; - procedure Check_Kind_For_Index_Constraint_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Array_Type_Definition - | Iir_Kind_Array_Subtype_Definition => - null; - when others => - Failed ("Index_Constraint_Flag", Target); - end case; - end Check_Kind_For_Index_Constraint_Flag; - function Get_Index_Constraint_Flag (Atype : Iir) return Boolean is begin - Check_Kind_For_Index_Constraint_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype))); return Get_Flag4 (Atype); end Get_Index_Constraint_Flag; procedure Set_Index_Constraint_Flag (Atype : Iir; Flag : Boolean) is begin - Check_Kind_For_Index_Constraint_Flag (Atype); + pragma Assert (Atype /= Null_Iir); + pragma Assert (Has_Index_Constraint_Flag (Get_Kind (Atype))); Set_Flag4 (Atype, Flag); end Set_Index_Constraint_Flag; - procedure Check_Kind_For_Assertion_Condition (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Assertion_Statement => - null; - when others => - Failed ("Assertion_Condition", Target); - end case; - end Check_Kind_For_Assertion_Condition; - function Get_Assertion_Condition (Target : Iir) return Iir is begin - Check_Kind_For_Assertion_Condition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Assertion_Condition (Get_Kind (Target))); return Get_Field1 (Target); end Get_Assertion_Condition; procedure Set_Assertion_Condition (Target : Iir; Cond : Iir) is begin - Check_Kind_For_Assertion_Condition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Assertion_Condition (Get_Kind (Target))); Set_Field1 (Target, Cond); end Set_Assertion_Condition; - procedure Check_Kind_For_Report_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - null; - when others => - Failed ("Report_Expression", Target); - end case; - end Check_Kind_For_Report_Expression; - function Get_Report_Expression (Target : Iir) return Iir is begin - Check_Kind_For_Report_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Report_Expression (Get_Kind (Target))); return Get_Field6 (Target); end Get_Report_Expression; procedure Set_Report_Expression (Target : Iir; Expr : Iir) is begin - Check_Kind_For_Report_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Report_Expression (Get_Kind (Target))); Set_Field6 (Target, Expr); end Set_Report_Expression; - procedure Check_Kind_For_Severity_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement => - null; - when others => - Failed ("Severity_Expression", Target); - end case; - end Check_Kind_For_Severity_Expression; - function Get_Severity_Expression (Target : Iir) return Iir is begin - Check_Kind_For_Severity_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Severity_Expression (Get_Kind (Target))); return Get_Field5 (Target); end Get_Severity_Expression; procedure Set_Severity_Expression (Target : Iir; Expr : Iir) is begin - Check_Kind_For_Severity_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Severity_Expression (Get_Kind (Target))); Set_Field5 (Target, Expr); end Set_Severity_Expression; - procedure Check_Kind_For_Instantiated_Unit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Instantiated_Unit", Target); - end case; - end Check_Kind_For_Instantiated_Unit; - function Get_Instantiated_Unit (Target : Iir) return Iir is begin - Check_Kind_For_Instantiated_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Instantiated_Unit (Get_Kind (Target))); return Get_Field1 (Target); end Get_Instantiated_Unit; procedure Set_Instantiated_Unit (Target : Iir; Unit : Iir) is begin - Check_Kind_For_Instantiated_Unit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Instantiated_Unit (Get_Kind (Target))); Set_Field1 (Target, Unit); end Set_Instantiated_Unit; - procedure Check_Kind_For_Generic_Map_Aspect_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Header - | Iir_Kind_Binding_Indication - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Header - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Generic_Map_Aspect_Chain", Target); - end case; - end Check_Kind_For_Generic_Map_Aspect_Chain; - function Get_Generic_Map_Aspect_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Generic_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target))); return Get_Field8 (Target); end Get_Generic_Map_Aspect_Chain; procedure Set_Generic_Map_Aspect_Chain (Target : Iir; Generics : Iir) is begin - Check_Kind_For_Generic_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generic_Map_Aspect_Chain (Get_Kind (Target))); Set_Field8 (Target, Generics); end Set_Generic_Map_Aspect_Chain; - procedure Check_Kind_For_Port_Map_Aspect_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Header - | Iir_Kind_Binding_Indication - | Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Port_Map_Aspect_Chain", Target); - end case; - end Check_Kind_For_Port_Map_Aspect_Chain; - function Get_Port_Map_Aspect_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Port_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target))); return Get_Field9 (Target); end Get_Port_Map_Aspect_Chain; procedure Set_Port_Map_Aspect_Chain (Target : Iir; Port : Iir) is begin - Check_Kind_For_Port_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Port_Map_Aspect_Chain (Get_Kind (Target))); Set_Field9 (Target, Port); end Set_Port_Map_Aspect_Chain; - procedure Check_Kind_For_Configuration_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Aspect_Configuration => - null; - when others => - Failed ("Configuration_Name", Target); - end case; - end Check_Kind_For_Configuration_Name; - function Get_Configuration_Name (Target : Iir) return Iir is begin - Check_Kind_For_Configuration_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Name (Get_Kind (Target))); return Get_Field1 (Target); end Get_Configuration_Name; procedure Set_Configuration_Name (Target : Iir; Conf : Iir) is begin - Check_Kind_For_Configuration_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Name (Get_Kind (Target))); Set_Field1 (Target, Conf); end Set_Configuration_Name; - procedure Check_Kind_For_Component_Configuration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Component_Configuration", Target); - end case; - end Check_Kind_For_Component_Configuration; - function Get_Component_Configuration (Target : Iir) return Iir is begin - Check_Kind_For_Component_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Component_Configuration (Get_Kind (Target))); return Get_Field6 (Target); end Get_Component_Configuration; procedure Set_Component_Configuration (Target : Iir; Conf : Iir) is begin - Check_Kind_For_Component_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Component_Configuration (Get_Kind (Target))); Set_Field6 (Target, Conf); end Set_Component_Configuration; - procedure Check_Kind_For_Configuration_Specification (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Configuration_Specification", Target); - end case; - end Check_Kind_For_Configuration_Specification; - function Get_Configuration_Specification (Target : Iir) return Iir is begin - Check_Kind_For_Configuration_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Specification (Get_Kind (Target))); return Get_Field7 (Target); end Get_Configuration_Specification; procedure Set_Configuration_Specification (Target : Iir; Conf : Iir) is begin - Check_Kind_For_Configuration_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Configuration_Specification (Get_Kind (Target))); Set_Field7 (Target, Conf); end Set_Configuration_Specification; - procedure Check_Kind_For_Default_Binding_Indication (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Instantiation_Statement => - null; - when others => - Failed ("Default_Binding_Indication", Target); - end case; - end Check_Kind_For_Default_Binding_Indication; - function Get_Default_Binding_Indication (Target : Iir) return Iir is begin - Check_Kind_For_Default_Binding_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target))); return Get_Field5 (Target); end Get_Default_Binding_Indication; procedure Set_Default_Binding_Indication (Target : Iir; Conf : Iir) is begin - Check_Kind_For_Default_Binding_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Binding_Indication (Get_Kind (Target))); Set_Field5 (Target, Conf); end Set_Default_Binding_Indication; - procedure Check_Kind_For_Default_Configuration_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Architecture_Body => - null; - when others => - Failed ("Default_Configuration_Declaration", Target); - end case; - end Check_Kind_For_Default_Configuration_Declaration; - function Get_Default_Configuration_Declaration (Target : Iir) return Iir is begin - Check_Kind_For_Default_Configuration_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert + (Has_Default_Configuration_Declaration (Get_Kind (Target))); return Get_Field6 (Target); end Get_Default_Configuration_Declaration; procedure Set_Default_Configuration_Declaration (Target : Iir; Conf : Iir) - is + is begin - Check_Kind_For_Default_Configuration_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert + (Has_Default_Configuration_Declaration (Get_Kind (Target))); Set_Field6 (Target, Conf); end Set_Default_Configuration_Declaration; - procedure Check_Kind_For_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_Case_Statement => - null; - when others => - Failed ("Expression", Target); - end case; - end Check_Kind_For_Expression; - function Get_Expression (Target : Iir) return Iir is begin - Check_Kind_For_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Expression (Get_Kind (Target))); return Get_Field5 (Target); end Get_Expression; procedure Set_Expression (Target : Iir; Expr : Iir) is begin - Check_Kind_For_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Expression (Get_Kind (Target))); Set_Field5 (Target, Expr); end Set_Expression; - procedure Check_Kind_For_Allocator_Designated_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype => - null; - when others => - Failed ("Allocator_Designated_Type", Target); - end case; - end Check_Kind_For_Allocator_Designated_Type; - function Get_Allocator_Designated_Type (Target : Iir) return Iir is begin - Check_Kind_For_Allocator_Designated_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target))); return Get_Field2 (Target); end Get_Allocator_Designated_Type; procedure Set_Allocator_Designated_Type (Target : Iir; A_Type : Iir) is begin - Check_Kind_For_Allocator_Designated_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Allocator_Designated_Type (Get_Kind (Target))); Set_Field2 (Target, A_Type); end Set_Allocator_Designated_Type; - procedure Check_Kind_For_Selected_Waveform_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - null; - when others => - Failed ("Selected_Waveform_Chain", Target); - end case; - end Check_Kind_For_Selected_Waveform_Chain; - function Get_Selected_Waveform_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Selected_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target))); return Get_Field7 (Target); end Get_Selected_Waveform_Chain; procedure Set_Selected_Waveform_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Selected_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Selected_Waveform_Chain (Get_Kind (Target))); Set_Field7 (Target, Chain); end Set_Selected_Waveform_Chain; - procedure Check_Kind_For_Conditional_Waveform_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - null; - when others => - Failed ("Conditional_Waveform_Chain", Target); - end case; - end Check_Kind_For_Conditional_Waveform_Chain; - function Get_Conditional_Waveform_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Conditional_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target))); return Get_Field7 (Target); end Get_Conditional_Waveform_Chain; procedure Set_Conditional_Waveform_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Conditional_Waveform_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Conditional_Waveform_Chain (Get_Kind (Target))); Set_Field7 (Target, Chain); end Set_Conditional_Waveform_Chain; - procedure Check_Kind_For_Guard_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Guard_Signal_Declaration => - null; - when others => - Failed ("Guard_Expression", Target); - end case; - end Check_Kind_For_Guard_Expression; - function Get_Guard_Expression (Target : Iir) return Iir is begin - Check_Kind_For_Guard_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard_Expression (Get_Kind (Target))); return Get_Field2 (Target); end Get_Guard_Expression; procedure Set_Guard_Expression (Target : Iir; Expr : Iir) is begin - Check_Kind_For_Guard_Expression (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard_Expression (Get_Kind (Target))); Set_Field2 (Target, Expr); end Set_Guard_Expression; - procedure Check_Kind_For_Guard_Decl (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Statement => - null; - when others => - Failed ("Guard_Decl", Target); - end case; - end Check_Kind_For_Guard_Decl; - function Get_Guard_Decl (Target : Iir_Block_Statement) return Iir is begin - Check_Kind_For_Guard_Decl (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard_Decl (Get_Kind (Target))); return Get_Field8 (Target); end Get_Guard_Decl; procedure Set_Guard_Decl (Target : Iir_Block_Statement; Decl : Iir) is begin - Check_Kind_For_Guard_Decl (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Guard_Decl (Get_Kind (Target))); Set_Field8 (Target, Decl); end Set_Guard_Decl; - procedure Check_Kind_For_Guard_Sensitivity_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Guard_Signal_Declaration => - null; - when others => - Failed ("Guard_Sensitivity_List", Target); - end case; - end Check_Kind_For_Guard_Sensitivity_List; - function Get_Guard_Sensitivity_List (Guard : Iir) return Iir_List is begin - Check_Kind_For_Guard_Sensitivity_List (Guard); + pragma Assert (Guard /= Null_Iir); + pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard))); return Iir_To_Iir_List (Get_Field6 (Guard)); end Get_Guard_Sensitivity_List; procedure Set_Guard_Sensitivity_List (Guard : Iir; List : Iir_List) is begin - Check_Kind_For_Guard_Sensitivity_List (Guard); + pragma Assert (Guard /= Null_Iir); + pragma Assert (Has_Guard_Sensitivity_List (Get_Kind (Guard))); Set_Field6 (Guard, Iir_List_To_Iir (List)); end Set_Guard_Sensitivity_List; - procedure Check_Kind_For_Block_Block_Configuration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Statement => - null; - when others => - Failed ("Block_Block_Configuration", Target); - end case; - end Check_Kind_For_Block_Block_Configuration; - function Get_Block_Block_Configuration (Block : Iir) return Iir is begin - Check_Kind_For_Block_Block_Configuration (Block); + pragma Assert (Block /= Null_Iir); + pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block))); return Get_Field6 (Block); end Get_Block_Block_Configuration; procedure Set_Block_Block_Configuration (Block : Iir; Conf : Iir) is begin - Check_Kind_For_Block_Block_Configuration (Block); + pragma Assert (Block /= Null_Iir); + pragma Assert (Has_Block_Block_Configuration (Get_Kind (Block))); Set_Field6 (Block, Conf); end Set_Block_Block_Configuration; - procedure Check_Kind_For_Package_Header (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Package_Declaration => - null; - when others => - Failed ("Package_Header", Target); - end case; - end Check_Kind_For_Package_Header; - function Get_Package_Header (Pkg : Iir) return Iir is begin - Check_Kind_For_Package_Header (Pkg); + pragma Assert (Pkg /= Null_Iir); + pragma Assert (Has_Package_Header (Get_Kind (Pkg))); return Get_Field5 (Pkg); end Get_Package_Header; procedure Set_Package_Header (Pkg : Iir; Header : Iir) is begin - Check_Kind_For_Package_Header (Pkg); + pragma Assert (Pkg /= Null_Iir); + pragma Assert (Has_Package_Header (Get_Kind (Pkg))); Set_Field5 (Pkg, Header); end Set_Package_Header; - procedure Check_Kind_For_Block_Header (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Block_Statement => - null; - when others => - Failed ("Block_Header", Target); - end case; - end Check_Kind_For_Block_Header; - function Get_Block_Header (Target : Iir) return Iir is begin - Check_Kind_For_Block_Header (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Header (Get_Kind (Target))); return Get_Field7 (Target); end Get_Block_Header; procedure Set_Block_Header (Target : Iir; Header : Iir) is begin - Check_Kind_For_Block_Header (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Block_Header (Get_Kind (Target))); Set_Field7 (Target, Header); end Set_Block_Header; - procedure Check_Kind_For_Uninstantiated_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Package_Instantiation_Declaration => - null; - when others => - Failed ("Uninstantiated_Name", Target); - end case; - end Check_Kind_For_Uninstantiated_Name; - function Get_Uninstantiated_Name (Inst : Iir) return Iir is begin - Check_Kind_For_Uninstantiated_Name (Inst); + pragma Assert (Inst /= Null_Iir); + pragma Assert (Has_Uninstantiated_Name (Get_Kind (Inst))); return Get_Field5 (Inst); end Get_Uninstantiated_Name; procedure Set_Uninstantiated_Name (Inst : Iir; Name : Iir) is begin - Check_Kind_For_Uninstantiated_Name (Inst); + pragma Assert (Inst /= Null_Iir); + pragma Assert (Has_Uninstantiated_Name (Get_Kind (Inst))); Set_Field5 (Inst, Name); end Set_Uninstantiated_Name; - procedure Check_Kind_For_Generate_Block_Configuration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Generate_Statement => - null; - when others => - Failed ("Generate_Block_Configuration", Target); - end case; - end Check_Kind_For_Generate_Block_Configuration; - function Get_Generate_Block_Configuration (Target : Iir) return Iir is begin - Check_Kind_For_Generate_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); return Get_Field7 (Target); end Get_Generate_Block_Configuration; procedure Set_Generate_Block_Configuration (Target : Iir; Conf : Iir) is begin - Check_Kind_For_Generate_Block_Configuration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generate_Block_Configuration (Get_Kind (Target))); Set_Field7 (Target, Conf); end Set_Generate_Block_Configuration; - procedure Check_Kind_For_Generation_Scheme (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Generate_Statement => - null; - when others => - Failed ("Generation_Scheme", Target); - end case; - end Check_Kind_For_Generation_Scheme; - function Get_Generation_Scheme (Target : Iir) return Iir is begin - Check_Kind_For_Generation_Scheme (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); return Get_Field6 (Target); end Get_Generation_Scheme; procedure Set_Generation_Scheme (Target : Iir; Scheme : Iir) is begin - Check_Kind_For_Generation_Scheme (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Generation_Scheme (Get_Kind (Target))); Set_Field6 (Target, Scheme); end Set_Generation_Scheme; - procedure Check_Kind_For_Condition (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Conditional_Waveform - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - null; - when others => - Failed ("Condition", Target); - end case; - end Check_Kind_For_Condition; - function Get_Condition (Target : Iir) return Iir is begin - Check_Kind_For_Condition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Condition (Get_Kind (Target))); return Get_Field1 (Target); end Get_Condition; procedure Set_Condition (Target : Iir; Condition : Iir) is begin - Check_Kind_For_Condition (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Condition (Get_Kind (Target))); Set_Field1 (Target, Condition); end Set_Condition; - procedure Check_Kind_For_Else_Clause (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_If_Statement - | Iir_Kind_Elsif => - null; - when others => - Failed ("Else_Clause", Target); - end case; - end Check_Kind_For_Else_Clause; - function Get_Else_Clause (Target : Iir) return Iir is begin - Check_Kind_For_Else_Clause (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Else_Clause (Get_Kind (Target))); return Get_Field6 (Target); end Get_Else_Clause; procedure Set_Else_Clause (Target : Iir; Clause : Iir) is begin - Check_Kind_For_Else_Clause (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Else_Clause (Get_Kind (Target))); Set_Field6 (Target, Clause); end Set_Else_Clause; - procedure Check_Kind_For_Parameter_Specification (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_For_Loop_Statement => - null; - when others => - Failed ("Parameter_Specification", Target); - end case; - end Check_Kind_For_Parameter_Specification; - function Get_Parameter_Specification (Target : Iir) return Iir is begin - Check_Kind_For_Parameter_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter_Specification (Get_Kind (Target))); return Get_Field1 (Target); end Get_Parameter_Specification; procedure Set_Parameter_Specification (Target : Iir; Param : Iir) is begin - Check_Kind_For_Parameter_Specification (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter_Specification (Get_Kind (Target))); Set_Field1 (Target, Param); end Set_Parameter_Specification; - procedure Check_Kind_For_Parent (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_File - | Iir_Kind_Design_Unit - | Iir_Kind_Library_Clause - | Iir_Kind_Use_Clause - | Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_None - | Iir_Kind_Choice_By_Name - | Iir_Kind_Block_Configuration - | Iir_Kind_Component_Configuration - | Iir_Kind_Record_Element_Constraint - | Iir_Kind_Attribute_Specification - | Iir_Kind_Disconnection_Specification - | Iir_Kind_Configuration_Specification - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Unit_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Concurrent_Conditional_Signal_Assignment - | Iir_Kind_Concurrent_Selected_Signal_Assignment - | Iir_Kind_Concurrent_Assertion_Statement - | Iir_Kind_Psl_Default_Clock - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement - | Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_Component_Instantiation_Statement - | Iir_Kind_Simple_Simultaneous_Statement - | Iir_Kind_Signal_Assignment_Statement - | Iir_Kind_Null_Statement - | Iir_Kind_Assertion_Statement - | Iir_Kind_Report_Statement - | Iir_Kind_Wait_Statement - | Iir_Kind_Variable_Assignment_Statement - | Iir_Kind_Return_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_Procedure_Call_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - null; - when others => - Failed ("Parent", Target); - end case; - end Check_Kind_For_Parent; - function Get_Parent (Target : Iir) return Iir is begin - Check_Kind_For_Parent (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parent (Get_Kind (Target))); return Get_Field0 (Target); end Get_Parent; procedure Set_Parent (Target : Iir; Parent : Iir) is begin - Check_Kind_For_Parent (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parent (Get_Kind (Target))); Set_Field0 (Target, Parent); end Set_Parent; - procedure Check_Kind_For_Loop_Label (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - null; - when others => - Failed ("Loop_Label", Target); - end case; - end Check_Kind_For_Loop_Label; - function Get_Loop_Label (Target : Iir) return Iir is begin - Check_Kind_For_Loop_Label (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Loop_Label (Get_Kind (Target))); return Get_Field5 (Target); end Get_Loop_Label; procedure Set_Loop_Label (Target : Iir; Stmt : Iir) is begin - Check_Kind_For_Loop_Label (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Loop_Label (Get_Kind (Target))); Set_Field5 (Target, Stmt); end Set_Loop_Label; - procedure Check_Kind_For_Component_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - null; - when others => - Failed ("Component_Name", Target); - end case; - end Check_Kind_For_Component_Name; - function Get_Component_Name (Target : Iir) return Iir is begin - Check_Kind_For_Component_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Component_Name (Get_Kind (Target))); return Get_Field4 (Target); end Get_Component_Name; procedure Set_Component_Name (Target : Iir; Name : Iir) is begin - Check_Kind_For_Component_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Component_Name (Get_Kind (Target))); Set_Field4 (Target, Name); end Set_Component_Name; - procedure Check_Kind_For_Instantiation_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - null; - when others => - Failed ("Instantiation_List", Target); - end case; - end Check_Kind_For_Instantiation_List; - function Get_Instantiation_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Instantiation_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Instantiation_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field1 (Target)); end Get_Instantiation_List; procedure Set_Instantiation_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Instantiation_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Instantiation_List (Get_Kind (Target))); Set_Field1 (Target, Iir_List_To_Iir (List)); end Set_Instantiation_List; - procedure Check_Kind_For_Entity_Aspect (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Binding_Indication => - null; - when others => - Failed ("Entity_Aspect", Target); - end case; - end Check_Kind_For_Entity_Aspect; - function Get_Entity_Aspect (Target : Iir_Binding_Indication) return Iir is begin - Check_Kind_For_Entity_Aspect (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Aspect (Get_Kind (Target))); return Get_Field3 (Target); end Get_Entity_Aspect; procedure Set_Entity_Aspect (Target : Iir_Binding_Indication; Entity : Iir) - is + is begin - Check_Kind_For_Entity_Aspect (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Entity_Aspect (Get_Kind (Target))); Set_Field3 (Target, Entity); end Set_Entity_Aspect; - procedure Check_Kind_For_Default_Entity_Aspect (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Binding_Indication => - null; - when others => - Failed ("Default_Entity_Aspect", Target); - end case; - end Check_Kind_For_Default_Entity_Aspect; - function Get_Default_Entity_Aspect (Target : Iir) return Iir is begin - Check_Kind_For_Default_Entity_Aspect (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target))); return Get_Field1 (Target); end Get_Default_Entity_Aspect; procedure Set_Default_Entity_Aspect (Target : Iir; Aspect : Iir) is begin - Check_Kind_For_Default_Entity_Aspect (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Entity_Aspect (Get_Kind (Target))); Set_Field1 (Target, Aspect); end Set_Default_Entity_Aspect; - procedure Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Binding_Indication => - null; - when others => - Failed ("Default_Generic_Map_Aspect_Chain", Target); - end case; - end Check_Kind_For_Default_Generic_Map_Aspect_Chain; - function Get_Default_Generic_Map_Aspect_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target))); return Get_Field6 (Target); end Get_Default_Generic_Map_Aspect_Chain; procedure Set_Default_Generic_Map_Aspect_Chain (Target : Iir; Chain : Iir) - is + is begin - Check_Kind_For_Default_Generic_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Generic_Map_Aspect_Chain (Get_Kind (Target))); Set_Field6 (Target, Chain); end Set_Default_Generic_Map_Aspect_Chain; - procedure Check_Kind_For_Default_Port_Map_Aspect_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Binding_Indication => - null; - when others => - Failed ("Default_Port_Map_Aspect_Chain", Target); - end case; - end Check_Kind_For_Default_Port_Map_Aspect_Chain; - function Get_Default_Port_Map_Aspect_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Default_Port_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target))); return Get_Field7 (Target); end Get_Default_Port_Map_Aspect_Chain; procedure Set_Default_Port_Map_Aspect_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Default_Port_Map_Aspect_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Default_Port_Map_Aspect_Chain (Get_Kind (Target))); Set_Field7 (Target, Chain); end Set_Default_Port_Map_Aspect_Chain; - procedure Check_Kind_For_Binding_Indication (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Configuration - | Iir_Kind_Configuration_Specification => - null; - when others => - Failed ("Binding_Indication", Target); - end case; - end Check_Kind_For_Binding_Indication; - function Get_Binding_Indication (Target : Iir) return Iir is begin - Check_Kind_For_Binding_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Binding_Indication (Get_Kind (Target))); return Get_Field3 (Target); end Get_Binding_Indication; procedure Set_Binding_Indication (Target : Iir; Binding : Iir) is begin - Check_Kind_For_Binding_Indication (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Binding_Indication (Get_Kind (Target))); Set_Field3 (Target, Binding); end Set_Binding_Indication; - procedure Check_Kind_For_Named_Entity (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Named_Entity", Target); - end case; - end Check_Kind_For_Named_Entity; - function Get_Named_Entity (Name : Iir) return Iir is begin - Check_Kind_For_Named_Entity (Name); + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Named_Entity (Get_Kind (Name))); return Get_Field4 (Name); end Get_Named_Entity; procedure Set_Named_Entity (Name : Iir; Val : Iir) is begin - Check_Kind_For_Named_Entity (Name); + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Named_Entity (Get_Kind (Name))); Set_Field4 (Name, Val); end Set_Named_Entity; - procedure Check_Kind_For_Alias_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol => - null; - when others => - Failed ("Alias_Declaration", Target); - end case; - end Check_Kind_For_Alias_Declaration; - function Get_Alias_Declaration (Name : Iir) return Iir is begin - Check_Kind_For_Alias_Declaration (Name); + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Alias_Declaration (Get_Kind (Name))); return Get_Field2 (Name); end Get_Alias_Declaration; procedure Set_Alias_Declaration (Name : Iir; Val : Iir) is begin - Check_Kind_For_Alias_Declaration (Name); + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_Alias_Declaration (Get_Kind (Name))); Set_Field2 (Name, Val); end Set_Alias_Declaration; - procedure Check_Kind_For_Expr_Staticness (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error - | Iir_Kind_Integer_Literal - | Iir_Kind_Floating_Point_Literal - | Iir_Kind_Null_Literal - | Iir_Kind_String_Literal - | Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal - | Iir_Kind_Bit_String_Literal - | Iir_Kind_Simple_Aggregate - | Iir_Kind_Overflow_Literal - | Iir_Kind_Attribute_Value - | Iir_Kind_Range_Expression - | Iir_Kind_Unit_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call - | Iir_Kind_Aggregate - | Iir_Kind_Parenthesis_Expression - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion - | Iir_Kind_Allocator_By_Expression - | Iir_Kind_Allocator_By_Subtype - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Expr_Staticness", Target); - end case; - end Check_Kind_For_Expr_Staticness; - function Get_Expr_Staticness (Target : Iir) return Iir_Staticness is begin - Check_Kind_For_Expr_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Expr_Staticness (Get_Kind (Target))); return Iir_Staticness'Val (Get_State1 (Target)); end Get_Expr_Staticness; procedure Set_Expr_Staticness (Target : Iir; Static : Iir_Staticness) is begin - Check_Kind_For_Expr_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Expr_Staticness (Get_Kind (Target))); Set_State1 (Target, Iir_Staticness'Pos (Static)); end Set_Expr_Staticness; - procedure Check_Kind_For_Error_Origin (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Error => - null; - when others => - Failed ("Error_Origin", Target); - end case; - end Check_Kind_For_Error_Origin; - function Get_Error_Origin (Target : Iir) return Iir is begin - Check_Kind_For_Error_Origin (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Error_Origin (Get_Kind (Target))); return Get_Field2 (Target); end Get_Error_Origin; procedure Set_Error_Origin (Target : Iir; Origin : Iir) is begin - Check_Kind_For_Error_Origin (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Error_Origin (Get_Kind (Target))); Set_Field2 (Target, Origin); end Set_Error_Origin; - procedure Check_Kind_For_Operand (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - null; - when others => - Failed ("Operand", Target); - end case; - end Check_Kind_For_Operand; - function Get_Operand (Target : Iir) return Iir is begin - Check_Kind_For_Operand (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Operand (Get_Kind (Target))); return Get_Field2 (Target); end Get_Operand; procedure Set_Operand (Target : Iir; An_Iir : Iir) is begin - Check_Kind_For_Operand (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Operand (Get_Kind (Target))); Set_Field2 (Target, An_Iir); end Set_Operand; - procedure Check_Kind_For_Left (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - null; - when others => - Failed ("Left", Target); - end case; - end Check_Kind_For_Left; - function Get_Left (Target : Iir) return Iir is begin - Check_Kind_For_Left (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Left (Get_Kind (Target))); return Get_Field2 (Target); end Get_Left; procedure Set_Left (Target : Iir; An_Iir : Iir) is begin - Check_Kind_For_Left (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Left (Get_Kind (Target))); Set_Field2 (Target, An_Iir); end Set_Left; - procedure Check_Kind_For_Right (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - null; - when others => - Failed ("Right", Target); - end case; - end Check_Kind_For_Right; - function Get_Right (Target : Iir) return Iir is begin - Check_Kind_For_Right (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Right (Get_Kind (Target))); return Get_Field4 (Target); end Get_Right; procedure Set_Right (Target : Iir; An_Iir : Iir) is begin - Check_Kind_For_Right (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Right (Get_Kind (Target))); Set_Field4 (Target, An_Iir); end Set_Right; - procedure Check_Kind_For_Unit_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Physical_Int_Literal - | Iir_Kind_Physical_Fp_Literal => - null; - when others => - Failed ("Unit_Name", Target); - end case; - end Check_Kind_For_Unit_Name; - function Get_Unit_Name (Target : Iir) return Iir is begin - Check_Kind_For_Unit_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Unit_Name (Get_Kind (Target))); return Get_Field3 (Target); end Get_Unit_Name; procedure Set_Unit_Name (Target : Iir; Name : Iir) is begin - Check_Kind_For_Unit_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Unit_Name (Get_Kind (Target))); Set_Field3 (Target, Name); end Set_Unit_Name; - procedure Check_Kind_For_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Object_Alias_Declaration => - null; - when others => - Failed ("Name", Target); - end case; - end Check_Kind_For_Name; - function Get_Name (Target : Iir) return Iir is begin - Check_Kind_For_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Name (Get_Kind (Target))); return Get_Field4 (Target); end Get_Name; procedure Set_Name (Target : Iir; Name : Iir) is begin - Check_Kind_For_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Name (Get_Kind (Target))); Set_Field4 (Target, Name); end Set_Name; - procedure Check_Kind_For_Group_Template_Name (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Group_Declaration => - null; - when others => - Failed ("Group_Template_Name", Target); - end case; - end Check_Kind_For_Group_Template_Name; - function Get_Group_Template_Name (Target : Iir) return Iir is begin - Check_Kind_For_Group_Template_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Group_Template_Name (Get_Kind (Target))); return Get_Field5 (Target); end Get_Group_Template_Name; procedure Set_Group_Template_Name (Target : Iir; Name : Iir) is begin - Check_Kind_For_Group_Template_Name (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Group_Template_Name (Get_Kind (Target))); Set_Field5 (Target, Name); end Set_Group_Template_Name; - procedure Check_Kind_For_Name_Staticness (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Value - | Iir_Kind_Unit_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Name_Staticness", Target); - end case; - end Check_Kind_For_Name_Staticness; - function Get_Name_Staticness (Target : Iir) return Iir_Staticness is begin - Check_Kind_For_Name_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Name_Staticness (Get_Kind (Target))); return Iir_Staticness'Val (Get_State2 (Target)); end Get_Name_Staticness; procedure Set_Name_Staticness (Target : Iir; Static : Iir_Staticness) is begin - Check_Kind_For_Name_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Name_Staticness (Get_Kind (Target))); Set_State2 (Target, Iir_Staticness'Pos (Static)); end Set_Name_Staticness; - procedure Check_Kind_For_Prefix (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signature - | Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call - | Iir_Kind_Selected_Element - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Selected_By_All_Name - | Iir_Kind_Parenthesis_Name - | Iir_Kind_Base_Attribute - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute - | Iir_Kind_Simple_Name_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute - | Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Prefix", Target); - end case; - end Check_Kind_For_Prefix; - function Get_Prefix (Target : Iir) return Iir is begin - Check_Kind_For_Prefix (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Prefix (Get_Kind (Target))); return Get_Field0 (Target); end Get_Prefix; procedure Set_Prefix (Target : Iir; Prefix : Iir) is begin - Check_Kind_For_Prefix (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Prefix (Get_Kind (Target))); Set_Field0 (Target, Prefix); end Set_Prefix; - procedure Check_Kind_For_Slice_Subtype (Target : Iir) is + function Get_Signature_Prefix (Sign : Iir) return Iir is begin - case Get_Kind (Target) is - when Iir_Kind_Slice_Name => - null; - when others => - Failed ("Slice_Subtype", Target); - end case; - end Check_Kind_For_Slice_Subtype; + pragma Assert (Sign /= Null_Iir); + pragma Assert (Has_Signature_Prefix (Get_Kind (Sign))); + return Get_Field1 (Sign); + end Get_Signature_Prefix; + + procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir) is + begin + pragma Assert (Sign /= Null_Iir); + pragma Assert (Has_Signature_Prefix (Get_Kind (Sign))); + Set_Field1 (Sign, Prefix); + end Set_Signature_Prefix; function Get_Slice_Subtype (Slice : Iir) return Iir is begin - Check_Kind_For_Slice_Subtype (Slice); + pragma Assert (Slice /= Null_Iir); + pragma Assert (Has_Slice_Subtype (Get_Kind (Slice))); return Get_Field3 (Slice); end Get_Slice_Subtype; procedure Set_Slice_Subtype (Slice : Iir; Atype : Iir) is begin - Check_Kind_For_Slice_Subtype (Slice); + pragma Assert (Slice /= Null_Iir); + pragma Assert (Has_Slice_Subtype (Get_Kind (Slice))); Set_Field3 (Slice, Atype); end Set_Slice_Subtype; - procedure Check_Kind_For_Suffix (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Slice_Name => - null; - when others => - Failed ("Suffix", Target); - end case; - end Check_Kind_For_Suffix; - function Get_Suffix (Target : Iir) return Iir is begin - Check_Kind_For_Suffix (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Suffix (Get_Kind (Target))); return Get_Field2 (Target); end Get_Suffix; procedure Set_Suffix (Target : Iir; Suffix : Iir) is begin - Check_Kind_For_Suffix (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Suffix (Get_Kind (Target))); Set_Field2 (Target, Suffix); end Set_Suffix; - procedure Check_Kind_For_Index_Subtype (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - null; - when others => - Failed ("Index_Subtype", Target); - end case; - end Check_Kind_For_Index_Subtype; - function Get_Index_Subtype (Attr : Iir) return Iir is begin - Check_Kind_For_Index_Subtype (Attr); + pragma Assert (Attr /= Null_Iir); + pragma Assert (Has_Index_Subtype (Get_Kind (Attr))); return Get_Field2 (Attr); end Get_Index_Subtype; procedure Set_Index_Subtype (Attr : Iir; St : Iir) is begin - Check_Kind_For_Index_Subtype (Attr); + pragma Assert (Attr /= Null_Iir); + pragma Assert (Has_Index_Subtype (Get_Kind (Attr))); Set_Field2 (Attr, St); end Set_Index_Subtype; - procedure Check_Kind_For_Parameter (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - null; - when others => - Failed ("Parameter", Target); - end case; - end Check_Kind_For_Parameter; - function Get_Parameter (Target : Iir) return Iir is begin - Check_Kind_For_Parameter (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter (Get_Kind (Target))); return Get_Field4 (Target); end Get_Parameter; procedure Set_Parameter (Target : Iir; Param : Iir) is begin - Check_Kind_For_Parameter (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter (Get_Kind (Target))); Set_Field4 (Target, Param); end Set_Parameter; - procedure Check_Kind_For_Actual_Type (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Individual => - null; - when others => - Failed ("Actual_Type", Target); - end case; - end Check_Kind_For_Actual_Type; - function Get_Actual_Type (Target : Iir) return Iir is begin - Check_Kind_For_Actual_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Actual_Type (Get_Kind (Target))); return Get_Field3 (Target); end Get_Actual_Type; procedure Set_Actual_Type (Target : Iir; Atype : Iir) is begin - Check_Kind_For_Actual_Type (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Actual_Type (Get_Kind (Target))); Set_Field3 (Target, Atype); end Set_Actual_Type; - procedure Check_Kind_For_Association_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Parenthesis_Name => - null; - when others => - Failed ("Association_Chain", Target); - end case; - end Check_Kind_For_Association_Chain; - function Get_Association_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Association_Chain (Get_Kind (Target))); return Get_Field2 (Target); end Get_Association_Chain; procedure Set_Association_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Association_Chain (Get_Kind (Target))); Set_Field2 (Target, Chain); end Set_Association_Chain; - procedure Check_Kind_For_Individual_Association_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Association_Element_By_Individual => - null; - when others => - Failed ("Individual_Association_Chain", Target); - end case; - end Check_Kind_For_Individual_Association_Chain; - function Get_Individual_Association_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Individual_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target))); return Get_Field4 (Target); end Get_Individual_Association_Chain; procedure Set_Individual_Association_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Individual_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Individual_Association_Chain (Get_Kind (Target))); Set_Field4 (Target, Chain); end Set_Individual_Association_Chain; - procedure Check_Kind_For_Aggregate_Info (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate => - null; - when others => - Failed ("Aggregate_Info", Target); - end case; - end Check_Kind_For_Aggregate_Info; - function Get_Aggregate_Info (Target : Iir) return Iir is begin - Check_Kind_For_Aggregate_Info (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggregate_Info (Get_Kind (Target))); return Get_Field2 (Target); end Get_Aggregate_Info; procedure Set_Aggregate_Info (Target : Iir; Info : Iir) is begin - Check_Kind_For_Aggregate_Info (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggregate_Info (Get_Kind (Target))); Set_Field2 (Target, Info); end Set_Aggregate_Info; - procedure Check_Kind_For_Sub_Aggregate_Info (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Sub_Aggregate_Info", Target); - end case; - end Check_Kind_For_Sub_Aggregate_Info; - function Get_Sub_Aggregate_Info (Target : Iir) return Iir is begin - Check_Kind_For_Sub_Aggregate_Info (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target))); return Get_Field1 (Target); end Get_Sub_Aggregate_Info; procedure Set_Sub_Aggregate_Info (Target : Iir; Info : Iir) is begin - Check_Kind_For_Sub_Aggregate_Info (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Sub_Aggregate_Info (Get_Kind (Target))); Set_Field1 (Target, Info); end Set_Sub_Aggregate_Info; - procedure Check_Kind_For_Aggr_Dynamic_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_Dynamic_Flag", Target); - end case; - end Check_Kind_For_Aggr_Dynamic_Flag; - function Get_Aggr_Dynamic_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Aggr_Dynamic_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target))); return Get_Flag3 (Target); end Get_Aggr_Dynamic_Flag; procedure Set_Aggr_Dynamic_Flag (Target : Iir; Val : Boolean) is begin - Check_Kind_For_Aggr_Dynamic_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Dynamic_Flag (Get_Kind (Target))); Set_Flag3 (Target, Val); end Set_Aggr_Dynamic_Flag; - procedure Check_Kind_For_Aggr_Min_Length (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_Min_Length", Target); - end case; - end Check_Kind_For_Aggr_Min_Length; - function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32 - is + is begin - Check_Kind_For_Aggr_Min_Length (Info); + pragma Assert (Info /= Null_Iir); + pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info))); return Iir_To_Iir_Int32 (Get_Field4 (Info)); end Get_Aggr_Min_Length; procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32) - is + is begin - Check_Kind_For_Aggr_Min_Length (Info); + pragma Assert (Info /= Null_Iir); + pragma Assert (Has_Aggr_Min_Length (Get_Kind (Info))); Set_Field4 (Info, Iir_Int32_To_Iir (Nbr)); end Set_Aggr_Min_Length; - procedure Check_Kind_For_Aggr_Low_Limit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_Low_Limit", Target); - end case; - end Check_Kind_For_Aggr_Low_Limit; - function Get_Aggr_Low_Limit (Target : Iir_Aggregate_Info) return Iir is begin - Check_Kind_For_Aggr_Low_Limit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target))); return Get_Field2 (Target); end Get_Aggr_Low_Limit; procedure Set_Aggr_Low_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is begin - Check_Kind_For_Aggr_Low_Limit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Low_Limit (Get_Kind (Target))); Set_Field2 (Target, Limit); end Set_Aggr_Low_Limit; - procedure Check_Kind_For_Aggr_High_Limit (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_High_Limit", Target); - end case; - end Check_Kind_For_Aggr_High_Limit; - function Get_Aggr_High_Limit (Target : Iir_Aggregate_Info) return Iir is begin - Check_Kind_For_Aggr_High_Limit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target))); return Get_Field3 (Target); end Get_Aggr_High_Limit; procedure Set_Aggr_High_Limit (Target : Iir_Aggregate_Info; Limit : Iir) is begin - Check_Kind_For_Aggr_High_Limit (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_High_Limit (Get_Kind (Target))); Set_Field3 (Target, Limit); end Set_Aggr_High_Limit; - procedure Check_Kind_For_Aggr_Others_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_Others_Flag", Target); - end case; - end Check_Kind_For_Aggr_Others_Flag; - function Get_Aggr_Others_Flag (Target : Iir_Aggregate_Info) return Boolean - is + is begin - Check_Kind_For_Aggr_Others_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target))); return Get_Flag2 (Target); end Get_Aggr_Others_Flag; procedure Set_Aggr_Others_Flag (Target : Iir_Aggregate_Info; Val : Boolean) - is + is begin - Check_Kind_For_Aggr_Others_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Others_Flag (Get_Kind (Target))); Set_Flag2 (Target, Val); end Set_Aggr_Others_Flag; - procedure Check_Kind_For_Aggr_Named_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate_Info => - null; - when others => - Failed ("Aggr_Named_Flag", Target); - end case; - end Check_Kind_For_Aggr_Named_Flag; - function Get_Aggr_Named_Flag (Target : Iir_Aggregate_Info) return Boolean - is + is begin - Check_Kind_For_Aggr_Named_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target))); return Get_Flag4 (Target); end Get_Aggr_Named_Flag; procedure Set_Aggr_Named_Flag (Target : Iir_Aggregate_Info; Val : Boolean) - is + is begin - Check_Kind_For_Aggr_Named_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Aggr_Named_Flag (Get_Kind (Target))); Set_Flag4 (Target, Val); end Set_Aggr_Named_Flag; - procedure Check_Kind_For_Value_Staticness (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate => - null; - when others => - Failed ("Value_Staticness", Target); - end case; - end Check_Kind_For_Value_Staticness; - function Get_Value_Staticness (Target : Iir) return Iir_Staticness is begin - Check_Kind_For_Value_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Value_Staticness (Get_Kind (Target))); return Iir_Staticness'Val (Get_State2 (Target)); end Get_Value_Staticness; procedure Set_Value_Staticness (Target : Iir; Staticness : Iir_Staticness) - is + is begin - Check_Kind_For_Value_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Value_Staticness (Get_Kind (Target))); Set_State2 (Target, Iir_Staticness'Pos (Staticness)); end Set_Value_Staticness; - procedure Check_Kind_For_Association_Choices_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Aggregate => - null; - when others => - Failed ("Association_Choices_Chain", Target); - end case; - end Check_Kind_For_Association_Choices_Chain; - function Get_Association_Choices_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Association_Choices_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target))); return Get_Field4 (Target); end Get_Association_Choices_Chain; procedure Set_Association_Choices_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Association_Choices_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Association_Choices_Chain (Get_Kind (Target))); Set_Field4 (Target, Chain); end Set_Association_Choices_Chain; - procedure Check_Kind_For_Case_Statement_Alternative_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Case_Statement => - null; - when others => - Failed ("Case_Statement_Alternative_Chain", Target); - end case; - end Check_Kind_For_Case_Statement_Alternative_Chain; - function Get_Case_Statement_Alternative_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Case_Statement_Alternative_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target))); return Get_Field1 (Target); end Get_Case_Statement_Alternative_Chain; procedure Set_Case_Statement_Alternative_Chain (Target : Iir; Chain : Iir) - is + is begin - Check_Kind_For_Case_Statement_Alternative_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Case_Statement_Alternative_Chain (Get_Kind (Target))); Set_Field1 (Target, Chain); end Set_Case_Statement_Alternative_Chain; - procedure Check_Kind_For_Choice_Staticness (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range => - null; - when others => - Failed ("Choice_Staticness", Target); - end case; - end Check_Kind_For_Choice_Staticness; - function Get_Choice_Staticness (Target : Iir) return Iir_Staticness is begin - Check_Kind_For_Choice_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Choice_Staticness (Get_Kind (Target))); return Iir_Staticness'Val (Get_State2 (Target)); end Get_Choice_Staticness; procedure Set_Choice_Staticness (Target : Iir; Staticness : Iir_Staticness) - is + is begin - Check_Kind_For_Choice_Staticness (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Choice_Staticness (Get_Kind (Target))); Set_State2 (Target, Iir_Staticness'Pos (Staticness)); end Set_Choice_Staticness; - procedure Check_Kind_For_Procedure_Call (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Concurrent_Procedure_Call_Statement - | Iir_Kind_Procedure_Call_Statement => - null; - when others => - Failed ("Procedure_Call", Target); - end case; - end Check_Kind_For_Procedure_Call; - function Get_Procedure_Call (Stmt : Iir) return Iir is begin - Check_Kind_For_Procedure_Call (Stmt); + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Procedure_Call (Get_Kind (Stmt))); return Get_Field1 (Stmt); end Get_Procedure_Call; procedure Set_Procedure_Call (Stmt : Iir; Call : Iir) is begin - Check_Kind_For_Procedure_Call (Stmt); + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Procedure_Call (Get_Kind (Stmt))); Set_Field1 (Stmt, Call); end Set_Procedure_Call; - procedure Check_Kind_For_Implementation (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Procedure_Call - | Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator - | Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator - | Iir_Kind_Function_Call => - null; - when others => - Failed ("Implementation", Target); - end case; - end Check_Kind_For_Implementation; - function Get_Implementation (Target : Iir) return Iir is begin - Check_Kind_For_Implementation (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Implementation (Get_Kind (Target))); return Get_Field3 (Target); end Get_Implementation; procedure Set_Implementation (Target : Iir; Decl : Iir) is begin - Check_Kind_For_Implementation (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Implementation (Get_Kind (Target))); Set_Field3 (Target, Decl); end Set_Implementation; - procedure Check_Kind_For_Parameter_Association_Chain (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call => - null; - when others => - Failed ("Parameter_Association_Chain", Target); - end case; - end Check_Kind_For_Parameter_Association_Chain; - function Get_Parameter_Association_Chain (Target : Iir) return Iir is begin - Check_Kind_For_Parameter_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target))); return Get_Field2 (Target); end Get_Parameter_Association_Chain; procedure Set_Parameter_Association_Chain (Target : Iir; Chain : Iir) is begin - Check_Kind_For_Parameter_Association_Chain (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Parameter_Association_Chain (Get_Kind (Target))); Set_Field2 (Target, Chain); end Set_Parameter_Association_Chain; - procedure Check_Kind_For_Method_Object (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Procedure_Call - | Iir_Kind_Function_Call => - null; - when others => - Failed ("Method_Object", Target); - end case; - end Check_Kind_For_Method_Object; - function Get_Method_Object (Target : Iir) return Iir is begin - Check_Kind_For_Method_Object (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Method_Object (Get_Kind (Target))); return Get_Field4 (Target); end Get_Method_Object; procedure Set_Method_Object (Target : Iir; Object : Iir) is begin - Check_Kind_For_Method_Object (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Method_Object (Get_Kind (Target))); Set_Field4 (Target, Object); end Set_Method_Object; - procedure Check_Kind_For_Subtype_Type_Mark (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Access_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Subtype_Definition => - null; - when others => - Failed ("Subtype_Type_Mark", Target); - end case; - end Check_Kind_For_Subtype_Type_Mark; - function Get_Subtype_Type_Mark (Target : Iir) return Iir is begin - Check_Kind_For_Subtype_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target))); return Get_Field2 (Target); end Get_Subtype_Type_Mark; procedure Set_Subtype_Type_Mark (Target : Iir; Mark : Iir) is begin - Check_Kind_For_Subtype_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Subtype_Type_Mark (Get_Kind (Target))); Set_Field2 (Target, Mark); end Set_Subtype_Type_Mark; - procedure Check_Kind_For_Type_Conversion_Subtype (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Type_Conversion => - null; - when others => - Failed ("Type_Conversion_Subtype", Target); - end case; - end Check_Kind_For_Type_Conversion_Subtype; - function Get_Type_Conversion_Subtype (Target : Iir) return Iir is begin - Check_Kind_For_Type_Conversion_Subtype (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target))); return Get_Field3 (Target); end Get_Type_Conversion_Subtype; procedure Set_Type_Conversion_Subtype (Target : Iir; Atype : Iir) is begin - Check_Kind_For_Type_Conversion_Subtype (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Conversion_Subtype (Get_Kind (Target))); Set_Field3 (Target, Atype); end Set_Type_Conversion_Subtype; - procedure Check_Kind_For_Type_Mark (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Disconnection_Specification - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Qualified_Expression - | Iir_Kind_Type_Conversion => - null; - when others => - Failed ("Type_Mark", Target); - end case; - end Check_Kind_For_Type_Mark; - function Get_Type_Mark (Target : Iir) return Iir is begin - Check_Kind_For_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Mark (Get_Kind (Target))); return Get_Field4 (Target); end Get_Type_Mark; procedure Set_Type_Mark (Target : Iir; Mark : Iir) is begin - Check_Kind_For_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Mark (Get_Kind (Target))); Set_Field4 (Target, Mark); end Set_Type_Mark; - procedure Check_Kind_For_File_Type_Mark (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Type_Definition => - null; - when others => - Failed ("File_Type_Mark", Target); - end case; - end Check_Kind_For_File_Type_Mark; - function Get_File_Type_Mark (Target : Iir) return Iir is begin - Check_Kind_For_File_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Type_Mark (Get_Kind (Target))); return Get_Field2 (Target); end Get_File_Type_Mark; procedure Set_File_Type_Mark (Target : Iir; Mark : Iir) is begin - Check_Kind_For_File_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_File_Type_Mark (Get_Kind (Target))); Set_Field2 (Target, Mark); end Set_File_Type_Mark; - procedure Check_Kind_For_Return_Type_Mark (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signature - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Return_Type_Mark", Target); - end case; - end Check_Kind_For_Return_Type_Mark; - function Get_Return_Type_Mark (Target : Iir) return Iir is begin - Check_Kind_For_Return_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Return_Type_Mark (Get_Kind (Target))); return Get_Field8 (Target); end Get_Return_Type_Mark; procedure Set_Return_Type_Mark (Target : Iir; Mark : Iir) is begin - Check_Kind_For_Return_Type_Mark (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Return_Type_Mark (Get_Kind (Target))); Set_Field8 (Target, Mark); end Set_Return_Type_Mark; - procedure Check_Kind_For_Lexical_Layout (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - null; - when others => - Failed ("Lexical_Layout", Target); - end case; - end Check_Kind_For_Lexical_Layout; - function Get_Lexical_Layout (Decl : Iir) return Iir_Lexical_Layout_Type is begin - Check_Kind_For_Lexical_Layout (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Lexical_Layout (Get_Kind (Decl))); return Iir_Lexical_Layout_Type'Val (Get_Odigit2 (Decl)); end Get_Lexical_Layout; procedure Set_Lexical_Layout (Decl : Iir; Lay : Iir_Lexical_Layout_Type) is begin - Check_Kind_For_Lexical_Layout (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Lexical_Layout (Get_Kind (Decl))); Set_Odigit2 (Decl, Iir_Lexical_Layout_Type'Pos (Lay)); end Set_Lexical_Layout; - procedure Check_Kind_For_Incomplete_Type_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Incomplete_Type_Definition => - null; - when others => - Failed ("Incomplete_Type_List", Target); - end case; - end Check_Kind_For_Incomplete_Type_List; - function Get_Incomplete_Type_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Incomplete_Type_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field2 (Target)); end Get_Incomplete_Type_List; procedure Set_Incomplete_Type_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Incomplete_Type_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Incomplete_Type_List (Get_Kind (Target))); Set_Field2 (Target, Iir_List_To_Iir (List)); end Set_Incomplete_Type_List; - procedure Check_Kind_For_Has_Disconnect_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => - null; - when others => - Failed ("Has_Disconnect_Flag", Target); - end case; - end Check_Kind_For_Has_Disconnect_Flag; - function Get_Has_Disconnect_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Has_Disconnect_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target))); return Get_Flag1 (Target); end Get_Has_Disconnect_Flag; procedure Set_Has_Disconnect_Flag (Target : Iir; Val : Boolean) is begin - Check_Kind_For_Has_Disconnect_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Has_Disconnect_Flag (Get_Kind (Target))); Set_Flag1 (Target, Val); end Set_Has_Disconnect_Flag; - procedure Check_Kind_For_Has_Active_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - null; - when others => - Failed ("Has_Active_Flag", Target); - end case; - end Check_Kind_For_Has_Active_Flag; - function Get_Has_Active_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Has_Active_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Has_Active_Flag (Get_Kind (Target))); return Get_Flag2 (Target); end Get_Has_Active_Flag; procedure Set_Has_Active_Flag (Target : Iir; Val : Boolean) is begin - Check_Kind_For_Has_Active_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Has_Active_Flag (Get_Kind (Target))); Set_Flag2 (Target, Val); end Set_Has_Active_Flag; - procedure Check_Kind_For_Is_Within_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Enumeration_Literal - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_For_Loop_Statement => - null; - when others => - Failed ("Is_Within_Flag", Target); - end case; - end Check_Kind_For_Is_Within_Flag; - function Get_Is_Within_Flag (Target : Iir) return Boolean is begin - Check_Kind_For_Is_Within_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Is_Within_Flag (Get_Kind (Target))); return Get_Flag5 (Target); end Get_Is_Within_Flag; procedure Set_Is_Within_Flag (Target : Iir; Val : Boolean) is begin - Check_Kind_For_Is_Within_Flag (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Is_Within_Flag (Get_Kind (Target))); Set_Flag5 (Target, Val); end Set_Is_Within_Flag; - procedure Check_Kind_For_Type_Marks_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Signature => - null; - when others => - Failed ("Type_Marks_List", Target); - end case; - end Check_Kind_For_Type_Marks_List; - function Get_Type_Marks_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Type_Marks_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Marks_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field2 (Target)); end Get_Type_Marks_List; procedure Set_Type_Marks_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Type_Marks_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Type_Marks_List (Get_Kind (Target))); Set_Field2 (Target, Iir_List_To_Iir (List)); end Set_Type_Marks_List; - procedure Check_Kind_For_Implicit_Alias_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Non_Object_Alias_Declaration => - null; - when others => - Failed ("Implicit_Alias_Flag", Target); - end case; - end Check_Kind_For_Implicit_Alias_Flag; - function Get_Implicit_Alias_Flag (Decl : Iir) return Boolean is begin - Check_Kind_For_Implicit_Alias_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl))); return Get_Flag1 (Decl); end Get_Implicit_Alias_Flag; procedure Set_Implicit_Alias_Flag (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Implicit_Alias_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Implicit_Alias_Flag (Get_Kind (Decl))); Set_Flag1 (Decl, Flag); end Set_Implicit_Alias_Flag; - procedure Check_Kind_For_Alias_Signature (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Non_Object_Alias_Declaration => - null; - when others => - Failed ("Alias_Signature", Target); - end case; - end Check_Kind_For_Alias_Signature; - function Get_Alias_Signature (Alias : Iir) return Iir is begin - Check_Kind_For_Alias_Signature (Alias); + pragma Assert (Alias /= Null_Iir); + pragma Assert (Has_Alias_Signature (Get_Kind (Alias))); return Get_Field5 (Alias); end Get_Alias_Signature; procedure Set_Alias_Signature (Alias : Iir; Signature : Iir) is begin - Check_Kind_For_Alias_Signature (Alias); + pragma Assert (Alias /= Null_Iir); + pragma Assert (Has_Alias_Signature (Get_Kind (Alias))); Set_Field5 (Alias, Signature); end Set_Alias_Signature; - procedure Check_Kind_For_Attribute_Signature (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Attribute_Name => - null; - when others => - Failed ("Attribute_Signature", Target); - end case; - end Check_Kind_For_Attribute_Signature; - function Get_Attribute_Signature (Attr : Iir) return Iir is begin - Check_Kind_For_Attribute_Signature (Attr); + pragma Assert (Attr /= Null_Iir); + pragma Assert (Has_Attribute_Signature (Get_Kind (Attr))); return Get_Field2 (Attr); end Get_Attribute_Signature; procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir) is begin - Check_Kind_For_Attribute_Signature (Attr); + pragma Assert (Attr /= Null_Iir); + pragma Assert (Has_Attribute_Signature (Get_Kind (Attr))); Set_Field2 (Attr, Signature); end Set_Attribute_Signature; - procedure Check_Kind_For_Overload_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Overload_List => - null; - when others => - Failed ("Overload_List", Target); - end case; - end Check_Kind_For_Overload_List; - function Get_Overload_List (Target : Iir) return Iir_List is begin - Check_Kind_For_Overload_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Overload_List (Get_Kind (Target))); return Iir_To_Iir_List (Get_Field1 (Target)); end Get_Overload_List; procedure Set_Overload_List (Target : Iir; List : Iir_List) is begin - Check_Kind_For_Overload_List (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Overload_List (Get_Kind (Target))); Set_Field1 (Target, Iir_List_To_Iir (List)); end Set_Overload_List; - procedure Check_Kind_For_Simple_Name_Identifier (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Simple_Name_Attribute => - null; - when others => - Failed ("Simple_Name_Identifier", Target); - end case; - end Check_Kind_For_Simple_Name_Identifier; - function Get_Simple_Name_Identifier (Target : Iir) return Name_Id is begin - Check_Kind_For_Simple_Name_Identifier (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target))); return Iir_To_Name_Id (Get_Field3 (Target)); end Get_Simple_Name_Identifier; procedure Set_Simple_Name_Identifier (Target : Iir; Ident : Name_Id) is begin - Check_Kind_For_Simple_Name_Identifier (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Name_Identifier (Get_Kind (Target))); Set_Field3 (Target, Name_Id_To_Iir (Ident)); end Set_Simple_Name_Identifier; - procedure Check_Kind_For_Simple_Name_Subtype (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Simple_Name_Attribute => - null; - when others => - Failed ("Simple_Name_Subtype", Target); - end case; - end Check_Kind_For_Simple_Name_Subtype; - function Get_Simple_Name_Subtype (Target : Iir) return Iir is begin - Check_Kind_For_Simple_Name_Subtype (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target))); return Get_Field4 (Target); end Get_Simple_Name_Subtype; procedure Set_Simple_Name_Subtype (Target : Iir; Atype : Iir) is begin - Check_Kind_For_Simple_Name_Subtype (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Simple_Name_Subtype (Get_Kind (Target))); Set_Field4 (Target, Atype); end Set_Simple_Name_Subtype; - procedure Check_Kind_For_Protected_Type_Body (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Protected_Type_Declaration => - null; - when others => - Failed ("Protected_Type_Body", Target); - end case; - end Check_Kind_For_Protected_Type_Body; - function Get_Protected_Type_Body (Target : Iir) return Iir is begin - Check_Kind_For_Protected_Type_Body (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Protected_Type_Body (Get_Kind (Target))); return Get_Field2 (Target); end Get_Protected_Type_Body; procedure Set_Protected_Type_Body (Target : Iir; Bod : Iir) is begin - Check_Kind_For_Protected_Type_Body (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Protected_Type_Body (Get_Kind (Target))); Set_Field2 (Target, Bod); end Set_Protected_Type_Body; - procedure Check_Kind_For_Protected_Type_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Protected_Type_Body => - null; - when others => - Failed ("Protected_Type_Declaration", Target); - end case; - end Check_Kind_For_Protected_Type_Declaration; - function Get_Protected_Type_Declaration (Target : Iir) return Iir is begin - Check_Kind_For_Protected_Type_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target))); return Get_Field4 (Target); end Get_Protected_Type_Declaration; procedure Set_Protected_Type_Declaration (Target : Iir; Decl : Iir) is begin - Check_Kind_For_Protected_Type_Declaration (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_Protected_Type_Declaration (Get_Kind (Target))); Set_Field4 (Target, Decl); end Set_Protected_Type_Declaration; - procedure Check_Kind_For_End_Location (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Design_Unit => - null; - when others => - Failed ("End_Location", Target); - end case; - end Check_Kind_For_End_Location; - function Get_End_Location (Target : Iir) return Location_Type is begin - Check_Kind_For_End_Location (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_End_Location (Get_Kind (Target))); return Iir_To_Location_Type (Get_Field6 (Target)); end Get_End_Location; procedure Set_End_Location (Target : Iir; Loc : Location_Type) is begin - Check_Kind_For_End_Location (Target); + pragma Assert (Target /= Null_Iir); + pragma Assert (Has_End_Location (Get_Kind (Target))); Set_Field6 (Target, Location_Type_To_Iir (Loc)); end Set_End_Location; - procedure Check_Kind_For_String_Id (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - null; - when others => - Failed ("String_Id", Target); - end case; - end Check_Kind_For_String_Id; - function Get_String_Id (Lit : Iir) return String_Id is begin - Check_Kind_For_String_Id (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Id (Get_Kind (Lit))); return Iir_To_String_Id (Get_Field3 (Lit)); end Get_String_Id; procedure Set_String_Id (Lit : Iir; Id : String_Id) is begin - Check_Kind_For_String_Id (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Id (Get_Kind (Lit))); Set_Field3 (Lit, String_Id_To_Iir (Id)); end Set_String_Id; - procedure Check_Kind_For_String_Length (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => - null; - when others => - Failed ("String_Length", Target); - end case; - end Check_Kind_For_String_Length; - function Get_String_Length (Lit : Iir) return Int32 is begin - Check_Kind_For_String_Length (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Length (Get_Kind (Lit))); return Iir_To_Int32 (Get_Field4 (Lit)); end Get_String_Length; procedure Set_String_Length (Lit : Iir; Len : Int32) is begin - Check_Kind_For_String_Length (Lit); + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_String_Length (Get_Kind (Lit))); Set_Field4 (Lit, Int32_To_Iir (Len)); end Set_String_Length; - procedure Check_Kind_For_Use_Flag (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration - | Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration - | Iir_Kind_Component_Declaration - | Iir_Kind_Attribute_Declaration - | Iir_Kind_Group_Template_Declaration - | Iir_Kind_Group_Declaration - | Iir_Kind_Non_Object_Alias_Declaration - | Iir_Kind_Psl_Declaration - | Iir_Kind_Terminal_Declaration - | Iir_Kind_Free_Quantity_Declaration - | Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Object_Alias_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - null; - when others => - Failed ("Use_Flag", Target); - end case; - end Check_Kind_For_Use_Flag; - function Get_Use_Flag (Decl : Iir) return Boolean is begin - Check_Kind_For_Use_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Use_Flag (Get_Kind (Decl))); return Get_Flag6 (Decl); end Get_Use_Flag; procedure Set_Use_Flag (Decl : Iir; Val : Boolean) is begin - Check_Kind_For_Use_Flag (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Use_Flag (Get_Kind (Decl))); Set_Flag6 (Decl, Val); end Set_Use_Flag; - procedure Check_Kind_For_End_Has_Reserved_Id (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => - null; - when others => - Failed ("End_Has_Reserved_Id", Target); - end case; - end Check_Kind_For_End_Has_Reserved_Id; - function Get_End_Has_Reserved_Id (Decl : Iir) return Boolean is begin - Check_Kind_For_End_Has_Reserved_Id (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl))); return Get_Flag8 (Decl); end Get_End_Has_Reserved_Id; procedure Set_End_Has_Reserved_Id (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_End_Has_Reserved_Id (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Reserved_Id (Get_Kind (Decl))); Set_Flag8 (Decl, Flag); end Set_End_Has_Reserved_Id; - procedure Check_Kind_For_End_Has_Identifier (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Protected_Type_Declaration - | Iir_Kind_Record_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Protected_Type_Body - | Iir_Kind_Package_Declaration - | Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Package_Body - | Iir_Kind_Configuration_Declaration - | Iir_Kind_Entity_Declaration - | Iir_Kind_Architecture_Body - | Iir_Kind_Component_Declaration - | Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement - | Iir_Kind_For_Loop_Statement - | Iir_Kind_While_Loop_Statement - | Iir_Kind_Case_Statement - | Iir_Kind_If_Statement - | Iir_Kind_Elsif => - null; - when others => - Failed ("End_Has_Identifier", Target); - end case; - end Check_Kind_For_End_Has_Identifier; - function Get_End_Has_Identifier (Decl : Iir) return Boolean is begin - Check_Kind_For_End_Has_Identifier (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl))); return Get_Flag9 (Decl); end Get_End_Has_Identifier; procedure Set_End_Has_Identifier (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_End_Has_Identifier (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Identifier (Get_Kind (Decl))); Set_Flag9 (Decl, Flag); end Set_End_Has_Identifier; - procedure Check_Kind_For_End_Has_Postponed (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("End_Has_Postponed", Target); - end case; - end Check_Kind_For_End_Has_Postponed; - function Get_End_Has_Postponed (Decl : Iir) return Boolean is begin - Check_Kind_For_End_Has_Postponed (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl))); return Get_Flag10 (Decl); end Get_End_Has_Postponed; procedure Set_End_Has_Postponed (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_End_Has_Postponed (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_End_Has_Postponed (Get_Kind (Decl))); Set_Flag10 (Decl, Flag); end Set_End_Has_Postponed; - procedure Check_Kind_For_Has_Begin (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Entity_Declaration - | Iir_Kind_Generate_Statement => - null; - when others => - Failed ("Has_Begin", Target); - end case; - end Check_Kind_For_Has_Begin; - function Get_Has_Begin (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Begin (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Begin (Get_Kind (Decl))); return Get_Flag10 (Decl); end Get_Has_Begin; procedure Set_Has_Begin (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Begin (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Begin (Get_Kind (Decl))); Set_Flag10 (Decl, Flag); end Set_Has_Begin; - procedure Check_Kind_For_Has_Is (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Component_Declaration - | Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement => - null; - when others => - Failed ("Has_Is", Target); - end case; - end Check_Kind_For_Has_Is; - function Get_Has_Is (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Is (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Is (Get_Kind (Decl))); return Get_Flag7 (Decl); end Get_Has_Is; procedure Set_Has_Is (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Is (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Is (Get_Kind (Decl))); Set_Flag7 (Decl, Flag); end Set_Has_Is; - procedure Check_Kind_For_Has_Pure (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration => - null; - when others => - Failed ("Has_Pure", Target); - end case; - end Check_Kind_For_Has_Pure; - function Get_Has_Pure (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Pure (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Pure (Get_Kind (Decl))); return Get_Flag8 (Decl); end Get_Has_Pure; procedure Set_Has_Pure (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Pure (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Pure (Get_Kind (Decl))); Set_Flag8 (Decl, Flag); end Set_Has_Pure; - procedure Check_Kind_For_Has_Body (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - null; - when others => - Failed ("Has_Body", Target); - end case; - end Check_Kind_For_Has_Body; - function Get_Has_Body (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Body (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Body (Get_Kind (Decl))); return Get_Flag9 (Decl); end Get_Has_Body; procedure Set_Has_Body (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Body (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Body (Get_Kind (Decl))); Set_Flag9 (Decl, Flag); end Set_Has_Body; - procedure Check_Kind_For_Has_Identifier_List (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Library_Clause - | Iir_Kind_Element_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Constant_Declaration - | Iir_Kind_Iterator_Declaration => - null; - when others => - Failed ("Has_Identifier_List", Target); - end case; - end Check_Kind_For_Has_Identifier_List; - function Get_Has_Identifier_List (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Identifier_List (Decl); - return Get_Flag7 (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl))); + return Get_Flag3 (Decl); end Get_Has_Identifier_List; procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Identifier_List (Decl); - Set_Flag7 (Decl, Flag); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Identifier_List (Get_Kind (Decl))); + Set_Flag3 (Decl, Flag); end Set_Has_Identifier_List; - procedure Check_Kind_For_Has_Mode (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_File_Declaration => - null; - when others => - Failed ("Has_Mode", Target); - end case; - end Check_Kind_For_Has_Mode; - function Get_Has_Mode (Decl : Iir) return Boolean is begin - Check_Kind_For_Has_Mode (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Mode (Get_Kind (Decl))); return Get_Flag8 (Decl); end Get_Has_Mode; procedure Set_Has_Mode (Decl : Iir; Flag : Boolean) is begin - Check_Kind_For_Has_Mode (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Has_Mode (Get_Kind (Decl))); Set_Flag8 (Decl, Flag); end Set_Has_Mode; - procedure Check_Kind_For_Psl_Property (Target : Iir) is + function Get_Is_Ref (N : Iir) return Boolean is begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - null; - when others => - Failed ("Psl_Property", Target); - end case; - end Check_Kind_For_Psl_Property; + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Is_Ref (Get_Kind (N))); + return Get_Flag7 (N); + end Get_Is_Ref; + + procedure Set_Is_Ref (N : Iir; Ref : Boolean) is + begin + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Is_Ref (Get_Kind (N))); + Set_Flag7 (N, Ref); + end Set_Is_Ref; function Get_Psl_Property (Decl : Iir) return PSL_Node is begin - Check_Kind_For_Psl_Property (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Property (Get_Kind (Decl))); return Iir_To_PSL_Node (Get_Field1 (Decl)); end Get_Psl_Property; procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node) is begin - Check_Kind_For_Psl_Property (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Property (Get_Kind (Decl))); Set_Field1 (Decl, PSL_Node_To_Iir (Prop)); end Set_Psl_Property; - procedure Check_Kind_For_Psl_Declaration (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Declaration => - null; - when others => - Failed ("Psl_Declaration", Target); - end case; - end Check_Kind_For_Psl_Declaration; - function Get_Psl_Declaration (Decl : Iir) return PSL_Node is begin - Check_Kind_For_Psl_Declaration (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Declaration (Get_Kind (Decl))); return Iir_To_PSL_Node (Get_Field1 (Decl)); end Get_Psl_Declaration; procedure Set_Psl_Declaration (Decl : Iir; Prop : PSL_Node) is begin - Check_Kind_For_Psl_Declaration (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Declaration (Get_Kind (Decl))); Set_Field1 (Decl, PSL_Node_To_Iir (Prop)); end Set_Psl_Declaration; - procedure Check_Kind_For_Psl_Expression (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Expression => - null; - when others => - Failed ("Psl_Expression", Target); - end case; - end Check_Kind_For_Psl_Expression; - function Get_Psl_Expression (Decl : Iir) return PSL_Node is begin - Check_Kind_For_Psl_Expression (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Expression (Get_Kind (Decl))); return Iir_To_PSL_Node (Get_Field3 (Decl)); end Get_Psl_Expression; procedure Set_Psl_Expression (Decl : Iir; Prop : PSL_Node) is begin - Check_Kind_For_Psl_Expression (Decl); + pragma Assert (Decl /= Null_Iir); + pragma Assert (Has_Psl_Expression (Get_Kind (Decl))); Set_Field3 (Decl, PSL_Node_To_Iir (Prop)); end Set_Psl_Expression; - procedure Check_Kind_For_Psl_Boolean (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Default_Clock => - null; - when others => - Failed ("Psl_Boolean", Target); - end case; - end Check_Kind_For_Psl_Boolean; - function Get_Psl_Boolean (N : Iir) return PSL_Node is begin - Check_Kind_For_Psl_Boolean (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Psl_Boolean (Get_Kind (N))); return Iir_To_PSL_Node (Get_Field1 (N)); end Get_Psl_Boolean; procedure Set_Psl_Boolean (N : Iir; Bool : PSL_Node) is begin - Check_Kind_For_Psl_Boolean (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_Psl_Boolean (Get_Kind (N))); Set_Field1 (N, PSL_Node_To_Iir (Bool)); end Set_Psl_Boolean; - procedure Check_Kind_For_PSL_Clock (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - null; - when others => - Failed ("PSL_Clock", Target); - end case; - end Check_Kind_For_PSL_Clock; - function Get_PSL_Clock (N : Iir) return PSL_Node is begin - Check_Kind_For_PSL_Clock (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_PSL_Clock (Get_Kind (N))); return Iir_To_PSL_Node (Get_Field7 (N)); end Get_PSL_Clock; procedure Set_PSL_Clock (N : Iir; Clock : PSL_Node) is begin - Check_Kind_For_PSL_Clock (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_PSL_Clock (Get_Kind (N))); Set_Field7 (N, PSL_Node_To_Iir (Clock)); end Set_PSL_Clock; - procedure Check_Kind_For_PSL_NFA (Target : Iir) is - begin - case Get_Kind (Target) is - when Iir_Kind_Psl_Declaration - | Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - null; - when others => - Failed ("PSL_NFA", Target); - end case; - end Check_Kind_For_PSL_NFA; - function Get_PSL_NFA (N : Iir) return PSL_NFA is begin - Check_Kind_For_PSL_NFA (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_PSL_NFA (Get_Kind (N))); return Iir_To_PSL_NFA (Get_Field8 (N)); end Get_PSL_NFA; procedure Set_PSL_NFA (N : Iir; Fa : PSL_NFA) is begin - Check_Kind_For_PSL_NFA (N); + pragma Assert (N /= Null_Iir); + pragma Assert (Has_PSL_NFA (Get_Kind (N))); Set_Field8 (N, PSL_NFA_To_Iir (Fa)); end Set_PSL_NFA; diff --git a/iirs.adb.in b/iirs.adb.in index 9c2319a3f..04511bb67 100644 --- a/iirs.adb.in +++ b/iirs.adb.in @@ -17,9 +17,9 @@ -- 02111-1307, USA. with Ada.Unchecked_Conversion; with Ada.Text_IO; -with Errorout; use Errorout; with Nodes; use Nodes; with Lists; use Lists; +with Nodes_Meta; use Nodes_Meta; package body Iirs is function Is_Null (Node : Iir) return Boolean is @@ -36,20 +36,6 @@ package body Iirs is -- General subprograms that operate on every iir -- --------------------------------------------------- - -- This is the procedure to call when an internal consistancy test has - -- failed. - -- The main idea is the consistancy test *MUST* have no side effect, - -- except calling this procedure. To speed up, this procedure could - -- be a no-op. - procedure Failed (Func: String := ""; Node : Iir := Null_Iir) - is - begin - if Func /= "" then - Error_Kind (Func, Node); - end if; - raise Internal_Error; - end Failed; - function Get_Format (Kind : Iir_Kind) return Format_Type; function Create_Iir (Kind : Iir_Kind) return Iir @@ -96,11 +96,16 @@ package Iirs is -- -- The methods appear after the comment: ' -- General methods.' -- They have the following format: - -- -- Field: FIELD (CONV) + -- -- Field: FIELD ATTR (CONV) -- function Get_NAME (PNAME : PTYPE) return RTYPE; -- procedure Set_NAME (PNAME : PTYPE; RNAME : RTYPE); -- 'FIELD' indicate which field of the node is used to store the value. - -- ' (CONV)' is required if the type of the value (indicated by RTYPE) is + -- ATTR is optional and if present must be one of: + -- Ref: the field is a reference to an existing node + -- Chain: the field contains a chain of nodes + -- Chain_Next: the field contains the next element of a chain (present + -- only on one field: Set/Get_Chain). + -- ' (CONV)' is present if the type of the value (indicated by RTYPE) is -- different from the type of the field. CONV can be either 'uc' or 'pos'. -- 'uc' indicates an unchecked conversion while 'pos' a pos/val conversion. -- @@ -257,7 +262,7 @@ package Iirs is -- -- Get/Set_Chain (Field2) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Has_Identifier_List (Flag3) --------------- -- Literals -- @@ -685,7 +690,7 @@ package Iirs is -- -- signature ::= '[' [ type_mark { , type_mark } ] [ RETURN type_mark ] ']' -- - -- Get/Set_Prefix (Field0) + -- Get/Set_Signature_Prefix (Field1) -- -- Get/Set_Type_Marks_List (Field2) -- @@ -929,6 +934,8 @@ package Iirs is -- Get/Set_After_Drivers_Flag (Flag5) -- -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Is_Ref (Flag7) -- Iir_Kind_Non_Object_Alias_Declaration (Short) -- @@ -1030,6 +1037,8 @@ package Iirs is -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_Use_Flag (Flag6) + -- + -- Get/Set_Is_Ref (Flag7) -- Iir_Kind_Nature_Declaration (Short) -- @@ -1108,6 +1117,8 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- + -- Get/Set_Is_Ref (Flag7) + -- -- Get/Set_Expr_Staticness (State1) -- -- Get/Set_Name_Staticness (State2) @@ -1315,6 +1326,8 @@ package Iirs is -- -- Get/Set_Has_Disconnect_Flag (Flag1) -- + -- Get/Set_Has_Identifier_List (Flag3) + -- -- Get/Set_Has_Active_Flag (Flag2) -- -- Get/Set_Visible_Flag (Flag4) @@ -1323,7 +1336,7 @@ package Iirs is -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Is_Ref (Flag7) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1399,11 +1412,13 @@ package Iirs is -- Only for Iir_Kind_Constant_Declaration: -- Get/Set_Deferred_Declaration_Flag (Flag1) -- + -- Get/Set_Has_Identifier_List (Flag3) + -- -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Is_Ref (Flag7) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1428,11 +1443,13 @@ package Iirs is -- True if the variable is a shared variable. -- Get/Set_Shared_Flag (Flag2) -- + -- Get/Set_Has_Identifier_List (Flag3) + -- -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Is_Ref (Flag7) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1475,11 +1492,13 @@ package Iirs is -- This is used only in vhdl 87. -- Get/Set_Mode (Odigit1) -- + -- Get/Set_Has_Identifier_List (Flag3) + -- -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_Use_Flag (Flag6) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Is_Ref (Flag7) -- -- Get/Set_Expr_Staticness (State1) -- @@ -1510,9 +1529,11 @@ package Iirs is -- -- Get/Set_Subtype_Indication (Field5) -- + -- Get/Set_Has_Identifier_List (Flag3) + -- -- Get/Set_Visible_Flag (Flag4) -- - -- Get/Set_Has_Identifier_List (Flag7) + -- Get/Set_Is_Ref (Flag7) -- Iir_Kind_Record_Element_Constraint (Short) -- @@ -1880,15 +1901,19 @@ package Iirs is -- -- index_subtype_definition ::= type_mark RANGE <> -- - -- Note: Use Get_Element_Subtype to get the element subtype definition. - -- Get/Set_Element_Subtype_Indication (Field1) + -- Get/Set_Element_Subtype (Field1) + -- + -- Get/Set_Element_Subtype_Indication (Field2) -- -- Get/Set_Type_Declarator (Field3) -- -- Get/Set_Base_Type (Field4) -- -- This is a list of type marks. - -- Get/Set_Index_Subtype_List (Field6) + -- Get/Set_Index_Subtype_Definition_List (Field6) + -- + -- Same as the index_subtype_definition_list. + -- Get/Set_Index_Subtype_List (Field9) -- -- Get/Set_Type_Staticness (State1) -- @@ -2045,14 +2070,6 @@ package Iirs is -- -- element_resolution ::= array_element_resolution | record_resolution -- - -- array_element_resolution ::= resolution_indication - -- - -- record_resolution ::= - -- record_element_resolution { , record_element_resolution } - -- - -- record_element_resolution ::= - -- record_element_simple_name resolution_indication - -- -- If there is no constraint but a resolution function name, the subtype -- indication is represented by a subtype_definition (which will be -- replaced by the correct subtype definition). If there is an array @@ -2113,7 +2130,7 @@ package Iirs is -- -- Get/Set_Base_Type (Field4) -- - -- Get/Set_Resolution_Function (Field5) + -- Get/Set_Resolution_Indication (Field5) -- -- Get/Set_Resolved_Flag (Flag1) -- @@ -2133,7 +2150,7 @@ package Iirs is -- -- Get/Set_Base_Type (Field4) -- - -- Get/Set_Resolution_Function (Field5) + -- Get/Set_Resolution_Indication (Field5) -- -- Get/Set_Tolerance (Field7) -- @@ -2165,6 +2182,36 @@ package Iirs is -- -- Get/Set_Signal_Type_Flag (Flag2) + -- Iir_Kind_Array_Element_Resolution (Short) + -- + -- LRM08 6.3 Subtype declarations + -- + -- array_element_resolution ::= resolution_indication + -- + -- Get/Set_Resolution_Indication (Field5) + + -- Iir_Kind_Record_Resolution (Short) + -- + -- LRM08 6.3 Subtype declarations + -- + -- record_resolution ::= + -- record_element_resolution { , record_element_resolution } + -- + -- Get/Set_Record_Element_Resolution_Chain (Field1) + + -- Iir_Kind_Record_Element_Resolution (Short) + -- + -- LRM08 6.3 Subtype declarations + -- + -- record_element_resolution ::= + -- /record_element/_simple_name resolution_indication + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Resolution_Indication (Field5) + -- Iir_Kind_Record_Subtype_Definition (Medium) -- -- Get/Set_Elements_Declaration_List (Field1) @@ -2175,7 +2222,7 @@ package Iirs is -- -- Get/Set_Base_Type (Field4) -- - -- Get/Set_Resolution_Function (Field5) + -- Get/Set_Resolution_Indication (Field5) -- -- Get/Set_Tolerance (Field7) -- @@ -2191,8 +2238,7 @@ package Iirs is -- Iir_Kind_Array_Subtype_Definition (Medium) -- - -- Note: Use Get_Element_Subtype to get the element subtype definition. - -- Get/Set_Element_Subtype_Indication (Field1) + -- Get/Set_Element_Subtype (Field1) -- -- Get/Set_Subtype_Type_Mark (Field2) -- @@ -2200,13 +2246,20 @@ package Iirs is -- -- Get/Set_Base_Type (Field4) -- - -- Get/Set_Resolution_Function (Field5) + -- Get/Set_Resolution_Indication (Field5) -- - -- The index_constraint. This is a list of subtype indication. - -- Get/Set_Index_Subtype_List (Field6) + -- The index_constraint list as it appears in the subtype indication (if + -- present). This is a list of subtype indication. + -- Get/Set_Index_Constraint_List (Field6) -- -- Get/Set_Tolerance (Field7) -- + -- Get/Set_Array_Element_Constraint (Field8) + -- + -- The type of the index. This is either the index_constraint list or the + -- index subtypes of the type_mark. + -- Get/Set_Index_Subtype_List (Field9) + -- -- Get/Set_Type_Staticness (State1) -- -- Get/Set_Constraint_State (State2) @@ -2241,7 +2294,7 @@ package Iirs is -- -- Get/Set_Subtype_Type_Mark (Field2) -- - -- Get/Set_Resolution_Function (Field5) + -- Get/Set_Resolution_Indication (Field5) -- -- Get/Set_Tolerance (Field7) @@ -3394,6 +3447,9 @@ package Iirs is Iir_Kind_Aggregate_Info, Iir_Kind_Procedure_Call, Iir_Kind_Record_Element_Constraint, + Iir_Kind_Array_Element_Resolution, + Iir_Kind_Record_Resolution, + Iir_Kind_Record_Element_Resolution, Iir_Kind_Attribute_Specification, Iir_Kind_Disconnection_Specification, @@ -4092,6 +4148,12 @@ package Iirs is --Iir_Kind_Integer_Subtype_Definition Iir_Kind_Enumeration_Subtype_Definition; + subtype Iir_Kinds_Scalar_Subtype_Definition is Iir_Kind range + Iir_Kind_Physical_Subtype_Definition .. + --Iir_Kind_Floating_Subtype_Definition + --Iir_Kind_Integer_Subtype_Definition + Iir_Kind_Enumeration_Subtype_Definition; + subtype Iir_Kinds_Scalar_Type_Definition is Iir_Kind range Iir_Kind_Physical_Subtype_Definition .. --Iir_Kind_Floating_Subtype_Definition @@ -4921,7 +4983,6 @@ package Iirs is procedure Set_Library_Directory (Library : Iir; Dir : Name_Id); -- Symbolic date, used to order design units in a library. - -- Display: Image -- Field: Field10 (pos) function Get_Date (Target : Iir) return Date_Type; procedure Set_Date (Target : Iir; Date : Date_Type); @@ -4935,7 +4996,7 @@ package Iirs is -- exception: the architecture of an entity aspect (of a component -- instantiation) may not have been analyzed. The Entity_Aspect_Entity -- is added to this list (instead of the non-existing design unit). - -- Field: Field8 Ref (uc) + -- Field: Field8 Of_Ref (uc) function Get_Dependence_List (Unit : Iir) return Iir_List; procedure Set_Dependence_List (Unit : Iir; List : Iir_List); @@ -4978,17 +5039,14 @@ package Iirs is -- Set the line and the offset in the line, only for the library manager. -- This is valid until the file is really loaded in memory. On loading, -- location will contain all this informations. - -- Display: Image -- Field: Field4 (uc) function Get_Design_Unit_Source_Pos (Design_Unit : Iir) return Source_Ptr; procedure Set_Design_Unit_Source_Pos (Design_Unit : Iir; Pos : Source_Ptr); - -- Display: Image -- Field: Field11 (uc) function Get_Design_Unit_Source_Line (Design_Unit : Iir) return Int32; procedure Set_Design_Unit_Source_Line (Design_Unit : Iir; Line : Int32); - -- Display: Image -- Field: Field12 (uc) function Get_Design_Unit_Source_Col (Design_Unit : Iir) return Int32; procedure Set_Design_Unit_Source_Col (Design_Unit : Iir; Line : Int32); @@ -4996,13 +5054,11 @@ package Iirs is -- literals. -- Value of an integer/physical literal. - -- Display: Image -- Field: Int64 function Get_Value (Lit : Iir) return Iir_Int64; procedure Set_Value (Lit : Iir; Val : Iir_Int64); -- Position (same as lit_type'pos) of an enumeration literal. - -- Display: Image -- Field: Field10 (pos) function Get_Enum_Pos (Lit : Iir) return Iir_Int32; procedure Set_Enum_Pos (Lit : Iir; Val : Iir_Int32); @@ -5017,7 +5073,6 @@ package Iirs is procedure Set_Physical_Unit_Value (Unit : Iir; Lit : Iir); -- Value of a floating point literal. - -- Display: Image -- Field: Fp64 function Get_Fp_Value (Lit : Iir) return Iir_Fp64; procedure Set_Fp_Value (Lit : Iir; Val : Iir_Fp64); @@ -5035,7 +5090,6 @@ package Iirs is procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List); -- The logarithm of the base (1, 3 or 4) of a bit string. - -- Display: Image -- Field: Field8 (pos) function Get_Bit_String_Base (Lit : Iir) return Base_Type; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type); @@ -5207,7 +5261,7 @@ package Iirs is -- To be used with Get/Set_Chain. -- There is no order, therefore, a new attribute value may be always -- prepended. - -- Field: Field4 + -- Field: Field4 Chain function Get_Attribute_Value_Chain (Target : Iir) return Iir; procedure Set_Attribute_Value_Chain (Target : Iir; Chain : Iir); @@ -5269,7 +5323,10 @@ package Iirs is procedure Set_Type (Target : Iir; Atype : Iir); pragma Inline (Get_Type); - -- Field: Field5 + -- The subtype indication of a declaration. Note that this node can be + -- shared between declarations if they are separated by comma, such as in: + -- variable a, b : integer := 5; + -- Field: Field5 Maybe_Ref function Get_Subtype_Indication (Target : Iir) return Iir; procedure Set_Subtype_Indication (Target : Iir; Atype : Iir); @@ -5328,7 +5385,6 @@ package Iirs is -- identifier. If the overload number is not 0, it is the rank of the -- subprogram. If the overload number is 0, then the identifier is not -- overloaded in the declarative region. - -- Display: Image -- Field: Field12 (pos) function Get_Overload_Number (Target : Iir) return Iir_Int32; procedure Set_Overload_Number (Target : Iir; Val : Iir_Int32); @@ -5339,7 +5395,6 @@ package Iirs is -- For a subprogram declared immediatly within a subprogram of level N, -- the depth is N + 1. -- Depth is used with depth of impure objects to check purity rules. - -- Display: Image -- Field: Field10 (pos) function Get_Subprogram_Depth (Target : Iir) return Iir_Int32; procedure Set_Subprogram_Depth (Target : Iir; Depth : Iir_Int32); @@ -5347,14 +5402,12 @@ package Iirs is -- Hash of a subprogram profile. -- This is used to speed up subprogram profile comparaison, which is very -- often used by overload. - -- Display: Image -- Field: Field11 (pos) function Get_Subprogram_Hash (Target : Iir) return Iir_Int32; procedure Set_Subprogram_Hash (Target : Iir; Val : Iir_Int32); pragma Inline (Get_Subprogram_Hash); -- Depth of the deepest impure object. - -- Display: Image -- Field: Field3 (uc) function Get_Impure_Depth (Target : Iir) return Iir_Int32; procedure Set_Impure_Depth (Target : Iir; Depth : Iir_Int32); @@ -5377,7 +5430,10 @@ package Iirs is -- Get the default value of an object declaration. -- Null_iir if no default value. - -- Field: Field6 + -- Note that this node can be shared between declarations if they are + -- separated by comma, such as in: + -- variable a, b : integer := 5; + -- Field: Field6 Maybe_Ref function Get_Default_Value (Target : Iir) return Iir; procedure Set_Default_Value (Target : Iir; Value : Iir); @@ -5404,8 +5460,8 @@ package Iirs is -- Get the design unit in which the target is declared. -- For a library unit, this is to get the design unit node. -- Field: Field0 - function Get_Design_Unit (Target : Iir) return Iir_Design_Unit; - procedure Set_Design_Unit (Target : Iir; Unit : Iir_Design_Unit); + function Get_Design_Unit (Target : Iir) return Iir; + procedure Set_Design_Unit (Target : Iir; Unit : Iir); -- Field: Field7 function Get_Block_Statement (Target : Iir) return Iir; @@ -5431,7 +5487,6 @@ package Iirs is function Get_File_Open_Kind (Target : Iir_File_Declaration) return Iir; procedure Set_File_Open_Kind (Target : Iir_File_Declaration; Kind : Iir); - -- Display: Image -- Field: Field4 (pos) function Get_Element_Position (Target : Iir) return Iir_Index32; procedure Set_Element_Position (Target : Iir; Pos : Iir_Index32); @@ -5486,7 +5541,6 @@ package Iirs is -- Get/Set the identifier of a declaration. -- Can also be used instead of get/set_label. - -- Display: Inline -- Field: Field3 (uc) function Get_Identifier (Target : Iir) return Name_Id; procedure Set_Identifier (Target : Iir; Identifier : Name_Id); @@ -5525,9 +5579,15 @@ package Iirs is procedure Set_Base_Type (Decl : Iir; Base_Type : Iir); pragma Inline (Get_Base_Type); + -- Either a resolution function name, an array_element_resolution or a + -- record_resolution -- Field: Field5 - function Get_Resolution_Function (Decl : Iir) return Iir; - procedure Set_Resolution_Function (Decl : Iir; Func : Iir); + function Get_Resolution_Indication (Decl : Iir) return Iir; + procedure Set_Resolution_Indication (Decl : Iir; Ind : Iir); + + -- Field: Field1 Chain + function Get_Record_Element_Resolution_Chain (Res : Iir) return Iir; + procedure Set_Record_Element_Resolution_Chain (Res : Iir; Chain : Iir); -- Field: Field7 function Get_Tolerance (Def : Iir) return Iir; @@ -5567,18 +5627,34 @@ package Iirs is function Get_Constraint_State (Atype : Iir) return Iir_Constraint; procedure Set_Constraint_State (Atype : Iir; State : Iir_Constraint); - -- Field: Field6 (uc) + -- Reference either index_subtype_definition_list of array_type_definition + -- or index_constraint_list of array_subtype_definition. + -- Field: Field9 Ref (uc) function Get_Index_Subtype_List (Decl : Iir) return Iir_List; procedure Set_Index_Subtype_List (Decl : Iir; List : Iir_List); - -- Field: Field2 (uc) - function Get_Index_List (Decl : Iir) return Iir_List; - procedure Set_Index_List (Decl : Iir; List : Iir_List); + -- List of type marks for indexes type of array types. + -- Field: Field6 (uc) + function Get_Index_Subtype_Definition_List (Def : Iir) return Iir_List; + procedure Set_Index_Subtype_Definition_List (Def : Iir; Idx : Iir_List); - -- Field: Field1 + -- The subtype_indication as it appears in a array type declaration. + -- Field: Field2 function Get_Element_Subtype_Indication (Decl : Iir) return Iir; procedure Set_Element_Subtype_Indication (Decl : Iir; Sub_Type : Iir); + -- Field: Field1 Ref + function Get_Element_Subtype (Decl : Iir) return Iir; + procedure Set_Element_Subtype (Decl : Iir; Sub_Type : Iir); + + -- Field: Field6 (uc) + function Get_Index_Constraint_List (Def : Iir) return Iir_List; + procedure Set_Index_Constraint_List (Def : Iir; List : Iir_List); + + -- Field: Field8 + function Get_Array_Element_Constraint (Def : Iir) return Iir; + procedure Set_Array_Element_Constraint (Def : Iir; El : Iir); + -- Chains of elements of a record. -- Field: Field1 (uc) function Get_Elements_Declaration_List (Decl : Iir) return Iir_List; @@ -5592,6 +5668,11 @@ package Iirs is function Get_Designated_Subtype_Indication (Target : Iir) return Iir; procedure Set_Designated_Subtype_Indication (Target : Iir; Dtype : Iir); + -- List of indexes for indexed name. + -- Field: Field2 (uc) + function Get_Index_List (Decl : Iir) return Iir_List; + procedure Set_Index_List (Decl : Iir; List : Iir_List); + -- The terminal declaration for the reference (ground) of a nature -- Field: Field2 function Get_Reference (Def : Iir) return Iir; @@ -5715,7 +5796,7 @@ package Iirs is -- Get/Set the resolved flag of a subtype definition. -- A subtype definition may be resolved either because a - -- resolution_function_name is present in the subtype_indication, or + -- resolution_indication is present in the subtype_indication, or -- because all elements type are resolved. -- Field: Flag1 function Get_Resolved_Flag (Atype : Iir) return Boolean; @@ -5984,6 +6065,11 @@ package Iirs is function Get_Prefix (Target : Iir) return Iir; procedure Set_Prefix (Target : Iir; Prefix : Iir); + -- Prefix of a name signature + -- Field: Field1 Ref + function Get_Signature_Prefix (Sign : Iir) return Iir; + procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir); + -- The subtype of a slice. Contrary to the Type field, this is not a -- reference. -- Field: Field3 @@ -6043,7 +6129,6 @@ package Iirs is -- the aggregate or for the current dimension of a sub-aggregate. -- The real number of elements may be greater than this number if there -- is an 'other' choice. - -- Display: Image -- Field: Field4 (uc) function Get_Aggr_Min_Length (Info : Iir_Aggregate_Info) return Iir_Int32; procedure Set_Aggr_Min_Length (Info : Iir_Aggregate_Info; Nbr : Iir_Int32); @@ -6183,7 +6268,7 @@ package Iirs is function Get_Attribute_Signature (Attr : Iir) return Iir; procedure Set_Attribute_Signature (Attr : Iir; Signature : Iir); - -- Field: Field1 Ref (uc) + -- Field: Field1 Of_Ref (uc) function Get_Overload_List (Target : Iir) return Iir_List; procedure Set_Overload_List (Target : Iir; List : Iir_List); @@ -6218,7 +6303,6 @@ package Iirs is procedure Set_String_Id (Lit : Iir; Id : String_Id); -- For a string literal: the string length. - -- Display: Image -- Field: Field4 (uc) function Get_String_Length (Lit : Iir) return Int32; procedure Set_String_Length (Lit : Iir; Len : Int32); @@ -6267,7 +6351,7 @@ package Iirs is -- declaration is followed by an identifier (and separated by a comma). -- This flag is set on all but the last declarations. -- Eg: on 'signal A, B, C : Bit', the flag is set on A and B (but not C). - -- Field: Flag7 + -- Field: Flag3 function Get_Has_Identifier_List (Decl : Iir) return Boolean; procedure Set_Has_Identifier_List (Decl : Iir; Flag : Boolean); @@ -6276,6 +6360,15 @@ package Iirs is function Get_Has_Mode (Decl : Iir) return Boolean; procedure Set_Has_Mode (Decl : Iir; Flag : Boolean); + -- Set to True if Maybe_Ref fields are references. This cannot be shared + -- with Has_Identifier_List as: Is_Ref is set to True on all items but + -- the first, while Has_Identifier_List is set to True on all items but + -- the last. Furthermore Is_Ref appears in nodes where Has_Identifier_List + -- is not present. + -- Field: Flag7 + function Get_Is_Ref (N : Iir) return Boolean; + procedure Set_Is_Ref (N : Iir; Ref : Boolean); + -- Field: Field1 (uc) function Get_Psl_Property (Decl : Iir) return PSL_Node; procedure Set_Psl_Property (Decl : Iir; Prop : PSL_Node); diff --git a/iirs_utils.adb b/iirs_utils.adb index 515ae0670..172b0c306 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -23,6 +23,7 @@ with Str_Table; with Std_Names; use Std_Names; with Flags; use Flags; with PSL.Nodes; +with Sem_Inst; package body Iirs_Utils is -- Transform the current token into an iir literal. @@ -542,6 +543,20 @@ package body Iirs_Utils is return Iir_Predefined_Functions'Image (Func); end Get_Predefined_Function_Name; + procedure Mark_Subprogram_Used (Subprg : Iir) + is + N : Iir; + begin + N := Subprg; + loop + exit when Get_Use_Flag (N); + Set_Use_Flag (N, True); + N := Sem_Inst.Get_Origin (N); + -- The origin may also be an instance. + exit when N = Null_Iir; + end loop; + end Mark_Subprogram_Used; + procedure Clear_Seen_Flag (Top : Iir) is Callees_List : Iir_Callees_List; @@ -600,6 +615,19 @@ package body Iirs_Utils is return Build_Simple_Name (Ref, Get_Location (Loc)); end Build_Simple_Name; + function Has_Resolution_Function (Subtyp : Iir) return Iir + is + Ind : constant Iir := Get_Resolution_Indication (Subtyp); + begin + if Ind /= Null_Iir + and then Get_Kind (Ind) in Iir_Kinds_Denoting_Name + then + return Get_Named_Entity (Ind); + else + return Null_Iir; + end if; + end Has_Resolution_Function; + function Get_Primary_Unit_Name (Physical_Def : Iir) return Iir is Unit : constant Iir := Get_Primary_Unit (Physical_Def); @@ -655,11 +683,18 @@ package body Iirs_Utils is return Get_Index_Type (Get_Index_Subtype_List (Array_Type), Idx); end Get_Index_Type; - function Get_Element_Subtype (Def : Iir) return Iir is + function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir + is + Type_Mark_Name : constant Iir := Get_Subtype_Type_Mark (Subtyp); begin - return Get_Type_Of_Subtype_Indication - (Get_Element_Subtype_Indication (Def)); - end Get_Element_Subtype; + if Type_Mark_Name = Null_Iir then + -- No type_mark (for array subtype created by constrained array + -- definition. + return Null_Iir; + else + return Get_Type (Get_Named_Entity (Type_Mark_Name)); + end if; + end Get_Denoted_Type_Mark; function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean is @@ -865,7 +900,7 @@ package body Iirs_Utils is end case; end Get_High_Limit; - function Is_Unidim_Array_Type (A_Type : Iir) return Boolean + function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean is Base_Type : constant Iir := Get_Base_Type (A_Type); begin @@ -876,7 +911,7 @@ package body Iirs_Utils is else return False; end if; - end Is_Unidim_Array_Type; + end Is_One_Dimensional_Array_Type; function Is_Range_Attribute_Name (Expr : Iir) return Boolean is @@ -900,20 +935,22 @@ package body Iirs_Utils is is Res : Iir_Array_Subtype_Definition; Base_Type : Iir; + List : Iir_List; begin Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Location (Res, Loc); Base_Type := Get_Base_Type (Arr_Type); Set_Base_Type (Res, Base_Type); - Set_Element_Subtype_Indication - (Res, Get_Element_Subtype_Indication (Base_Type)); - if Get_Kind (Arr_Type) /= Iir_Kind_Array_Type_Definition then - Set_Resolution_Function (Res, Get_Resolution_Function (Arr_Type)); + Set_Element_Subtype (Res, Get_Element_Subtype (Base_Type)); + if Get_Kind (Arr_Type) = Iir_Kind_Array_Subtype_Definition then + Set_Resolution_Indication (Res, Get_Resolution_Indication (Arr_Type)); end if; Set_Resolved_Flag (Res, Get_Resolved_Flag (Arr_Type)); Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Arr_Type)); Set_Type_Staticness (Res, Get_Type_Staticness (Base_Type)); - Set_Index_Subtype_List (Res, Create_Iir_List); + List := Create_Iir_List; + Set_Index_Subtype_List (Res, List); + Set_Index_Constraint_List (Res, List); return Res; end Create_Array_Subtype; @@ -1044,6 +1081,13 @@ package body Iirs_Utils is and then Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir; end Is_Generic_Mapped_Package; + function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean + is + K : constant Iir_Kind := Get_Kind (N); + begin + return K = K1 or K = K2; + end Kind_In; + function Get_HDL_Node (N : PSL_Node) return Iir is begin return Iir (PSL.Nodes.Get_HDL_Node (N)); diff --git a/iirs_utils.ads b/iirs_utils.ads index b638d1b4b..e77e5723e 100644 --- a/iirs_utils.ads +++ b/iirs_utils.ads @@ -81,6 +81,10 @@ package Iirs_Utils is function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) return String; + -- Mark SUBPRG as used. If SUBPRG is an instance, its generic is also + -- marked. + procedure Mark_Subprogram_Used (Subprg : Iir); + -- Create the range_constraint node for an enumeration type. procedure Create_Range_Constraint_For_Enumeration_Type (Def : Iir_Enumeration_Type_Definition); @@ -114,6 +118,10 @@ package Iirs_Utils is function Build_Simple_Name (Ref : Iir; Loc : Location_Type) return Iir; function Build_Simple_Name (Ref : Iir; Loc : Iir) return Iir; + -- If SUBTYP has a resolution indication that is a function name, returns + -- the function declaration (not the name). + function Has_Resolution_Function (Subtyp : Iir) return Iir; + -- Return a simple name for the primary unit of physical type PHYSICAL_DEF. -- This is the artificial unit name for the value of the primary unit, thus -- its location is the location of the primary unit. Used mainly to build @@ -138,8 +146,8 @@ package Iirs_Utils is -- Likewise but for array type or subtype ARRAY_TYPE. function Get_Index_Type (Array_Type : Iir; Idx : Natural) return Iir; - -- Return the element type of array type or array subtype DEF. - function Get_Element_Subtype (Def : Iir) return Iir; + -- Return the type or subtype definition of the SUBTYP type mark. + function Get_Denoted_Type_Mark (Subtyp : Iir) return Iir; -- Return true iff L and R have the same profile. -- L and R must be subprograms specification (or spec_body). @@ -184,13 +192,12 @@ package Iirs_Utils is function Get_High_Limit (Arange : Iir_Range_Expression) return Iir; -- Return TRUE iff type/subtype definition A_TYPE is an undim array. - function Is_Unidim_Array_Type (A_Type : Iir) return Boolean; + function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean; -- Return TRUE iff unsemantized EXPR is a range attribute. function Is_Range_Attribute_Name (Expr : Iir) return Boolean; - -- Create an array subtype from array_type or unconstrained_array_subtype - -- ARR_TYPE. + -- Create an array subtype from array_type or array_subtype ARR_TYPE. -- All fields of the returned node are filled, except the index_list. -- The type_staticness is set with the type staticness of the element -- subtype and therefore must be updated. @@ -226,6 +233,10 @@ package Iirs_Utils is -- Return TRUE if the base name of NAME is a signal object. function Is_Signal_Object (Name: Iir) return Boolean; + -- Return True IFF kind of N is K1 or K2. + function Kind_In (N : Iir; K1, K2 : Iir_Kind) return Boolean; + pragma Inline (Kind_In); + -- IIR wrapper around Get_HDL_Node/Set_HDL_Node. function Get_HDL_Node (N : PSL_Node) return Iir; procedure Set_HDL_Node (N : PSL_Node; Expr : Iir); diff --git a/nodes_gc.adb b/nodes_gc.adb index d433c7931..65fe7f2b5 100644 --- a/nodes_gc.adb +++ b/nodes_gc.adb @@ -19,6 +19,7 @@ with Ada.Text_IO; with Types; use Types; with Nodes; +with Nodes_Meta; with Iirs; use Iirs; with Libraries; with Disp_Tree; @@ -116,7 +117,6 @@ package body Nodes_GC is Disp_Tree.Disp_Tree (N, True); end Report_Unreferenced_Node; - -- Subprograms procedure Mark_Iir (N : Iir) is begin if N = Null_Iir then @@ -128,640 +128,43 @@ package body Nodes_GC is Markers (N) := True; end if; - case Get_Kind (N) is - when Iir_Kind_Unused - | Iir_Kind_Entity_Aspect_Open - | Iir_Kind_Behavior_Attribute - | Iir_Kind_Structure_Attribute => - null; - when Iir_Kind_Error => - Mark_Iir (Get_Error_Origin (N)); - when Iir_Kind_Design_File => - Mark_Iir_List (Get_File_Dependence_List (N)); - Mark_Chain (Get_First_Design_Unit (N)); - when Iir_Kind_Design_Unit => - Mark_Chain (Get_Context_Items (N)); - Mark_Iir (Get_Library_Unit (N)); - Mark_Iir_List (Get_Analysis_Checks_List (N)); - when Iir_Kind_Library_Clause => - Mark_Iir (Get_Library_Declaration (N)); - when Iir_Kind_Use_Clause => - Mark_Iir (Get_Selected_Name (N)); - Mark_Iir (Get_Use_Clause_Chain (N)); - when Iir_Kind_Integer_Literal => - Mark_Iir (Get_Literal_Origin (N)); - when Iir_Kind_Floating_Point_Literal => - Mark_Iir (Get_Literal_Origin (N)); - when Iir_Kind_Null_Literal => - null; - when Iir_Kind_String_Literal => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir (Get_Literal_Subtype (N)); - when Iir_Kind_Physical_Int_Literal => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir (Get_Unit_Name (N)); - when Iir_Kind_Physical_Fp_Literal => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir (Get_Unit_Name (N)); - when Iir_Kind_Bit_String_Literal => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir (Get_Literal_Subtype (N)); - Mark_Iir (Get_Bit_String_0 (N)); - Mark_Iir (Get_Bit_String_1 (N)); - when Iir_Kind_Simple_Aggregate => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir_List (Get_Simple_Aggregate_List (N)); - Mark_Iir (Get_Literal_Subtype (N)); - when Iir_Kind_Overflow_Literal => - Mark_Iir (Get_Literal_Origin (N)); - when Iir_Kind_Waveform_Element => - Mark_Iir (Get_We_Value (N)); - Mark_Iir (Get_Time (N)); - when Iir_Kind_Conditional_Waveform => - Mark_Iir (Get_Condition (N)); - Mark_Chain (Get_Waveform_Chain (N)); - when Iir_Kind_Association_Element_By_Expression => - Mark_Iir (Get_Formal (N)); - Mark_Iir (Get_Actual (N)); - Mark_Iir (Get_In_Conversion (N)); - Mark_Iir (Get_Out_Conversion (N)); - when Iir_Kind_Association_Element_By_Individual => - Mark_Iir (Get_Formal (N)); - Mark_Iir (Get_Actual_Type (N)); - Mark_Chain (Get_Individual_Association_Chain (N)); - when Iir_Kind_Association_Element_Open => - Mark_Iir (Get_Formal (N)); - when Iir_Kind_Choice_By_Others - | Iir_Kind_Choice_By_None => - Mark_Iir (Get_Associated_Expr (N)); - Mark_Chain (Get_Associated_Chain (N)); - when Iir_Kind_Choice_By_Expression => - Mark_Iir (Get_Associated_Expr (N)); - Mark_Chain (Get_Associated_Chain (N)); - Mark_Iir (Get_Choice_Expression (N)); - when Iir_Kind_Choice_By_Range => - Mark_Iir (Get_Associated_Expr (N)); - Mark_Chain (Get_Associated_Chain (N)); - Mark_Iir (Get_Choice_Range (N)); - when Iir_Kind_Choice_By_Name => - Mark_Iir (Get_Associated_Expr (N)); - Mark_Chain (Get_Associated_Chain (N)); - Mark_Iir (Get_Choice_Name (N)); - when Iir_Kind_Entity_Aspect_Entity => - Mark_Iir (Get_Entity_Name (N)); - Mark_Iir (Get_Architecture (N)); - when Iir_Kind_Entity_Aspect_Configuration => - Mark_Iir (Get_Configuration_Name (N)); - when Iir_Kind_Block_Configuration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Chain (Get_Configuration_Item_Chain (N)); - Mark_Iir (Get_Block_Specification (N)); - when Iir_Kind_Block_Header => - Mark_Chain (Get_Generic_Chain (N)); - Mark_Chain (Get_Port_Chain (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - Mark_Chain (Get_Port_Map_Aspect_Chain (N)); - when Iir_Kind_Component_Configuration => - Mark_Iir_List (Get_Instantiation_List (N)); - Mark_Iir (Get_Binding_Indication (N)); - Mark_Iir (Get_Component_Name (N)); - Mark_Iir (Get_Block_Configuration (N)); - when Iir_Kind_Binding_Indication => - Mark_Iir (Get_Default_Entity_Aspect (N)); - Mark_Iir (Get_Entity_Aspect (N)); - Mark_Chain (Get_Default_Generic_Map_Aspect_Chain (N)); - Mark_Chain (Get_Default_Port_Map_Aspect_Chain (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - Mark_Chain (Get_Port_Map_Aspect_Chain (N)); - when Iir_Kind_Entity_Class => - null; - when Iir_Kind_Attribute_Value => - Mark_Iir (Get_Spec_Chain (N)); - when Iir_Kind_Signature => - Mark_Iir (Get_Prefix (N)); - Mark_Iir_List (Get_Type_Marks_List (N)); - Mark_Iir (Get_Return_Type_Mark (N)); - when Iir_Kind_Aggregate_Info => - Mark_Iir (Get_Sub_Aggregate_Info (N)); - Mark_Iir (Get_Aggr_Low_Limit (N)); - Mark_Iir (Get_Aggr_High_Limit (N)); - when Iir_Kind_Procedure_Call => - Mark_Iir (Get_Prefix (N)); - Mark_Chain (Get_Parameter_Association_Chain (N)); - Mark_Iir (Get_Method_Object (N)); - when Iir_Kind_Record_Element_Constraint => - Mark_Iir (Get_Element_Declaration (N)); - when Iir_Kind_Attribute_Specification => - Mark_Iir_List (Get_Entity_Name_List (N)); - Mark_Iir (Get_Attribute_Value_Spec_Chain (N)); - Mark_Iir (Get_Expression (N)); - Mark_Iir (Get_Attribute_Designator (N)); - Mark_Iir (Get_Attribute_Specification_Chain (N)); - when Iir_Kind_Disconnection_Specification => - Mark_Iir_List (Get_Signal_List (N)); - Mark_Iir (Get_Type_Mark (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Configuration_Specification => - Mark_Iir_List (Get_Instantiation_List (N)); - Mark_Iir (Get_Binding_Indication (N)); - Mark_Iir (Get_Component_Name (N)); - when Iir_Kind_Access_Type_Definition => - Mark_Iir (Get_Designated_Subtype_Indication (N)); - when Iir_Kind_Incomplete_Type_Definition => - Mark_Iir_List (Get_Incomplete_Type_List (N)); - when Iir_Kind_File_Type_Definition => - Mark_Iir (Get_File_Type_Mark (N)); - when Iir_Kind_Protected_Type_Declaration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Protected_Type_Body (N)); - when Iir_Kind_Record_Type_Definition => - Mark_Iir_List (Get_Elements_Declaration_List (N)); - when Iir_Kind_Array_Type_Definition => - Mark_Iir (Get_Element_Subtype_Indication (N)); - Mark_Iir_List (Get_Index_Subtype_List (N)); - when Iir_Kind_Array_Subtype_Definition => - Mark_Iir (Get_Element_Subtype_Indication (N)); - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Resolution_Function (N)); - Mark_Iir_List (Get_Index_Subtype_List (N)); - Mark_Iir (Get_Tolerance (N)); - when Iir_Kind_Record_Subtype_Definition => - Mark_Iir_List (Get_Elements_Declaration_List (N)); - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Resolution_Function (N)); - Mark_Iir (Get_Tolerance (N)); - when Iir_Kind_Access_Subtype_Definition => - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Designated_Subtype_Indication (N)); - when Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - Mark_Iir (Get_Range_Constraint (N)); - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Resolution_Function (N)); - when Iir_Kind_Floating_Subtype_Definition => - Mark_Iir (Get_Range_Constraint (N)); - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Resolution_Function (N)); - Mark_Iir (Get_Tolerance (N)); - when Iir_Kind_Enumeration_Type_Definition => - Mark_Iir (Get_Range_Constraint (N)); - Mark_Iir_List (Get_Enumeration_Literal_List (N)); - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition => - null; - when Iir_Kind_Physical_Type_Definition => - Mark_Chain (Get_Unit_Chain (N)); - when Iir_Kind_Range_Expression => - Mark_Iir (Get_Left_Limit (N)); - Mark_Iir (Get_Right_Limit (N)); - Mark_Iir (Get_Range_Origin (N)); - when Iir_Kind_Protected_Type_Body => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Protected_Type_Declaration (N)); - when Iir_Kind_Subtype_Definition => - Mark_Iir (Get_Range_Constraint (N)); - Mark_Iir (Get_Subtype_Type_Mark (N)); - Mark_Iir (Get_Resolution_Function (N)); - Mark_Iir (Get_Tolerance (N)); - when Iir_Kind_Scalar_Nature_Definition => - Mark_Iir (Get_Reference (N)); - Mark_Iir (Get_Nature_Declarator (N)); - Mark_Iir (Get_Across_Type (N)); - Mark_Iir (Get_Through_Type (N)); - when Iir_Kind_Overload_List => - null; - when Iir_Kind_Type_Declaration => - Mark_Iir (Get_Type_Definition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_Anonymous_Type_Declaration => - Mark_Iir (Get_Type_Definition (N)); - Mark_Iir (Get_Subtype_Definition (N)); - when Iir_Kind_Subtype_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - when Iir_Kind_Nature_Declaration - | Iir_Kind_Subnature_Declaration => - Mark_Iir (Get_Nature (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_Package_Declaration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Package_Header (N)); - when Iir_Kind_Package_Instantiation_Declaration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Uninstantiated_Name (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - when Iir_Kind_Package_Body => - Mark_Chain (Get_Declaration_Chain (N)); - when Iir_Kind_Configuration_Declaration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Entity_Name (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Block_Configuration (N)); - when Iir_Kind_Entity_Declaration => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Concurrent_Statement_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Chain (Get_Port_Chain (N)); - when Iir_Kind_Architecture_Body => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Entity_Name (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Concurrent_Statement_Chain (N)); - Mark_Iir (Get_Default_Configuration_Declaration (N)); - when Iir_Kind_Package_Header => - Mark_Chain (Get_Generic_Chain (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - when Iir_Kind_Unit_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Physical_Literal (N)); - Mark_Iir (Get_Physical_Unit_Value (N)); - when Iir_Kind_Library_Declaration => - Mark_Chain (Get_Design_File_Chain (N)); - when Iir_Kind_Component_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Chain (Get_Port_Chain (N)); - when Iir_Kind_Attribute_Declaration => - Mark_Iir (Get_Type_Mark (N)); - when Iir_Kind_Group_Template_Declaration => - Mark_Chain (Get_Entity_Class_Entry_Chain (N)); - when Iir_Kind_Group_Declaration => - Mark_Iir_List (Get_Group_Constituent_List (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Group_Template_Name (N)); - when Iir_Kind_Element_Declaration => - Mark_Iir (Get_Subtype_Indication (N)); - when Iir_Kind_Non_Object_Alias_Declaration => - Mark_Iir (Get_Name (N)); - Mark_Iir (Get_Alias_Signature (N)); - when Iir_Kind_Psl_Declaration => - Mark_PSL_Node (Get_Psl_Declaration (N)); - Mark_PSL_Node (Get_PSL_Clock (N)); - Mark_PSL_NFA (Get_PSL_NFA (N)); - when Iir_Kind_Terminal_Declaration => - Mark_Iir (Get_Nature (N)); - when Iir_Kind_Free_Quantity_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Default_Value (N)); - when Iir_Kind_Across_Quantity_Declaration - | Iir_Kind_Through_Quantity_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Default_Value (N)); - Mark_Iir (Get_Tolerance (N)); - Mark_Iir (Get_Plus_Terminal (N)); - Mark_Iir (Get_Minus_Terminal (N)); - when Iir_Kind_Enumeration_Literal => - Mark_Iir (Get_Literal_Origin (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_Function_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Interface_Declaration_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Iir (Get_Return_Type_Mark (N)); - when Iir_Kind_Implicit_Function_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Interface_Declaration_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - when Iir_Kind_Implicit_Procedure_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Interface_Declaration_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - when Iir_Kind_Procedure_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Interface_Declaration_Chain (N)); - Mark_Chain (Get_Generic_Chain (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Iir (Get_Return_Type_Mark (N)); - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - when Iir_Kind_Object_Alias_Declaration => - Mark_Iir (Get_Name (N)); - Mark_Iir (Get_Subtype_Indication (N)); - when Iir_Kind_File_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_File_Logical_Name (N)); - Mark_Iir (Get_File_Open_Kind (N)); - when Iir_Kind_Guard_Signal_Declaration => - Mark_Iir (Get_Guard_Expression (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir_List (Get_Guard_Sensitivity_List (N)); - Mark_Iir (Get_Block_Statement (N)); - when Iir_Kind_Signal_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Default_Value (N)); - Mark_Iir (Get_Signal_Driver (N)); - when Iir_Kind_Variable_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Default_Value (N)); - when Iir_Kind_Constant_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Default_Value (N)); - Mark_Iir (Get_Deferred_Declaration (N)); - when Iir_Kind_Iterator_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Discrete_Range (N)); - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Default_Value (N)); - when Iir_Kind_Signal_Interface_Declaration => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Subtype_Indication (N)); - Mark_Iir (Get_Default_Value (N)); - when Iir_Kind_Identity_Operator - | Iir_Kind_Negation_Operator - | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator - | Iir_Kind_Condition_Operator - | Iir_Kind_Reduction_And_Operator - | Iir_Kind_Reduction_Or_Operator - | Iir_Kind_Reduction_Nand_Operator - | Iir_Kind_Reduction_Nor_Operator - | Iir_Kind_Reduction_Xor_Operator - | Iir_Kind_Reduction_Xnor_Operator => - Mark_Iir (Get_Operand (N)); - when Iir_Kind_And_Operator - | Iir_Kind_Or_Operator - | Iir_Kind_Nand_Operator - | Iir_Kind_Nor_Operator - | Iir_Kind_Xor_Operator - | Iir_Kind_Xnor_Operator - | Iir_Kind_Equality_Operator - | Iir_Kind_Inequality_Operator - | Iir_Kind_Less_Than_Operator - | Iir_Kind_Less_Than_Or_Equal_Operator - | Iir_Kind_Greater_Than_Operator - | Iir_Kind_Greater_Than_Or_Equal_Operator - | Iir_Kind_Match_Equality_Operator - | Iir_Kind_Match_Inequality_Operator - | Iir_Kind_Match_Less_Than_Operator - | Iir_Kind_Match_Less_Than_Or_Equal_Operator - | Iir_Kind_Match_Greater_Than_Operator - | Iir_Kind_Match_Greater_Than_Or_Equal_Operator - | Iir_Kind_Sll_Operator - | Iir_Kind_Sla_Operator - | Iir_Kind_Srl_Operator - | Iir_Kind_Sra_Operator - | Iir_Kind_Rol_Operator - | Iir_Kind_Ror_Operator - | Iir_Kind_Addition_Operator - | Iir_Kind_Substraction_Operator - | Iir_Kind_Concatenation_Operator - | Iir_Kind_Multiplication_Operator - | Iir_Kind_Division_Operator - | Iir_Kind_Modulus_Operator - | Iir_Kind_Remainder_Operator - | Iir_Kind_Exponentiation_Operator => - Mark_Iir (Get_Left (N)); - Mark_Iir (Get_Right (N)); - when Iir_Kind_Function_Call => - Mark_Iir (Get_Prefix (N)); - Mark_Chain (Get_Parameter_Association_Chain (N)); - Mark_Iir (Get_Method_Object (N)); - when Iir_Kind_Aggregate => - Mark_Iir (Get_Aggregate_Info (N)); - Mark_Chain (Get_Association_Choices_Chain (N)); - Mark_Iir (Get_Literal_Subtype (N)); - when Iir_Kind_Parenthesis_Expression => - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Qualified_Expression => - Mark_Iir (Get_Type_Mark (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Type_Conversion => - Mark_Iir (Get_Type_Conversion_Subtype (N)); - Mark_Iir (Get_Type_Mark (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Allocator_By_Expression => - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Allocator_By_Subtype => - Mark_Iir (Get_Subtype_Indication (N)); - when Iir_Kind_Selected_Element => - Mark_Iir (Get_Prefix (N)); - when Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Left_Type_Attribute - | Iir_Kind_Right_Type_Attribute - | Iir_Kind_High_Type_Attribute - | Iir_Kind_Low_Type_Attribute - | Iir_Kind_Ascending_Type_Attribute - | Iir_Kind_Instance_Name_Attribute - | Iir_Kind_Path_Name_Attribute => - Mark_Iir (Get_Prefix (N)); - when Iir_Kind_Slice_Name => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Suffix (N)); - Mark_Iir (Get_Slice_Subtype (N)); - when Iir_Kind_Indexed_Name => - Mark_Iir (Get_Prefix (N)); - Mark_Iir_List (Get_Index_List (N)); - when Iir_Kind_Psl_Expression => - Mark_PSL_Node (Get_Psl_Expression (N)); - when Iir_Kind_Sensitized_Process_Statement => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - Mark_Iir_List (Get_Sensitivity_List (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Iir (Get_Process_Origin (N)); - when Iir_Kind_Process_Statement => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - Mark_Iir_List (Get_Callees_List (N)); - Mark_Iir (Get_Process_Origin (N)); - when Iir_Kind_Concurrent_Conditional_Signal_Assignment => - Mark_Iir (Get_Target (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Reject_Time_Expression (N)); - Mark_Chain (Get_Conditional_Waveform_Chain (N)); - Mark_Iir (Get_Guard (N)); - when Iir_Kind_Concurrent_Selected_Signal_Assignment => - Mark_Iir (Get_Target (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Expression (N)); - Mark_Iir (Get_Reject_Time_Expression (N)); - Mark_Chain (Get_Selected_Waveform_Chain (N)); - Mark_Iir (Get_Guard (N)); - when Iir_Kind_Concurrent_Assertion_Statement => - Mark_Iir (Get_Assertion_Condition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Severity_Expression (N)); - Mark_Iir (Get_Report_Expression (N)); - when Iir_Kind_Psl_Default_Clock => - Mark_PSL_Node (Get_Psl_Boolean (N)); - when Iir_Kind_Psl_Assert_Statement - | Iir_Kind_Psl_Cover_Statement => - Mark_PSL_Node (Get_Psl_Property (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Severity_Expression (N)); - Mark_Iir (Get_Report_Expression (N)); - Mark_PSL_Node (Get_PSL_Clock (N)); - Mark_PSL_NFA (Get_PSL_NFA (N)); - when Iir_Kind_Concurrent_Procedure_Call_Statement => - Mark_Iir (Get_Procedure_Call (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_Block_Statement => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Concurrent_Statement_Chain (N)); - Mark_Iir (Get_Block_Block_Configuration (N)); - Mark_Iir (Get_Block_Header (N)); - Mark_Iir (Get_Guard_Decl (N)); - when Iir_Kind_Generate_Statement => - Mark_Chain (Get_Declaration_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Concurrent_Statement_Chain (N)); - Mark_Iir (Get_Generation_Scheme (N)); - Mark_Iir (Get_Generate_Block_Configuration (N)); - when Iir_Kind_Component_Instantiation_Statement => - Mark_Iir (Get_Instantiated_Unit (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Default_Binding_Indication (N)); - Mark_Iir (Get_Component_Configuration (N)); - Mark_Iir (Get_Configuration_Specification (N)); - Mark_Chain (Get_Generic_Map_Aspect_Chain (N)); - Mark_Chain (Get_Port_Map_Aspect_Chain (N)); - when Iir_Kind_Simple_Simultaneous_Statement => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Simultaneous_Left (N)); - Mark_Iir (Get_Simultaneous_Right (N)); - Mark_Iir (Get_Tolerance (N)); - when Iir_Kind_Signal_Assignment_Statement => - Mark_Iir (Get_Target (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Waveform_Chain (N)); - Mark_Iir (Get_Reject_Time_Expression (N)); - when Iir_Kind_Null_Statement => - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_Assertion_Statement => - Mark_Iir (Get_Assertion_Condition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Severity_Expression (N)); - Mark_Iir (Get_Report_Expression (N)); - when Iir_Kind_Report_Statement => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Severity_Expression (N)); - Mark_Iir (Get_Report_Expression (N)); - when Iir_Kind_Wait_Statement => - Mark_Iir (Get_Timeout_Clause (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Condition_Clause (N)); - Mark_Iir_List (Get_Sensitivity_List (N)); - when Iir_Kind_Variable_Assignment_Statement => - Mark_Iir (Get_Target (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Return_Statement => - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_For_Loop_Statement => - Mark_Iir (Get_Parameter_Specification (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - when Iir_Kind_While_Loop_Statement => - Mark_Iir (Get_Condition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - when Iir_Kind_Next_Statement - | Iir_Kind_Exit_Statement => - Mark_Iir (Get_Condition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Loop_Label (N)); - when Iir_Kind_Case_Statement => - Mark_Chain (Get_Case_Statement_Alternative_Chain (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Iir (Get_Expression (N)); - when Iir_Kind_Procedure_Call_Statement => - Mark_Iir (Get_Procedure_Call (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - when Iir_Kind_If_Statement => - Mark_Iir (Get_Condition (N)); - Mark_Iir (Get_Attribute_Value_Chain (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - Mark_Iir (Get_Else_Clause (N)); - when Iir_Kind_Elsif => - Mark_Iir (Get_Condition (N)); - Mark_Chain (Get_Sequential_Statement_Chain (N)); - Mark_Iir (Get_Else_Clause (N)); - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name => - Mark_Iir (Get_Alias_Declaration (N)); - when Iir_Kind_Selected_Name => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Alias_Declaration (N)); - when Iir_Kind_Operator_Symbol => - Mark_Iir (Get_Alias_Declaration (N)); - when Iir_Kind_Selected_By_All_Name => - Mark_Iir (Get_Prefix (N)); - when Iir_Kind_Parenthesis_Name => - Mark_Iir (Get_Prefix (N)); - Mark_Chain (Get_Association_Chain (N)); - when Iir_Kind_Base_Attribute => - Mark_Iir (Get_Prefix (N)); - when Iir_Kind_Image_Attribute - | Iir_Kind_Value_Attribute - | Iir_Kind_Pos_Attribute - | Iir_Kind_Val_Attribute - | Iir_Kind_Succ_Attribute - | Iir_Kind_Pred_Attribute - | Iir_Kind_Leftof_Attribute - | Iir_Kind_Rightof_Attribute => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Parameter (N)); - when Iir_Kind_Delayed_Attribute - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Parameter (N)); - when Iir_Kind_Event_Attribute - | Iir_Kind_Active_Attribute - | Iir_Kind_Last_Event_Attribute - | Iir_Kind_Last_Active_Attribute - | Iir_Kind_Last_Value_Attribute - | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute => - Mark_Iir (Get_Prefix (N)); - when Iir_Kind_Simple_Name_Attribute => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Simple_Name_Subtype (N)); - when Iir_Kind_Left_Array_Attribute - | Iir_Kind_Right_Array_Attribute - | Iir_Kind_High_Array_Attribute - | Iir_Kind_Low_Array_Attribute - | Iir_Kind_Length_Array_Attribute - | Iir_Kind_Ascending_Array_Attribute - | Iir_Kind_Range_Array_Attribute - | Iir_Kind_Reverse_Range_Array_Attribute => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Index_Subtype (N)); - Mark_Iir (Get_Parameter (N)); - when Iir_Kind_Attribute_Name => - Mark_Iir (Get_Prefix (N)); - Mark_Iir (Get_Attribute_Signature (N)); - end case; + declare + use Nodes_Meta; + Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); + F : Fields_Enum; + begin + for I in Fields'Range loop + F := Fields (I); + case Get_Field_Attribute (F) is + when Attr_Ref + | Attr_Chain_Next => + null; + when Attr_Maybe_Ref => + if not Get_Is_Ref (N) then + Mark_Iir (Get_Iir (N, F)); + end if; + when Attr_Chain => + Mark_Chain (Get_Iir (N, F)); + when Attr_None => + case Get_Field_Type (F) is + when Type_Iir => + Mark_Iir (Get_Iir (N, F)); + when Type_Iir_List => + Mark_Iir_List (Get_Iir_List (N, F)); + when Type_PSL_Node => + Mark_PSL_Node (Get_PSL_Node (N, F)); + when Type_PSL_NFA => + Mark_PSL_NFA (Get_PSL_NFA (N, F)); + when others => + null; + end case; + when Attr_Of_Ref => + raise Internal_Error; + end case; + end loop; + end; end Mark_Iir; - procedure Report_Unreferenced is use Ada.Text_IO; diff --git a/nodes_meta.adb b/nodes_meta.adb new file mode 100644 index 000000000..c84ff2337 --- /dev/null +++ b/nodes_meta.adb @@ -0,0 +1,9352 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package body Nodes_Meta is + Fields_Type : constant array (Fields_Enum) of Types_Enum := + ( + Field_First_Design_Unit => Type_Iir, + Field_Last_Design_Unit => Type_Iir, + Field_Library_Declaration => Type_Iir, + Field_File_Time_Stamp => Type_Time_Stamp_Id, + Field_Analysis_Time_Stamp => Type_Time_Stamp_Id, + Field_Library => Type_Iir, + Field_File_Dependence_List => Type_Iir_List, + Field_Design_File_Filename => Type_Name_Id, + Field_Design_File_Directory => Type_Name_Id, + Field_Design_File => Type_Iir, + Field_Design_File_Chain => Type_Iir, + Field_Library_Directory => Type_Name_Id, + Field_Date => Type_Date_Type, + Field_Context_Items => Type_Iir, + Field_Dependence_List => Type_Iir_List, + Field_Analysis_Checks_List => Type_Iir_List, + Field_Date_State => Type_Date_State_Type, + Field_Guarded_Target_State => Type_Tri_State_Type, + Field_Library_Unit => Type_Iir, + Field_Hash_Chain => Type_Iir, + Field_Design_Unit_Source_Pos => Type_Source_Ptr, + Field_Design_Unit_Source_Line => Type_Int32, + Field_Design_Unit_Source_Col => Type_Int32, + Field_Value => Type_Iir_Int64, + Field_Enum_Pos => Type_Iir_Int32, + Field_Physical_Literal => Type_Iir, + Field_Physical_Unit_Value => Type_Iir, + Field_Fp_Value => Type_Iir_Fp64, + Field_Enumeration_Decl => Type_Iir, + Field_Simple_Aggregate_List => Type_Iir_List, + Field_Bit_String_Base => Type_Base_Type, + Field_Bit_String_0 => Type_Iir, + Field_Bit_String_1 => Type_Iir, + Field_Literal_Origin => Type_Iir, + Field_Range_Origin => Type_Iir, + Field_Literal_Subtype => Type_Iir, + Field_Entity_Class => Type_Token_Type, + Field_Entity_Name_List => Type_Iir_List, + Field_Attribute_Designator => Type_Iir, + Field_Attribute_Specification_Chain => Type_Iir, + Field_Attribute_Specification => Type_Iir, + Field_Signal_List => Type_Iir_List, + Field_Designated_Entity => Type_Iir, + Field_Formal => Type_Iir, + Field_Actual => Type_Iir, + Field_In_Conversion => Type_Iir, + Field_Out_Conversion => Type_Iir, + Field_Whole_Association_Flag => Type_Boolean, + Field_Collapse_Signal_Flag => Type_Boolean, + Field_Artificial_Flag => Type_Boolean, + Field_Open_Flag => Type_Boolean, + Field_After_Drivers_Flag => Type_Boolean, + Field_We_Value => Type_Iir, + Field_Time => Type_Iir, + Field_Associated_Expr => Type_Iir, + Field_Associated_Chain => Type_Iir, + Field_Choice_Name => Type_Iir, + Field_Choice_Expression => Type_Iir, + Field_Choice_Range => Type_Iir, + Field_Same_Alternative_Flag => Type_Boolean, + Field_Architecture => Type_Iir, + Field_Block_Specification => Type_Iir, + Field_Prev_Block_Configuration => Type_Iir, + Field_Configuration_Item_Chain => Type_Iir, + Field_Attribute_Value_Chain => Type_Iir, + Field_Spec_Chain => Type_Iir, + Field_Attribute_Value_Spec_Chain => Type_Iir, + Field_Entity_Name => Type_Iir, + Field_Package => Type_Iir, + Field_Package_Body => Type_Iir, + Field_Need_Body => Type_Boolean, + Field_Block_Configuration => Type_Iir, + Field_Concurrent_Statement_Chain => Type_Iir, + Field_Chain => Type_Iir, + Field_Port_Chain => Type_Iir, + Field_Generic_Chain => Type_Iir, + Field_Type => Type_Iir, + Field_Subtype_Indication => Type_Iir, + Field_Discrete_Range => Type_Iir, + Field_Type_Definition => Type_Iir, + Field_Subtype_Definition => Type_Iir, + Field_Nature => Type_Iir, + Field_Mode => Type_Iir_Mode, + Field_Signal_Kind => Type_Iir_Signal_Kind, + Field_Base_Name => Type_Iir, + Field_Interface_Declaration_Chain => Type_Iir, + Field_Subprogram_Specification => Type_Iir, + Field_Sequential_Statement_Chain => Type_Iir, + Field_Subprogram_Body => Type_Iir, + Field_Overload_Number => Type_Iir_Int32, + Field_Subprogram_Depth => Type_Iir_Int32, + Field_Subprogram_Hash => Type_Iir_Int32, + Field_Impure_Depth => Type_Iir_Int32, + Field_Return_Type => Type_Iir, + Field_Implicit_Definition => Type_Iir_Predefined_Functions, + Field_Type_Reference => Type_Iir, + Field_Default_Value => Type_Iir, + Field_Deferred_Declaration => Type_Iir, + Field_Deferred_Declaration_Flag => Type_Boolean, + Field_Shared_Flag => Type_Boolean, + Field_Design_Unit => Type_Iir, + Field_Block_Statement => Type_Iir, + Field_Signal_Driver => Type_Iir, + Field_Declaration_Chain => Type_Iir, + Field_File_Logical_Name => Type_Iir, + Field_File_Open_Kind => Type_Iir, + Field_Element_Position => Type_Iir_Index32, + Field_Element_Declaration => Type_Iir, + Field_Selected_Element => Type_Iir, + Field_Use_Clause_Chain => Type_Iir, + Field_Selected_Name => Type_Iir, + Field_Type_Declarator => Type_Iir, + Field_Enumeration_Literal_List => Type_Iir_List, + Field_Entity_Class_Entry_Chain => Type_Iir, + Field_Group_Constituent_List => Type_Iir_List, + Field_Unit_Chain => Type_Iir, + Field_Primary_Unit => Type_Iir, + Field_Identifier => Type_Name_Id, + Field_Label => Type_Name_Id, + Field_Visible_Flag => Type_Boolean, + Field_Range_Constraint => Type_Iir, + Field_Direction => Type_Iir_Direction, + Field_Left_Limit => Type_Iir, + Field_Right_Limit => Type_Iir, + Field_Base_Type => Type_Iir, + Field_Resolution_Indication => Type_Iir, + Field_Record_Element_Resolution_Chain => Type_Iir, + Field_Tolerance => Type_Iir, + Field_Plus_Terminal => Type_Iir, + Field_Minus_Terminal => Type_Iir, + Field_Simultaneous_Left => Type_Iir, + Field_Simultaneous_Right => Type_Iir, + Field_Text_File_Flag => Type_Boolean, + Field_Only_Characters_Flag => Type_Boolean, + Field_Type_Staticness => Type_Iir_Staticness, + Field_Constraint_State => Type_Iir_Constraint, + Field_Index_Subtype_List => Type_Iir_List, + Field_Index_Subtype_Definition_List => Type_Iir_List, + Field_Element_Subtype_Indication => Type_Iir, + Field_Element_Subtype => Type_Iir, + Field_Index_Constraint_List => Type_Iir_List, + Field_Array_Element_Constraint => Type_Iir, + Field_Elements_Declaration_List => Type_Iir_List, + Field_Designated_Type => Type_Iir, + Field_Designated_Subtype_Indication => Type_Iir, + Field_Index_List => Type_Iir_List, + Field_Reference => Type_Iir, + Field_Nature_Declarator => Type_Iir, + Field_Across_Type => Type_Iir, + Field_Through_Type => Type_Iir, + Field_Target => Type_Iir, + Field_Waveform_Chain => Type_Iir, + Field_Guard => Type_Iir, + Field_Delay_Mechanism => Type_Iir_Delay_Mechanism, + Field_Reject_Time_Expression => Type_Iir, + Field_Sensitivity_List => Type_Iir_List, + Field_Process_Origin => Type_Iir, + Field_Condition_Clause => Type_Iir, + Field_Timeout_Clause => Type_Iir, + Field_Postponed_Flag => Type_Boolean, + Field_Callees_List => Type_Iir_List, + Field_Passive_Flag => Type_Boolean, + Field_Resolution_Function_Flag => Type_Boolean, + Field_Wait_State => Type_Tri_State_Type, + Field_All_Sensitized_State => Type_Iir_All_Sensitized, + Field_Seen_Flag => Type_Boolean, + Field_Pure_Flag => Type_Boolean, + Field_Foreign_Flag => Type_Boolean, + Field_Resolved_Flag => Type_Boolean, + Field_Signal_Type_Flag => Type_Boolean, + Field_Has_Signal_Flag => Type_Boolean, + Field_Purity_State => Type_Iir_Pure_State, + Field_Elab_Flag => Type_Boolean, + Field_Index_Constraint_Flag => Type_Boolean, + Field_Assertion_Condition => Type_Iir, + Field_Report_Expression => Type_Iir, + Field_Severity_Expression => Type_Iir, + Field_Instantiated_Unit => Type_Iir, + Field_Generic_Map_Aspect_Chain => Type_Iir, + Field_Port_Map_Aspect_Chain => Type_Iir, + Field_Configuration_Name => Type_Iir, + Field_Component_Configuration => Type_Iir, + Field_Configuration_Specification => Type_Iir, + Field_Default_Binding_Indication => Type_Iir, + Field_Default_Configuration_Declaration => Type_Iir, + Field_Expression => Type_Iir, + Field_Allocator_Designated_Type => Type_Iir, + Field_Selected_Waveform_Chain => Type_Iir, + Field_Conditional_Waveform_Chain => Type_Iir, + Field_Guard_Expression => Type_Iir, + Field_Guard_Decl => Type_Iir, + Field_Guard_Sensitivity_List => Type_Iir_List, + Field_Block_Block_Configuration => Type_Iir, + Field_Package_Header => Type_Iir, + Field_Block_Header => Type_Iir, + Field_Uninstantiated_Name => Type_Iir, + Field_Generate_Block_Configuration => Type_Iir, + Field_Generation_Scheme => Type_Iir, + Field_Condition => Type_Iir, + Field_Else_Clause => Type_Iir, + Field_Parameter_Specification => Type_Iir, + Field_Parent => Type_Iir, + Field_Loop_Label => Type_Iir, + Field_Component_Name => Type_Iir, + Field_Instantiation_List => Type_Iir_List, + Field_Entity_Aspect => Type_Iir, + Field_Default_Entity_Aspect => Type_Iir, + Field_Default_Generic_Map_Aspect_Chain => Type_Iir, + Field_Default_Port_Map_Aspect_Chain => Type_Iir, + Field_Binding_Indication => Type_Iir, + Field_Named_Entity => Type_Iir, + Field_Alias_Declaration => Type_Iir, + Field_Expr_Staticness => Type_Iir_Staticness, + Field_Error_Origin => Type_Iir, + Field_Operand => Type_Iir, + Field_Left => Type_Iir, + Field_Right => Type_Iir, + Field_Unit_Name => Type_Iir, + Field_Name => Type_Iir, + Field_Group_Template_Name => Type_Iir, + Field_Name_Staticness => Type_Iir_Staticness, + Field_Prefix => Type_Iir, + Field_Signature_Prefix => Type_Iir, + Field_Slice_Subtype => Type_Iir, + Field_Suffix => Type_Iir, + Field_Index_Subtype => Type_Iir, + Field_Parameter => Type_Iir, + Field_Actual_Type => Type_Iir, + Field_Association_Chain => Type_Iir, + Field_Individual_Association_Chain => Type_Iir, + Field_Aggregate_Info => Type_Iir, + Field_Sub_Aggregate_Info => Type_Iir, + Field_Aggr_Dynamic_Flag => Type_Boolean, + Field_Aggr_Min_Length => Type_Iir_Int32, + Field_Aggr_Low_Limit => Type_Iir, + Field_Aggr_High_Limit => Type_Iir, + Field_Aggr_Others_Flag => Type_Boolean, + Field_Aggr_Named_Flag => Type_Boolean, + Field_Value_Staticness => Type_Iir_Staticness, + Field_Association_Choices_Chain => Type_Iir, + Field_Case_Statement_Alternative_Chain => Type_Iir, + Field_Choice_Staticness => Type_Iir_Staticness, + Field_Procedure_Call => Type_Iir, + Field_Implementation => Type_Iir, + Field_Parameter_Association_Chain => Type_Iir, + Field_Method_Object => Type_Iir, + Field_Subtype_Type_Mark => Type_Iir, + Field_Type_Conversion_Subtype => Type_Iir, + Field_Type_Mark => Type_Iir, + Field_File_Type_Mark => Type_Iir, + Field_Return_Type_Mark => Type_Iir, + Field_Lexical_Layout => Type_Iir_Lexical_Layout_Type, + Field_Incomplete_Type_List => Type_Iir_List, + Field_Has_Disconnect_Flag => Type_Boolean, + Field_Has_Active_Flag => Type_Boolean, + Field_Is_Within_Flag => Type_Boolean, + Field_Type_Marks_List => Type_Iir_List, + Field_Implicit_Alias_Flag => Type_Boolean, + Field_Alias_Signature => Type_Iir, + Field_Attribute_Signature => Type_Iir, + Field_Overload_List => Type_Iir_List, + Field_Simple_Name_Identifier => Type_Name_Id, + Field_Simple_Name_Subtype => Type_Iir, + Field_Protected_Type_Body => Type_Iir, + Field_Protected_Type_Declaration => Type_Iir, + Field_End_Location => Type_Location_Type, + Field_String_Id => Type_String_Id, + Field_String_Length => Type_Int32, + Field_Use_Flag => Type_Boolean, + Field_End_Has_Reserved_Id => Type_Boolean, + Field_End_Has_Identifier => Type_Boolean, + Field_End_Has_Postponed => Type_Boolean, + Field_Has_Begin => Type_Boolean, + Field_Has_Is => Type_Boolean, + Field_Has_Pure => Type_Boolean, + Field_Has_Body => Type_Boolean, + Field_Has_Identifier_List => Type_Boolean, + Field_Has_Mode => Type_Boolean, + Field_Is_Ref => Type_Boolean, + Field_Psl_Property => Type_PSL_Node, + Field_Psl_Declaration => Type_PSL_Node, + Field_Psl_Expression => Type_PSL_Node, + Field_Psl_Boolean => Type_PSL_Node, + Field_PSL_Clock => Type_PSL_Node, + Field_PSL_NFA => Type_PSL_NFA + ); + + function Get_Field_Type (F : Fields_Enum) return Types_Enum is + begin + return Fields_Type (F); + end Get_Field_Type; + + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + when Field_First_Design_Unit => + return "first_design_unit"; + when Field_Last_Design_Unit => + return "last_design_unit"; + when Field_Library_Declaration => + return "library_declaration"; + when Field_File_Time_Stamp => + return "file_time_stamp"; + when Field_Analysis_Time_Stamp => + return "analysis_time_stamp"; + when Field_Library => + return "library"; + when Field_File_Dependence_List => + return "file_dependence_list"; + when Field_Design_File_Filename => + return "design_file_filename"; + when Field_Design_File_Directory => + return "design_file_directory"; + when Field_Design_File => + return "design_file"; + when Field_Design_File_Chain => + return "design_file_chain"; + when Field_Library_Directory => + return "library_directory"; + when Field_Date => + return "date"; + when Field_Context_Items => + return "context_items"; + when Field_Dependence_List => + return "dependence_list"; + when Field_Analysis_Checks_List => + return "analysis_checks_list"; + when Field_Date_State => + return "date_state"; + when Field_Guarded_Target_State => + return "guarded_target_state"; + when Field_Library_Unit => + return "library_unit"; + when Field_Hash_Chain => + return "hash_chain"; + when Field_Design_Unit_Source_Pos => + return "design_unit_source_pos"; + when Field_Design_Unit_Source_Line => + return "design_unit_source_line"; + when Field_Design_Unit_Source_Col => + return "design_unit_source_col"; + when Field_Value => + return "value"; + when Field_Enum_Pos => + return "enum_pos"; + when Field_Physical_Literal => + return "physical_literal"; + when Field_Physical_Unit_Value => + return "physical_unit_value"; + when Field_Fp_Value => + return "fp_value"; + when Field_Enumeration_Decl => + return "enumeration_decl"; + when Field_Simple_Aggregate_List => + return "simple_aggregate_list"; + when Field_Bit_String_Base => + return "bit_string_base"; + when Field_Bit_String_0 => + return "bit_string_0"; + when Field_Bit_String_1 => + return "bit_string_1"; + when Field_Literal_Origin => + return "literal_origin"; + when Field_Range_Origin => + return "range_origin"; + when Field_Literal_Subtype => + return "literal_subtype"; + when Field_Entity_Class => + return "entity_class"; + when Field_Entity_Name_List => + return "entity_name_list"; + when Field_Attribute_Designator => + return "attribute_designator"; + when Field_Attribute_Specification_Chain => + return "attribute_specification_chain"; + when Field_Attribute_Specification => + return "attribute_specification"; + when Field_Signal_List => + return "signal_list"; + when Field_Designated_Entity => + return "designated_entity"; + when Field_Formal => + return "formal"; + when Field_Actual => + return "actual"; + when Field_In_Conversion => + return "in_conversion"; + when Field_Out_Conversion => + return "out_conversion"; + when Field_Whole_Association_Flag => + return "whole_association_flag"; + when Field_Collapse_Signal_Flag => + return "collapse_signal_flag"; + when Field_Artificial_Flag => + return "artificial_flag"; + when Field_Open_Flag => + return "open_flag"; + when Field_After_Drivers_Flag => + return "after_drivers_flag"; + when Field_We_Value => + return "we_value"; + when Field_Time => + return "time"; + when Field_Associated_Expr => + return "associated_expr"; + when Field_Associated_Chain => + return "associated_chain"; + when Field_Choice_Name => + return "choice_name"; + when Field_Choice_Expression => + return "choice_expression"; + when Field_Choice_Range => + return "choice_range"; + when Field_Same_Alternative_Flag => + return "same_alternative_flag"; + when Field_Architecture => + return "architecture"; + when Field_Block_Specification => + return "block_specification"; + when Field_Prev_Block_Configuration => + return "prev_block_configuration"; + when Field_Configuration_Item_Chain => + return "configuration_item_chain"; + when Field_Attribute_Value_Chain => + return "attribute_value_chain"; + when Field_Spec_Chain => + return "spec_chain"; + when Field_Attribute_Value_Spec_Chain => + return "attribute_value_spec_chain"; + when Field_Entity_Name => + return "entity_name"; + when Field_Package => + return "package"; + when Field_Package_Body => + return "package_body"; + when Field_Need_Body => + return "need_body"; + when Field_Block_Configuration => + return "block_configuration"; + when Field_Concurrent_Statement_Chain => + return "concurrent_statement_chain"; + when Field_Chain => + return "chain"; + when Field_Port_Chain => + return "port_chain"; + when Field_Generic_Chain => + return "generic_chain"; + when Field_Type => + return "type"; + when Field_Subtype_Indication => + return "subtype_indication"; + when Field_Discrete_Range => + return "discrete_range"; + when Field_Type_Definition => + return "type_definition"; + when Field_Subtype_Definition => + return "subtype_definition"; + when Field_Nature => + return "nature"; + when Field_Mode => + return "mode"; + when Field_Signal_Kind => + return "signal_kind"; + when Field_Base_Name => + return "base_name"; + when Field_Interface_Declaration_Chain => + return "interface_declaration_chain"; + when Field_Subprogram_Specification => + return "subprogram_specification"; + when Field_Sequential_Statement_Chain => + return "sequential_statement_chain"; + when Field_Subprogram_Body => + return "subprogram_body"; + when Field_Overload_Number => + return "overload_number"; + when Field_Subprogram_Depth => + return "subprogram_depth"; + when Field_Subprogram_Hash => + return "subprogram_hash"; + when Field_Impure_Depth => + return "impure_depth"; + when Field_Return_Type => + return "return_type"; + when Field_Implicit_Definition => + return "implicit_definition"; + when Field_Type_Reference => + return "type_reference"; + when Field_Default_Value => + return "default_value"; + when Field_Deferred_Declaration => + return "deferred_declaration"; + when Field_Deferred_Declaration_Flag => + return "deferred_declaration_flag"; + when Field_Shared_Flag => + return "shared_flag"; + when Field_Design_Unit => + return "design_unit"; + when Field_Block_Statement => + return "block_statement"; + when Field_Signal_Driver => + return "signal_driver"; + when Field_Declaration_Chain => + return "declaration_chain"; + when Field_File_Logical_Name => + return "file_logical_name"; + when Field_File_Open_Kind => + return "file_open_kind"; + when Field_Element_Position => + return "element_position"; + when Field_Element_Declaration => + return "element_declaration"; + when Field_Selected_Element => + return "selected_element"; + when Field_Use_Clause_Chain => + return "use_clause_chain"; + when Field_Selected_Name => + return "selected_name"; + when Field_Type_Declarator => + return "type_declarator"; + when Field_Enumeration_Literal_List => + return "enumeration_literal_list"; + when Field_Entity_Class_Entry_Chain => + return "entity_class_entry_chain"; + when Field_Group_Constituent_List => + return "group_constituent_list"; + when Field_Unit_Chain => + return "unit_chain"; + when Field_Primary_Unit => + return "primary_unit"; + when Field_Identifier => + return "identifier"; + when Field_Label => + return "label"; + when Field_Visible_Flag => + return "visible_flag"; + when Field_Range_Constraint => + return "range_constraint"; + when Field_Direction => + return "direction"; + when Field_Left_Limit => + return "left_limit"; + when Field_Right_Limit => + return "right_limit"; + when Field_Base_Type => + return "base_type"; + when Field_Resolution_Indication => + return "resolution_indication"; + when Field_Record_Element_Resolution_Chain => + return "record_element_resolution_chain"; + when Field_Tolerance => + return "tolerance"; + when Field_Plus_Terminal => + return "plus_terminal"; + when Field_Minus_Terminal => + return "minus_terminal"; + when Field_Simultaneous_Left => + return "simultaneous_left"; + when Field_Simultaneous_Right => + return "simultaneous_right"; + when Field_Text_File_Flag => + return "text_file_flag"; + when Field_Only_Characters_Flag => + return "only_characters_flag"; + when Field_Type_Staticness => + return "type_staticness"; + when Field_Constraint_State => + return "constraint_state"; + when Field_Index_Subtype_List => + return "index_subtype_list"; + when Field_Index_Subtype_Definition_List => + return "index_subtype_definition_list"; + when Field_Element_Subtype_Indication => + return "element_subtype_indication"; + when Field_Element_Subtype => + return "element_subtype"; + when Field_Index_Constraint_List => + return "index_constraint_list"; + when Field_Array_Element_Constraint => + return "array_element_constraint"; + when Field_Elements_Declaration_List => + return "elements_declaration_list"; + when Field_Designated_Type => + return "designated_type"; + when Field_Designated_Subtype_Indication => + return "designated_subtype_indication"; + when Field_Index_List => + return "index_list"; + when Field_Reference => + return "reference"; + when Field_Nature_Declarator => + return "nature_declarator"; + when Field_Across_Type => + return "across_type"; + when Field_Through_Type => + return "through_type"; + when Field_Target => + return "target"; + when Field_Waveform_Chain => + return "waveform_chain"; + when Field_Guard => + return "guard"; + when Field_Delay_Mechanism => + return "delay_mechanism"; + when Field_Reject_Time_Expression => + return "reject_time_expression"; + when Field_Sensitivity_List => + return "sensitivity_list"; + when Field_Process_Origin => + return "process_origin"; + when Field_Condition_Clause => + return "condition_clause"; + when Field_Timeout_Clause => + return "timeout_clause"; + when Field_Postponed_Flag => + return "postponed_flag"; + when Field_Callees_List => + return "callees_list"; + when Field_Passive_Flag => + return "passive_flag"; + when Field_Resolution_Function_Flag => + return "resolution_function_flag"; + when Field_Wait_State => + return "wait_state"; + when Field_All_Sensitized_State => + return "all_sensitized_state"; + when Field_Seen_Flag => + return "seen_flag"; + when Field_Pure_Flag => + return "pure_flag"; + when Field_Foreign_Flag => + return "foreign_flag"; + when Field_Resolved_Flag => + return "resolved_flag"; + when Field_Signal_Type_Flag => + return "signal_type_flag"; + when Field_Has_Signal_Flag => + return "has_signal_flag"; + when Field_Purity_State => + return "purity_state"; + when Field_Elab_Flag => + return "elab_flag"; + when Field_Index_Constraint_Flag => + return "index_constraint_flag"; + when Field_Assertion_Condition => + return "assertion_condition"; + when Field_Report_Expression => + return "report_expression"; + when Field_Severity_Expression => + return "severity_expression"; + when Field_Instantiated_Unit => + return "instantiated_unit"; + when Field_Generic_Map_Aspect_Chain => + return "generic_map_aspect_chain"; + when Field_Port_Map_Aspect_Chain => + return "port_map_aspect_chain"; + when Field_Configuration_Name => + return "configuration_name"; + when Field_Component_Configuration => + return "component_configuration"; + when Field_Configuration_Specification => + return "configuration_specification"; + when Field_Default_Binding_Indication => + return "default_binding_indication"; + when Field_Default_Configuration_Declaration => + return "default_configuration_declaration"; + when Field_Expression => + return "expression"; + when Field_Allocator_Designated_Type => + return "allocator_designated_type"; + when Field_Selected_Waveform_Chain => + return "selected_waveform_chain"; + when Field_Conditional_Waveform_Chain => + return "conditional_waveform_chain"; + when Field_Guard_Expression => + return "guard_expression"; + when Field_Guard_Decl => + return "guard_decl"; + when Field_Guard_Sensitivity_List => + return "guard_sensitivity_list"; + when Field_Block_Block_Configuration => + return "block_block_configuration"; + when Field_Package_Header => + return "package_header"; + when Field_Block_Header => + return "block_header"; + when Field_Uninstantiated_Name => + return "uninstantiated_name"; + when Field_Generate_Block_Configuration => + return "generate_block_configuration"; + when Field_Generation_Scheme => + return "generation_scheme"; + when Field_Condition => + return "condition"; + when Field_Else_Clause => + return "else_clause"; + when Field_Parameter_Specification => + return "parameter_specification"; + when Field_Parent => + return "parent"; + when Field_Loop_Label => + return "loop_label"; + when Field_Component_Name => + return "component_name"; + when Field_Instantiation_List => + return "instantiation_list"; + when Field_Entity_Aspect => + return "entity_aspect"; + when Field_Default_Entity_Aspect => + return "default_entity_aspect"; + when Field_Default_Generic_Map_Aspect_Chain => + return "default_generic_map_aspect_chain"; + when Field_Default_Port_Map_Aspect_Chain => + return "default_port_map_aspect_chain"; + when Field_Binding_Indication => + return "binding_indication"; + when Field_Named_Entity => + return "named_entity"; + when Field_Alias_Declaration => + return "alias_declaration"; + when Field_Expr_Staticness => + return "expr_staticness"; + when Field_Error_Origin => + return "error_origin"; + when Field_Operand => + return "operand"; + when Field_Left => + return "left"; + when Field_Right => + return "right"; + when Field_Unit_Name => + return "unit_name"; + when Field_Name => + return "name"; + when Field_Group_Template_Name => + return "group_template_name"; + when Field_Name_Staticness => + return "name_staticness"; + when Field_Prefix => + return "prefix"; + when Field_Signature_Prefix => + return "signature_prefix"; + when Field_Slice_Subtype => + return "slice_subtype"; + when Field_Suffix => + return "suffix"; + when Field_Index_Subtype => + return "index_subtype"; + when Field_Parameter => + return "parameter"; + when Field_Actual_Type => + return "actual_type"; + when Field_Association_Chain => + return "association_chain"; + when Field_Individual_Association_Chain => + return "individual_association_chain"; + when Field_Aggregate_Info => + return "aggregate_info"; + when Field_Sub_Aggregate_Info => + return "sub_aggregate_info"; + when Field_Aggr_Dynamic_Flag => + return "aggr_dynamic_flag"; + when Field_Aggr_Min_Length => + return "aggr_min_length"; + when Field_Aggr_Low_Limit => + return "aggr_low_limit"; + when Field_Aggr_High_Limit => + return "aggr_high_limit"; + when Field_Aggr_Others_Flag => + return "aggr_others_flag"; + when Field_Aggr_Named_Flag => + return "aggr_named_flag"; + when Field_Value_Staticness => + return "value_staticness"; + when Field_Association_Choices_Chain => + return "association_choices_chain"; + when Field_Case_Statement_Alternative_Chain => + return "case_statement_alternative_chain"; + when Field_Choice_Staticness => + return "choice_staticness"; + when Field_Procedure_Call => + return "procedure_call"; + when Field_Implementation => + return "implementation"; + when Field_Parameter_Association_Chain => + return "parameter_association_chain"; + when Field_Method_Object => + return "method_object"; + when Field_Subtype_Type_Mark => + return "subtype_type_mark"; + when Field_Type_Conversion_Subtype => + return "type_conversion_subtype"; + when Field_Type_Mark => + return "type_mark"; + when Field_File_Type_Mark => + return "file_type_mark"; + when Field_Return_Type_Mark => + return "return_type_mark"; + when Field_Lexical_Layout => + return "lexical_layout"; + when Field_Incomplete_Type_List => + return "incomplete_type_list"; + when Field_Has_Disconnect_Flag => + return "has_disconnect_flag"; + when Field_Has_Active_Flag => + return "has_active_flag"; + when Field_Is_Within_Flag => + return "is_within_flag"; + when Field_Type_Marks_List => + return "type_marks_list"; + when Field_Implicit_Alias_Flag => + return "implicit_alias_flag"; + when Field_Alias_Signature => + return "alias_signature"; + when Field_Attribute_Signature => + return "attribute_signature"; + when Field_Overload_List => + return "overload_list"; + when Field_Simple_Name_Identifier => + return "simple_name_identifier"; + when Field_Simple_Name_Subtype => + return "simple_name_subtype"; + when Field_Protected_Type_Body => + return "protected_type_body"; + when Field_Protected_Type_Declaration => + return "protected_type_declaration"; + when Field_End_Location => + return "end_location"; + when Field_String_Id => + return "string_id"; + when Field_String_Length => + return "string_length"; + when Field_Use_Flag => + return "use_flag"; + when Field_End_Has_Reserved_Id => + return "end_has_reserved_id"; + when Field_End_Has_Identifier => + return "end_has_identifier"; + when Field_End_Has_Postponed => + return "end_has_postponed"; + when Field_Has_Begin => + return "has_begin"; + when Field_Has_Is => + return "has_is"; + when Field_Has_Pure => + return "has_pure"; + when Field_Has_Body => + return "has_body"; + when Field_Has_Identifier_List => + return "has_identifier_list"; + when Field_Has_Mode => + return "has_mode"; + when Field_Is_Ref => + return "is_ref"; + when Field_Psl_Property => + return "psl_property"; + when Field_Psl_Declaration => + return "psl_declaration"; + when Field_Psl_Expression => + return "psl_expression"; + when Field_Psl_Boolean => + return "psl_boolean"; + when Field_PSL_Clock => + return "psl_clock"; + when Field_PSL_NFA => + return "psl_nfa"; + end case; + end Get_Field_Image; + + function Get_Iir_Image (K : Iir_Kind) return String is + begin + case K is + when Iir_Kind_Unused => + return "unused"; + when Iir_Kind_Error => + return "error"; + when Iir_Kind_Design_File => + return "design_file"; + when Iir_Kind_Design_Unit => + return "design_unit"; + when Iir_Kind_Library_Clause => + return "library_clause"; + when Iir_Kind_Use_Clause => + return "use_clause"; + when Iir_Kind_Integer_Literal => + return "integer_literal"; + when Iir_Kind_Floating_Point_Literal => + return "floating_point_literal"; + when Iir_Kind_Null_Literal => + return "null_literal"; + when Iir_Kind_String_Literal => + return "string_literal"; + when Iir_Kind_Physical_Int_Literal => + return "physical_int_literal"; + when Iir_Kind_Physical_Fp_Literal => + return "physical_fp_literal"; + when Iir_Kind_Bit_String_Literal => + return "bit_string_literal"; + when Iir_Kind_Simple_Aggregate => + return "simple_aggregate"; + when Iir_Kind_Overflow_Literal => + return "overflow_literal"; + when Iir_Kind_Waveform_Element => + return "waveform_element"; + when Iir_Kind_Conditional_Waveform => + return "conditional_waveform"; + when Iir_Kind_Association_Element_By_Expression => + return "association_element_by_expression"; + when Iir_Kind_Association_Element_By_Individual => + return "association_element_by_individual"; + when Iir_Kind_Association_Element_Open => + return "association_element_open"; + when Iir_Kind_Choice_By_Others => + return "choice_by_others"; + when Iir_Kind_Choice_By_Expression => + return "choice_by_expression"; + when Iir_Kind_Choice_By_Range => + return "choice_by_range"; + when Iir_Kind_Choice_By_None => + return "choice_by_none"; + when Iir_Kind_Choice_By_Name => + return "choice_by_name"; + when Iir_Kind_Entity_Aspect_Entity => + return "entity_aspect_entity"; + when Iir_Kind_Entity_Aspect_Configuration => + return "entity_aspect_configuration"; + when Iir_Kind_Entity_Aspect_Open => + return "entity_aspect_open"; + when Iir_Kind_Block_Configuration => + return "block_configuration"; + when Iir_Kind_Block_Header => + return "block_header"; + when Iir_Kind_Component_Configuration => + return "component_configuration"; + when Iir_Kind_Binding_Indication => + return "binding_indication"; + when Iir_Kind_Entity_Class => + return "entity_class"; + when Iir_Kind_Attribute_Value => + return "attribute_value"; + when Iir_Kind_Signature => + return "signature"; + when Iir_Kind_Aggregate_Info => + return "aggregate_info"; + when Iir_Kind_Procedure_Call => + return "procedure_call"; + when Iir_Kind_Record_Element_Constraint => + return "record_element_constraint"; + when Iir_Kind_Array_Element_Resolution => + return "array_element_resolution"; + when Iir_Kind_Record_Resolution => + return "record_resolution"; + when Iir_Kind_Record_Element_Resolution => + return "record_element_resolution"; + when Iir_Kind_Attribute_Specification => + return "attribute_specification"; + when Iir_Kind_Disconnection_Specification => + return "disconnection_specification"; + when Iir_Kind_Configuration_Specification => + return "configuration_specification"; + when Iir_Kind_Access_Type_Definition => + return "access_type_definition"; + when Iir_Kind_Incomplete_Type_Definition => + return "incomplete_type_definition"; + when Iir_Kind_File_Type_Definition => + return "file_type_definition"; + when Iir_Kind_Protected_Type_Declaration => + return "protected_type_declaration"; + when Iir_Kind_Record_Type_Definition => + return "record_type_definition"; + when Iir_Kind_Array_Type_Definition => + return "array_type_definition"; + when Iir_Kind_Array_Subtype_Definition => + return "array_subtype_definition"; + when Iir_Kind_Record_Subtype_Definition => + return "record_subtype_definition"; + when Iir_Kind_Access_Subtype_Definition => + return "access_subtype_definition"; + when Iir_Kind_Physical_Subtype_Definition => + return "physical_subtype_definition"; + when Iir_Kind_Floating_Subtype_Definition => + return "floating_subtype_definition"; + when Iir_Kind_Integer_Subtype_Definition => + return "integer_subtype_definition"; + when Iir_Kind_Enumeration_Subtype_Definition => + return "enumeration_subtype_definition"; + when Iir_Kind_Enumeration_Type_Definition => + return "enumeration_type_definition"; + when Iir_Kind_Integer_Type_Definition => + return "integer_type_definition"; + when Iir_Kind_Floating_Type_Definition => + return "floating_type_definition"; + when Iir_Kind_Physical_Type_Definition => + return "physical_type_definition"; + when Iir_Kind_Range_Expression => + return "range_expression"; + when Iir_Kind_Protected_Type_Body => + return "protected_type_body"; + when Iir_Kind_Subtype_Definition => + return "subtype_definition"; + when Iir_Kind_Scalar_Nature_Definition => + return "scalar_nature_definition"; + when Iir_Kind_Overload_List => + return "overload_list"; + when Iir_Kind_Type_Declaration => + return "type_declaration"; + when Iir_Kind_Anonymous_Type_Declaration => + return "anonymous_type_declaration"; + when Iir_Kind_Subtype_Declaration => + return "subtype_declaration"; + when Iir_Kind_Nature_Declaration => + return "nature_declaration"; + when Iir_Kind_Subnature_Declaration => + return "subnature_declaration"; + when Iir_Kind_Package_Declaration => + return "package_declaration"; + when Iir_Kind_Package_Instantiation_Declaration => + return "package_instantiation_declaration"; + when Iir_Kind_Package_Body => + return "package_body"; + when Iir_Kind_Configuration_Declaration => + return "configuration_declaration"; + when Iir_Kind_Entity_Declaration => + return "entity_declaration"; + when Iir_Kind_Architecture_Body => + return "architecture_body"; + when Iir_Kind_Package_Header => + return "package_header"; + when Iir_Kind_Unit_Declaration => + return "unit_declaration"; + when Iir_Kind_Library_Declaration => + return "library_declaration"; + when Iir_Kind_Component_Declaration => + return "component_declaration"; + when Iir_Kind_Attribute_Declaration => + return "attribute_declaration"; + when Iir_Kind_Group_Template_Declaration => + return "group_template_declaration"; + when Iir_Kind_Group_Declaration => + return "group_declaration"; + when Iir_Kind_Element_Declaration => + return "element_declaration"; + when Iir_Kind_Non_Object_Alias_Declaration => + return "non_object_alias_declaration"; + when Iir_Kind_Psl_Declaration => + return "psl_declaration"; + when Iir_Kind_Terminal_Declaration => + return "terminal_declaration"; + when Iir_Kind_Free_Quantity_Declaration => + return "free_quantity_declaration"; + when Iir_Kind_Across_Quantity_Declaration => + return "across_quantity_declaration"; + when Iir_Kind_Through_Quantity_Declaration => + return "through_quantity_declaration"; + when Iir_Kind_Enumeration_Literal => + return "enumeration_literal"; + when Iir_Kind_Function_Declaration => + return "function_declaration"; + when Iir_Kind_Implicit_Function_Declaration => + return "implicit_function_declaration"; + when Iir_Kind_Implicit_Procedure_Declaration => + return "implicit_procedure_declaration"; + when Iir_Kind_Procedure_Declaration => + return "procedure_declaration"; + when Iir_Kind_Function_Body => + return "function_body"; + when Iir_Kind_Procedure_Body => + return "procedure_body"; + when Iir_Kind_Object_Alias_Declaration => + return "object_alias_declaration"; + when Iir_Kind_File_Declaration => + return "file_declaration"; + when Iir_Kind_Guard_Signal_Declaration => + return "guard_signal_declaration"; + when Iir_Kind_Signal_Declaration => + return "signal_declaration"; + when Iir_Kind_Variable_Declaration => + return "variable_declaration"; + when Iir_Kind_Constant_Declaration => + return "constant_declaration"; + when Iir_Kind_Iterator_Declaration => + return "iterator_declaration"; + when Iir_Kind_Constant_Interface_Declaration => + return "constant_interface_declaration"; + when Iir_Kind_Variable_Interface_Declaration => + return "variable_interface_declaration"; + when Iir_Kind_Signal_Interface_Declaration => + return "signal_interface_declaration"; + when Iir_Kind_File_Interface_Declaration => + return "file_interface_declaration"; + when Iir_Kind_Identity_Operator => + return "identity_operator"; + when Iir_Kind_Negation_Operator => + return "negation_operator"; + when Iir_Kind_Absolute_Operator => + return "absolute_operator"; + when Iir_Kind_Not_Operator => + return "not_operator"; + when Iir_Kind_Condition_Operator => + return "condition_operator"; + when Iir_Kind_Reduction_And_Operator => + return "reduction_and_operator"; + when Iir_Kind_Reduction_Or_Operator => + return "reduction_or_operator"; + when Iir_Kind_Reduction_Nand_Operator => + return "reduction_nand_operator"; + when Iir_Kind_Reduction_Nor_Operator => + return "reduction_nor_operator"; + when Iir_Kind_Reduction_Xor_Operator => + return "reduction_xor_operator"; + when Iir_Kind_Reduction_Xnor_Operator => + return "reduction_xnor_operator"; + when Iir_Kind_And_Operator => + return "and_operator"; + when Iir_Kind_Or_Operator => + return "or_operator"; + when Iir_Kind_Nand_Operator => + return "nand_operator"; + when Iir_Kind_Nor_Operator => + return "nor_operator"; + when Iir_Kind_Xor_Operator => + return "xor_operator"; + when Iir_Kind_Xnor_Operator => + return "xnor_operator"; + when Iir_Kind_Equality_Operator => + return "equality_operator"; + when Iir_Kind_Inequality_Operator => + return "inequality_operator"; + when Iir_Kind_Less_Than_Operator => + return "less_than_operator"; + when Iir_Kind_Less_Than_Or_Equal_Operator => + return "less_than_or_equal_operator"; + when Iir_Kind_Greater_Than_Operator => + return "greater_than_operator"; + when Iir_Kind_Greater_Than_Or_Equal_Operator => + return "greater_than_or_equal_operator"; + when Iir_Kind_Match_Equality_Operator => + return "match_equality_operator"; + when Iir_Kind_Match_Inequality_Operator => + return "match_inequality_operator"; + when Iir_Kind_Match_Less_Than_Operator => + return "match_less_than_operator"; + when Iir_Kind_Match_Less_Than_Or_Equal_Operator => + return "match_less_than_or_equal_operator"; + when Iir_Kind_Match_Greater_Than_Operator => + return "match_greater_than_operator"; + when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => + return "match_greater_than_or_equal_operator"; + when Iir_Kind_Sll_Operator => + return "sll_operator"; + when Iir_Kind_Sla_Operator => + return "sla_operator"; + when Iir_Kind_Srl_Operator => + return "srl_operator"; + when Iir_Kind_Sra_Operator => + return "sra_operator"; + when Iir_Kind_Rol_Operator => + return "rol_operator"; + when Iir_Kind_Ror_Operator => + return "ror_operator"; + when Iir_Kind_Addition_Operator => + return "addition_operator"; + when Iir_Kind_Substraction_Operator => + return "substraction_operator"; + when Iir_Kind_Concatenation_Operator => + return "concatenation_operator"; + when Iir_Kind_Multiplication_Operator => + return "multiplication_operator"; + when Iir_Kind_Division_Operator => + return "division_operator"; + when Iir_Kind_Modulus_Operator => + return "modulus_operator"; + when Iir_Kind_Remainder_Operator => + return "remainder_operator"; + when Iir_Kind_Exponentiation_Operator => + return "exponentiation_operator"; + when Iir_Kind_Function_Call => + return "function_call"; + when Iir_Kind_Aggregate => + return "aggregate"; + when Iir_Kind_Parenthesis_Expression => + return "parenthesis_expression"; + when Iir_Kind_Qualified_Expression => + return "qualified_expression"; + when Iir_Kind_Type_Conversion => + return "type_conversion"; + when Iir_Kind_Allocator_By_Expression => + return "allocator_by_expression"; + when Iir_Kind_Allocator_By_Subtype => + return "allocator_by_subtype"; + when Iir_Kind_Selected_Element => + return "selected_element"; + when Iir_Kind_Dereference => + return "dereference"; + when Iir_Kind_Implicit_Dereference => + return "implicit_dereference"; + when Iir_Kind_Slice_Name => + return "slice_name"; + when Iir_Kind_Indexed_Name => + return "indexed_name"; + when Iir_Kind_Psl_Expression => + return "psl_expression"; + when Iir_Kind_Sensitized_Process_Statement => + return "sensitized_process_statement"; + when Iir_Kind_Process_Statement => + return "process_statement"; + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + return "concurrent_conditional_signal_assignment"; + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + return "concurrent_selected_signal_assignment"; + when Iir_Kind_Concurrent_Assertion_Statement => + return "concurrent_assertion_statement"; + when Iir_Kind_Psl_Default_Clock => + return "psl_default_clock"; + when Iir_Kind_Psl_Assert_Statement => + return "psl_assert_statement"; + when Iir_Kind_Psl_Cover_Statement => + return "psl_cover_statement"; + when Iir_Kind_Concurrent_Procedure_Call_Statement => + return "concurrent_procedure_call_statement"; + when Iir_Kind_Block_Statement => + return "block_statement"; + when Iir_Kind_Generate_Statement => + return "generate_statement"; + when Iir_Kind_Component_Instantiation_Statement => + return "component_instantiation_statement"; + when Iir_Kind_Simple_Simultaneous_Statement => + return "simple_simultaneous_statement"; + when Iir_Kind_Signal_Assignment_Statement => + return "signal_assignment_statement"; + when Iir_Kind_Null_Statement => + return "null_statement"; + when Iir_Kind_Assertion_Statement => + return "assertion_statement"; + when Iir_Kind_Report_Statement => + return "report_statement"; + when Iir_Kind_Wait_Statement => + return "wait_statement"; + when Iir_Kind_Variable_Assignment_Statement => + return "variable_assignment_statement"; + when Iir_Kind_Return_Statement => + return "return_statement"; + when Iir_Kind_For_Loop_Statement => + return "for_loop_statement"; + when Iir_Kind_While_Loop_Statement => + return "while_loop_statement"; + when Iir_Kind_Next_Statement => + return "next_statement"; + when Iir_Kind_Exit_Statement => + return "exit_statement"; + when Iir_Kind_Case_Statement => + return "case_statement"; + when Iir_Kind_Procedure_Call_Statement => + return "procedure_call_statement"; + when Iir_Kind_If_Statement => + return "if_statement"; + when Iir_Kind_Elsif => + return "elsif"; + when Iir_Kind_Character_Literal => + return "character_literal"; + when Iir_Kind_Simple_Name => + return "simple_name"; + when Iir_Kind_Selected_Name => + return "selected_name"; + when Iir_Kind_Operator_Symbol => + return "operator_symbol"; + when Iir_Kind_Selected_By_All_Name => + return "selected_by_all_name"; + when Iir_Kind_Parenthesis_Name => + return "parenthesis_name"; + when Iir_Kind_Base_Attribute => + return "base_attribute"; + when Iir_Kind_Left_Type_Attribute => + return "left_type_attribute"; + when Iir_Kind_Right_Type_Attribute => + return "right_type_attribute"; + when Iir_Kind_High_Type_Attribute => + return "high_type_attribute"; + when Iir_Kind_Low_Type_Attribute => + return "low_type_attribute"; + when Iir_Kind_Ascending_Type_Attribute => + return "ascending_type_attribute"; + when Iir_Kind_Image_Attribute => + return "image_attribute"; + when Iir_Kind_Value_Attribute => + return "value_attribute"; + when Iir_Kind_Pos_Attribute => + return "pos_attribute"; + when Iir_Kind_Val_Attribute => + return "val_attribute"; + when Iir_Kind_Succ_Attribute => + return "succ_attribute"; + when Iir_Kind_Pred_Attribute => + return "pred_attribute"; + when Iir_Kind_Leftof_Attribute => + return "leftof_attribute"; + when Iir_Kind_Rightof_Attribute => + return "rightof_attribute"; + when Iir_Kind_Delayed_Attribute => + return "delayed_attribute"; + when Iir_Kind_Stable_Attribute => + return "stable_attribute"; + when Iir_Kind_Quiet_Attribute => + return "quiet_attribute"; + when Iir_Kind_Transaction_Attribute => + return "transaction_attribute"; + when Iir_Kind_Event_Attribute => + return "event_attribute"; + when Iir_Kind_Active_Attribute => + return "active_attribute"; + when Iir_Kind_Last_Event_Attribute => + return "last_event_attribute"; + when Iir_Kind_Last_Active_Attribute => + return "last_active_attribute"; + when Iir_Kind_Last_Value_Attribute => + return "last_value_attribute"; + when Iir_Kind_Driving_Attribute => + return "driving_attribute"; + when Iir_Kind_Driving_Value_Attribute => + return "driving_value_attribute"; + when Iir_Kind_Behavior_Attribute => + return "behavior_attribute"; + when Iir_Kind_Structure_Attribute => + return "structure_attribute"; + when Iir_Kind_Simple_Name_Attribute => + return "simple_name_attribute"; + when Iir_Kind_Instance_Name_Attribute => + return "instance_name_attribute"; + when Iir_Kind_Path_Name_Attribute => + return "path_name_attribute"; + when Iir_Kind_Left_Array_Attribute => + return "left_array_attribute"; + when Iir_Kind_Right_Array_Attribute => + return "right_array_attribute"; + when Iir_Kind_High_Array_Attribute => + return "high_array_attribute"; + when Iir_Kind_Low_Array_Attribute => + return "low_array_attribute"; + when Iir_Kind_Length_Array_Attribute => + return "length_array_attribute"; + when Iir_Kind_Ascending_Array_Attribute => + return "ascending_array_attribute"; + when Iir_Kind_Range_Array_Attribute => + return "range_array_attribute"; + when Iir_Kind_Reverse_Range_Array_Attribute => + return "reverse_range_array_attribute"; + when Iir_Kind_Attribute_Name => + return "attribute_name"; + end case; + end Get_Iir_Image; + + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is + begin + case F is + when Field_First_Design_Unit => + return Attr_Chain; + when Field_Last_Design_Unit => + return Attr_Ref; + when Field_Library_Declaration => + return Attr_None; + when Field_File_Time_Stamp => + return Attr_None; + when Field_Analysis_Time_Stamp => + return Attr_None; + when Field_Library => + return Attr_Ref; + when Field_File_Dependence_List => + return Attr_None; + when Field_Design_File_Filename => + return Attr_None; + when Field_Design_File_Directory => + return Attr_None; + when Field_Design_File => + return Attr_Ref; + when Field_Design_File_Chain => + return Attr_Chain; + when Field_Library_Directory => + return Attr_None; + when Field_Date => + return Attr_None; + when Field_Context_Items => + return Attr_Chain; + when Field_Dependence_List => + return Attr_Of_Ref; + when Field_Analysis_Checks_List => + return Attr_None; + when Field_Date_State => + return Attr_None; + when Field_Guarded_Target_State => + return Attr_None; + when Field_Library_Unit => + return Attr_None; + when Field_Hash_Chain => + return Attr_Ref; + when Field_Design_Unit_Source_Pos => + return Attr_None; + when Field_Design_Unit_Source_Line => + return Attr_None; + when Field_Design_Unit_Source_Col => + return Attr_None; + when Field_Value => + return Attr_None; + when Field_Enum_Pos => + return Attr_None; + when Field_Physical_Literal => + return Attr_None; + when Field_Physical_Unit_Value => + return Attr_None; + when Field_Fp_Value => + return Attr_None; + when Field_Enumeration_Decl => + return Attr_Ref; + when Field_Simple_Aggregate_List => + return Attr_None; + when Field_Bit_String_Base => + return Attr_None; + when Field_Bit_String_0 => + return Attr_None; + when Field_Bit_String_1 => + return Attr_None; + when Field_Literal_Origin => + return Attr_None; + when Field_Range_Origin => + return Attr_None; + when Field_Literal_Subtype => + return Attr_None; + when Field_Entity_Class => + return Attr_None; + when Field_Entity_Name_List => + return Attr_None; + when Field_Attribute_Designator => + return Attr_None; + when Field_Attribute_Specification_Chain => + return Attr_None; + when Field_Attribute_Specification => + return Attr_Ref; + when Field_Signal_List => + return Attr_None; + when Field_Designated_Entity => + return Attr_Ref; + when Field_Formal => + return Attr_None; + when Field_Actual => + return Attr_None; + when Field_In_Conversion => + return Attr_None; + when Field_Out_Conversion => + return Attr_None; + when Field_Whole_Association_Flag => + return Attr_None; + when Field_Collapse_Signal_Flag => + return Attr_None; + when Field_Artificial_Flag => + return Attr_None; + when Field_Open_Flag => + return Attr_None; + when Field_After_Drivers_Flag => + return Attr_None; + when Field_We_Value => + return Attr_None; + when Field_Time => + return Attr_None; + when Field_Associated_Expr => + return Attr_None; + when Field_Associated_Chain => + return Attr_Chain; + when Field_Choice_Name => + return Attr_None; + when Field_Choice_Expression => + return Attr_None; + when Field_Choice_Range => + return Attr_None; + when Field_Same_Alternative_Flag => + return Attr_None; + when Field_Architecture => + return Attr_None; + when Field_Block_Specification => + return Attr_None; + when Field_Prev_Block_Configuration => + return Attr_Ref; + when Field_Configuration_Item_Chain => + return Attr_Chain; + when Field_Attribute_Value_Chain => + return Attr_Chain; + when Field_Spec_Chain => + return Attr_None; + when Field_Attribute_Value_Spec_Chain => + return Attr_None; + when Field_Entity_Name => + return Attr_None; + when Field_Package => + return Attr_Ref; + when Field_Package_Body => + return Attr_Ref; + when Field_Need_Body => + return Attr_None; + when Field_Block_Configuration => + return Attr_None; + when Field_Concurrent_Statement_Chain => + return Attr_Chain; + when Field_Chain => + return Attr_Chain_Next; + when Field_Port_Chain => + return Attr_Chain; + when Field_Generic_Chain => + return Attr_Chain; + when Field_Type => + return Attr_Ref; + when Field_Subtype_Indication => + return Attr_Maybe_Ref; + when Field_Discrete_Range => + return Attr_None; + when Field_Type_Definition => + return Attr_None; + when Field_Subtype_Definition => + return Attr_None; + when Field_Nature => + return Attr_None; + when Field_Mode => + return Attr_None; + when Field_Signal_Kind => + return Attr_None; + when Field_Base_Name => + return Attr_Ref; + when Field_Interface_Declaration_Chain => + return Attr_Chain; + when Field_Subprogram_Specification => + return Attr_Ref; + when Field_Sequential_Statement_Chain => + return Attr_Chain; + when Field_Subprogram_Body => + return Attr_Ref; + when Field_Overload_Number => + return Attr_None; + when Field_Subprogram_Depth => + return Attr_None; + when Field_Subprogram_Hash => + return Attr_None; + when Field_Impure_Depth => + return Attr_None; + when Field_Return_Type => + return Attr_Ref; + when Field_Implicit_Definition => + return Attr_None; + when Field_Type_Reference => + return Attr_Ref; + when Field_Default_Value => + return Attr_Maybe_Ref; + when Field_Deferred_Declaration => + return Attr_None; + when Field_Deferred_Declaration_Flag => + return Attr_None; + when Field_Shared_Flag => + return Attr_None; + when Field_Design_Unit => + return Attr_None; + when Field_Block_Statement => + return Attr_None; + when Field_Signal_Driver => + return Attr_None; + when Field_Declaration_Chain => + return Attr_Chain; + when Field_File_Logical_Name => + return Attr_None; + when Field_File_Open_Kind => + return Attr_None; + when Field_Element_Position => + return Attr_None; + when Field_Element_Declaration => + return Attr_None; + when Field_Selected_Element => + return Attr_Ref; + when Field_Use_Clause_Chain => + return Attr_None; + when Field_Selected_Name => + return Attr_None; + when Field_Type_Declarator => + return Attr_Ref; + when Field_Enumeration_Literal_List => + return Attr_None; + when Field_Entity_Class_Entry_Chain => + return Attr_Chain; + when Field_Group_Constituent_List => + return Attr_None; + when Field_Unit_Chain => + return Attr_Chain; + when Field_Primary_Unit => + return Attr_Ref; + when Field_Identifier => + return Attr_None; + when Field_Label => + return Attr_None; + when Field_Visible_Flag => + return Attr_None; + when Field_Range_Constraint => + return Attr_None; + when Field_Direction => + return Attr_None; + when Field_Left_Limit => + return Attr_None; + when Field_Right_Limit => + return Attr_None; + when Field_Base_Type => + return Attr_Ref; + when Field_Resolution_Indication => + return Attr_None; + when Field_Record_Element_Resolution_Chain => + return Attr_Chain; + when Field_Tolerance => + return Attr_None; + when Field_Plus_Terminal => + return Attr_None; + when Field_Minus_Terminal => + return Attr_None; + when Field_Simultaneous_Left => + return Attr_None; + when Field_Simultaneous_Right => + return Attr_None; + when Field_Text_File_Flag => + return Attr_None; + when Field_Only_Characters_Flag => + return Attr_None; + when Field_Type_Staticness => + return Attr_None; + when Field_Constraint_State => + return Attr_None; + when Field_Index_Subtype_List => + return Attr_Ref; + when Field_Index_Subtype_Definition_List => + return Attr_None; + when Field_Element_Subtype_Indication => + return Attr_None; + when Field_Element_Subtype => + return Attr_Ref; + when Field_Index_Constraint_List => + return Attr_None; + when Field_Array_Element_Constraint => + return Attr_None; + when Field_Elements_Declaration_List => + return Attr_None; + when Field_Designated_Type => + return Attr_Ref; + when Field_Designated_Subtype_Indication => + return Attr_None; + when Field_Index_List => + return Attr_None; + when Field_Reference => + return Attr_None; + when Field_Nature_Declarator => + return Attr_None; + when Field_Across_Type => + return Attr_None; + when Field_Through_Type => + return Attr_None; + when Field_Target => + return Attr_None; + when Field_Waveform_Chain => + return Attr_Chain; + when Field_Guard => + return Attr_None; + when Field_Delay_Mechanism => + return Attr_None; + when Field_Reject_Time_Expression => + return Attr_None; + when Field_Sensitivity_List => + return Attr_None; + when Field_Process_Origin => + return Attr_None; + when Field_Condition_Clause => + return Attr_None; + when Field_Timeout_Clause => + return Attr_None; + when Field_Postponed_Flag => + return Attr_None; + when Field_Callees_List => + return Attr_None; + when Field_Passive_Flag => + return Attr_None; + when Field_Resolution_Function_Flag => + return Attr_None; + when Field_Wait_State => + return Attr_None; + when Field_All_Sensitized_State => + return Attr_None; + when Field_Seen_Flag => + return Attr_None; + when Field_Pure_Flag => + return Attr_None; + when Field_Foreign_Flag => + return Attr_None; + when Field_Resolved_Flag => + return Attr_None; + when Field_Signal_Type_Flag => + return Attr_None; + when Field_Has_Signal_Flag => + return Attr_None; + when Field_Purity_State => + return Attr_None; + when Field_Elab_Flag => + return Attr_None; + when Field_Index_Constraint_Flag => + return Attr_None; + when Field_Assertion_Condition => + return Attr_None; + when Field_Report_Expression => + return Attr_None; + when Field_Severity_Expression => + return Attr_None; + when Field_Instantiated_Unit => + return Attr_None; + when Field_Generic_Map_Aspect_Chain => + return Attr_Chain; + when Field_Port_Map_Aspect_Chain => + return Attr_Chain; + when Field_Configuration_Name => + return Attr_None; + when Field_Component_Configuration => + return Attr_None; + when Field_Configuration_Specification => + return Attr_None; + when Field_Default_Binding_Indication => + return Attr_None; + when Field_Default_Configuration_Declaration => + return Attr_None; + when Field_Expression => + return Attr_None; + when Field_Allocator_Designated_Type => + return Attr_Ref; + when Field_Selected_Waveform_Chain => + return Attr_Chain; + when Field_Conditional_Waveform_Chain => + return Attr_Chain; + when Field_Guard_Expression => + return Attr_None; + when Field_Guard_Decl => + return Attr_None; + when Field_Guard_Sensitivity_List => + return Attr_None; + when Field_Block_Block_Configuration => + return Attr_None; + when Field_Package_Header => + return Attr_None; + when Field_Block_Header => + return Attr_None; + when Field_Uninstantiated_Name => + return Attr_None; + when Field_Generate_Block_Configuration => + return Attr_None; + when Field_Generation_Scheme => + return Attr_None; + when Field_Condition => + return Attr_None; + when Field_Else_Clause => + return Attr_None; + when Field_Parameter_Specification => + return Attr_None; + when Field_Parent => + return Attr_Ref; + when Field_Loop_Label => + return Attr_None; + when Field_Component_Name => + return Attr_None; + when Field_Instantiation_List => + return Attr_None; + when Field_Entity_Aspect => + return Attr_None; + when Field_Default_Entity_Aspect => + return Attr_None; + when Field_Default_Generic_Map_Aspect_Chain => + return Attr_Chain; + when Field_Default_Port_Map_Aspect_Chain => + return Attr_Chain; + when Field_Binding_Indication => + return Attr_None; + when Field_Named_Entity => + return Attr_Ref; + when Field_Alias_Declaration => + return Attr_None; + when Field_Expr_Staticness => + return Attr_None; + when Field_Error_Origin => + return Attr_None; + when Field_Operand => + return Attr_None; + when Field_Left => + return Attr_None; + when Field_Right => + return Attr_None; + when Field_Unit_Name => + return Attr_None; + when Field_Name => + return Attr_None; + when Field_Group_Template_Name => + return Attr_None; + when Field_Name_Staticness => + return Attr_None; + when Field_Prefix => + return Attr_None; + when Field_Signature_Prefix => + return Attr_Ref; + when Field_Slice_Subtype => + return Attr_None; + when Field_Suffix => + return Attr_None; + when Field_Index_Subtype => + return Attr_None; + when Field_Parameter => + return Attr_None; + when Field_Actual_Type => + return Attr_None; + when Field_Association_Chain => + return Attr_Chain; + when Field_Individual_Association_Chain => + return Attr_Chain; + when Field_Aggregate_Info => + return Attr_None; + when Field_Sub_Aggregate_Info => + return Attr_None; + when Field_Aggr_Dynamic_Flag => + return Attr_None; + when Field_Aggr_Min_Length => + return Attr_None; + when Field_Aggr_Low_Limit => + return Attr_None; + when Field_Aggr_High_Limit => + return Attr_None; + when Field_Aggr_Others_Flag => + return Attr_None; + when Field_Aggr_Named_Flag => + return Attr_None; + when Field_Value_Staticness => + return Attr_None; + when Field_Association_Choices_Chain => + return Attr_Chain; + when Field_Case_Statement_Alternative_Chain => + return Attr_Chain; + when Field_Choice_Staticness => + return Attr_None; + when Field_Procedure_Call => + return Attr_None; + when Field_Implementation => + return Attr_Ref; + when Field_Parameter_Association_Chain => + return Attr_Chain; + when Field_Method_Object => + return Attr_None; + when Field_Subtype_Type_Mark => + return Attr_None; + when Field_Type_Conversion_Subtype => + return Attr_None; + when Field_Type_Mark => + return Attr_None; + when Field_File_Type_Mark => + return Attr_None; + when Field_Return_Type_Mark => + return Attr_None; + when Field_Lexical_Layout => + return Attr_None; + when Field_Incomplete_Type_List => + return Attr_None; + when Field_Has_Disconnect_Flag => + return Attr_None; + when Field_Has_Active_Flag => + return Attr_None; + when Field_Is_Within_Flag => + return Attr_None; + when Field_Type_Marks_List => + return Attr_None; + when Field_Implicit_Alias_Flag => + return Attr_None; + when Field_Alias_Signature => + return Attr_None; + when Field_Attribute_Signature => + return Attr_None; + when Field_Overload_List => + return Attr_Of_Ref; + when Field_Simple_Name_Identifier => + return Attr_None; + when Field_Simple_Name_Subtype => + return Attr_None; + when Field_Protected_Type_Body => + return Attr_None; + when Field_Protected_Type_Declaration => + return Attr_None; + when Field_End_Location => + return Attr_None; + when Field_String_Id => + return Attr_None; + when Field_String_Length => + return Attr_None; + when Field_Use_Flag => + return Attr_None; + when Field_End_Has_Reserved_Id => + return Attr_None; + when Field_End_Has_Identifier => + return Attr_None; + when Field_End_Has_Postponed => + return Attr_None; + when Field_Has_Begin => + return Attr_None; + when Field_Has_Is => + return Attr_None; + when Field_Has_Pure => + return Attr_None; + when Field_Has_Body => + return Attr_None; + when Field_Has_Identifier_List => + return Attr_None; + when Field_Has_Mode => + return Attr_None; + when Field_Is_Ref => + return Attr_None; + when Field_Psl_Property => + return Attr_None; + when Field_Psl_Declaration => + return Attr_None; + when Field_Psl_Expression => + return Attr_None; + when Field_Psl_Boolean => + return Attr_None; + when Field_PSL_Clock => + return Attr_None; + when Field_PSL_NFA => + return Attr_None; + end case; + end Get_Field_Attribute; + + Fields_Of_Iir : constant Fields_Array := + ( + -- Iir_Kind_Unused + -- Iir_Kind_Error + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Expr_Staticness, + Field_Error_Origin, + Field_Type, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Design_File + Field_Design_File_Directory, + Field_Design_File_Filename, + Field_Analysis_Time_Stamp, + Field_File_Time_Stamp, + Field_Elab_Flag, + Field_File_Dependence_List, + Field_Chain, + Field_First_Design_Unit, + Field_Library, + Field_Last_Design_Unit, + -- Iir_Kind_Design_Unit + Field_Date, + Field_Design_Unit_Source_Line, + Field_Design_Unit_Source_Col, + Field_Identifier, + Field_Design_Unit_Source_Pos, + Field_End_Location, + Field_Elab_Flag, + Field_Date_State, + Field_Context_Items, + Field_Chain, + Field_Library_Unit, + Field_Analysis_Checks_List, + Field_Design_File, + Field_Hash_Chain, + Field_Dependence_List, + -- Iir_Kind_Library_Clause + Field_Identifier, + Field_Has_Identifier_List, + Field_Library_Declaration, + Field_Chain, + Field_Parent, + -- Iir_Kind_Use_Clause + Field_Selected_Name, + Field_Chain, + Field_Use_Clause_Chain, + Field_Parent, + -- Iir_Kind_Integer_Literal + Field_Value, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Type, + -- Iir_Kind_Floating_Point_Literal + Field_Fp_Value, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Type, + -- Iir_Kind_Null_Literal + Field_Expr_Staticness, + Field_Type, + -- Iir_Kind_String_Literal + Field_String_Id, + Field_String_Length, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Literal_Subtype, + Field_Type, + -- Iir_Kind_Physical_Int_Literal + Field_Value, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Unit_Name, + Field_Type, + -- Iir_Kind_Physical_Fp_Literal + Field_Fp_Value, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Unit_Name, + Field_Type, + -- Iir_Kind_Bit_String_Literal + Field_String_Id, + Field_String_Length, + Field_Bit_String_Base, + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Literal_Subtype, + Field_Bit_String_0, + Field_Bit_String_1, + Field_Type, + -- Iir_Kind_Simple_Aggregate + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Simple_Aggregate_List, + Field_Literal_Subtype, + Field_Type, + -- Iir_Kind_Overflow_Literal + Field_Expr_Staticness, + Field_Literal_Origin, + Field_Type, + -- Iir_Kind_Waveform_Element + Field_We_Value, + Field_Chain, + Field_Time, + -- Iir_Kind_Conditional_Waveform + Field_Condition, + Field_Chain, + Field_Waveform_Chain, + -- Iir_Kind_Association_Element_By_Expression + Field_Whole_Association_Flag, + Field_Collapse_Signal_Flag, + Field_Formal, + Field_Chain, + Field_Actual, + Field_In_Conversion, + Field_Out_Conversion, + -- Iir_Kind_Association_Element_By_Individual + Field_Whole_Association_Flag, + Field_Collapse_Signal_Flag, + Field_Formal, + Field_Chain, + Field_Actual_Type, + Field_Individual_Association_Chain, + -- Iir_Kind_Association_Element_Open + Field_Whole_Association_Flag, + Field_Collapse_Signal_Flag, + Field_Artificial_Flag, + Field_Formal, + Field_Chain, + -- Iir_Kind_Choice_By_Others + Field_Same_Alternative_Flag, + Field_Chain, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Parent, + -- Iir_Kind_Choice_By_Expression + Field_Same_Alternative_Flag, + Field_Choice_Staticness, + Field_Chain, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Choice_Expression, + Field_Parent, + -- Iir_Kind_Choice_By_Range + Field_Same_Alternative_Flag, + Field_Choice_Staticness, + Field_Chain, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Choice_Range, + Field_Parent, + -- Iir_Kind_Choice_By_None + Field_Same_Alternative_Flag, + Field_Chain, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Parent, + -- Iir_Kind_Choice_By_Name + Field_Same_Alternative_Flag, + Field_Chain, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Choice_Name, + Field_Parent, + -- Iir_Kind_Entity_Aspect_Entity + Field_Entity_Name, + Field_Architecture, + -- Iir_Kind_Entity_Aspect_Configuration + Field_Configuration_Name, + -- Iir_Kind_Entity_Aspect_Open + -- Iir_Kind_Block_Configuration + Field_Declaration_Chain, + Field_Chain, + Field_Configuration_Item_Chain, + Field_Block_Specification, + Field_Parent, + Field_Prev_Block_Configuration, + -- Iir_Kind_Block_Header + Field_Generic_Chain, + Field_Port_Chain, + Field_Generic_Map_Aspect_Chain, + Field_Port_Map_Aspect_Chain, + -- Iir_Kind_Component_Configuration + Field_Instantiation_List, + Field_Chain, + Field_Binding_Indication, + Field_Component_Name, + Field_Block_Configuration, + Field_Parent, + -- Iir_Kind_Binding_Indication + Field_Default_Entity_Aspect, + Field_Entity_Aspect, + Field_Default_Generic_Map_Aspect_Chain, + Field_Default_Port_Map_Aspect_Chain, + Field_Generic_Map_Aspect_Chain, + Field_Port_Map_Aspect_Chain, + -- Iir_Kind_Entity_Class + Field_Entity_Class, + Field_Chain, + -- Iir_Kind_Attribute_Value + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Spec_Chain, + Field_Chain, + Field_Type, + Field_Designated_Entity, + Field_Attribute_Specification, + Field_Base_Name, + -- Iir_Kind_Signature + Field_Type_Marks_List, + Field_Return_Type_Mark, + Field_Signature_Prefix, + -- Iir_Kind_Aggregate_Info + Field_Aggr_Min_Length, + Field_Aggr_Others_Flag, + Field_Aggr_Dynamic_Flag, + Field_Aggr_Named_Flag, + Field_Sub_Aggregate_Info, + Field_Aggr_Low_Limit, + Field_Aggr_High_Limit, + -- Iir_Kind_Procedure_Call + Field_Prefix, + Field_Parameter_Association_Chain, + Field_Method_Object, + Field_Implementation, + -- Iir_Kind_Record_Element_Constraint + Field_Identifier, + Field_Element_Position, + Field_Visible_Flag, + Field_Element_Declaration, + Field_Parent, + Field_Type, + -- Iir_Kind_Array_Element_Resolution + Field_Resolution_Indication, + -- Iir_Kind_Record_Resolution + Field_Record_Element_Resolution_Chain, + -- Iir_Kind_Record_Element_Resolution + Field_Identifier, + Field_Chain, + Field_Resolution_Indication, + -- Iir_Kind_Attribute_Specification + Field_Entity_Class, + Field_Entity_Name_List, + Field_Chain, + Field_Attribute_Value_Spec_Chain, + Field_Expression, + Field_Attribute_Designator, + Field_Attribute_Specification_Chain, + Field_Parent, + -- Iir_Kind_Disconnection_Specification + Field_Chain, + Field_Signal_List, + Field_Type_Mark, + Field_Expression, + Field_Parent, + -- Iir_Kind_Configuration_Specification + Field_Instantiation_List, + Field_Chain, + Field_Binding_Indication, + Field_Component_Name, + Field_Parent, + -- Iir_Kind_Access_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Type_Staticness, + Field_Designated_Subtype_Indication, + Field_Designated_Type, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Incomplete_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Incomplete_Type_List, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_File_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Text_File_Flag, + Field_Type_Staticness, + Field_File_Type_Mark, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Protected_Type_Declaration + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Type_Staticness, + Field_Declaration_Chain, + Field_Protected_Type_Body, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Record_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Type_Staticness, + Field_Constraint_State, + Field_Elements_Declaration_List, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Array_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Index_Constraint_Flag, + Field_Type_Staticness, + Field_Constraint_State, + Field_Element_Subtype_Indication, + Field_Index_Subtype_Definition_List, + Field_Element_Subtype, + Field_Type_Declarator, + Field_Base_Type, + Field_Index_Subtype_List, + -- Iir_Kind_Array_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Index_Constraint_Flag, + Field_Type_Staticness, + Field_Constraint_State, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Index_Constraint_List, + Field_Tolerance, + Field_Array_Element_Constraint, + Field_Element_Subtype, + Field_Type_Declarator, + Field_Base_Type, + Field_Index_Subtype_List, + -- Iir_Kind_Record_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Constraint_State, + Field_Elements_Declaration_List, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Tolerance, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Access_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Type_Staticness, + Field_Subtype_Type_Mark, + Field_Designated_Subtype_Indication, + Field_Designated_Type, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Physical_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Range_Constraint, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Floating_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Range_Constraint, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Tolerance, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Integer_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Range_Constraint, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Enumeration_Subtype_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Range_Constraint, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Enumeration_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Only_Characters_Flag, + Field_Type_Staticness, + Field_Range_Constraint, + Field_Enumeration_Literal_List, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Integer_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Floating_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Type_Staticness, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Physical_Type_Definition + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Type_Staticness, + Field_Unit_Chain, + Field_Type_Declarator, + Field_Base_Type, + -- Iir_Kind_Range_Expression + Field_Expr_Staticness, + Field_Direction, + Field_Left_Limit, + Field_Right_Limit, + Field_Range_Origin, + Field_Type, + -- Iir_Kind_Protected_Type_Body + Field_Identifier, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Chain, + Field_Protected_Type_Declaration, + Field_Parent, + -- Iir_Kind_Subtype_Definition + Field_Range_Constraint, + Field_Subtype_Type_Mark, + Field_Resolution_Indication, + Field_Tolerance, + -- Iir_Kind_Scalar_Nature_Definition + Field_Reference, + Field_Nature_Declarator, + Field_Across_Type, + Field_Through_Type, + -- Iir_Kind_Overload_List + Field_Overload_List, + -- Iir_Kind_Type_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Type_Definition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_Anonymous_Type_Declaration + Field_Identifier, + Field_Type_Definition, + Field_Chain, + Field_Subtype_Definition, + Field_Parent, + -- Iir_Kind_Subtype_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_Nature_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Nature, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_Subnature_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Nature, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_Package_Declaration + Field_Identifier, + Field_Need_Body, + Field_Visible_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Attribute_Value_Chain, + Field_Package_Header, + Field_Parent, + Field_Package_Body, + -- Iir_Kind_Package_Instantiation_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Attribute_Value_Chain, + Field_Uninstantiated_Name, + Field_Generic_Chain, + Field_Generic_Map_Aspect_Chain, + Field_Parent, + Field_Package_Body, + -- Iir_Kind_Package_Body + Field_Identifier, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Parent, + Field_Package, + -- Iir_Kind_Configuration_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Entity_Name, + Field_Attribute_Value_Chain, + Field_Block_Configuration, + Field_Parent, + -- Iir_Kind_Entity_Declaration + Field_Identifier, + Field_Has_Begin, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Attribute_Value_Chain, + Field_Concurrent_Statement_Chain, + Field_Generic_Chain, + Field_Port_Chain, + Field_Parent, + -- Iir_Kind_Architecture_Body + Field_Identifier, + Field_Foreign_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Entity_Name, + Field_Attribute_Value_Chain, + Field_Concurrent_Statement_Chain, + Field_Default_Configuration_Declaration, + Field_Parent, + -- Iir_Kind_Package_Header + Field_Generic_Chain, + Field_Generic_Map_Aspect_Chain, + -- Iir_Kind_Unit_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Physical_Literal, + Field_Physical_Unit_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Library_Declaration + Field_Date, + Field_Library_Directory, + Field_Identifier, + Field_Visible_Flag, + Field_Design_File_Chain, + Field_Chain, + -- Iir_Kind_Component_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Has_Is, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Generic_Chain, + Field_Port_Chain, + Field_Parent, + -- Iir_Kind_Attribute_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Chain, + Field_Type_Mark, + Field_Parent, + Field_Type, + -- Iir_Kind_Group_Template_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Entity_Class_Entry_Chain, + Field_Chain, + Field_Parent, + -- Iir_Kind_Group_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Group_Constituent_List, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Group_Template_Name, + Field_Parent, + -- Iir_Kind_Element_Declaration + Field_Identifier, + Field_Element_Position, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_Is_Ref, + Field_Subtype_Indication, + Field_Type, + -- Iir_Kind_Non_Object_Alias_Declaration + Field_Identifier, + Field_Implicit_Alias_Flag, + Field_Visible_Flag, + Field_Use_Flag, + Field_Chain, + Field_Name, + Field_Alias_Signature, + Field_Parent, + -- Iir_Kind_Psl_Declaration + Field_Psl_Declaration, + Field_Identifier, + Field_PSL_Clock, + Field_PSL_NFA, + Field_Visible_Flag, + Field_Use_Flag, + Field_Chain, + Field_Parent, + -- Iir_Kind_Terminal_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Nature, + Field_Chain, + Field_Parent, + -- Iir_Kind_Free_Quantity_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Across_Quantity_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Tolerance, + Field_Plus_Terminal, + Field_Minus_Terminal, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Through_Quantity_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_Use_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Tolerance, + Field_Plus_Terminal, + Field_Minus_Terminal, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Enumeration_Literal + Field_Enum_Pos, + Field_Subprogram_Hash, + Field_Identifier, + Field_Seen_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Literal_Origin, + Field_Attribute_Value_Chain, + Field_Parent, + Field_Type, + Field_Enumeration_Decl, + -- Iir_Kind_Function_Declaration + Field_Subprogram_Depth, + Field_Subprogram_Hash, + Field_Overload_Number, + Field_Identifier, + Field_Seen_Flag, + Field_Pure_Flag, + Field_Foreign_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Use_Flag, + Field_Resolution_Function_Flag, + Field_Has_Pure, + Field_Has_Body, + Field_Wait_State, + Field_All_Sensitized_State, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Interface_Declaration_Chain, + Field_Generic_Chain, + Field_Callees_List, + Field_Return_Type_Mark, + Field_Parent, + Field_Return_Type, + Field_Subprogram_Body, + -- Iir_Kind_Implicit_Function_Declaration + Field_Subprogram_Hash, + Field_Overload_Number, + Field_Identifier, + Field_Implicit_Definition, + Field_Seen_Flag, + Field_Pure_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Use_Flag, + Field_Wait_State, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Interface_Declaration_Chain, + Field_Generic_Chain, + Field_Callees_List, + Field_Generic_Map_Aspect_Chain, + Field_Parent, + Field_Return_Type, + Field_Type_Reference, + -- Iir_Kind_Implicit_Procedure_Declaration + Field_Subprogram_Hash, + Field_Overload_Number, + Field_Identifier, + Field_Implicit_Definition, + Field_Seen_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Use_Flag, + Field_Wait_State, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Interface_Declaration_Chain, + Field_Generic_Chain, + Field_Callees_List, + Field_Generic_Map_Aspect_Chain, + Field_Parent, + Field_Type_Reference, + -- Iir_Kind_Procedure_Declaration + Field_Subprogram_Depth, + Field_Subprogram_Hash, + Field_Overload_Number, + Field_Identifier, + Field_Seen_Flag, + Field_Passive_Flag, + Field_Foreign_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Use_Flag, + Field_Has_Body, + Field_Wait_State, + Field_Purity_State, + Field_All_Sensitized_State, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Interface_Declaration_Chain, + Field_Generic_Chain, + Field_Callees_List, + Field_Return_Type_Mark, + Field_Parent, + Field_Subprogram_Body, + -- Iir_Kind_Function_Body + Field_Impure_Depth, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Chain, + Field_Sequential_Statement_Chain, + Field_Parent, + Field_Subprogram_Specification, + -- Iir_Kind_Procedure_Body + Field_Impure_Depth, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Chain, + Field_Sequential_Statement_Chain, + Field_Parent, + Field_Subprogram_Specification, + -- Iir_Kind_Object_Alias_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Name, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_File_Declaration + Field_Identifier, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Has_Mode, + Field_Mode, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_File_Logical_Name, + Field_File_Open_Kind, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_Guard_Signal_Declaration + Field_Identifier, + Field_Has_Active_Flag, + Field_Visible_Flag, + Field_Use_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Signal_Kind, + Field_Guard_Expression, + Field_Attribute_Value_Chain, + Field_Guard_Sensitivity_List, + Field_Block_Statement, + Field_Parent, + Field_Type, + -- Iir_Kind_Signal_Declaration + Field_Identifier, + Field_Has_Disconnect_Flag, + Field_Has_Active_Flag, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Signal_Kind, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Signal_Driver, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Variable_Declaration + Field_Identifier, + Field_Shared_Flag, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Constant_Declaration + Field_Identifier, + Field_Deferred_Declaration_Flag, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Deferred_Declaration, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Iterator_Declaration + Field_Identifier, + Field_Has_Identifier_List, + Field_Visible_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Discrete_Range, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_Constant_Interface_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Mode, + Field_Lexical_Layout, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Variable_Interface_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Mode, + Field_Lexical_Layout, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Signal_Interface_Declaration + Field_Identifier, + Field_Has_Disconnect_Flag, + Field_Has_Active_Flag, + Field_Open_Flag, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Mode, + Field_Lexical_Layout, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Signal_Kind, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_File_Interface_Declaration + Field_Identifier, + Field_Visible_Flag, + Field_After_Drivers_Flag, + Field_Use_Flag, + Field_Is_Ref, + Field_Mode, + Field_Lexical_Layout, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Subtype_Indication, + Field_Default_Value, + Field_Parent, + Field_Type, + -- Iir_Kind_Identity_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Negation_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Absolute_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Not_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Condition_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_And_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_Or_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_Nand_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_Nor_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_Xor_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_Reduction_Xnor_Operator + Field_Expr_Staticness, + Field_Operand, + Field_Type, + Field_Implementation, + -- Iir_Kind_And_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Or_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Nand_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Nor_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Xor_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Xnor_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Equality_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Inequality_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Less_Than_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Less_Than_Or_Equal_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Greater_Than_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Greater_Than_Or_Equal_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Equality_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Inequality_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Less_Than_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Less_Than_Or_Equal_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Greater_Than_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Match_Greater_Than_Or_Equal_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Sll_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Sla_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Srl_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Sra_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Rol_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Ror_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Addition_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Substraction_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Concatenation_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Multiplication_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Division_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Modulus_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Remainder_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Exponentiation_Operator + Field_Expr_Staticness, + Field_Left, + Field_Right, + Field_Type, + Field_Implementation, + -- Iir_Kind_Function_Call + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter_Association_Chain, + Field_Method_Object, + Field_Type, + Field_Implementation, + Field_Base_Name, + -- Iir_Kind_Aggregate + Field_Expr_Staticness, + Field_Value_Staticness, + Field_Aggregate_Info, + Field_Association_Choices_Chain, + Field_Literal_Subtype, + Field_Type, + -- Iir_Kind_Parenthesis_Expression + Field_Expr_Staticness, + Field_Expression, + Field_Type, + -- Iir_Kind_Qualified_Expression + Field_Expr_Staticness, + Field_Type_Mark, + Field_Expression, + Field_Type, + -- Iir_Kind_Type_Conversion + Field_Expr_Staticness, + Field_Type_Conversion_Subtype, + Field_Type_Mark, + Field_Expression, + Field_Type, + -- Iir_Kind_Allocator_By_Expression + Field_Expr_Staticness, + Field_Expression, + Field_Type, + Field_Allocator_Designated_Type, + -- Iir_Kind_Allocator_By_Subtype + Field_Expr_Staticness, + Field_Subtype_Indication, + Field_Type, + Field_Allocator_Designated_Type, + -- Iir_Kind_Selected_Element + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Selected_Element, + Field_Base_Name, + -- Iir_Kind_Dereference + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Implicit_Dereference + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Slice_Name + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Suffix, + Field_Slice_Subtype, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Indexed_Name + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_List, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Psl_Expression + Field_Psl_Expression, + Field_Type, + -- Iir_Kind_Sensitized_Process_Statement + Field_Label, + Field_Seen_Flag, + Field_End_Has_Postponed, + Field_Passive_Flag, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Has_Is, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Wait_State, + Field_Declaration_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Sequential_Statement_Chain, + Field_Sensitivity_List, + Field_Callees_List, + Field_Process_Origin, + Field_Parent, + -- Iir_Kind_Process_Statement + Field_Label, + Field_Seen_Flag, + Field_End_Has_Postponed, + Field_Passive_Flag, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_Has_Is, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Wait_State, + Field_Declaration_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Sequential_Statement_Chain, + Field_Callees_List, + Field_Process_Origin, + Field_Parent, + -- Iir_Kind_Concurrent_Conditional_Signal_Assignment + Field_Delay_Mechanism, + Field_Label, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Guarded_Target_State, + Field_Target, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Reject_Time_Expression, + Field_Conditional_Waveform_Chain, + Field_Guard, + Field_Parent, + -- Iir_Kind_Concurrent_Selected_Signal_Assignment + Field_Delay_Mechanism, + Field_Label, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Guarded_Target_State, + Field_Target, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Expression, + Field_Reject_Time_Expression, + Field_Selected_Waveform_Chain, + Field_Guard, + Field_Parent, + -- Iir_Kind_Concurrent_Assertion_Statement + Field_Label, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Assertion_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Severity_Expression, + Field_Report_Expression, + Field_Parent, + -- Iir_Kind_Psl_Default_Clock + Field_Psl_Boolean, + Field_Label, + Field_Chain, + Field_Parent, + -- Iir_Kind_Psl_Assert_Statement + Field_Psl_Property, + Field_Label, + Field_PSL_Clock, + Field_PSL_NFA, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Severity_Expression, + Field_Report_Expression, + Field_Parent, + -- Iir_Kind_Psl_Cover_Statement + Field_Psl_Property, + Field_Label, + Field_PSL_Clock, + Field_PSL_NFA, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Severity_Expression, + Field_Report_Expression, + Field_Parent, + -- Iir_Kind_Concurrent_Procedure_Call_Statement + Field_Label, + Field_Postponed_Flag, + Field_Visible_Flag, + Field_Procedure_Call, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_Block_Statement + Field_Label, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Concurrent_Statement_Chain, + Field_Block_Block_Configuration, + Field_Block_Header, + Field_Guard_Decl, + Field_Parent, + -- Iir_Kind_Generate_Statement + Field_Label, + Field_Has_Begin, + Field_Visible_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_Declaration_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Concurrent_Statement_Chain, + Field_Generation_Scheme, + Field_Generate_Block_Configuration, + Field_Parent, + -- Iir_Kind_Component_Instantiation_Statement + Field_Label, + Field_Visible_Flag, + Field_Instantiated_Unit, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Default_Binding_Indication, + Field_Component_Configuration, + Field_Configuration_Specification, + Field_Generic_Map_Aspect_Chain, + Field_Port_Map_Aspect_Chain, + Field_Parent, + -- Iir_Kind_Simple_Simultaneous_Statement + Field_Label, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Simultaneous_Left, + Field_Simultaneous_Right, + Field_Tolerance, + Field_Parent, + -- Iir_Kind_Signal_Assignment_Statement + Field_Delay_Mechanism, + Field_Label, + Field_Visible_Flag, + Field_Guarded_Target_State, + Field_Target, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Waveform_Chain, + Field_Reject_Time_Expression, + Field_Parent, + -- Iir_Kind_Null_Statement + Field_Label, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_Assertion_Statement + Field_Label, + Field_Visible_Flag, + Field_Assertion_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Severity_Expression, + Field_Report_Expression, + Field_Parent, + -- Iir_Kind_Report_Statement + Field_Label, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Severity_Expression, + Field_Report_Expression, + Field_Parent, + -- Iir_Kind_Wait_Statement + Field_Label, + Field_Visible_Flag, + Field_Timeout_Clause, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Condition_Clause, + Field_Sensitivity_List, + Field_Parent, + -- Iir_Kind_Variable_Assignment_Statement + Field_Label, + Field_Visible_Flag, + Field_Target, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Expression, + Field_Parent, + -- Iir_Kind_Return_Statement + Field_Label, + Field_Visible_Flag, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Expression, + Field_Parent, + Field_Type, + -- Iir_Kind_For_Loop_Statement + Field_Label, + Field_Visible_Flag, + Field_Is_Within_Flag, + Field_End_Has_Identifier, + Field_Parameter_Specification, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Sequential_Statement_Chain, + Field_Parent, + -- Iir_Kind_While_Loop_Statement + Field_Label, + Field_Visible_Flag, + Field_End_Has_Identifier, + Field_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Sequential_Statement_Chain, + Field_Parent, + -- Iir_Kind_Next_Statement + Field_Label, + Field_Visible_Flag, + Field_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Loop_Label, + Field_Parent, + -- Iir_Kind_Exit_Statement + Field_Label, + Field_Visible_Flag, + Field_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Loop_Label, + Field_Parent, + -- Iir_Kind_Case_Statement + Field_Label, + Field_Visible_Flag, + Field_End_Has_Identifier, + Field_Case_Statement_Alternative_Chain, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Expression, + Field_Parent, + -- Iir_Kind_Procedure_Call_Statement + Field_Label, + Field_Visible_Flag, + Field_Procedure_Call, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Parent, + -- Iir_Kind_If_Statement + Field_Label, + Field_Visible_Flag, + Field_End_Has_Identifier, + Field_Condition, + Field_Chain, + Field_Attribute_Value_Chain, + Field_Sequential_Statement_Chain, + Field_Else_Clause, + Field_Parent, + -- Iir_Kind_Elsif + Field_End_Has_Identifier, + Field_Condition, + Field_Sequential_Statement_Chain, + Field_Else_Clause, + Field_Parent, + -- Iir_Kind_Character_Literal + Field_Identifier, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Alias_Declaration, + Field_Type, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Simple_Name + Field_Identifier, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Alias_Declaration, + Field_Type, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Selected_Name + Field_Identifier, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Alias_Declaration, + Field_Type, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Operator_Symbol + Field_Identifier, + Field_Alias_Declaration, + Field_Type, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Selected_By_All_Name + Field_Expr_Staticness, + Field_Prefix, + Field_Type, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Parenthesis_Name + Field_Prefix, + Field_Association_Chain, + Field_Type, + Field_Named_Entity, + -- Iir_Kind_Base_Attribute + Field_Prefix, + Field_Type, + -- Iir_Kind_Left_Type_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Right_Type_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_High_Type_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Low_Type_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Ascending_Type_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Image_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Value_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Pos_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Val_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Succ_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Pred_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Leftof_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Rightof_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Delayed_Attribute + Field_Has_Active_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Chain, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Stable_Attribute + Field_Has_Active_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Chain, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Quiet_Attribute + Field_Has_Active_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Chain, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Transaction_Attribute + Field_Has_Active_Flag, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Chain, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Event_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Active_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Last_Event_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Last_Active_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Last_Value_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Driving_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Driving_Value_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + -- Iir_Kind_Behavior_Attribute + -- Iir_Kind_Structure_Attribute + -- Iir_Kind_Simple_Name_Attribute + Field_Simple_Name_Identifier, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Simple_Name_Subtype, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Instance_Name_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Path_Name_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Left_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Right_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_High_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Low_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Length_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Ascending_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Range_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Reverse_Range_Array_Attribute + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Index_Subtype, + Field_Parameter, + Field_Type, + Field_Base_Name, + -- Iir_Kind_Attribute_Name + Field_Identifier, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Prefix, + Field_Attribute_Signature, + Field_Type, + Field_Named_Entity, + Field_Base_Name + ); + + Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer := + ( + Iir_Kind_Unused => -1, + Iir_Kind_Error => 7, + Iir_Kind_Design_File => 17, + Iir_Kind_Design_Unit => 32, + Iir_Kind_Library_Clause => 37, + Iir_Kind_Use_Clause => 41, + Iir_Kind_Integer_Literal => 45, + Iir_Kind_Floating_Point_Literal => 49, + Iir_Kind_Null_Literal => 51, + Iir_Kind_String_Literal => 57, + Iir_Kind_Physical_Int_Literal => 62, + Iir_Kind_Physical_Fp_Literal => 67, + Iir_Kind_Bit_String_Literal => 76, + Iir_Kind_Simple_Aggregate => 81, + Iir_Kind_Overflow_Literal => 84, + Iir_Kind_Waveform_Element => 87, + Iir_Kind_Conditional_Waveform => 90, + Iir_Kind_Association_Element_By_Expression => 97, + Iir_Kind_Association_Element_By_Individual => 103, + Iir_Kind_Association_Element_Open => 108, + Iir_Kind_Choice_By_Others => 113, + Iir_Kind_Choice_By_Expression => 120, + Iir_Kind_Choice_By_Range => 127, + Iir_Kind_Choice_By_None => 132, + Iir_Kind_Choice_By_Name => 138, + Iir_Kind_Entity_Aspect_Entity => 140, + Iir_Kind_Entity_Aspect_Configuration => 141, + Iir_Kind_Entity_Aspect_Open => 141, + Iir_Kind_Block_Configuration => 147, + Iir_Kind_Block_Header => 151, + Iir_Kind_Component_Configuration => 157, + Iir_Kind_Binding_Indication => 163, + Iir_Kind_Entity_Class => 165, + Iir_Kind_Attribute_Value => 173, + Iir_Kind_Signature => 176, + Iir_Kind_Aggregate_Info => 183, + Iir_Kind_Procedure_Call => 187, + Iir_Kind_Record_Element_Constraint => 193, + Iir_Kind_Array_Element_Resolution => 194, + Iir_Kind_Record_Resolution => 195, + Iir_Kind_Record_Element_Resolution => 198, + Iir_Kind_Attribute_Specification => 206, + Iir_Kind_Disconnection_Specification => 211, + Iir_Kind_Configuration_Specification => 216, + Iir_Kind_Access_Type_Definition => 223, + Iir_Kind_Incomplete_Type_Definition => 230, + Iir_Kind_File_Type_Definition => 237, + Iir_Kind_Protected_Type_Declaration => 246, + Iir_Kind_Record_Type_Definition => 256, + Iir_Kind_Array_Type_Definition => 268, + Iir_Kind_Array_Subtype_Definition => 283, + Iir_Kind_Record_Subtype_Definition => 294, + Iir_Kind_Access_Subtype_Definition => 302, + Iir_Kind_Physical_Subtype_Definition => 311, + Iir_Kind_Floating_Subtype_Definition => 321, + Iir_Kind_Integer_Subtype_Definition => 330, + Iir_Kind_Enumeration_Subtype_Definition => 339, + Iir_Kind_Enumeration_Type_Definition => 348, + Iir_Kind_Integer_Type_Definition => 354, + Iir_Kind_Floating_Type_Definition => 360, + Iir_Kind_Physical_Type_Definition => 369, + Iir_Kind_Range_Expression => 375, + Iir_Kind_Protected_Type_Body => 382, + Iir_Kind_Subtype_Definition => 386, + Iir_Kind_Scalar_Nature_Definition => 390, + Iir_Kind_Overload_List => 391, + Iir_Kind_Type_Declaration => 398, + Iir_Kind_Anonymous_Type_Declaration => 403, + Iir_Kind_Subtype_Declaration => 412, + Iir_Kind_Nature_Declaration => 419, + Iir_Kind_Subnature_Declaration => 426, + Iir_Kind_Package_Declaration => 436, + Iir_Kind_Package_Instantiation_Declaration => 447, + Iir_Kind_Package_Body => 453, + Iir_Kind_Configuration_Declaration => 462, + Iir_Kind_Entity_Declaration => 474, + Iir_Kind_Architecture_Body => 486, + Iir_Kind_Package_Header => 488, + Iir_Kind_Unit_Declaration => 498, + Iir_Kind_Library_Declaration => 504, + Iir_Kind_Component_Declaration => 515, + Iir_Kind_Attribute_Declaration => 522, + Iir_Kind_Group_Template_Declaration => 528, + Iir_Kind_Group_Declaration => 536, + Iir_Kind_Element_Declaration => 543, + Iir_Kind_Non_Object_Alias_Declaration => 551, + Iir_Kind_Psl_Declaration => 559, + Iir_Kind_Terminal_Declaration => 565, + Iir_Kind_Free_Quantity_Declaration => 575, + Iir_Kind_Across_Quantity_Declaration => 588, + Iir_Kind_Through_Quantity_Declaration => 601, + Iir_Kind_Enumeration_Literal => 614, + Iir_Kind_Function_Declaration => 638, + Iir_Kind_Implicit_Function_Declaration => 657, + Iir_Kind_Implicit_Procedure_Declaration => 674, + Iir_Kind_Procedure_Declaration => 696, + Iir_Kind_Function_Body => 704, + Iir_Kind_Procedure_Body => 712, + Iir_Kind_Object_Alias_Declaration => 724, + Iir_Kind_File_Declaration => 740, + Iir_Kind_Guard_Signal_Declaration => 753, + Iir_Kind_Signal_Declaration => 771, + Iir_Kind_Variable_Declaration => 785, + Iir_Kind_Constant_Declaration => 800, + Iir_Kind_Iterator_Declaration => 813, + Iir_Kind_Constant_Interface_Declaration => 828, + Iir_Kind_Variable_Interface_Declaration => 843, + Iir_Kind_Signal_Interface_Declaration => 862, + Iir_Kind_File_Interface_Declaration => 877, + Iir_Kind_Identity_Operator => 881, + Iir_Kind_Negation_Operator => 885, + Iir_Kind_Absolute_Operator => 889, + Iir_Kind_Not_Operator => 893, + Iir_Kind_Condition_Operator => 897, + Iir_Kind_Reduction_And_Operator => 901, + Iir_Kind_Reduction_Or_Operator => 905, + Iir_Kind_Reduction_Nand_Operator => 909, + Iir_Kind_Reduction_Nor_Operator => 913, + Iir_Kind_Reduction_Xor_Operator => 917, + Iir_Kind_Reduction_Xnor_Operator => 921, + Iir_Kind_And_Operator => 926, + Iir_Kind_Or_Operator => 931, + Iir_Kind_Nand_Operator => 936, + Iir_Kind_Nor_Operator => 941, + Iir_Kind_Xor_Operator => 946, + Iir_Kind_Xnor_Operator => 951, + Iir_Kind_Equality_Operator => 956, + Iir_Kind_Inequality_Operator => 961, + Iir_Kind_Less_Than_Operator => 966, + Iir_Kind_Less_Than_Or_Equal_Operator => 971, + Iir_Kind_Greater_Than_Operator => 976, + Iir_Kind_Greater_Than_Or_Equal_Operator => 981, + Iir_Kind_Match_Equality_Operator => 986, + Iir_Kind_Match_Inequality_Operator => 991, + Iir_Kind_Match_Less_Than_Operator => 996, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1001, + Iir_Kind_Match_Greater_Than_Operator => 1006, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1011, + Iir_Kind_Sll_Operator => 1016, + Iir_Kind_Sla_Operator => 1021, + Iir_Kind_Srl_Operator => 1026, + Iir_Kind_Sra_Operator => 1031, + Iir_Kind_Rol_Operator => 1036, + Iir_Kind_Ror_Operator => 1041, + Iir_Kind_Addition_Operator => 1046, + Iir_Kind_Substraction_Operator => 1051, + Iir_Kind_Concatenation_Operator => 1056, + Iir_Kind_Multiplication_Operator => 1061, + Iir_Kind_Division_Operator => 1066, + Iir_Kind_Modulus_Operator => 1071, + Iir_Kind_Remainder_Operator => 1076, + Iir_Kind_Exponentiation_Operator => 1081, + Iir_Kind_Function_Call => 1089, + Iir_Kind_Aggregate => 1095, + Iir_Kind_Parenthesis_Expression => 1098, + Iir_Kind_Qualified_Expression => 1102, + Iir_Kind_Type_Conversion => 1107, + Iir_Kind_Allocator_By_Expression => 1111, + Iir_Kind_Allocator_By_Subtype => 1115, + Iir_Kind_Selected_Element => 1121, + Iir_Kind_Dereference => 1126, + Iir_Kind_Implicit_Dereference => 1131, + Iir_Kind_Slice_Name => 1138, + Iir_Kind_Indexed_Name => 1144, + Iir_Kind_Psl_Expression => 1146, + Iir_Kind_Sensitized_Process_Statement => 1165, + Iir_Kind_Process_Statement => 1183, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1195, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1208, + Iir_Kind_Concurrent_Assertion_Statement => 1217, + Iir_Kind_Psl_Default_Clock => 1221, + Iir_Kind_Psl_Assert_Statement => 1231, + Iir_Kind_Psl_Cover_Statement => 1241, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1248, + Iir_Kind_Block_Statement => 1261, + Iir_Kind_Generate_Statement => 1273, + Iir_Kind_Component_Instantiation_Statement => 1284, + Iir_Kind_Simple_Simultaneous_Statement => 1292, + Iir_Kind_Signal_Assignment_Statement => 1302, + Iir_Kind_Null_Statement => 1307, + Iir_Kind_Assertion_Statement => 1315, + Iir_Kind_Report_Statement => 1322, + Iir_Kind_Wait_Statement => 1330, + Iir_Kind_Variable_Assignment_Statement => 1337, + Iir_Kind_Return_Statement => 1344, + Iir_Kind_For_Loop_Statement => 1353, + Iir_Kind_While_Loop_Statement => 1361, + Iir_Kind_Next_Statement => 1368, + Iir_Kind_Exit_Statement => 1375, + Iir_Kind_Case_Statement => 1383, + Iir_Kind_Procedure_Call_Statement => 1389, + Iir_Kind_If_Statement => 1398, + Iir_Kind_Elsif => 1403, + Iir_Kind_Character_Literal => 1410, + Iir_Kind_Simple_Name => 1417, + Iir_Kind_Selected_Name => 1425, + Iir_Kind_Operator_Symbol => 1430, + Iir_Kind_Selected_By_All_Name => 1435, + Iir_Kind_Parenthesis_Name => 1439, + Iir_Kind_Base_Attribute => 1441, + Iir_Kind_Left_Type_Attribute => 1446, + Iir_Kind_Right_Type_Attribute => 1451, + Iir_Kind_High_Type_Attribute => 1456, + Iir_Kind_Low_Type_Attribute => 1461, + Iir_Kind_Ascending_Type_Attribute => 1466, + Iir_Kind_Image_Attribute => 1472, + Iir_Kind_Value_Attribute => 1478, + Iir_Kind_Pos_Attribute => 1484, + Iir_Kind_Val_Attribute => 1490, + Iir_Kind_Succ_Attribute => 1496, + Iir_Kind_Pred_Attribute => 1502, + Iir_Kind_Leftof_Attribute => 1508, + Iir_Kind_Rightof_Attribute => 1514, + Iir_Kind_Delayed_Attribute => 1522, + Iir_Kind_Stable_Attribute => 1530, + Iir_Kind_Quiet_Attribute => 1538, + Iir_Kind_Transaction_Attribute => 1546, + Iir_Kind_Event_Attribute => 1550, + Iir_Kind_Active_Attribute => 1554, + Iir_Kind_Last_Event_Attribute => 1558, + Iir_Kind_Last_Active_Attribute => 1562, + Iir_Kind_Last_Value_Attribute => 1566, + Iir_Kind_Driving_Attribute => 1570, + Iir_Kind_Driving_Value_Attribute => 1574, + Iir_Kind_Behavior_Attribute => 1574, + Iir_Kind_Structure_Attribute => 1574, + Iir_Kind_Simple_Name_Attribute => 1581, + Iir_Kind_Instance_Name_Attribute => 1586, + Iir_Kind_Path_Name_Attribute => 1591, + Iir_Kind_Left_Array_Attribute => 1598, + Iir_Kind_Right_Array_Attribute => 1605, + Iir_Kind_High_Array_Attribute => 1612, + Iir_Kind_Low_Array_Attribute => 1619, + Iir_Kind_Length_Array_Attribute => 1626, + Iir_Kind_Ascending_Array_Attribute => 1633, + Iir_Kind_Range_Array_Attribute => 1640, + Iir_Kind_Reverse_Range_Array_Attribute => 1647, + Iir_Kind_Attribute_Name => 1655 + ); + + function Get_Fields (K : Iir_Kind) return Fields_Array + is + First : Natural; + Last : Integer; + begin + if K = Iir_Kind'First then + First := Fields_Of_Iir'First; + else + First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1; + end if; + Last := Fields_Of_Iir_Last (K); + return Fields_Of_Iir (First .. Last); + end Get_Fields; + + function Get_Base_Type + (N : Iir; F : Fields_Enum) return Base_Type is + begin + pragma Assert (Fields_Type (F) = Type_Base_Type); + case F is + when Field_Bit_String_Base => + return Get_Bit_String_Base (N); + when others => + raise Internal_Error; + end case; + end Get_Base_Type; + + procedure Set_Base_Type + (N : Iir; F : Fields_Enum; V: Base_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Base_Type); + case F is + when Field_Bit_String_Base => + Set_Bit_String_Base (N, V); + when others => + raise Internal_Error; + end case; + end Set_Base_Type; + + function Get_Boolean + (N : Iir; F : Fields_Enum) return Boolean is + begin + pragma Assert (Fields_Type (F) = Type_Boolean); + case F is + when Field_Whole_Association_Flag => + return Get_Whole_Association_Flag (N); + when Field_Collapse_Signal_Flag => + return Get_Collapse_Signal_Flag (N); + when Field_Artificial_Flag => + return Get_Artificial_Flag (N); + when Field_Open_Flag => + return Get_Open_Flag (N); + when Field_After_Drivers_Flag => + return Get_After_Drivers_Flag (N); + when Field_Same_Alternative_Flag => + return Get_Same_Alternative_Flag (N); + when Field_Need_Body => + return Get_Need_Body (N); + when Field_Deferred_Declaration_Flag => + return Get_Deferred_Declaration_Flag (N); + when Field_Shared_Flag => + return Get_Shared_Flag (N); + when Field_Visible_Flag => + return Get_Visible_Flag (N); + when Field_Text_File_Flag => + return Get_Text_File_Flag (N); + when Field_Only_Characters_Flag => + return Get_Only_Characters_Flag (N); + when Field_Postponed_Flag => + return Get_Postponed_Flag (N); + when Field_Passive_Flag => + return Get_Passive_Flag (N); + when Field_Resolution_Function_Flag => + return Get_Resolution_Function_Flag (N); + when Field_Seen_Flag => + return Get_Seen_Flag (N); + when Field_Pure_Flag => + return Get_Pure_Flag (N); + when Field_Foreign_Flag => + return Get_Foreign_Flag (N); + when Field_Resolved_Flag => + return Get_Resolved_Flag (N); + when Field_Signal_Type_Flag => + return Get_Signal_Type_Flag (N); + when Field_Has_Signal_Flag => + return Get_Has_Signal_Flag (N); + when Field_Elab_Flag => + return Get_Elab_Flag (N); + when Field_Index_Constraint_Flag => + return Get_Index_Constraint_Flag (N); + when Field_Aggr_Dynamic_Flag => + return Get_Aggr_Dynamic_Flag (N); + when Field_Aggr_Others_Flag => + return Get_Aggr_Others_Flag (N); + when Field_Aggr_Named_Flag => + return Get_Aggr_Named_Flag (N); + when Field_Has_Disconnect_Flag => + return Get_Has_Disconnect_Flag (N); + when Field_Has_Active_Flag => + return Get_Has_Active_Flag (N); + when Field_Is_Within_Flag => + return Get_Is_Within_Flag (N); + when Field_Implicit_Alias_Flag => + return Get_Implicit_Alias_Flag (N); + when Field_Use_Flag => + return Get_Use_Flag (N); + when Field_End_Has_Reserved_Id => + return Get_End_Has_Reserved_Id (N); + when Field_End_Has_Identifier => + return Get_End_Has_Identifier (N); + when Field_End_Has_Postponed => + return Get_End_Has_Postponed (N); + when Field_Has_Begin => + return Get_Has_Begin (N); + when Field_Has_Is => + return Get_Has_Is (N); + when Field_Has_Pure => + return Get_Has_Pure (N); + when Field_Has_Body => + return Get_Has_Body (N); + when Field_Has_Identifier_List => + return Get_Has_Identifier_List (N); + when Field_Has_Mode => + return Get_Has_Mode (N); + when Field_Is_Ref => + return Get_Is_Ref (N); + when others => + raise Internal_Error; + end case; + end Get_Boolean; + + procedure Set_Boolean + (N : Iir; F : Fields_Enum; V: Boolean) is + begin + pragma Assert (Fields_Type (F) = Type_Boolean); + case F is + when Field_Whole_Association_Flag => + Set_Whole_Association_Flag (N, V); + when Field_Collapse_Signal_Flag => + Set_Collapse_Signal_Flag (N, V); + when Field_Artificial_Flag => + Set_Artificial_Flag (N, V); + when Field_Open_Flag => + Set_Open_Flag (N, V); + when Field_After_Drivers_Flag => + Set_After_Drivers_Flag (N, V); + when Field_Same_Alternative_Flag => + Set_Same_Alternative_Flag (N, V); + when Field_Need_Body => + Set_Need_Body (N, V); + when Field_Deferred_Declaration_Flag => + Set_Deferred_Declaration_Flag (N, V); + when Field_Shared_Flag => + Set_Shared_Flag (N, V); + when Field_Visible_Flag => + Set_Visible_Flag (N, V); + when Field_Text_File_Flag => + Set_Text_File_Flag (N, V); + when Field_Only_Characters_Flag => + Set_Only_Characters_Flag (N, V); + when Field_Postponed_Flag => + Set_Postponed_Flag (N, V); + when Field_Passive_Flag => + Set_Passive_Flag (N, V); + when Field_Resolution_Function_Flag => + Set_Resolution_Function_Flag (N, V); + when Field_Seen_Flag => + Set_Seen_Flag (N, V); + when Field_Pure_Flag => + Set_Pure_Flag (N, V); + when Field_Foreign_Flag => + Set_Foreign_Flag (N, V); + when Field_Resolved_Flag => + Set_Resolved_Flag (N, V); + when Field_Signal_Type_Flag => + Set_Signal_Type_Flag (N, V); + when Field_Has_Signal_Flag => + Set_Has_Signal_Flag (N, V); + when Field_Elab_Flag => + Set_Elab_Flag (N, V); + when Field_Index_Constraint_Flag => + Set_Index_Constraint_Flag (N, V); + when Field_Aggr_Dynamic_Flag => + Set_Aggr_Dynamic_Flag (N, V); + when Field_Aggr_Others_Flag => + Set_Aggr_Others_Flag (N, V); + when Field_Aggr_Named_Flag => + Set_Aggr_Named_Flag (N, V); + when Field_Has_Disconnect_Flag => + Set_Has_Disconnect_Flag (N, V); + when Field_Has_Active_Flag => + Set_Has_Active_Flag (N, V); + when Field_Is_Within_Flag => + Set_Is_Within_Flag (N, V); + when Field_Implicit_Alias_Flag => + Set_Implicit_Alias_Flag (N, V); + when Field_Use_Flag => + Set_Use_Flag (N, V); + when Field_End_Has_Reserved_Id => + Set_End_Has_Reserved_Id (N, V); + when Field_End_Has_Identifier => + Set_End_Has_Identifier (N, V); + when Field_End_Has_Postponed => + Set_End_Has_Postponed (N, V); + when Field_Has_Begin => + Set_Has_Begin (N, V); + when Field_Has_Is => + Set_Has_Is (N, V); + when Field_Has_Pure => + Set_Has_Pure (N, V); + when Field_Has_Body => + Set_Has_Body (N, V); + when Field_Has_Identifier_List => + Set_Has_Identifier_List (N, V); + when Field_Has_Mode => + Set_Has_Mode (N, V); + when Field_Is_Ref => + Set_Is_Ref (N, V); + when others => + raise Internal_Error; + end case; + end Set_Boolean; + + function Get_Date_State_Type + (N : Iir; F : Fields_Enum) return Date_State_Type is + begin + pragma Assert (Fields_Type (F) = Type_Date_State_Type); + case F is + when Field_Date_State => + return Get_Date_State (N); + when others => + raise Internal_Error; + end case; + end Get_Date_State_Type; + + procedure Set_Date_State_Type + (N : Iir; F : Fields_Enum; V: Date_State_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Date_State_Type); + case F is + when Field_Date_State => + Set_Date_State (N, V); + when others => + raise Internal_Error; + end case; + end Set_Date_State_Type; + + function Get_Date_Type + (N : Iir; F : Fields_Enum) return Date_Type is + begin + pragma Assert (Fields_Type (F) = Type_Date_Type); + case F is + when Field_Date => + return Get_Date (N); + when others => + raise Internal_Error; + end case; + end Get_Date_Type; + + procedure Set_Date_Type + (N : Iir; F : Fields_Enum; V: Date_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Date_Type); + case F is + when Field_Date => + Set_Date (N, V); + when others => + raise Internal_Error; + end case; + end Set_Date_Type; + + function Get_Iir + (N : Iir; F : Fields_Enum) return Iir is + begin + pragma Assert (Fields_Type (F) = Type_Iir); + case F is + when Field_First_Design_Unit => + return Get_First_Design_Unit (N); + when Field_Last_Design_Unit => + return Get_Last_Design_Unit (N); + when Field_Library_Declaration => + return Get_Library_Declaration (N); + when Field_Library => + return Get_Library (N); + when Field_Design_File => + return Get_Design_File (N); + when Field_Design_File_Chain => + return Get_Design_File_Chain (N); + when Field_Context_Items => + return Get_Context_Items (N); + when Field_Library_Unit => + return Get_Library_Unit (N); + when Field_Hash_Chain => + return Get_Hash_Chain (N); + when Field_Physical_Literal => + return Get_Physical_Literal (N); + when Field_Physical_Unit_Value => + return Get_Physical_Unit_Value (N); + when Field_Enumeration_Decl => + return Get_Enumeration_Decl (N); + when Field_Bit_String_0 => + return Get_Bit_String_0 (N); + when Field_Bit_String_1 => + return Get_Bit_String_1 (N); + when Field_Literal_Origin => + return Get_Literal_Origin (N); + when Field_Range_Origin => + return Get_Range_Origin (N); + when Field_Literal_Subtype => + return Get_Literal_Subtype (N); + when Field_Attribute_Designator => + return Get_Attribute_Designator (N); + when Field_Attribute_Specification_Chain => + return Get_Attribute_Specification_Chain (N); + when Field_Attribute_Specification => + return Get_Attribute_Specification (N); + when Field_Designated_Entity => + return Get_Designated_Entity (N); + when Field_Formal => + return Get_Formal (N); + when Field_Actual => + return Get_Actual (N); + when Field_In_Conversion => + return Get_In_Conversion (N); + when Field_Out_Conversion => + return Get_Out_Conversion (N); + when Field_We_Value => + return Get_We_Value (N); + when Field_Time => + return Get_Time (N); + when Field_Associated_Expr => + return Get_Associated_Expr (N); + when Field_Associated_Chain => + return Get_Associated_Chain (N); + when Field_Choice_Name => + return Get_Choice_Name (N); + when Field_Choice_Expression => + return Get_Choice_Expression (N); + when Field_Choice_Range => + return Get_Choice_Range (N); + when Field_Architecture => + return Get_Architecture (N); + when Field_Block_Specification => + return Get_Block_Specification (N); + when Field_Prev_Block_Configuration => + return Get_Prev_Block_Configuration (N); + when Field_Configuration_Item_Chain => + return Get_Configuration_Item_Chain (N); + when Field_Attribute_Value_Chain => + return Get_Attribute_Value_Chain (N); + when Field_Spec_Chain => + return Get_Spec_Chain (N); + when Field_Attribute_Value_Spec_Chain => + return Get_Attribute_Value_Spec_Chain (N); + when Field_Entity_Name => + return Get_Entity_Name (N); + when Field_Package => + return Get_Package (N); + when Field_Package_Body => + return Get_Package_Body (N); + when Field_Block_Configuration => + return Get_Block_Configuration (N); + when Field_Concurrent_Statement_Chain => + return Get_Concurrent_Statement_Chain (N); + when Field_Chain => + return Get_Chain (N); + when Field_Port_Chain => + return Get_Port_Chain (N); + when Field_Generic_Chain => + return Get_Generic_Chain (N); + when Field_Type => + return Get_Type (N); + when Field_Subtype_Indication => + return Get_Subtype_Indication (N); + when Field_Discrete_Range => + return Get_Discrete_Range (N); + when Field_Type_Definition => + return Get_Type_Definition (N); + when Field_Subtype_Definition => + return Get_Subtype_Definition (N); + when Field_Nature => + return Get_Nature (N); + when Field_Base_Name => + return Get_Base_Name (N); + when Field_Interface_Declaration_Chain => + return Get_Interface_Declaration_Chain (N); + when Field_Subprogram_Specification => + return Get_Subprogram_Specification (N); + when Field_Sequential_Statement_Chain => + return Get_Sequential_Statement_Chain (N); + when Field_Subprogram_Body => + return Get_Subprogram_Body (N); + when Field_Return_Type => + return Get_Return_Type (N); + when Field_Type_Reference => + return Get_Type_Reference (N); + when Field_Default_Value => + return Get_Default_Value (N); + when Field_Deferred_Declaration => + return Get_Deferred_Declaration (N); + when Field_Design_Unit => + return Get_Design_Unit (N); + when Field_Block_Statement => + return Get_Block_Statement (N); + when Field_Signal_Driver => + return Get_Signal_Driver (N); + when Field_Declaration_Chain => + return Get_Declaration_Chain (N); + when Field_File_Logical_Name => + return Get_File_Logical_Name (N); + when Field_File_Open_Kind => + return Get_File_Open_Kind (N); + when Field_Element_Declaration => + return Get_Element_Declaration (N); + when Field_Selected_Element => + return Get_Selected_Element (N); + when Field_Use_Clause_Chain => + return Get_Use_Clause_Chain (N); + when Field_Selected_Name => + return Get_Selected_Name (N); + when Field_Type_Declarator => + return Get_Type_Declarator (N); + when Field_Entity_Class_Entry_Chain => + return Get_Entity_Class_Entry_Chain (N); + when Field_Unit_Chain => + return Get_Unit_Chain (N); + when Field_Primary_Unit => + return Get_Primary_Unit (N); + when Field_Range_Constraint => + return Get_Range_Constraint (N); + when Field_Left_Limit => + return Get_Left_Limit (N); + when Field_Right_Limit => + return Get_Right_Limit (N); + when Field_Base_Type => + return Get_Base_Type (N); + when Field_Resolution_Indication => + return Get_Resolution_Indication (N); + when Field_Record_Element_Resolution_Chain => + return Get_Record_Element_Resolution_Chain (N); + when Field_Tolerance => + return Get_Tolerance (N); + when Field_Plus_Terminal => + return Get_Plus_Terminal (N); + when Field_Minus_Terminal => + return Get_Minus_Terminal (N); + when Field_Simultaneous_Left => + return Get_Simultaneous_Left (N); + when Field_Simultaneous_Right => + return Get_Simultaneous_Right (N); + when Field_Element_Subtype_Indication => + return Get_Element_Subtype_Indication (N); + when Field_Element_Subtype => + return Get_Element_Subtype (N); + when Field_Array_Element_Constraint => + return Get_Array_Element_Constraint (N); + when Field_Designated_Type => + return Get_Designated_Type (N); + when Field_Designated_Subtype_Indication => + return Get_Designated_Subtype_Indication (N); + when Field_Reference => + return Get_Reference (N); + when Field_Nature_Declarator => + return Get_Nature_Declarator (N); + when Field_Across_Type => + return Get_Across_Type (N); + when Field_Through_Type => + return Get_Through_Type (N); + when Field_Target => + return Get_Target (N); + when Field_Waveform_Chain => + return Get_Waveform_Chain (N); + when Field_Guard => + return Get_Guard (N); + when Field_Reject_Time_Expression => + return Get_Reject_Time_Expression (N); + when Field_Process_Origin => + return Get_Process_Origin (N); + when Field_Condition_Clause => + return Get_Condition_Clause (N); + when Field_Timeout_Clause => + return Get_Timeout_Clause (N); + when Field_Assertion_Condition => + return Get_Assertion_Condition (N); + when Field_Report_Expression => + return Get_Report_Expression (N); + when Field_Severity_Expression => + return Get_Severity_Expression (N); + when Field_Instantiated_Unit => + return Get_Instantiated_Unit (N); + when Field_Generic_Map_Aspect_Chain => + return Get_Generic_Map_Aspect_Chain (N); + when Field_Port_Map_Aspect_Chain => + return Get_Port_Map_Aspect_Chain (N); + when Field_Configuration_Name => + return Get_Configuration_Name (N); + when Field_Component_Configuration => + return Get_Component_Configuration (N); + when Field_Configuration_Specification => + return Get_Configuration_Specification (N); + when Field_Default_Binding_Indication => + return Get_Default_Binding_Indication (N); + when Field_Default_Configuration_Declaration => + return Get_Default_Configuration_Declaration (N); + when Field_Expression => + return Get_Expression (N); + when Field_Allocator_Designated_Type => + return Get_Allocator_Designated_Type (N); + when Field_Selected_Waveform_Chain => + return Get_Selected_Waveform_Chain (N); + when Field_Conditional_Waveform_Chain => + return Get_Conditional_Waveform_Chain (N); + when Field_Guard_Expression => + return Get_Guard_Expression (N); + when Field_Guard_Decl => + return Get_Guard_Decl (N); + when Field_Block_Block_Configuration => + return Get_Block_Block_Configuration (N); + when Field_Package_Header => + return Get_Package_Header (N); + when Field_Block_Header => + return Get_Block_Header (N); + when Field_Uninstantiated_Name => + return Get_Uninstantiated_Name (N); + when Field_Generate_Block_Configuration => + return Get_Generate_Block_Configuration (N); + when Field_Generation_Scheme => + return Get_Generation_Scheme (N); + when Field_Condition => + return Get_Condition (N); + when Field_Else_Clause => + return Get_Else_Clause (N); + when Field_Parameter_Specification => + return Get_Parameter_Specification (N); + when Field_Parent => + return Get_Parent (N); + when Field_Loop_Label => + return Get_Loop_Label (N); + when Field_Component_Name => + return Get_Component_Name (N); + when Field_Entity_Aspect => + return Get_Entity_Aspect (N); + when Field_Default_Entity_Aspect => + return Get_Default_Entity_Aspect (N); + when Field_Default_Generic_Map_Aspect_Chain => + return Get_Default_Generic_Map_Aspect_Chain (N); + when Field_Default_Port_Map_Aspect_Chain => + return Get_Default_Port_Map_Aspect_Chain (N); + when Field_Binding_Indication => + return Get_Binding_Indication (N); + when Field_Named_Entity => + return Get_Named_Entity (N); + when Field_Alias_Declaration => + return Get_Alias_Declaration (N); + when Field_Error_Origin => + return Get_Error_Origin (N); + when Field_Operand => + return Get_Operand (N); + when Field_Left => + return Get_Left (N); + when Field_Right => + return Get_Right (N); + when Field_Unit_Name => + return Get_Unit_Name (N); + when Field_Name => + return Get_Name (N); + when Field_Group_Template_Name => + return Get_Group_Template_Name (N); + when Field_Prefix => + return Get_Prefix (N); + when Field_Signature_Prefix => + return Get_Signature_Prefix (N); + when Field_Slice_Subtype => + return Get_Slice_Subtype (N); + when Field_Suffix => + return Get_Suffix (N); + when Field_Index_Subtype => + return Get_Index_Subtype (N); + when Field_Parameter => + return Get_Parameter (N); + when Field_Actual_Type => + return Get_Actual_Type (N); + when Field_Association_Chain => + return Get_Association_Chain (N); + when Field_Individual_Association_Chain => + return Get_Individual_Association_Chain (N); + when Field_Aggregate_Info => + return Get_Aggregate_Info (N); + when Field_Sub_Aggregate_Info => + return Get_Sub_Aggregate_Info (N); + when Field_Aggr_Low_Limit => + return Get_Aggr_Low_Limit (N); + when Field_Aggr_High_Limit => + return Get_Aggr_High_Limit (N); + when Field_Association_Choices_Chain => + return Get_Association_Choices_Chain (N); + when Field_Case_Statement_Alternative_Chain => + return Get_Case_Statement_Alternative_Chain (N); + when Field_Procedure_Call => + return Get_Procedure_Call (N); + when Field_Implementation => + return Get_Implementation (N); + when Field_Parameter_Association_Chain => + return Get_Parameter_Association_Chain (N); + when Field_Method_Object => + return Get_Method_Object (N); + when Field_Subtype_Type_Mark => + return Get_Subtype_Type_Mark (N); + when Field_Type_Conversion_Subtype => + return Get_Type_Conversion_Subtype (N); + when Field_Type_Mark => + return Get_Type_Mark (N); + when Field_File_Type_Mark => + return Get_File_Type_Mark (N); + when Field_Return_Type_Mark => + return Get_Return_Type_Mark (N); + when Field_Alias_Signature => + return Get_Alias_Signature (N); + when Field_Attribute_Signature => + return Get_Attribute_Signature (N); + when Field_Simple_Name_Subtype => + return Get_Simple_Name_Subtype (N); + when Field_Protected_Type_Body => + return Get_Protected_Type_Body (N); + when Field_Protected_Type_Declaration => + return Get_Protected_Type_Declaration (N); + when others => + raise Internal_Error; + end case; + end Get_Iir; + + procedure Set_Iir + (N : Iir; F : Fields_Enum; V: Iir) is + begin + pragma Assert (Fields_Type (F) = Type_Iir); + case F is + when Field_First_Design_Unit => + Set_First_Design_Unit (N, V); + when Field_Last_Design_Unit => + Set_Last_Design_Unit (N, V); + when Field_Library_Declaration => + Set_Library_Declaration (N, V); + when Field_Library => + Set_Library (N, V); + when Field_Design_File => + Set_Design_File (N, V); + when Field_Design_File_Chain => + Set_Design_File_Chain (N, V); + when Field_Context_Items => + Set_Context_Items (N, V); + when Field_Library_Unit => + Set_Library_Unit (N, V); + when Field_Hash_Chain => + Set_Hash_Chain (N, V); + when Field_Physical_Literal => + Set_Physical_Literal (N, V); + when Field_Physical_Unit_Value => + Set_Physical_Unit_Value (N, V); + when Field_Enumeration_Decl => + Set_Enumeration_Decl (N, V); + when Field_Bit_String_0 => + Set_Bit_String_0 (N, V); + when Field_Bit_String_1 => + Set_Bit_String_1 (N, V); + when Field_Literal_Origin => + Set_Literal_Origin (N, V); + when Field_Range_Origin => + Set_Range_Origin (N, V); + when Field_Literal_Subtype => + Set_Literal_Subtype (N, V); + when Field_Attribute_Designator => + Set_Attribute_Designator (N, V); + when Field_Attribute_Specification_Chain => + Set_Attribute_Specification_Chain (N, V); + when Field_Attribute_Specification => + Set_Attribute_Specification (N, V); + when Field_Designated_Entity => + Set_Designated_Entity (N, V); + when Field_Formal => + Set_Formal (N, V); + when Field_Actual => + Set_Actual (N, V); + when Field_In_Conversion => + Set_In_Conversion (N, V); + when Field_Out_Conversion => + Set_Out_Conversion (N, V); + when Field_We_Value => + Set_We_Value (N, V); + when Field_Time => + Set_Time (N, V); + when Field_Associated_Expr => + Set_Associated_Expr (N, V); + when Field_Associated_Chain => + Set_Associated_Chain (N, V); + when Field_Choice_Name => + Set_Choice_Name (N, V); + when Field_Choice_Expression => + Set_Choice_Expression (N, V); + when Field_Choice_Range => + Set_Choice_Range (N, V); + when Field_Architecture => + Set_Architecture (N, V); + when Field_Block_Specification => + Set_Block_Specification (N, V); + when Field_Prev_Block_Configuration => + Set_Prev_Block_Configuration (N, V); + when Field_Configuration_Item_Chain => + Set_Configuration_Item_Chain (N, V); + when Field_Attribute_Value_Chain => + Set_Attribute_Value_Chain (N, V); + when Field_Spec_Chain => + Set_Spec_Chain (N, V); + when Field_Attribute_Value_Spec_Chain => + Set_Attribute_Value_Spec_Chain (N, V); + when Field_Entity_Name => + Set_Entity_Name (N, V); + when Field_Package => + Set_Package (N, V); + when Field_Package_Body => + Set_Package_Body (N, V); + when Field_Block_Configuration => + Set_Block_Configuration (N, V); + when Field_Concurrent_Statement_Chain => + Set_Concurrent_Statement_Chain (N, V); + when Field_Chain => + Set_Chain (N, V); + when Field_Port_Chain => + Set_Port_Chain (N, V); + when Field_Generic_Chain => + Set_Generic_Chain (N, V); + when Field_Type => + Set_Type (N, V); + when Field_Subtype_Indication => + Set_Subtype_Indication (N, V); + when Field_Discrete_Range => + Set_Discrete_Range (N, V); + when Field_Type_Definition => + Set_Type_Definition (N, V); + when Field_Subtype_Definition => + Set_Subtype_Definition (N, V); + when Field_Nature => + Set_Nature (N, V); + when Field_Base_Name => + Set_Base_Name (N, V); + when Field_Interface_Declaration_Chain => + Set_Interface_Declaration_Chain (N, V); + when Field_Subprogram_Specification => + Set_Subprogram_Specification (N, V); + when Field_Sequential_Statement_Chain => + Set_Sequential_Statement_Chain (N, V); + when Field_Subprogram_Body => + Set_Subprogram_Body (N, V); + when Field_Return_Type => + Set_Return_Type (N, V); + when Field_Type_Reference => + Set_Type_Reference (N, V); + when Field_Default_Value => + Set_Default_Value (N, V); + when Field_Deferred_Declaration => + Set_Deferred_Declaration (N, V); + when Field_Design_Unit => + Set_Design_Unit (N, V); + when Field_Block_Statement => + Set_Block_Statement (N, V); + when Field_Signal_Driver => + Set_Signal_Driver (N, V); + when Field_Declaration_Chain => + Set_Declaration_Chain (N, V); + when Field_File_Logical_Name => + Set_File_Logical_Name (N, V); + when Field_File_Open_Kind => + Set_File_Open_Kind (N, V); + when Field_Element_Declaration => + Set_Element_Declaration (N, V); + when Field_Selected_Element => + Set_Selected_Element (N, V); + when Field_Use_Clause_Chain => + Set_Use_Clause_Chain (N, V); + when Field_Selected_Name => + Set_Selected_Name (N, V); + when Field_Type_Declarator => + Set_Type_Declarator (N, V); + when Field_Entity_Class_Entry_Chain => + Set_Entity_Class_Entry_Chain (N, V); + when Field_Unit_Chain => + Set_Unit_Chain (N, V); + when Field_Primary_Unit => + Set_Primary_Unit (N, V); + when Field_Range_Constraint => + Set_Range_Constraint (N, V); + when Field_Left_Limit => + Set_Left_Limit (N, V); + when Field_Right_Limit => + Set_Right_Limit (N, V); + when Field_Base_Type => + Set_Base_Type (N, V); + when Field_Resolution_Indication => + Set_Resolution_Indication (N, V); + when Field_Record_Element_Resolution_Chain => + Set_Record_Element_Resolution_Chain (N, V); + when Field_Tolerance => + Set_Tolerance (N, V); + when Field_Plus_Terminal => + Set_Plus_Terminal (N, V); + when Field_Minus_Terminal => + Set_Minus_Terminal (N, V); + when Field_Simultaneous_Left => + Set_Simultaneous_Left (N, V); + when Field_Simultaneous_Right => + Set_Simultaneous_Right (N, V); + when Field_Element_Subtype_Indication => + Set_Element_Subtype_Indication (N, V); + when Field_Element_Subtype => + Set_Element_Subtype (N, V); + when Field_Array_Element_Constraint => + Set_Array_Element_Constraint (N, V); + when Field_Designated_Type => + Set_Designated_Type (N, V); + when Field_Designated_Subtype_Indication => + Set_Designated_Subtype_Indication (N, V); + when Field_Reference => + Set_Reference (N, V); + when Field_Nature_Declarator => + Set_Nature_Declarator (N, V); + when Field_Across_Type => + Set_Across_Type (N, V); + when Field_Through_Type => + Set_Through_Type (N, V); + when Field_Target => + Set_Target (N, V); + when Field_Waveform_Chain => + Set_Waveform_Chain (N, V); + when Field_Guard => + Set_Guard (N, V); + when Field_Reject_Time_Expression => + Set_Reject_Time_Expression (N, V); + when Field_Process_Origin => + Set_Process_Origin (N, V); + when Field_Condition_Clause => + Set_Condition_Clause (N, V); + when Field_Timeout_Clause => + Set_Timeout_Clause (N, V); + when Field_Assertion_Condition => + Set_Assertion_Condition (N, V); + when Field_Report_Expression => + Set_Report_Expression (N, V); + when Field_Severity_Expression => + Set_Severity_Expression (N, V); + when Field_Instantiated_Unit => + Set_Instantiated_Unit (N, V); + when Field_Generic_Map_Aspect_Chain => + Set_Generic_Map_Aspect_Chain (N, V); + when Field_Port_Map_Aspect_Chain => + Set_Port_Map_Aspect_Chain (N, V); + when Field_Configuration_Name => + Set_Configuration_Name (N, V); + when Field_Component_Configuration => + Set_Component_Configuration (N, V); + when Field_Configuration_Specification => + Set_Configuration_Specification (N, V); + when Field_Default_Binding_Indication => + Set_Default_Binding_Indication (N, V); + when Field_Default_Configuration_Declaration => + Set_Default_Configuration_Declaration (N, V); + when Field_Expression => + Set_Expression (N, V); + when Field_Allocator_Designated_Type => + Set_Allocator_Designated_Type (N, V); + when Field_Selected_Waveform_Chain => + Set_Selected_Waveform_Chain (N, V); + when Field_Conditional_Waveform_Chain => + Set_Conditional_Waveform_Chain (N, V); + when Field_Guard_Expression => + Set_Guard_Expression (N, V); + when Field_Guard_Decl => + Set_Guard_Decl (N, V); + when Field_Block_Block_Configuration => + Set_Block_Block_Configuration (N, V); + when Field_Package_Header => + Set_Package_Header (N, V); + when Field_Block_Header => + Set_Block_Header (N, V); + when Field_Uninstantiated_Name => + Set_Uninstantiated_Name (N, V); + when Field_Generate_Block_Configuration => + Set_Generate_Block_Configuration (N, V); + when Field_Generation_Scheme => + Set_Generation_Scheme (N, V); + when Field_Condition => + Set_Condition (N, V); + when Field_Else_Clause => + Set_Else_Clause (N, V); + when Field_Parameter_Specification => + Set_Parameter_Specification (N, V); + when Field_Parent => + Set_Parent (N, V); + when Field_Loop_Label => + Set_Loop_Label (N, V); + when Field_Component_Name => + Set_Component_Name (N, V); + when Field_Entity_Aspect => + Set_Entity_Aspect (N, V); + when Field_Default_Entity_Aspect => + Set_Default_Entity_Aspect (N, V); + when Field_Default_Generic_Map_Aspect_Chain => + Set_Default_Generic_Map_Aspect_Chain (N, V); + when Field_Default_Port_Map_Aspect_Chain => + Set_Default_Port_Map_Aspect_Chain (N, V); + when Field_Binding_Indication => + Set_Binding_Indication (N, V); + when Field_Named_Entity => + Set_Named_Entity (N, V); + when Field_Alias_Declaration => + Set_Alias_Declaration (N, V); + when Field_Error_Origin => + Set_Error_Origin (N, V); + when Field_Operand => + Set_Operand (N, V); + when Field_Left => + Set_Left (N, V); + when Field_Right => + Set_Right (N, V); + when Field_Unit_Name => + Set_Unit_Name (N, V); + when Field_Name => + Set_Name (N, V); + when Field_Group_Template_Name => + Set_Group_Template_Name (N, V); + when Field_Prefix => + Set_Prefix (N, V); + when Field_Signature_Prefix => + Set_Signature_Prefix (N, V); + when Field_Slice_Subtype => + Set_Slice_Subtype (N, V); + when Field_Suffix => + Set_Suffix (N, V); + when Field_Index_Subtype => + Set_Index_Subtype (N, V); + when Field_Parameter => + Set_Parameter (N, V); + when Field_Actual_Type => + Set_Actual_Type (N, V); + when Field_Association_Chain => + Set_Association_Chain (N, V); + when Field_Individual_Association_Chain => + Set_Individual_Association_Chain (N, V); + when Field_Aggregate_Info => + Set_Aggregate_Info (N, V); + when Field_Sub_Aggregate_Info => + Set_Sub_Aggregate_Info (N, V); + when Field_Aggr_Low_Limit => + Set_Aggr_Low_Limit (N, V); + when Field_Aggr_High_Limit => + Set_Aggr_High_Limit (N, V); + when Field_Association_Choices_Chain => + Set_Association_Choices_Chain (N, V); + when Field_Case_Statement_Alternative_Chain => + Set_Case_Statement_Alternative_Chain (N, V); + when Field_Procedure_Call => + Set_Procedure_Call (N, V); + when Field_Implementation => + Set_Implementation (N, V); + when Field_Parameter_Association_Chain => + Set_Parameter_Association_Chain (N, V); + when Field_Method_Object => + Set_Method_Object (N, V); + when Field_Subtype_Type_Mark => + Set_Subtype_Type_Mark (N, V); + when Field_Type_Conversion_Subtype => + Set_Type_Conversion_Subtype (N, V); + when Field_Type_Mark => + Set_Type_Mark (N, V); + when Field_File_Type_Mark => + Set_File_Type_Mark (N, V); + when Field_Return_Type_Mark => + Set_Return_Type_Mark (N, V); + when Field_Alias_Signature => + Set_Alias_Signature (N, V); + when Field_Attribute_Signature => + Set_Attribute_Signature (N, V); + when Field_Simple_Name_Subtype => + Set_Simple_Name_Subtype (N, V); + when Field_Protected_Type_Body => + Set_Protected_Type_Body (N, V); + when Field_Protected_Type_Declaration => + Set_Protected_Type_Declaration (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir; + + function Get_Iir_All_Sensitized + (N : Iir; F : Fields_Enum) return Iir_All_Sensitized is + begin + pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized); + case F is + when Field_All_Sensitized_State => + return Get_All_Sensitized_State (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_All_Sensitized; + + procedure Set_Iir_All_Sensitized + (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_All_Sensitized); + case F is + when Field_All_Sensitized_State => + Set_All_Sensitized_State (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_All_Sensitized; + + function Get_Iir_Constraint + (N : Iir; F : Fields_Enum) return Iir_Constraint is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Constraint); + case F is + when Field_Constraint_State => + return Get_Constraint_State (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Constraint; + + procedure Set_Iir_Constraint + (N : Iir; F : Fields_Enum; V: Iir_Constraint) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Constraint); + case F is + when Field_Constraint_State => + Set_Constraint_State (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Constraint; + + function Get_Iir_Delay_Mechanism + (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism); + case F is + when Field_Delay_Mechanism => + return Get_Delay_Mechanism (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Delay_Mechanism; + + procedure Set_Iir_Delay_Mechanism + (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Delay_Mechanism); + case F is + when Field_Delay_Mechanism => + Set_Delay_Mechanism (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Delay_Mechanism; + + function Get_Iir_Direction + (N : Iir; F : Fields_Enum) return Iir_Direction is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Direction); + case F is + when Field_Direction => + return Get_Direction (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Direction; + + procedure Set_Iir_Direction + (N : Iir; F : Fields_Enum; V: Iir_Direction) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Direction); + case F is + when Field_Direction => + Set_Direction (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Direction; + + function Get_Iir_Fp64 + (N : Iir; F : Fields_Enum) return Iir_Fp64 is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Fp64); + case F is + when Field_Fp_Value => + return Get_Fp_Value (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Fp64; + + procedure Set_Iir_Fp64 + (N : Iir; F : Fields_Enum; V: Iir_Fp64) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Fp64); + case F is + when Field_Fp_Value => + Set_Fp_Value (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Fp64; + + function Get_Iir_Index32 + (N : Iir; F : Fields_Enum) return Iir_Index32 is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Index32); + case F is + when Field_Element_Position => + return Get_Element_Position (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Index32; + + procedure Set_Iir_Index32 + (N : Iir; F : Fields_Enum; V: Iir_Index32) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Index32); + case F is + when Field_Element_Position => + Set_Element_Position (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Index32; + + function Get_Iir_Int32 + (N : Iir; F : Fields_Enum) return Iir_Int32 is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Int32); + case F is + when Field_Enum_Pos => + return Get_Enum_Pos (N); + when Field_Overload_Number => + return Get_Overload_Number (N); + when Field_Subprogram_Depth => + return Get_Subprogram_Depth (N); + when Field_Subprogram_Hash => + return Get_Subprogram_Hash (N); + when Field_Impure_Depth => + return Get_Impure_Depth (N); + when Field_Aggr_Min_Length => + return Get_Aggr_Min_Length (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Int32; + + procedure Set_Iir_Int32 + (N : Iir; F : Fields_Enum; V: Iir_Int32) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Int32); + case F is + when Field_Enum_Pos => + Set_Enum_Pos (N, V); + when Field_Overload_Number => + Set_Overload_Number (N, V); + when Field_Subprogram_Depth => + Set_Subprogram_Depth (N, V); + when Field_Subprogram_Hash => + Set_Subprogram_Hash (N, V); + when Field_Impure_Depth => + Set_Impure_Depth (N, V); + when Field_Aggr_Min_Length => + Set_Aggr_Min_Length (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Int32; + + function Get_Iir_Int64 + (N : Iir; F : Fields_Enum) return Iir_Int64 is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Int64); + case F is + when Field_Value => + return Get_Value (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Int64; + + procedure Set_Iir_Int64 + (N : Iir; F : Fields_Enum; V: Iir_Int64) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Int64); + case F is + when Field_Value => + Set_Value (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Int64; + + function Get_Iir_Lexical_Layout_Type + (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type); + case F is + when Field_Lexical_Layout => + return Get_Lexical_Layout (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Lexical_Layout_Type; + + procedure Set_Iir_Lexical_Layout_Type + (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Lexical_Layout_Type); + case F is + when Field_Lexical_Layout => + Set_Lexical_Layout (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Lexical_Layout_Type; + + function Get_Iir_List + (N : Iir; F : Fields_Enum) return Iir_List is + begin + pragma Assert (Fields_Type (F) = Type_Iir_List); + case F is + when Field_File_Dependence_List => + return Get_File_Dependence_List (N); + when Field_Dependence_List => + return Get_Dependence_List (N); + when Field_Analysis_Checks_List => + return Get_Analysis_Checks_List (N); + when Field_Simple_Aggregate_List => + return Get_Simple_Aggregate_List (N); + when Field_Entity_Name_List => + return Get_Entity_Name_List (N); + when Field_Signal_List => + return Get_Signal_List (N); + when Field_Enumeration_Literal_List => + return Get_Enumeration_Literal_List (N); + when Field_Group_Constituent_List => + return Get_Group_Constituent_List (N); + when Field_Index_Subtype_List => + return Get_Index_Subtype_List (N); + when Field_Index_Subtype_Definition_List => + return Get_Index_Subtype_Definition_List (N); + when Field_Index_Constraint_List => + return Get_Index_Constraint_List (N); + when Field_Elements_Declaration_List => + return Get_Elements_Declaration_List (N); + when Field_Index_List => + return Get_Index_List (N); + when Field_Sensitivity_List => + return Get_Sensitivity_List (N); + when Field_Callees_List => + return Get_Callees_List (N); + when Field_Guard_Sensitivity_List => + return Get_Guard_Sensitivity_List (N); + when Field_Instantiation_List => + return Get_Instantiation_List (N); + when Field_Incomplete_Type_List => + return Get_Incomplete_Type_List (N); + when Field_Type_Marks_List => + return Get_Type_Marks_List (N); + when Field_Overload_List => + return Get_Overload_List (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_List; + + procedure Set_Iir_List + (N : Iir; F : Fields_Enum; V: Iir_List) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_List); + case F is + when Field_File_Dependence_List => + Set_File_Dependence_List (N, V); + when Field_Dependence_List => + Set_Dependence_List (N, V); + when Field_Analysis_Checks_List => + Set_Analysis_Checks_List (N, V); + when Field_Simple_Aggregate_List => + Set_Simple_Aggregate_List (N, V); + when Field_Entity_Name_List => + Set_Entity_Name_List (N, V); + when Field_Signal_List => + Set_Signal_List (N, V); + when Field_Enumeration_Literal_List => + Set_Enumeration_Literal_List (N, V); + when Field_Group_Constituent_List => + Set_Group_Constituent_List (N, V); + when Field_Index_Subtype_List => + Set_Index_Subtype_List (N, V); + when Field_Index_Subtype_Definition_List => + Set_Index_Subtype_Definition_List (N, V); + when Field_Index_Constraint_List => + Set_Index_Constraint_List (N, V); + when Field_Elements_Declaration_List => + Set_Elements_Declaration_List (N, V); + when Field_Index_List => + Set_Index_List (N, V); + when Field_Sensitivity_List => + Set_Sensitivity_List (N, V); + when Field_Callees_List => + Set_Callees_List (N, V); + when Field_Guard_Sensitivity_List => + Set_Guard_Sensitivity_List (N, V); + when Field_Instantiation_List => + Set_Instantiation_List (N, V); + when Field_Incomplete_Type_List => + Set_Incomplete_Type_List (N, V); + when Field_Type_Marks_List => + Set_Type_Marks_List (N, V); + when Field_Overload_List => + Set_Overload_List (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_List; + + function Get_Iir_Mode + (N : Iir; F : Fields_Enum) return Iir_Mode is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Mode); + case F is + when Field_Mode => + return Get_Mode (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Mode; + + procedure Set_Iir_Mode + (N : Iir; F : Fields_Enum; V: Iir_Mode) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Mode); + case F is + when Field_Mode => + Set_Mode (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Mode; + + function Get_Iir_Predefined_Functions + (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions); + case F is + when Field_Implicit_Definition => + return Get_Implicit_Definition (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Predefined_Functions; + + procedure Set_Iir_Predefined_Functions + (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Predefined_Functions); + case F is + when Field_Implicit_Definition => + Set_Implicit_Definition (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Predefined_Functions; + + function Get_Iir_Pure_State + (N : Iir; F : Fields_Enum) return Iir_Pure_State is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Pure_State); + case F is + when Field_Purity_State => + return Get_Purity_State (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Pure_State; + + procedure Set_Iir_Pure_State + (N : Iir; F : Fields_Enum; V: Iir_Pure_State) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Pure_State); + case F is + when Field_Purity_State => + Set_Purity_State (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Pure_State; + + function Get_Iir_Signal_Kind + (N : Iir; F : Fields_Enum) return Iir_Signal_Kind is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind); + case F is + when Field_Signal_Kind => + return Get_Signal_Kind (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Signal_Kind; + + procedure Set_Iir_Signal_Kind + (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Signal_Kind); + case F is + when Field_Signal_Kind => + Set_Signal_Kind (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Signal_Kind; + + function Get_Iir_Staticness + (N : Iir; F : Fields_Enum) return Iir_Staticness is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Staticness); + case F is + when Field_Type_Staticness => + return Get_Type_Staticness (N); + when Field_Expr_Staticness => + return Get_Expr_Staticness (N); + when Field_Name_Staticness => + return Get_Name_Staticness (N); + when Field_Value_Staticness => + return Get_Value_Staticness (N); + when Field_Choice_Staticness => + return Get_Choice_Staticness (N); + when others => + raise Internal_Error; + end case; + end Get_Iir_Staticness; + + procedure Set_Iir_Staticness + (N : Iir; F : Fields_Enum; V: Iir_Staticness) is + begin + pragma Assert (Fields_Type (F) = Type_Iir_Staticness); + case F is + when Field_Type_Staticness => + Set_Type_Staticness (N, V); + when Field_Expr_Staticness => + Set_Expr_Staticness (N, V); + when Field_Name_Staticness => + Set_Name_Staticness (N, V); + when Field_Value_Staticness => + Set_Value_Staticness (N, V); + when Field_Choice_Staticness => + Set_Choice_Staticness (N, V); + when others => + raise Internal_Error; + end case; + end Set_Iir_Staticness; + + function Get_Int32 + (N : Iir; F : Fields_Enum) return Int32 is + begin + pragma Assert (Fields_Type (F) = Type_Int32); + case F is + when Field_Design_Unit_Source_Line => + return Get_Design_Unit_Source_Line (N); + when Field_Design_Unit_Source_Col => + return Get_Design_Unit_Source_Col (N); + when Field_String_Length => + return Get_String_Length (N); + when others => + raise Internal_Error; + end case; + end Get_Int32; + + procedure Set_Int32 + (N : Iir; F : Fields_Enum; V: Int32) is + begin + pragma Assert (Fields_Type (F) = Type_Int32); + case F is + when Field_Design_Unit_Source_Line => + Set_Design_Unit_Source_Line (N, V); + when Field_Design_Unit_Source_Col => + Set_Design_Unit_Source_Col (N, V); + when Field_String_Length => + Set_String_Length (N, V); + when others => + raise Internal_Error; + end case; + end Set_Int32; + + function Get_Location_Type + (N : Iir; F : Fields_Enum) return Location_Type is + begin + pragma Assert (Fields_Type (F) = Type_Location_Type); + case F is + when Field_End_Location => + return Get_End_Location (N); + when others => + raise Internal_Error; + end case; + end Get_Location_Type; + + procedure Set_Location_Type + (N : Iir; F : Fields_Enum; V: Location_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Location_Type); + case F is + when Field_End_Location => + Set_End_Location (N, V); + when others => + raise Internal_Error; + end case; + end Set_Location_Type; + + function Get_Name_Id + (N : Iir; F : Fields_Enum) return Name_Id is + begin + pragma Assert (Fields_Type (F) = Type_Name_Id); + case F is + when Field_Design_File_Filename => + return Get_Design_File_Filename (N); + when Field_Design_File_Directory => + return Get_Design_File_Directory (N); + when Field_Library_Directory => + return Get_Library_Directory (N); + when Field_Identifier => + return Get_Identifier (N); + when Field_Label => + return Get_Label (N); + when Field_Simple_Name_Identifier => + return Get_Simple_Name_Identifier (N); + when others => + raise Internal_Error; + end case; + end Get_Name_Id; + + procedure Set_Name_Id + (N : Iir; F : Fields_Enum; V: Name_Id) is + begin + pragma Assert (Fields_Type (F) = Type_Name_Id); + case F is + when Field_Design_File_Filename => + Set_Design_File_Filename (N, V); + when Field_Design_File_Directory => + Set_Design_File_Directory (N, V); + when Field_Library_Directory => + Set_Library_Directory (N, V); + when Field_Identifier => + Set_Identifier (N, V); + when Field_Label => + Set_Label (N, V); + when Field_Simple_Name_Identifier => + Set_Simple_Name_Identifier (N, V); + when others => + raise Internal_Error; + end case; + end Set_Name_Id; + + function Get_PSL_NFA + (N : Iir; F : Fields_Enum) return PSL_NFA is + begin + pragma Assert (Fields_Type (F) = Type_PSL_NFA); + case F is + when Field_PSL_NFA => + return Get_PSL_NFA (N); + when others => + raise Internal_Error; + end case; + end Get_PSL_NFA; + + procedure Set_PSL_NFA + (N : Iir; F : Fields_Enum; V: PSL_NFA) is + begin + pragma Assert (Fields_Type (F) = Type_PSL_NFA); + case F is + when Field_PSL_NFA => + Set_PSL_NFA (N, V); + when others => + raise Internal_Error; + end case; + end Set_PSL_NFA; + + function Get_PSL_Node + (N : Iir; F : Fields_Enum) return PSL_Node is + begin + pragma Assert (Fields_Type (F) = Type_PSL_Node); + case F is + when Field_Psl_Property => + return Get_Psl_Property (N); + when Field_Psl_Declaration => + return Get_Psl_Declaration (N); + when Field_Psl_Expression => + return Get_Psl_Expression (N); + when Field_Psl_Boolean => + return Get_Psl_Boolean (N); + when Field_PSL_Clock => + return Get_PSL_Clock (N); + when others => + raise Internal_Error; + end case; + end Get_PSL_Node; + + procedure Set_PSL_Node + (N : Iir; F : Fields_Enum; V: PSL_Node) is + begin + pragma Assert (Fields_Type (F) = Type_PSL_Node); + case F is + when Field_Psl_Property => + Set_Psl_Property (N, V); + when Field_Psl_Declaration => + Set_Psl_Declaration (N, V); + when Field_Psl_Expression => + Set_Psl_Expression (N, V); + when Field_Psl_Boolean => + Set_Psl_Boolean (N, V); + when Field_PSL_Clock => + Set_PSL_Clock (N, V); + when others => + raise Internal_Error; + end case; + end Set_PSL_Node; + + function Get_Source_Ptr + (N : Iir; F : Fields_Enum) return Source_Ptr is + begin + pragma Assert (Fields_Type (F) = Type_Source_Ptr); + case F is + when Field_Design_Unit_Source_Pos => + return Get_Design_Unit_Source_Pos (N); + when others => + raise Internal_Error; + end case; + end Get_Source_Ptr; + + procedure Set_Source_Ptr + (N : Iir; F : Fields_Enum; V: Source_Ptr) is + begin + pragma Assert (Fields_Type (F) = Type_Source_Ptr); + case F is + when Field_Design_Unit_Source_Pos => + Set_Design_Unit_Source_Pos (N, V); + when others => + raise Internal_Error; + end case; + end Set_Source_Ptr; + + function Get_String_Id + (N : Iir; F : Fields_Enum) return String_Id is + begin + pragma Assert (Fields_Type (F) = Type_String_Id); + case F is + when Field_String_Id => + return Get_String_Id (N); + when others => + raise Internal_Error; + end case; + end Get_String_Id; + + procedure Set_String_Id + (N : Iir; F : Fields_Enum; V: String_Id) is + begin + pragma Assert (Fields_Type (F) = Type_String_Id); + case F is + when Field_String_Id => + Set_String_Id (N, V); + when others => + raise Internal_Error; + end case; + end Set_String_Id; + + function Get_Time_Stamp_Id + (N : Iir; F : Fields_Enum) return Time_Stamp_Id is + begin + pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); + case F is + when Field_File_Time_Stamp => + return Get_File_Time_Stamp (N); + when Field_Analysis_Time_Stamp => + return Get_Analysis_Time_Stamp (N); + when others => + raise Internal_Error; + end case; + end Get_Time_Stamp_Id; + + procedure Set_Time_Stamp_Id + (N : Iir; F : Fields_Enum; V: Time_Stamp_Id) is + begin + pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); + case F is + when Field_File_Time_Stamp => + Set_File_Time_Stamp (N, V); + when Field_Analysis_Time_Stamp => + Set_Analysis_Time_Stamp (N, V); + when others => + raise Internal_Error; + end case; + end Set_Time_Stamp_Id; + + function Get_Token_Type + (N : Iir; F : Fields_Enum) return Token_Type is + begin + pragma Assert (Fields_Type (F) = Type_Token_Type); + case F is + when Field_Entity_Class => + return Get_Entity_Class (N); + when others => + raise Internal_Error; + end case; + end Get_Token_Type; + + procedure Set_Token_Type + (N : Iir; F : Fields_Enum; V: Token_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Token_Type); + case F is + when Field_Entity_Class => + Set_Entity_Class (N, V); + when others => + raise Internal_Error; + end case; + end Set_Token_Type; + + function Get_Tri_State_Type + (N : Iir; F : Fields_Enum) return Tri_State_Type is + begin + pragma Assert (Fields_Type (F) = Type_Tri_State_Type); + case F is + when Field_Guarded_Target_State => + return Get_Guarded_Target_State (N); + when Field_Wait_State => + return Get_Wait_State (N); + when others => + raise Internal_Error; + end case; + end Get_Tri_State_Type; + + procedure Set_Tri_State_Type + (N : Iir; F : Fields_Enum; V: Tri_State_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Tri_State_Type); + case F is + when Field_Guarded_Target_State => + Set_Guarded_Target_State (N, V); + when Field_Wait_State => + Set_Wait_State (N, V); + when others => + raise Internal_Error; + end case; + end Set_Tri_State_Type; + + function Has_First_Design_Unit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_First_Design_Unit; + + function Has_Last_Design_Unit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_Last_Design_Unit; + + function Has_Library_Declaration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Library_Clause; + end Has_Library_Declaration; + + function Has_File_Time_Stamp (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_File_Time_Stamp; + + function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_Analysis_Time_Stamp; + + function Has_Library (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_Library; + + function Has_File_Dependence_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_File_Dependence_List; + + function Has_Design_File_Filename (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_Design_File_Filename; + + function Has_Design_File_Directory (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_File; + end Has_Design_File_Directory; + + function Has_Design_File (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Design_File; + + function Has_Design_File_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Library_Declaration; + end Has_Design_File_Chain; + + function Has_Library_Directory (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Library_Declaration; + end Has_Library_Directory; + + function Has_Date (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Design_Unit + | Iir_Kind_Library_Declaration => + return True; + when others => + return False; + end case; + end Has_Date; + + function Has_Context_Items (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Context_Items; + + function Has_Dependence_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Dependence_List; + + function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Analysis_Checks_List; + + function Has_Date_State (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Date_State; + + function Has_Guarded_Target_State (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + return True; + when others => + return False; + end case; + end Has_Guarded_Target_State; + + function Has_Library_Unit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Library_Unit; + + function Has_Hash_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Hash_Chain; + + function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Design_Unit_Source_Pos; + + function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Design_Unit_Source_Line; + + function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Design_Unit_Source_Col; + + function Has_Value (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Integer_Literal + | Iir_Kind_Physical_Int_Literal => + return True; + when others => + return False; + end case; + end Has_Value; + + function Has_Enum_Pos (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Enumeration_Literal; + end Has_Enum_Pos; + + function Has_Physical_Literal (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Unit_Declaration; + end Has_Physical_Literal; + + function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Unit_Declaration; + end Has_Physical_Unit_Value; + + function Has_Fp_Value (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Floating_Point_Literal + | Iir_Kind_Physical_Fp_Literal => + return True; + when others => + return False; + end case; + end Has_Fp_Value; + + function Has_Enumeration_Decl (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Enumeration_Literal; + end Has_Enumeration_Decl; + + function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Simple_Aggregate; + end Has_Simple_Aggregate_List; + + function Has_Bit_String_Base (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Bit_String_Literal; + end Has_Bit_String_Base; + + function Has_Bit_String_0 (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Bit_String_Literal; + end Has_Bit_String_0; + + function Has_Bit_String_1 (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Bit_String_Literal; + end Has_Bit_String_1; + + function Has_Literal_Origin (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Overflow_Literal + | Iir_Kind_Enumeration_Literal => + return True; + when others => + return False; + end case; + end Has_Literal_Origin; + + function Has_Range_Origin (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Range_Expression; + end Has_Range_Origin; + + function Has_Literal_Subtype (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_String_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Aggregate => + return True; + when others => + return False; + end case; + end Has_Literal_Subtype; + + function Has_Entity_Class (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Specification => + return True; + when others => + return False; + end case; + end Has_Entity_Class; + + function Has_Entity_Name_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Specification; + end Has_Entity_Name_List; + + function Has_Attribute_Designator (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Specification; + end Has_Attribute_Designator; + + function Has_Attribute_Specification_Chain (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Attribute_Specification; + end Has_Attribute_Specification_Chain; + + function Has_Attribute_Specification (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Value; + end Has_Attribute_Specification; + + function Has_Signal_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Disconnection_Specification; + end Has_Signal_List; + + function Has_Designated_Entity (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Value; + end Has_Designated_Entity; + + function Has_Formal (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + return True; + when others => + return False; + end case; + end Has_Formal; + + function Has_Actual (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Expression; + end Has_Actual; + + function Has_In_Conversion (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Expression; + end Has_In_Conversion; + + function Has_Out_Conversion (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Expression; + end Has_Out_Conversion; + + function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + return True; + when others => + return False; + end case; + end Has_Whole_Association_Flag; + + function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + return True; + when others => + return False; + end case; + end Has_Collapse_Signal_Flag; + + function Has_Artificial_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_Open; + end Has_Artificial_Flag; + + function Has_Open_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Signal_Interface_Declaration; + end Has_Open_Flag; + + function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_After_Drivers_Flag; + + function Has_We_Value (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Waveform_Element; + end Has_We_Value; + + function Has_Time (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Waveform_Element; + end Has_Time; + + function Has_Associated_Expr (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name => + return True; + when others => + return False; + end case; + end Has_Associated_Expr; + + function Has_Associated_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name => + return True; + when others => + return False; + end case; + end Has_Associated_Chain; + + function Has_Choice_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Choice_By_Name; + end Has_Choice_Name; + + function Has_Choice_Expression (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Choice_By_Expression; + end Has_Choice_Expression; + + function Has_Choice_Range (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Choice_By_Range; + end Has_Choice_Range; + + function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name => + return True; + when others => + return False; + end case; + end Has_Same_Alternative_Flag; + + function Has_Architecture (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Entity_Aspect_Entity; + end Has_Architecture; + + function Has_Block_Specification (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Configuration; + end Has_Block_Specification; + + function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Configuration; + end Has_Prev_Block_Configuration; + + function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Configuration; + end Has_Configuration_Item_Chain; + + function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Unit_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + return True; + when others => + return False; + end case; + end Has_Attribute_Value_Chain; + + function Has_Spec_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Value; + end Has_Spec_Chain; + + function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Specification; + end Has_Attribute_Value_Spec_Chain; + + function Has_Entity_Name (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Aspect_Entity + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Architecture_Body => + return True; + when others => + return False; + end case; + end Has_Entity_Name; + + function Has_Package (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Package_Body; + end Has_Package; + + function Has_Package_Body (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration => + return True; + when others => + return False; + end case; + end Has_Package_Body; + + function Has_Need_Body (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Package_Declaration; + end Has_Need_Body; + + function Has_Block_Configuration (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Declaration => + return True; + when others => + return False; + end case; + end Has_Block_Configuration; + + function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + return True; + when others => + return False; + end case; + end Has_Concurrent_Statement_Chain; + + function Has_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Waveform_Element + | Iir_Kind_Conditional_Waveform + | Iir_Kind_Association_Element_By_Expression + | Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Entity_Class + | Iir_Kind_Attribute_Value + | Iir_Kind_Record_Element_Resolution + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + return True; + when others => + return False; + end case; + end Has_Chain; + + function Has_Port_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Entity_Declaration + | Iir_Kind_Component_Declaration => + return True; + when others => + return False; + end case; + end Has_Port_Chain; + + function Has_Generic_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Header + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Generic_Chain; + + function Has_Type (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Overflow_Literal + | Iir_Kind_Attribute_Value + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Range_Expression + | Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Unit_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Parenthesis_Expression + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Psl_Expression + | Iir_Kind_Return_Statement + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Base_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Type; + + function Has_Subtype_Indication (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Allocator_By_Subtype => + return True; + when others => + return False; + end case; + end Has_Subtype_Indication; + + function Has_Discrete_Range (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Iterator_Declaration; + end Has_Discrete_Range; + + function Has_Type_Definition (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration => + return True; + when others => + return False; + end case; + end Has_Type_Definition; + + function Has_Subtype_Definition (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Anonymous_Type_Declaration; + end Has_Subtype_Definition; + + function Has_Nature (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Terminal_Declaration => + return True; + when others => + return False; + end case; + end Has_Nature; + + function Has_Mode (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_File_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Mode; + + function Has_Signal_Kind (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Signal_Kind; + + function Has_Base_Name (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Attribute_Value + | Iir_Kind_Function_Call + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Base_Name; + + function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Interface_Declaration_Chain; + + function Has_Subprogram_Specification (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + return True; + when others => + return False; + end case; + end Has_Subprogram_Specification; + + function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Sequential_Statement_Chain; + + function Has_Subprogram_Body (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Subprogram_Body; + + function Has_Overload_Number (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Overload_Number; + + function Has_Subprogram_Depth (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Subprogram_Depth; + + function Has_Subprogram_Hash (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Subprogram_Hash; + + function Has_Impure_Depth (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + return True; + when others => + return False; + end case; + end Has_Impure_Depth; + + function Has_Return_Type (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + return True; + when others => + return False; + end case; + end Has_Return_Type; + + function Has_Implicit_Definition (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Implicit_Definition; + + function Has_Type_Reference (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Type_Reference; + + function Has_Default_Value (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Default_Value; + + function Has_Deferred_Declaration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Constant_Declaration; + end Has_Deferred_Declaration; + + function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Constant_Declaration; + end Has_Deferred_Declaration_Flag; + + function Has_Shared_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Variable_Declaration; + end Has_Shared_Flag; + + function Has_Design_Unit (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body => + return True; + when others => + return False; + end case; + end Has_Design_Unit; + + function Has_Block_Statement (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Guard_Signal_Declaration; + end Has_Block_Statement; + + function Has_Signal_Driver (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Signal_Declaration; + end Has_Signal_Driver; + + function Has_Declaration_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Configuration + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + return True; + when others => + return False; + end case; + end Has_Declaration_Chain; + + function Has_File_Logical_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_File_Declaration; + end Has_File_Logical_Name; + + function Has_File_Open_Kind (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_File_Declaration; + end Has_File_Open_Kind; + + function Has_Element_Position (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Record_Element_Constraint + | Iir_Kind_Element_Declaration => + return True; + when others => + return False; + end case; + end Has_Element_Position; + + function Has_Element_Declaration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Record_Element_Constraint; + end Has_Element_Declaration; + + function Has_Selected_Element (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Selected_Element; + end Has_Selected_Element; + + function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Use_Clause; + end Has_Use_Clause_Chain; + + function Has_Selected_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Use_Clause; + end Has_Selected_Name; + + function Has_Type_Declarator (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Type_Declarator; + + function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Enumeration_Type_Definition; + end Has_Enumeration_Literal_List; + + function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Group_Template_Declaration; + end Has_Entity_Class_Entry_Chain; + + function Has_Group_Constituent_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Group_Declaration; + end Has_Group_Constituent_List; + + function Has_Unit_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Physical_Type_Definition; + end Has_Unit_Chain; + + function Has_Primary_Unit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Physical_Type_Definition; + end Has_Primary_Unit; + + function Has_Identifier (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Record_Element_Resolution + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Identifier; + + function Has_Label (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + return True; + when others => + return False; + end case; + end Has_Label; + + function Has_Visible_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Record_Element_Constraint + | Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Unit_Declaration + | Iir_Kind_Library_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + return True; + when others => + return False; + end case; + end Has_Visible_Flag; + + function Has_Range_Constraint (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Range_Constraint; + + function Has_Direction (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Range_Expression; + end Has_Direction; + + function Has_Left_Limit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Range_Expression; + end Has_Left_Limit; + + function Has_Right_Limit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Range_Expression; + end Has_Right_Limit; + + function Has_Base_Type (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Base_Type; + + function Has_Resolution_Indication (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Element_Resolution + | Iir_Kind_Record_Element_Resolution + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Resolution_Indication; + + function Has_Record_Element_Resolution_Chain (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Record_Resolution; + end Has_Record_Element_Resolution_Chain; + + function Has_Tolerance (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Subtype_Definition + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Simple_Simultaneous_Statement => + return True; + when others => + return False; + end case; + end Has_Tolerance; + + function Has_Plus_Terminal (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration => + return True; + when others => + return False; + end case; + end Has_Plus_Terminal; + + function Has_Minus_Terminal (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration => + return True; + when others => + return False; + end case; + end Has_Minus_Terminal; + + function Has_Simultaneous_Left (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Simple_Simultaneous_Statement; + end Has_Simultaneous_Left; + + function Has_Simultaneous_Right (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Simple_Simultaneous_Statement; + end Has_Simultaneous_Right; + + function Has_Text_File_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_File_Type_Definition; + end Has_Text_File_Flag; + + function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Enumeration_Type_Definition; + end Has_Only_Characters_Flag; + + function Has_Type_Staticness (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Type_Staticness; + + function Has_Constraint_State (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Constraint_State; + + function Has_Index_Subtype_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Index_Subtype_List; + + function Has_Index_Subtype_Definition_List (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Array_Type_Definition; + end Has_Index_Subtype_Definition_List; + + function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Array_Type_Definition; + end Has_Element_Subtype_Indication; + + function Has_Element_Subtype (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Element_Subtype; + + function Has_Index_Constraint_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Array_Subtype_Definition; + end Has_Index_Constraint_List; + + function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Array_Subtype_Definition; + end Has_Array_Element_Constraint; + + function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Elements_Declaration_List; + + function Has_Designated_Type (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Access_Type_Definition + | Iir_Kind_Access_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Designated_Type; + + function Has_Designated_Subtype_Indication (K : Iir_Kind) + return Boolean is + begin + case K is + when Iir_Kind_Access_Type_Definition + | Iir_Kind_Access_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Designated_Subtype_Indication; + + function Has_Index_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Indexed_Name; + end Has_Index_List; + + function Has_Reference (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Scalar_Nature_Definition; + end Has_Reference; + + function Has_Nature_Declarator (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Scalar_Nature_Definition; + end Has_Nature_Declarator; + + function Has_Across_Type (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Scalar_Nature_Definition; + end Has_Across_Type; + + function Has_Through_Type (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Scalar_Nature_Definition; + end Has_Through_Type; + + function Has_Target (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Variable_Assignment_Statement => + return True; + when others => + return False; + end case; + end Has_Target; + + function Has_Waveform_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Conditional_Waveform + | Iir_Kind_Signal_Assignment_Statement => + return True; + when others => + return False; + end case; + end Has_Waveform_Chain; + + function Has_Guard (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment => + return True; + when others => + return False; + end case; + end Has_Guard; + + function Has_Delay_Mechanism (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + return True; + when others => + return False; + end case; + end Has_Delay_Mechanism; + + function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Signal_Assignment_Statement => + return True; + when others => + return False; + end case; + end Has_Reject_Time_Expression; + + function Has_Sensitivity_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Wait_Statement => + return True; + when others => + return False; + end case; + end Has_Sensitivity_List; + + function Has_Process_Origin (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Process_Origin; + + function Has_Condition_Clause (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Wait_Statement; + end Has_Condition_Clause; + + function Has_Timeout_Clause (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Wait_Statement; + end Has_Timeout_Clause; + + function Has_Postponed_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement => + return True; + when others => + return False; + end case; + end Has_Postponed_Flag; + + function Has_Callees_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Callees_List; + + function Has_Passive_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Passive_Flag; + + function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Function_Declaration; + end Has_Resolution_Function_Flag; + + function Has_Wait_State (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Wait_State; + + function Has_All_Sensitized_State (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_All_Sensitized_State; + + function Has_Seen_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Seen_Flag; + + function Has_Pure_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration => + return True; + when others => + return False; + end case; + end Has_Pure_Flag; + + function Has_Foreign_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Architecture_Body + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Foreign_Flag; + + function Has_Resolved_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Resolved_Flag; + + function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Access_Type_Definition + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_File_Type_Definition + | Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Signal_Type_Flag; + + function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Incomplete_Type_Definition + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Type_Definition => + return True; + when others => + return False; + end case; + end Has_Has_Signal_Flag; + + function Has_Purity_State (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Procedure_Declaration; + end Has_Purity_State; + + function Has_Elab_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit => + return True; + when others => + return False; + end case; + end Has_Elab_Flag; + + function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Index_Constraint_Flag; + + function Has_Assertion_Condition (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Assertion_Statement => + return True; + when others => + return False; + end case; + end Has_Assertion_Condition; + + function Has_Report_Expression (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + return True; + when others => + return False; + end case; + end Has_Report_Expression; + + function Has_Severity_Expression (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement => + return True; + when others => + return False; + end case; + end Has_Severity_Expression; + + function Has_Instantiated_Unit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Component_Instantiation_Statement; + end Has_Instantiated_Unit; + + function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Binding_Indication + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Header + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Component_Instantiation_Statement => + return True; + when others => + return False; + end case; + end Has_Generic_Map_Aspect_Chain; + + function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Block_Header + | Iir_Kind_Binding_Indication + | Iir_Kind_Component_Instantiation_Statement => + return True; + when others => + return False; + end case; + end Has_Port_Map_Aspect_Chain; + + function Has_Configuration_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Entity_Aspect_Configuration; + end Has_Configuration_Name; + + function Has_Component_Configuration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Component_Instantiation_Statement; + end Has_Component_Configuration; + + function Has_Configuration_Specification (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Component_Instantiation_Statement; + end Has_Configuration_Specification; + + function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Component_Instantiation_Statement; + end Has_Default_Binding_Indication; + + function Has_Default_Configuration_Declaration (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Architecture_Body; + end Has_Default_Configuration_Declaration; + + function Has_Expression (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Parenthesis_Expression + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_Case_Statement => + return True; + when others => + return False; + end case; + end Has_Expression; + + function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype => + return True; + when others => + return False; + end case; + end Has_Allocator_Designated_Type; + + function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Concurrent_Selected_Signal_Assignment; + end Has_Selected_Waveform_Chain; + + function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Concurrent_Conditional_Signal_Assignment; + end Has_Conditional_Waveform_Chain; + + function Has_Guard_Expression (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Guard_Signal_Declaration; + end Has_Guard_Expression; + + function Has_Guard_Decl (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Statement; + end Has_Guard_Decl; + + function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Guard_Signal_Declaration; + end Has_Guard_Sensitivity_List; + + function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Statement; + end Has_Block_Block_Configuration; + + function Has_Package_Header (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Package_Declaration; + end Has_Package_Header; + + function Has_Block_Header (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Block_Statement; + end Has_Block_Header; + + function Has_Uninstantiated_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Package_Instantiation_Declaration; + end Has_Uninstantiated_Name; + + function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Generate_Statement; + end Has_Generate_Block_Configuration; + + function Has_Generation_Scheme (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Generate_Statement; + end Has_Generation_Scheme; + + function Has_Condition (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Conditional_Waveform + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Condition; + + function Has_Else_Clause (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Else_Clause; + + function Has_Parameter_Specification (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_For_Loop_Statement; + end Has_Parameter_Specification; + + function Has_Parent (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Design_File + | Iir_Kind_Design_Unit + | Iir_Kind_Library_Clause + | Iir_Kind_Use_Clause + | Iir_Kind_Choice_By_Others + | Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range + | Iir_Kind_Choice_By_None + | Iir_Kind_Choice_By_Name + | Iir_Kind_Block_Configuration + | Iir_Kind_Component_Configuration + | Iir_Kind_Record_Element_Constraint + | Iir_Kind_Attribute_Specification + | Iir_Kind_Disconnection_Specification + | Iir_Kind_Configuration_Specification + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Unit_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_Simple_Simultaneous_Statement + | Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Variable_Assignment_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_Parent; + + function Has_Loop_Label (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement => + return True; + when others => + return False; + end case; + end Has_Loop_Label; + + function Has_Component_Name (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + return True; + when others => + return False; + end case; + end Has_Component_Name; + + function Has_Instantiation_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + return True; + when others => + return False; + end case; + end Has_Instantiation_List; + + function Has_Entity_Aspect (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Binding_Indication; + end Has_Entity_Aspect; + + function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Binding_Indication; + end Has_Default_Entity_Aspect; + + function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Binding_Indication; + end Has_Default_Generic_Map_Aspect_Chain; + + function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Binding_Indication; + end Has_Default_Port_Map_Aspect_Chain; + + function Has_Binding_Indication (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Component_Configuration + | Iir_Kind_Configuration_Specification => + return True; + when others => + return False; + end case; + end Has_Binding_Indication; + + function Has_Named_Entity (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Named_Entity; + + function Has_Alias_Declaration (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol => + return True; + when others => + return False; + end case; + end Has_Alias_Declaration; + + function Has_Expr_Staticness (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Error + | Iir_Kind_Integer_Literal + | Iir_Kind_Floating_Point_Literal + | Iir_Kind_Null_Literal + | Iir_Kind_String_Literal + | Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal + | Iir_Kind_Bit_String_Literal + | Iir_Kind_Simple_Aggregate + | Iir_Kind_Overflow_Literal + | Iir_Kind_Attribute_Value + | Iir_Kind_Range_Expression + | Iir_Kind_Unit_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call + | Iir_Kind_Aggregate + | Iir_Kind_Parenthesis_Expression + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion + | Iir_Kind_Allocator_By_Expression + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Expr_Staticness; + + function Has_Error_Origin (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Error; + end Has_Error_Origin; + + function Has_Operand (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator => + return True; + when others => + return False; + end case; + end Has_Operand; + + function Has_Left (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator => + return True; + when others => + return False; + end case; + end Has_Left; + + function Has_Right (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator => + return True; + when others => + return False; + end case; + end Has_Right; + + function Has_Unit_Name (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal => + return True; + when others => + return False; + end case; + end Has_Unit_Name; + + function Has_Name (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Object_Alias_Declaration => + return True; + when others => + return False; + end case; + end Has_Name; + + function Has_Group_Template_Name (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Group_Declaration; + end Has_Group_Template_Name; + + function Has_Name_Staticness (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Attribute_Value + | Iir_Kind_Unit_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Function_Call + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Character_Literal + | Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Name_Staticness; + + function Has_Prefix (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Call + | Iir_Kind_Function_Call + | Iir_Kind_Selected_Element + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Parenthesis_Name + | Iir_Kind_Base_Attribute + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Event_Attribute + | Iir_Kind_Active_Attribute + | Iir_Kind_Last_Event_Attribute + | Iir_Kind_Last_Active_Attribute + | Iir_Kind_Last_Value_Attribute + | Iir_Kind_Driving_Attribute + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kind_Attribute_Name => + return True; + when others => + return False; + end case; + end Has_Prefix; + + function Has_Signature_Prefix (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Signature; + end Has_Signature_Prefix; + + function Has_Slice_Subtype (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Slice_Name; + end Has_Slice_Subtype; + + function Has_Suffix (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Slice_Name; + end Has_Suffix; + + function Has_Index_Subtype (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => + return True; + when others => + return False; + end case; + end Has_Index_Subtype; + + function Has_Parameter (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => + return True; + when others => + return False; + end case; + end Has_Parameter; + + function Has_Actual_Type (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Individual; + end Has_Actual_Type; + + function Has_Association_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Parenthesis_Name; + end Has_Association_Chain; + + function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Association_Element_By_Individual; + end Has_Individual_Association_Chain; + + function Has_Aggregate_Info (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate; + end Has_Aggregate_Info; + + function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Sub_Aggregate_Info; + + function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_Dynamic_Flag; + + function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_Min_Length; + + function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_Low_Limit; + + function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_High_Limit; + + function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_Others_Flag; + + function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate_Info; + end Has_Aggr_Named_Flag; + + function Has_Value_Staticness (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate; + end Has_Value_Staticness; + + function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Aggregate; + end Has_Association_Choices_Chain; + + function Has_Case_Statement_Alternative_Chain (K : Iir_Kind) + return Boolean is + begin + return K = Iir_Kind_Case_Statement; + end Has_Case_Statement_Alternative_Chain; + + function Has_Choice_Staticness (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Choice_By_Expression + | Iir_Kind_Choice_By_Range => + return True; + when others => + return False; + end case; + end Has_Choice_Staticness; + + function Has_Procedure_Call (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_Procedure_Call_Statement => + return True; + when others => + return False; + end case; + end Has_Procedure_Call; + + function Has_Implementation (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Call + | Iir_Kind_Identity_Operator + | Iir_Kind_Negation_Operator + | Iir_Kind_Absolute_Operator + | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator + | Iir_Kind_And_Operator + | Iir_Kind_Or_Operator + | Iir_Kind_Nand_Operator + | Iir_Kind_Nor_Operator + | Iir_Kind_Xor_Operator + | Iir_Kind_Xnor_Operator + | Iir_Kind_Equality_Operator + | Iir_Kind_Inequality_Operator + | Iir_Kind_Less_Than_Operator + | Iir_Kind_Less_Than_Or_Equal_Operator + | Iir_Kind_Greater_Than_Operator + | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator + | Iir_Kind_Sll_Operator + | Iir_Kind_Sla_Operator + | Iir_Kind_Srl_Operator + | Iir_Kind_Sra_Operator + | Iir_Kind_Rol_Operator + | Iir_Kind_Ror_Operator + | Iir_Kind_Addition_Operator + | Iir_Kind_Substraction_Operator + | Iir_Kind_Concatenation_Operator + | Iir_Kind_Multiplication_Operator + | Iir_Kind_Division_Operator + | Iir_Kind_Modulus_Operator + | Iir_Kind_Remainder_Operator + | Iir_Kind_Exponentiation_Operator + | Iir_Kind_Function_Call => + return True; + when others => + return False; + end case; + end Has_Implementation; + + function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Call + | Iir_Kind_Function_Call => + return True; + when others => + return False; + end case; + end Has_Parameter_Association_Chain; + + function Has_Method_Object (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Call + | Iir_Kind_Function_Call => + return True; + when others => + return False; + end case; + end Has_Method_Object; + + function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition + | Iir_Kind_Access_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Subtype_Definition => + return True; + when others => + return False; + end case; + end Has_Subtype_Type_Mark; + + function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Type_Conversion; + end Has_Type_Conversion_Subtype; + + function Has_Type_Mark (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Disconnection_Specification + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Qualified_Expression + | Iir_Kind_Type_Conversion => + return True; + when others => + return False; + end case; + end Has_Type_Mark; + + function Has_File_Type_Mark (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_File_Type_Definition; + end Has_File_Type_Mark; + + function Has_Return_Type_Mark (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Signature + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Return_Type_Mark; + + function Has_Lexical_Layout (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Lexical_Layout; + + function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Incomplete_Type_Definition; + end Has_Incomplete_Type_List; + + function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Has_Disconnect_Flag; + + function Has_Has_Active_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Transaction_Attribute => + return True; + when others => + return False; + end case; + end Has_Has_Active_Flag; + + function Has_Is_Within_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Enumeration_Literal + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_For_Loop_Statement => + return True; + when others => + return False; + end case; + end Has_Is_Within_Flag; + + function Has_Type_Marks_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Signature; + end Has_Type_Marks_List; + + function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Non_Object_Alias_Declaration; + end Has_Implicit_Alias_Flag; + + function Has_Alias_Signature (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Non_Object_Alias_Declaration; + end Has_Alias_Signature; + + function Has_Attribute_Signature (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Attribute_Name; + end Has_Attribute_Signature; + + function Has_Overload_List (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Overload_List; + end Has_Overload_List; + + function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Simple_Name_Attribute; + end Has_Simple_Name_Identifier; + + function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Simple_Name_Attribute; + end Has_Simple_Name_Subtype; + + function Has_Protected_Type_Body (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Protected_Type_Declaration; + end Has_Protected_Type_Body; + + function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Protected_Type_Body; + end Has_Protected_Type_Declaration; + + function Has_End_Location (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_End_Location; + + function Has_String_Id (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_String_Literal + | Iir_Kind_Bit_String_Literal => + return True; + when others => + return False; + end case; + end Has_String_Id; + + function Has_String_Length (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_String_Literal + | Iir_Kind_Bit_String_Literal => + return True; + when others => + return False; + end case; + end Has_String_Length; + + function Has_Use_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Nature_Declaration + | Iir_Kind_Subnature_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Group_Template_Declaration + | Iir_Kind_Group_Declaration + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Psl_Declaration + | Iir_Kind_Terminal_Declaration + | Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Across_Quantity_Declaration + | Iir_Kind_Through_Quantity_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Use_Flag; + + function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement => + return True; + when others => + return False; + end case; + end Has_End_Has_Reserved_Id; + + function Has_End_Has_Identifier (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Protected_Type_Declaration + | Iir_Kind_Record_Type_Definition + | Iir_Kind_Physical_Type_Definition + | Iir_Kind_Protected_Type_Body + | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Package_Body + | Iir_Kind_Configuration_Declaration + | Iir_Kind_Entity_Declaration + | Iir_Kind_Architecture_Body + | Iir_Kind_Component_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement + | Iir_Kind_Block_Statement + | Iir_Kind_Generate_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_If_Statement + | Iir_Kind_Elsif => + return True; + when others => + return False; + end case; + end Has_End_Has_Identifier; + + function Has_End_Has_Postponed (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_End_Has_Postponed; + + function Has_Has_Begin (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Generate_Statement => + return True; + when others => + return False; + end case; + end Has_Has_Begin; + + function Has_Has_Is (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Component_Declaration + | Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Process_Statement => + return True; + when others => + return False; + end case; + end Has_Has_Is; + + function Has_Has_Pure (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Function_Declaration; + end Has_Has_Pure; + + function Has_Has_Body (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + return True; + when others => + return False; + end case; + end Has_Has_Body; + + function Has_Has_Identifier_List (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Library_Clause + | Iir_Kind_Element_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration => + return True; + when others => + return False; + end case; + end Has_Has_Identifier_List; + + function Has_Has_Mode (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_File_Declaration; + end Has_Has_Mode; + + function Has_Is_Ref (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Element_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Constant_Interface_Declaration + | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_File_Interface_Declaration => + return True; + when others => + return False; + end case; + end Has_Is_Ref; + + function Has_Psl_Property (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement => + return True; + when others => + return False; + end case; + end Has_Psl_Property; + + function Has_Psl_Declaration (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Psl_Declaration; + end Has_Psl_Declaration; + + function Has_Psl_Expression (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Psl_Expression; + end Has_Psl_Expression; + + function Has_Psl_Boolean (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Psl_Default_Clock; + end Has_Psl_Boolean; + + function Has_PSL_Clock (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement => + return True; + when others => + return False; + end case; + end Has_PSL_Clock; + + function Has_PSL_NFA (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Psl_Declaration + | Iir_Kind_Psl_Assert_Statement + | Iir_Kind_Psl_Cover_Statement => + return True; + when others => + return False; + end case; + end Has_PSL_NFA; + +end Nodes_Meta; diff --git a/nodes_meta.adb.in b/nodes_meta.adb.in new file mode 100644 index 000000000..d94c2d626 --- /dev/null +++ b/nodes_meta.adb.in @@ -0,0 +1,76 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package body Nodes_Meta is + Fields_Type : constant array (Fields_Enum) of Types_Enum := + ( + -- FIELDS_TYPE + ); + + function Get_Field_Type (F : Fields_Enum) return Types_Enum is + begin + return Fields_Type (F); + end Get_Field_Type; + + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + -- FIELD_IMAGE + end case; + end Get_Field_Image; + + function Get_Iir_Image (K : Iir_Kind) return String is + begin + case K is + -- IIR_IMAGE + end case; + end Get_Iir_Image; + + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is + begin + case F is + -- FIELD_ATTRIBUTE + end case; + end Get_Field_Attribute; + + Fields_Of_Iir : constant Fields_Array := + ( + -- FIELDS_ARRAY + ); + + Fields_Of_Iir_Last : constant array (Iir_Kind) of Integer := + ( + -- FIELDS_ARRAY_POS + ); + + function Get_Fields (K : Iir_Kind) return Fields_Array + is + First : Natural; + Last : Integer; + begin + if K = Iir_Kind'First then + First := Fields_Of_Iir'First; + else + First := Fields_Of_Iir_Last (Iir_Kind'Pred (K)) + 1; + end if; + Last := Fields_Of_Iir_Last (K); + return Fields_Of_Iir (First .. Last); + end Get_Fields; + + -- FUNCS_BODY +end Nodes_Meta; diff --git a/nodes_meta.ads b/nodes_meta.ads new file mode 100644 index 000000000..4183fc8a4 --- /dev/null +++ b/nodes_meta.ads @@ -0,0 +1,821 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; +with Tokens; use Tokens; + +package Nodes_Meta is + -- The enumeration of all possible types in the nodes. + type Types_Enum is + ( + Type_Base_Type, + Type_Boolean, + Type_Date_State_Type, + Type_Date_Type, + Type_Iir, + Type_Iir_All_Sensitized, + Type_Iir_Constraint, + Type_Iir_Delay_Mechanism, + Type_Iir_Direction, + Type_Iir_Fp64, + Type_Iir_Index32, + Type_Iir_Int32, + Type_Iir_Int64, + Type_Iir_Lexical_Layout_Type, + Type_Iir_List, + Type_Iir_Mode, + Type_Iir_Predefined_Functions, + Type_Iir_Pure_State, + Type_Iir_Signal_Kind, + Type_Iir_Staticness, + Type_Int32, + Type_Location_Type, + Type_Name_Id, + Type_PSL_NFA, + Type_PSL_Node, + Type_Source_Ptr, + Type_String_Id, + Type_Time_Stamp_Id, + Type_Token_Type, + Type_Tri_State_Type + ); + + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + Field_First_Design_Unit, + Field_Last_Design_Unit, + Field_Library_Declaration, + Field_File_Time_Stamp, + Field_Analysis_Time_Stamp, + Field_Library, + Field_File_Dependence_List, + Field_Design_File_Filename, + Field_Design_File_Directory, + Field_Design_File, + Field_Design_File_Chain, + Field_Library_Directory, + Field_Date, + Field_Context_Items, + Field_Dependence_List, + Field_Analysis_Checks_List, + Field_Date_State, + Field_Guarded_Target_State, + Field_Library_Unit, + Field_Hash_Chain, + Field_Design_Unit_Source_Pos, + Field_Design_Unit_Source_Line, + Field_Design_Unit_Source_Col, + Field_Value, + Field_Enum_Pos, + Field_Physical_Literal, + Field_Physical_Unit_Value, + Field_Fp_Value, + Field_Enumeration_Decl, + Field_Simple_Aggregate_List, + Field_Bit_String_Base, + Field_Bit_String_0, + Field_Bit_String_1, + Field_Literal_Origin, + Field_Range_Origin, + Field_Literal_Subtype, + Field_Entity_Class, + Field_Entity_Name_List, + Field_Attribute_Designator, + Field_Attribute_Specification_Chain, + Field_Attribute_Specification, + Field_Signal_List, + Field_Designated_Entity, + Field_Formal, + Field_Actual, + Field_In_Conversion, + Field_Out_Conversion, + Field_Whole_Association_Flag, + Field_Collapse_Signal_Flag, + Field_Artificial_Flag, + Field_Open_Flag, + Field_After_Drivers_Flag, + Field_We_Value, + Field_Time, + Field_Associated_Expr, + Field_Associated_Chain, + Field_Choice_Name, + Field_Choice_Expression, + Field_Choice_Range, + Field_Same_Alternative_Flag, + Field_Architecture, + Field_Block_Specification, + Field_Prev_Block_Configuration, + Field_Configuration_Item_Chain, + Field_Attribute_Value_Chain, + Field_Spec_Chain, + Field_Attribute_Value_Spec_Chain, + Field_Entity_Name, + Field_Package, + Field_Package_Body, + Field_Need_Body, + Field_Block_Configuration, + Field_Concurrent_Statement_Chain, + Field_Chain, + Field_Port_Chain, + Field_Generic_Chain, + Field_Type, + Field_Subtype_Indication, + Field_Discrete_Range, + Field_Type_Definition, + Field_Subtype_Definition, + Field_Nature, + Field_Mode, + Field_Signal_Kind, + Field_Base_Name, + Field_Interface_Declaration_Chain, + Field_Subprogram_Specification, + Field_Sequential_Statement_Chain, + Field_Subprogram_Body, + Field_Overload_Number, + Field_Subprogram_Depth, + Field_Subprogram_Hash, + Field_Impure_Depth, + Field_Return_Type, + Field_Implicit_Definition, + Field_Type_Reference, + Field_Default_Value, + Field_Deferred_Declaration, + Field_Deferred_Declaration_Flag, + Field_Shared_Flag, + Field_Design_Unit, + Field_Block_Statement, + Field_Signal_Driver, + Field_Declaration_Chain, + Field_File_Logical_Name, + Field_File_Open_Kind, + Field_Element_Position, + Field_Element_Declaration, + Field_Selected_Element, + Field_Use_Clause_Chain, + Field_Selected_Name, + Field_Type_Declarator, + Field_Enumeration_Literal_List, + Field_Entity_Class_Entry_Chain, + Field_Group_Constituent_List, + Field_Unit_Chain, + Field_Primary_Unit, + Field_Identifier, + Field_Label, + Field_Visible_Flag, + Field_Range_Constraint, + Field_Direction, + Field_Left_Limit, + Field_Right_Limit, + Field_Base_Type, + Field_Resolution_Indication, + Field_Record_Element_Resolution_Chain, + Field_Tolerance, + Field_Plus_Terminal, + Field_Minus_Terminal, + Field_Simultaneous_Left, + Field_Simultaneous_Right, + Field_Text_File_Flag, + Field_Only_Characters_Flag, + Field_Type_Staticness, + Field_Constraint_State, + Field_Index_Subtype_List, + Field_Index_Subtype_Definition_List, + Field_Element_Subtype_Indication, + Field_Element_Subtype, + Field_Index_Constraint_List, + Field_Array_Element_Constraint, + Field_Elements_Declaration_List, + Field_Designated_Type, + Field_Designated_Subtype_Indication, + Field_Index_List, + Field_Reference, + Field_Nature_Declarator, + Field_Across_Type, + Field_Through_Type, + Field_Target, + Field_Waveform_Chain, + Field_Guard, + Field_Delay_Mechanism, + Field_Reject_Time_Expression, + Field_Sensitivity_List, + Field_Process_Origin, + Field_Condition_Clause, + Field_Timeout_Clause, + Field_Postponed_Flag, + Field_Callees_List, + Field_Passive_Flag, + Field_Resolution_Function_Flag, + Field_Wait_State, + Field_All_Sensitized_State, + Field_Seen_Flag, + Field_Pure_Flag, + Field_Foreign_Flag, + Field_Resolved_Flag, + Field_Signal_Type_Flag, + Field_Has_Signal_Flag, + Field_Purity_State, + Field_Elab_Flag, + Field_Index_Constraint_Flag, + Field_Assertion_Condition, + Field_Report_Expression, + Field_Severity_Expression, + Field_Instantiated_Unit, + Field_Generic_Map_Aspect_Chain, + Field_Port_Map_Aspect_Chain, + Field_Configuration_Name, + Field_Component_Configuration, + Field_Configuration_Specification, + Field_Default_Binding_Indication, + Field_Default_Configuration_Declaration, + Field_Expression, + Field_Allocator_Designated_Type, + Field_Selected_Waveform_Chain, + Field_Conditional_Waveform_Chain, + Field_Guard_Expression, + Field_Guard_Decl, + Field_Guard_Sensitivity_List, + Field_Block_Block_Configuration, + Field_Package_Header, + Field_Block_Header, + Field_Uninstantiated_Name, + Field_Generate_Block_Configuration, + Field_Generation_Scheme, + Field_Condition, + Field_Else_Clause, + Field_Parameter_Specification, + Field_Parent, + Field_Loop_Label, + Field_Component_Name, + Field_Instantiation_List, + Field_Entity_Aspect, + Field_Default_Entity_Aspect, + Field_Default_Generic_Map_Aspect_Chain, + Field_Default_Port_Map_Aspect_Chain, + Field_Binding_Indication, + Field_Named_Entity, + Field_Alias_Declaration, + Field_Expr_Staticness, + Field_Error_Origin, + Field_Operand, + Field_Left, + Field_Right, + Field_Unit_Name, + Field_Name, + Field_Group_Template_Name, + Field_Name_Staticness, + Field_Prefix, + Field_Signature_Prefix, + Field_Slice_Subtype, + Field_Suffix, + Field_Index_Subtype, + Field_Parameter, + Field_Actual_Type, + Field_Association_Chain, + Field_Individual_Association_Chain, + Field_Aggregate_Info, + Field_Sub_Aggregate_Info, + Field_Aggr_Dynamic_Flag, + Field_Aggr_Min_Length, + Field_Aggr_Low_Limit, + Field_Aggr_High_Limit, + Field_Aggr_Others_Flag, + Field_Aggr_Named_Flag, + Field_Value_Staticness, + Field_Association_Choices_Chain, + Field_Case_Statement_Alternative_Chain, + Field_Choice_Staticness, + Field_Procedure_Call, + Field_Implementation, + Field_Parameter_Association_Chain, + Field_Method_Object, + Field_Subtype_Type_Mark, + Field_Type_Conversion_Subtype, + Field_Type_Mark, + Field_File_Type_Mark, + Field_Return_Type_Mark, + Field_Lexical_Layout, + Field_Incomplete_Type_List, + Field_Has_Disconnect_Flag, + Field_Has_Active_Flag, + Field_Is_Within_Flag, + Field_Type_Marks_List, + Field_Implicit_Alias_Flag, + Field_Alias_Signature, + Field_Attribute_Signature, + Field_Overload_List, + Field_Simple_Name_Identifier, + Field_Simple_Name_Subtype, + Field_Protected_Type_Body, + Field_Protected_Type_Declaration, + Field_End_Location, + Field_String_Id, + Field_String_Length, + Field_Use_Flag, + Field_End_Has_Reserved_Id, + Field_End_Has_Identifier, + Field_End_Has_Postponed, + Field_Has_Begin, + Field_Has_Is, + Field_Has_Pure, + Field_Has_Body, + Field_Has_Identifier_List, + Field_Has_Mode, + Field_Is_Ref, + Field_Psl_Property, + Field_Psl_Declaration, + Field_Psl_Expression, + Field_Psl_Boolean, + Field_PSL_Clock, + Field_PSL_NFA + ); + pragma Discard_Names (Fields_Enum); + + -- Return the type of field F. + function Get_Field_Type (F : Fields_Enum) return Types_Enum; + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + -- Get the name of a kind. + function Get_Iir_Image (K : Iir_Kind) return String; + + -- Possible attributes of a field. + type Field_Attribute is + ( + Attr_None, + Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, + Attr_Chain, Attr_Chain_Next + ); + + -- Get the attribute of a field. + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; + + type Fields_Array is array (Natural range <>) of Fields_Enum; + + -- Return the list of fields for node K. The fields are sorted: first + -- the non nodes/list of nodes, then the nodes/lists that aren't reference, + -- and then the reference. + function Get_Fields (K : Iir_Kind) return Fields_Array; + + -- Get/Set a field. + function Get_Base_Type + (N : Iir; F : Fields_Enum) return Base_Type; + procedure Set_Base_Type + (N : Iir; F : Fields_Enum; V: Base_Type); + + function Get_Boolean + (N : Iir; F : Fields_Enum) return Boolean; + procedure Set_Boolean + (N : Iir; F : Fields_Enum; V: Boolean); + + function Get_Date_State_Type + (N : Iir; F : Fields_Enum) return Date_State_Type; + procedure Set_Date_State_Type + (N : Iir; F : Fields_Enum; V: Date_State_Type); + + function Get_Date_Type + (N : Iir; F : Fields_Enum) return Date_Type; + procedure Set_Date_Type + (N : Iir; F : Fields_Enum; V: Date_Type); + + function Get_Iir + (N : Iir; F : Fields_Enum) return Iir; + procedure Set_Iir + (N : Iir; F : Fields_Enum; V: Iir); + + function Get_Iir_All_Sensitized + (N : Iir; F : Fields_Enum) return Iir_All_Sensitized; + procedure Set_Iir_All_Sensitized + (N : Iir; F : Fields_Enum; V: Iir_All_Sensitized); + + function Get_Iir_Constraint + (N : Iir; F : Fields_Enum) return Iir_Constraint; + procedure Set_Iir_Constraint + (N : Iir; F : Fields_Enum; V: Iir_Constraint); + + function Get_Iir_Delay_Mechanism + (N : Iir; F : Fields_Enum) return Iir_Delay_Mechanism; + procedure Set_Iir_Delay_Mechanism + (N : Iir; F : Fields_Enum; V: Iir_Delay_Mechanism); + + function Get_Iir_Direction + (N : Iir; F : Fields_Enum) return Iir_Direction; + procedure Set_Iir_Direction + (N : Iir; F : Fields_Enum; V: Iir_Direction); + + function Get_Iir_Fp64 + (N : Iir; F : Fields_Enum) return Iir_Fp64; + procedure Set_Iir_Fp64 + (N : Iir; F : Fields_Enum; V: Iir_Fp64); + + function Get_Iir_Index32 + (N : Iir; F : Fields_Enum) return Iir_Index32; + procedure Set_Iir_Index32 + (N : Iir; F : Fields_Enum; V: Iir_Index32); + + function Get_Iir_Int32 + (N : Iir; F : Fields_Enum) return Iir_Int32; + procedure Set_Iir_Int32 + (N : Iir; F : Fields_Enum; V: Iir_Int32); + + function Get_Iir_Int64 + (N : Iir; F : Fields_Enum) return Iir_Int64; + procedure Set_Iir_Int64 + (N : Iir; F : Fields_Enum; V: Iir_Int64); + + function Get_Iir_Lexical_Layout_Type + (N : Iir; F : Fields_Enum) return Iir_Lexical_Layout_Type; + procedure Set_Iir_Lexical_Layout_Type + (N : Iir; F : Fields_Enum; V: Iir_Lexical_Layout_Type); + + function Get_Iir_List + (N : Iir; F : Fields_Enum) return Iir_List; + procedure Set_Iir_List + (N : Iir; F : Fields_Enum; V: Iir_List); + + function Get_Iir_Mode + (N : Iir; F : Fields_Enum) return Iir_Mode; + procedure Set_Iir_Mode + (N : Iir; F : Fields_Enum; V: Iir_Mode); + + function Get_Iir_Predefined_Functions + (N : Iir; F : Fields_Enum) return Iir_Predefined_Functions; + procedure Set_Iir_Predefined_Functions + (N : Iir; F : Fields_Enum; V: Iir_Predefined_Functions); + + function Get_Iir_Pure_State + (N : Iir; F : Fields_Enum) return Iir_Pure_State; + procedure Set_Iir_Pure_State + (N : Iir; F : Fields_Enum; V: Iir_Pure_State); + + function Get_Iir_Signal_Kind + (N : Iir; F : Fields_Enum) return Iir_Signal_Kind; + procedure Set_Iir_Signal_Kind + (N : Iir; F : Fields_Enum; V: Iir_Signal_Kind); + + function Get_Iir_Staticness + (N : Iir; F : Fields_Enum) return Iir_Staticness; + procedure Set_Iir_Staticness + (N : Iir; F : Fields_Enum; V: Iir_Staticness); + + function Get_Int32 + (N : Iir; F : Fields_Enum) return Int32; + procedure Set_Int32 + (N : Iir; F : Fields_Enum; V: Int32); + + function Get_Location_Type + (N : Iir; F : Fields_Enum) return Location_Type; + procedure Set_Location_Type + (N : Iir; F : Fields_Enum; V: Location_Type); + + function Get_Name_Id + (N : Iir; F : Fields_Enum) return Name_Id; + procedure Set_Name_Id + (N : Iir; F : Fields_Enum; V: Name_Id); + + function Get_PSL_NFA + (N : Iir; F : Fields_Enum) return PSL_NFA; + procedure Set_PSL_NFA + (N : Iir; F : Fields_Enum; V: PSL_NFA); + + function Get_PSL_Node + (N : Iir; F : Fields_Enum) return PSL_Node; + procedure Set_PSL_Node + (N : Iir; F : Fields_Enum; V: PSL_Node); + + function Get_Source_Ptr + (N : Iir; F : Fields_Enum) return Source_Ptr; + procedure Set_Source_Ptr + (N : Iir; F : Fields_Enum; V: Source_Ptr); + + function Get_String_Id + (N : Iir; F : Fields_Enum) return String_Id; + procedure Set_String_Id + (N : Iir; F : Fields_Enum; V: String_Id); + + function Get_Time_Stamp_Id + (N : Iir; F : Fields_Enum) return Time_Stamp_Id; + procedure Set_Time_Stamp_Id + (N : Iir; F : Fields_Enum; V: Time_Stamp_Id); + + function Get_Token_Type + (N : Iir; F : Fields_Enum) return Token_Type; + procedure Set_Token_Type + (N : Iir; F : Fields_Enum; V: Token_Type); + + function Get_Tri_State_Type + (N : Iir; F : Fields_Enum) return Tri_State_Type; + procedure Set_Tri_State_Type + (N : Iir; F : Fields_Enum; V: Tri_State_Type); + + function Has_First_Design_Unit (K : Iir_Kind) return Boolean; + function Has_Last_Design_Unit (K : Iir_Kind) return Boolean; + function Has_Library_Declaration (K : Iir_Kind) return Boolean; + function Has_File_Time_Stamp (K : Iir_Kind) return Boolean; + function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean; + function Has_Library (K : Iir_Kind) return Boolean; + function Has_File_Dependence_List (K : Iir_Kind) return Boolean; + function Has_Design_File_Filename (K : Iir_Kind) return Boolean; + function Has_Design_File_Directory (K : Iir_Kind) return Boolean; + function Has_Design_File (K : Iir_Kind) return Boolean; + function Has_Design_File_Chain (K : Iir_Kind) return Boolean; + function Has_Library_Directory (K : Iir_Kind) return Boolean; + function Has_Date (K : Iir_Kind) return Boolean; + function Has_Context_Items (K : Iir_Kind) return Boolean; + function Has_Dependence_List (K : Iir_Kind) return Boolean; + function Has_Analysis_Checks_List (K : Iir_Kind) return Boolean; + function Has_Date_State (K : Iir_Kind) return Boolean; + function Has_Guarded_Target_State (K : Iir_Kind) return Boolean; + function Has_Library_Unit (K : Iir_Kind) return Boolean; + function Has_Hash_Chain (K : Iir_Kind) return Boolean; + function Has_Design_Unit_Source_Pos (K : Iir_Kind) return Boolean; + function Has_Design_Unit_Source_Line (K : Iir_Kind) return Boolean; + function Has_Design_Unit_Source_Col (K : Iir_Kind) return Boolean; + function Has_Value (K : Iir_Kind) return Boolean; + function Has_Enum_Pos (K : Iir_Kind) return Boolean; + function Has_Physical_Literal (K : Iir_Kind) return Boolean; + function Has_Physical_Unit_Value (K : Iir_Kind) return Boolean; + function Has_Fp_Value (K : Iir_Kind) return Boolean; + function Has_Enumeration_Decl (K : Iir_Kind) return Boolean; + function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean; + function Has_Bit_String_Base (K : Iir_Kind) return Boolean; + function Has_Bit_String_0 (K : Iir_Kind) return Boolean; + function Has_Bit_String_1 (K : Iir_Kind) return Boolean; + function Has_Literal_Origin (K : Iir_Kind) return Boolean; + function Has_Range_Origin (K : Iir_Kind) return Boolean; + function Has_Literal_Subtype (K : Iir_Kind) return Boolean; + function Has_Entity_Class (K : Iir_Kind) return Boolean; + function Has_Entity_Name_List (K : Iir_Kind) return Boolean; + function Has_Attribute_Designator (K : Iir_Kind) return Boolean; + function Has_Attribute_Specification_Chain (K : Iir_Kind) + return Boolean; + function Has_Attribute_Specification (K : Iir_Kind) return Boolean; + function Has_Signal_List (K : Iir_Kind) return Boolean; + function Has_Designated_Entity (K : Iir_Kind) return Boolean; + function Has_Formal (K : Iir_Kind) return Boolean; + function Has_Actual (K : Iir_Kind) return Boolean; + function Has_In_Conversion (K : Iir_Kind) return Boolean; + function Has_Out_Conversion (K : Iir_Kind) return Boolean; + function Has_Whole_Association_Flag (K : Iir_Kind) return Boolean; + function Has_Collapse_Signal_Flag (K : Iir_Kind) return Boolean; + function Has_Artificial_Flag (K : Iir_Kind) return Boolean; + function Has_Open_Flag (K : Iir_Kind) return Boolean; + function Has_After_Drivers_Flag (K : Iir_Kind) return Boolean; + function Has_We_Value (K : Iir_Kind) return Boolean; + function Has_Time (K : Iir_Kind) return Boolean; + function Has_Associated_Expr (K : Iir_Kind) return Boolean; + function Has_Associated_Chain (K : Iir_Kind) return Boolean; + function Has_Choice_Name (K : Iir_Kind) return Boolean; + function Has_Choice_Expression (K : Iir_Kind) return Boolean; + function Has_Choice_Range (K : Iir_Kind) return Boolean; + function Has_Same_Alternative_Flag (K : Iir_Kind) return Boolean; + function Has_Architecture (K : Iir_Kind) return Boolean; + function Has_Block_Specification (K : Iir_Kind) return Boolean; + function Has_Prev_Block_Configuration (K : Iir_Kind) return Boolean; + function Has_Configuration_Item_Chain (K : Iir_Kind) return Boolean; + function Has_Attribute_Value_Chain (K : Iir_Kind) return Boolean; + function Has_Spec_Chain (K : Iir_Kind) return Boolean; + function Has_Attribute_Value_Spec_Chain (K : Iir_Kind) return Boolean; + function Has_Entity_Name (K : Iir_Kind) return Boolean; + function Has_Package (K : Iir_Kind) return Boolean; + function Has_Package_Body (K : Iir_Kind) return Boolean; + function Has_Need_Body (K : Iir_Kind) return Boolean; + function Has_Block_Configuration (K : Iir_Kind) return Boolean; + function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean; + function Has_Chain (K : Iir_Kind) return Boolean; + function Has_Port_Chain (K : Iir_Kind) return Boolean; + function Has_Generic_Chain (K : Iir_Kind) return Boolean; + function Has_Type (K : Iir_Kind) return Boolean; + function Has_Subtype_Indication (K : Iir_Kind) return Boolean; + function Has_Discrete_Range (K : Iir_Kind) return Boolean; + function Has_Type_Definition (K : Iir_Kind) return Boolean; + function Has_Subtype_Definition (K : Iir_Kind) return Boolean; + function Has_Nature (K : Iir_Kind) return Boolean; + function Has_Mode (K : Iir_Kind) return Boolean; + function Has_Signal_Kind (K : Iir_Kind) return Boolean; + function Has_Base_Name (K : Iir_Kind) return Boolean; + function Has_Interface_Declaration_Chain (K : Iir_Kind) return Boolean; + function Has_Subprogram_Specification (K : Iir_Kind) return Boolean; + function Has_Sequential_Statement_Chain (K : Iir_Kind) return Boolean; + function Has_Subprogram_Body (K : Iir_Kind) return Boolean; + function Has_Overload_Number (K : Iir_Kind) return Boolean; + function Has_Subprogram_Depth (K : Iir_Kind) return Boolean; + function Has_Subprogram_Hash (K : Iir_Kind) return Boolean; + function Has_Impure_Depth (K : Iir_Kind) return Boolean; + function Has_Return_Type (K : Iir_Kind) return Boolean; + function Has_Implicit_Definition (K : Iir_Kind) return Boolean; + function Has_Type_Reference (K : Iir_Kind) return Boolean; + function Has_Default_Value (K : Iir_Kind) return Boolean; + function Has_Deferred_Declaration (K : Iir_Kind) return Boolean; + function Has_Deferred_Declaration_Flag (K : Iir_Kind) return Boolean; + function Has_Shared_Flag (K : Iir_Kind) return Boolean; + function Has_Design_Unit (K : Iir_Kind) return Boolean; + function Has_Block_Statement (K : Iir_Kind) return Boolean; + function Has_Signal_Driver (K : Iir_Kind) return Boolean; + function Has_Declaration_Chain (K : Iir_Kind) return Boolean; + function Has_File_Logical_Name (K : Iir_Kind) return Boolean; + function Has_File_Open_Kind (K : Iir_Kind) return Boolean; + function Has_Element_Position (K : Iir_Kind) return Boolean; + function Has_Element_Declaration (K : Iir_Kind) return Boolean; + function Has_Selected_Element (K : Iir_Kind) return Boolean; + function Has_Use_Clause_Chain (K : Iir_Kind) return Boolean; + function Has_Selected_Name (K : Iir_Kind) return Boolean; + function Has_Type_Declarator (K : Iir_Kind) return Boolean; + function Has_Enumeration_Literal_List (K : Iir_Kind) return Boolean; + function Has_Entity_Class_Entry_Chain (K : Iir_Kind) return Boolean; + function Has_Group_Constituent_List (K : Iir_Kind) return Boolean; + function Has_Unit_Chain (K : Iir_Kind) return Boolean; + function Has_Primary_Unit (K : Iir_Kind) return Boolean; + function Has_Identifier (K : Iir_Kind) return Boolean; + function Has_Label (K : Iir_Kind) return Boolean; + function Has_Visible_Flag (K : Iir_Kind) return Boolean; + function Has_Range_Constraint (K : Iir_Kind) return Boolean; + function Has_Direction (K : Iir_Kind) return Boolean; + function Has_Left_Limit (K : Iir_Kind) return Boolean; + function Has_Right_Limit (K : Iir_Kind) return Boolean; + function Has_Base_Type (K : Iir_Kind) return Boolean; + function Has_Resolution_Indication (K : Iir_Kind) return Boolean; + function Has_Record_Element_Resolution_Chain (K : Iir_Kind) + return Boolean; + function Has_Tolerance (K : Iir_Kind) return Boolean; + function Has_Plus_Terminal (K : Iir_Kind) return Boolean; + function Has_Minus_Terminal (K : Iir_Kind) return Boolean; + function Has_Simultaneous_Left (K : Iir_Kind) return Boolean; + function Has_Simultaneous_Right (K : Iir_Kind) return Boolean; + function Has_Text_File_Flag (K : Iir_Kind) return Boolean; + function Has_Only_Characters_Flag (K : Iir_Kind) return Boolean; + function Has_Type_Staticness (K : Iir_Kind) return Boolean; + function Has_Constraint_State (K : Iir_Kind) return Boolean; + function Has_Index_Subtype_List (K : Iir_Kind) return Boolean; + function Has_Index_Subtype_Definition_List (K : Iir_Kind) + return Boolean; + function Has_Element_Subtype_Indication (K : Iir_Kind) return Boolean; + function Has_Element_Subtype (K : Iir_Kind) return Boolean; + function Has_Index_Constraint_List (K : Iir_Kind) return Boolean; + function Has_Array_Element_Constraint (K : Iir_Kind) return Boolean; + function Has_Elements_Declaration_List (K : Iir_Kind) return Boolean; + function Has_Designated_Type (K : Iir_Kind) return Boolean; + function Has_Designated_Subtype_Indication (K : Iir_Kind) + return Boolean; + function Has_Index_List (K : Iir_Kind) return Boolean; + function Has_Reference (K : Iir_Kind) return Boolean; + function Has_Nature_Declarator (K : Iir_Kind) return Boolean; + function Has_Across_Type (K : Iir_Kind) return Boolean; + function Has_Through_Type (K : Iir_Kind) return Boolean; + function Has_Target (K : Iir_Kind) return Boolean; + function Has_Waveform_Chain (K : Iir_Kind) return Boolean; + function Has_Guard (K : Iir_Kind) return Boolean; + function Has_Delay_Mechanism (K : Iir_Kind) return Boolean; + function Has_Reject_Time_Expression (K : Iir_Kind) return Boolean; + function Has_Sensitivity_List (K : Iir_Kind) return Boolean; + function Has_Process_Origin (K : Iir_Kind) return Boolean; + function Has_Condition_Clause (K : Iir_Kind) return Boolean; + function Has_Timeout_Clause (K : Iir_Kind) return Boolean; + function Has_Postponed_Flag (K : Iir_Kind) return Boolean; + function Has_Callees_List (K : Iir_Kind) return Boolean; + function Has_Passive_Flag (K : Iir_Kind) return Boolean; + function Has_Resolution_Function_Flag (K : Iir_Kind) return Boolean; + function Has_Wait_State (K : Iir_Kind) return Boolean; + function Has_All_Sensitized_State (K : Iir_Kind) return Boolean; + function Has_Seen_Flag (K : Iir_Kind) return Boolean; + function Has_Pure_Flag (K : Iir_Kind) return Boolean; + function Has_Foreign_Flag (K : Iir_Kind) return Boolean; + function Has_Resolved_Flag (K : Iir_Kind) return Boolean; + function Has_Signal_Type_Flag (K : Iir_Kind) return Boolean; + function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean; + function Has_Purity_State (K : Iir_Kind) return Boolean; + function Has_Elab_Flag (K : Iir_Kind) return Boolean; + function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean; + function Has_Assertion_Condition (K : Iir_Kind) return Boolean; + function Has_Report_Expression (K : Iir_Kind) return Boolean; + function Has_Severity_Expression (K : Iir_Kind) return Boolean; + function Has_Instantiated_Unit (K : Iir_Kind) return Boolean; + function Has_Generic_Map_Aspect_Chain (K : Iir_Kind) return Boolean; + function Has_Port_Map_Aspect_Chain (K : Iir_Kind) return Boolean; + function Has_Configuration_Name (K : Iir_Kind) return Boolean; + function Has_Component_Configuration (K : Iir_Kind) return Boolean; + function Has_Configuration_Specification (K : Iir_Kind) return Boolean; + function Has_Default_Binding_Indication (K : Iir_Kind) return Boolean; + function Has_Default_Configuration_Declaration (K : Iir_Kind) + return Boolean; + function Has_Expression (K : Iir_Kind) return Boolean; + function Has_Allocator_Designated_Type (K : Iir_Kind) return Boolean; + function Has_Selected_Waveform_Chain (K : Iir_Kind) return Boolean; + function Has_Conditional_Waveform_Chain (K : Iir_Kind) return Boolean; + function Has_Guard_Expression (K : Iir_Kind) return Boolean; + function Has_Guard_Decl (K : Iir_Kind) return Boolean; + function Has_Guard_Sensitivity_List (K : Iir_Kind) return Boolean; + function Has_Block_Block_Configuration (K : Iir_Kind) return Boolean; + function Has_Package_Header (K : Iir_Kind) return Boolean; + function Has_Block_Header (K : Iir_Kind) return Boolean; + function Has_Uninstantiated_Name (K : Iir_Kind) return Boolean; + function Has_Generate_Block_Configuration (K : Iir_Kind) return Boolean; + function Has_Generation_Scheme (K : Iir_Kind) return Boolean; + function Has_Condition (K : Iir_Kind) return Boolean; + function Has_Else_Clause (K : Iir_Kind) return Boolean; + function Has_Parameter_Specification (K : Iir_Kind) return Boolean; + function Has_Parent (K : Iir_Kind) return Boolean; + function Has_Loop_Label (K : Iir_Kind) return Boolean; + function Has_Component_Name (K : Iir_Kind) return Boolean; + function Has_Instantiation_List (K : Iir_Kind) return Boolean; + function Has_Entity_Aspect (K : Iir_Kind) return Boolean; + function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean; + function Has_Default_Generic_Map_Aspect_Chain (K : Iir_Kind) + return Boolean; + function Has_Default_Port_Map_Aspect_Chain (K : Iir_Kind) + return Boolean; + function Has_Binding_Indication (K : Iir_Kind) return Boolean; + function Has_Named_Entity (K : Iir_Kind) return Boolean; + function Has_Alias_Declaration (K : Iir_Kind) return Boolean; + function Has_Expr_Staticness (K : Iir_Kind) return Boolean; + function Has_Error_Origin (K : Iir_Kind) return Boolean; + function Has_Operand (K : Iir_Kind) return Boolean; + function Has_Left (K : Iir_Kind) return Boolean; + function Has_Right (K : Iir_Kind) return Boolean; + function Has_Unit_Name (K : Iir_Kind) return Boolean; + function Has_Name (K : Iir_Kind) return Boolean; + function Has_Group_Template_Name (K : Iir_Kind) return Boolean; + function Has_Name_Staticness (K : Iir_Kind) return Boolean; + function Has_Prefix (K : Iir_Kind) return Boolean; + function Has_Signature_Prefix (K : Iir_Kind) return Boolean; + function Has_Slice_Subtype (K : Iir_Kind) return Boolean; + function Has_Suffix (K : Iir_Kind) return Boolean; + function Has_Index_Subtype (K : Iir_Kind) return Boolean; + function Has_Parameter (K : Iir_Kind) return Boolean; + function Has_Actual_Type (K : Iir_Kind) return Boolean; + function Has_Association_Chain (K : Iir_Kind) return Boolean; + function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean; + function Has_Aggregate_Info (K : Iir_Kind) return Boolean; + function Has_Sub_Aggregate_Info (K : Iir_Kind) return Boolean; + function Has_Aggr_Dynamic_Flag (K : Iir_Kind) return Boolean; + function Has_Aggr_Min_Length (K : Iir_Kind) return Boolean; + function Has_Aggr_Low_Limit (K : Iir_Kind) return Boolean; + function Has_Aggr_High_Limit (K : Iir_Kind) return Boolean; + function Has_Aggr_Others_Flag (K : Iir_Kind) return Boolean; + function Has_Aggr_Named_Flag (K : Iir_Kind) return Boolean; + function Has_Value_Staticness (K : Iir_Kind) return Boolean; + function Has_Association_Choices_Chain (K : Iir_Kind) return Boolean; + function Has_Case_Statement_Alternative_Chain (K : Iir_Kind) + return Boolean; + function Has_Choice_Staticness (K : Iir_Kind) return Boolean; + function Has_Procedure_Call (K : Iir_Kind) return Boolean; + function Has_Implementation (K : Iir_Kind) return Boolean; + function Has_Parameter_Association_Chain (K : Iir_Kind) return Boolean; + function Has_Method_Object (K : Iir_Kind) return Boolean; + function Has_Subtype_Type_Mark (K : Iir_Kind) return Boolean; + function Has_Type_Conversion_Subtype (K : Iir_Kind) return Boolean; + function Has_Type_Mark (K : Iir_Kind) return Boolean; + function Has_File_Type_Mark (K : Iir_Kind) return Boolean; + function Has_Return_Type_Mark (K : Iir_Kind) return Boolean; + function Has_Lexical_Layout (K : Iir_Kind) return Boolean; + function Has_Incomplete_Type_List (K : Iir_Kind) return Boolean; + function Has_Has_Disconnect_Flag (K : Iir_Kind) return Boolean; + function Has_Has_Active_Flag (K : Iir_Kind) return Boolean; + function Has_Is_Within_Flag (K : Iir_Kind) return Boolean; + function Has_Type_Marks_List (K : Iir_Kind) return Boolean; + function Has_Implicit_Alias_Flag (K : Iir_Kind) return Boolean; + function Has_Alias_Signature (K : Iir_Kind) return Boolean; + function Has_Attribute_Signature (K : Iir_Kind) return Boolean; + function Has_Overload_List (K : Iir_Kind) return Boolean; + function Has_Simple_Name_Identifier (K : Iir_Kind) return Boolean; + function Has_Simple_Name_Subtype (K : Iir_Kind) return Boolean; + function Has_Protected_Type_Body (K : Iir_Kind) return Boolean; + function Has_Protected_Type_Declaration (K : Iir_Kind) return Boolean; + function Has_End_Location (K : Iir_Kind) return Boolean; + function Has_String_Id (K : Iir_Kind) return Boolean; + function Has_String_Length (K : Iir_Kind) return Boolean; + function Has_Use_Flag (K : Iir_Kind) return Boolean; + function Has_End_Has_Reserved_Id (K : Iir_Kind) return Boolean; + function Has_End_Has_Identifier (K : Iir_Kind) return Boolean; + function Has_End_Has_Postponed (K : Iir_Kind) return Boolean; + function Has_Has_Begin (K : Iir_Kind) return Boolean; + function Has_Has_Is (K : Iir_Kind) return Boolean; + function Has_Has_Pure (K : Iir_Kind) return Boolean; + function Has_Has_Body (K : Iir_Kind) return Boolean; + function Has_Has_Identifier_List (K : Iir_Kind) return Boolean; + function Has_Has_Mode (K : Iir_Kind) return Boolean; + function Has_Is_Ref (K : Iir_Kind) return Boolean; + function Has_Psl_Property (K : Iir_Kind) return Boolean; + function Has_Psl_Declaration (K : Iir_Kind) return Boolean; + function Has_Psl_Expression (K : Iir_Kind) return Boolean; + function Has_Psl_Boolean (K : Iir_Kind) return Boolean; + function Has_PSL_Clock (K : Iir_Kind) return Boolean; + function Has_PSL_NFA (K : Iir_Kind) return Boolean; +end Nodes_Meta; diff --git a/nodes_meta.ads.in b/nodes_meta.ads.in new file mode 100644 index 000000000..8e1dceca9 --- /dev/null +++ b/nodes_meta.ads.in @@ -0,0 +1,66 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Iirs; use Iirs; +with Tokens; use Tokens; + +package Nodes_Meta is + -- The enumeration of all possible types in the nodes. + type Types_Enum is + ( + -- TYPES + ); + + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + -- FIELDS + ); + pragma Discard_Names (Fields_Enum); + + -- Return the type of field F. + function Get_Field_Type (F : Fields_Enum) return Types_Enum; + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + -- Get the name of a kind. + function Get_Iir_Image (K : Iir_Kind) return String; + + -- Possible attributes of a field. + type Field_Attribute is + ( + Attr_None, + Attr_Ref, Attr_Maybe_Ref, Attr_Of_Ref, + Attr_Chain, Attr_Chain_Next + ); + + -- Get the attribute of a field. + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; + + type Fields_Array is array (Natural range <>) of Fields_Enum; + + -- Return the list of fields for node K. The fields are sorted: first + -- the non nodes/list of nodes, then the nodes/lists that aren't reference, + -- and then the reference. + function Get_Fields (K : Iir_Kind) return Fields_Array; + + -- Get/Set a field. + -- FUNCS +end Nodes_Meta; @@ -407,7 +407,7 @@ package body Parse is -- postcond: next token function Parse_Range_Constraint_Of_Subtype_Indication (Type_Mark : Iir; - Resolution_Function : Iir := Null_Iir) + Resolution_Indication : Iir := Null_Iir) return Iir is Def : Iir; @@ -416,7 +416,7 @@ package body Parse is Location_Copy (Def, Type_Mark); Set_Subtype_Type_Mark (Def, Type_Mark); Set_Range_Constraint (Def, Parse_Range_Constraint); - Set_Resolution_Function (Def, Resolution_Function); + Set_Resolution_Indication (Def, Resolution_Indication); Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt); return Def; @@ -791,7 +791,7 @@ package body Parse is -- There is a signature. They are normally followed by an -- attribute. Res := Parse_Signature; - Set_Prefix (Res, Prefix); + Set_Signature_Prefix (Res, Prefix); when Tok_Tick => -- There is an attribute. @@ -818,7 +818,7 @@ package body Parse is Set_Location (Res); if Get_Kind (Prefix) = Iir_Kind_Signature then Set_Attribute_Signature (Res, Prefix); - Set_Prefix (Res, Get_Prefix (Prefix)); + Set_Prefix (Res, Get_Signature_Prefix (Prefix)); else Set_Prefix (Res, Prefix); end if; @@ -1163,22 +1163,24 @@ package body Parse is Default_Value := Null_Iir; end if; + -- Subtype_Indication and Default_Value are set only on the first + -- interface. + Set_Subtype_Indication (First, Interface_Type); + if Get_Kind (First) /= Iir_Kind_File_Interface_Declaration then + Set_Default_Value (First, Default_Value); + end if; + Inter := First; while Inter /= Null_Iir loop Set_Mode (Inter, Interface_Mode); Set_Parent (Inter, Parent); + Set_Is_Ref (Inter, Inter /= First); if Inter = Last then Set_Lexical_Layout (Inter, Lexical_Layout or Iir_Lexical_Has_Type); else Set_Lexical_Layout (Inter, Lexical_Layout); end if; - if Inter = First then - Set_Subtype_Indication (Inter, Interface_Type); - if Get_Kind (Inter) /= Iir_Kind_File_Interface_Declaration then - Set_Default_Value (Inter, Default_Value); - end if; - end if; if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then Set_Signal_Kind (Inter, Signal_Kind); end if; @@ -1403,6 +1405,7 @@ package body Parse is Loc : Location_Type; Def : Iir; Type_Mark : Iir; + Element_Subtype : Iir; begin Loc := Get_Token_Location; @@ -1471,20 +1474,25 @@ package body Parse is Scan; end loop; + -- Skip ')' and 'of' + Expect (Tok_Right_Paren); + Scan_Expect (Tok_Of); + Scan; + + Element_Subtype := Parse_Subtype_Indication; + if Array_Constrained then + -- Sem_Type will create the array type. Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Set_Element_Subtype (Res_Type, Element_Subtype); + Set_Index_Constraint_List (Res_Type, Index_List); else Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition); + Set_Element_Subtype_Indication (Res_Type, Element_Subtype); + Set_Index_Subtype_Definition_List (Res_Type, Index_List); end if; Set_Location (Res_Type, Loc); - Set_Index_Subtype_List (Res_Type, Index_List); - -- Skip ')' and 'of' - Expect (Tok_Right_Paren); - Scan_Expect (Tok_Of); - Scan; - - Set_Element_Subtype_Indication (Res_Type, Parse_Subtype_Indication); return Res_Type; end Parse_Array_Definition; @@ -1973,12 +1981,9 @@ package body Parse is -- record_element_simple_name resolution_indication function Parse_Resolution_Indication return Iir is - Res : Iir; + Ind : Iir; Def : Iir; Loc : Location_Type; - El_List : Iir_List; - El : Iir; - Id : Name_Id; begin if Current_Token = Tok_Identifier then -- Resolution function name. @@ -1987,46 +1992,64 @@ package body Parse is -- Element resolution. Loc := Get_Token_Location; - Scan; -- Eat '(' - Res := Parse_Resolution_Indication; + -- Eat '(' + Scan; + + Ind := Parse_Resolution_Indication; if Current_Token = Tok_Identifier or else Current_Token = Tok_Left_Paren then - -- This was in fact a record_resolution. - if Get_Kind (Res) /= Iir_Kind_Simple_Name then - Error_Msg_Parse ("element name expected", Res); - return Null_Iir; - end if; - Id := Get_Identifier (Res); - Free_Iir (Res); - Def := Create_Iir (Iir_Kind_Record_Subtype_Definition); - Set_Location (Def, Loc); - El_List := Create_Iir_List; - Set_Elements_Declaration_List (Def, El_List); - loop - El := Create_Iir (Iir_Kind_Record_Element_Constraint); - Set_Location (El, Loc); - Set_Identifier (El, Id); - Set_Element_Declaration (El, Parse_Resolution_Indication); - Append_Element (El_List, El); - exit when Current_Token = Tok_Right_Paren; - Expect (Tok_Comma); - Scan; - if Current_Token /= Tok_Identifier then - Error_Msg_Parse ("record element identifier expected"); - exit; + declare + Id : Name_Id; + El : Iir; + First, Last : Iir; + begin + -- This was in fact a record_resolution. + if Get_Kind (Ind) = Iir_Kind_Simple_Name then + Id := Get_Identifier (Ind); + else + Error_Msg_Parse ("element name expected", Ind); + Id := Null_Identifier; end if; - Id := Current_Identifier; - Loc := Get_Token_Location; - Scan; - end loop; + Free_Iir (Ind); + + Def := Create_Iir (Iir_Kind_Record_Resolution); + Set_Location (Def, Loc); + Sub_Chain_Init (First, Last); + loop + El := Create_Iir (Iir_Kind_Record_Element_Resolution); + Set_Location (El, Loc); + Set_Identifier (El, Id); + Set_Resolution_Indication (El, Parse_Resolution_Indication); + Sub_Chain_Append (First, Last, El); + exit when Current_Token = Tok_Right_Paren; + + -- Eat ',' + Expect (Tok_Comma); + Scan; + + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("record element identifier expected"); + exit; + end if; + Id := Current_Identifier; + Loc := Get_Token_Location; + + -- Eat identifier + Scan; + end loop; + Set_Record_Element_Resolution_Chain (Def, First); + end; else - Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); + Def := Create_Iir (Iir_Kind_Array_Element_Resolution); Set_Location (Def, Loc); - Set_Element_Subtype_Indication (Def, Res); + Set_Resolution_Indication (Def, Ind); end if; + + -- Eat ')' Expect (Tok_Right_Paren); Scan; + return Def; else Error_Msg_Parse ("resolution indication expected"); @@ -2053,6 +2076,7 @@ package body Parse is is Def : Iir; El : Iir; + Index_List : Iir_List; begin -- Index_constraint. Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); @@ -2065,22 +2089,27 @@ package body Parse is -- Eat 'open'. Scan; else - Set_Index_Subtype_List (Def, Create_Iir_List); - -- index_constraint ::= (discrete_range {, discrete_range} ) + Index_List := Create_Iir_List; + Set_Index_Constraint_List (Def, Index_List); + -- index_constraint ::= (discrete_range {, discrete_range} ) loop - -- accept parenthesis or comma. El := Parse_Discrete_Range; - Append_Element (Get_Index_Subtype_List (Def), El); + Append_Element (Index_List, El); + exit when Current_Token = Tok_Right_Paren; + + -- Eat ',' Expect (Tok_Comma); Scan; end loop; end if; + + -- Eat ')' Expect (Tok_Right_Paren); Scan; if Current_Token = Tok_Left_Paren then - Set_Element_Subtype_Indication (Def, Parse_Element_Constraint); + Set_Element_Subtype (Def, Parse_Element_Constraint); end if; return Def; end Parse_Element_Constraint; @@ -2117,19 +2146,23 @@ package body Parse is -- -- constraint ::= -- range_constraint | array_constraint | record_constraint + -- + -- NAME is the type_mark when already parsed (in range expression or + -- allocator by type). function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir is Type_Mark : Iir; Def: Iir; - Resolution_Function: Iir; + Resolution_Indication: Iir; Tolerance : Iir; begin -- FIXME: location. - Resolution_Function := Null_Iir; + Resolution_Indication := Null_Iir; Def := Null_Iir; if Name /= Null_Iir then + -- The type_mark was already parsed. Type_Mark := Name; Check_Type_Mark (Name); else @@ -2138,7 +2171,7 @@ package body Parse is Error_Msg_Parse ("resolution_indication not allowed before vhdl08"); end if; - Resolution_Function := Parse_Resolution_Indication; + Resolution_Indication := Parse_Resolution_Indication; end if; if Current_Token /= Tok_Identifier then Error_Msg_Parse ("type mark expected in a subtype indication"); @@ -2148,10 +2181,10 @@ package body Parse is end if; if Current_Token = Tok_Identifier then - if Resolution_Function /= Null_Iir then + if Resolution_Indication /= Null_Iir then Error_Msg_Parse ("resolution function already indicated"); end if; - Resolution_Function := Type_Mark; + Resolution_Indication := Type_Mark; Type_Mark := Parse_Type_Mark (Check_Paren => False); end if; @@ -2160,7 +2193,7 @@ package body Parse is -- element_constraint. Def := Parse_Element_Constraint; Set_Subtype_Type_Mark (Def, Type_Mark); - Set_Resolution_Function (Def, Resolution_Function); + Set_Resolution_Indication (Def, Resolution_Indication); Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt); when Tok_Range => @@ -2169,19 +2202,21 @@ package body Parse is Scan; Def := Parse_Range_Constraint_Of_Subtype_Indication - (Type_Mark, Resolution_Function); + (Type_Mark, Resolution_Indication); when others => Tolerance := Parse_Tolerance_Aspect_Opt; - if Resolution_Function /= Null_Iir + if Resolution_Indication /= Null_Iir or else Tolerance /= Null_Iir then + -- A subtype needs to be created. Def := Create_Iir (Iir_Kind_Subtype_Definition); Location_Copy (Def, Type_Mark); Set_Subtype_Type_Mark (Def, Type_Mark); - Set_Resolution_Function (Def, Resolution_Function); + Set_Resolution_Indication (Def, Resolution_Indication); Set_Tolerance (Def, Tolerance); else + -- This is just an alias. Def := Type_Mark; end if; end case; @@ -2720,8 +2755,9 @@ package body Parse is Set_Has_Identifier_List (Object, True); end loop; - -- The colon was parsed. + -- Eat ':' Scan; + Object_Type := Parse_Subtype_Indication; if Kind = Iir_Kind_Signal_Declaration then @@ -2783,27 +2819,31 @@ package body Parse is end if; end if; + Set_Subtype_Indication (First, Object_Type); + if Kind /= Iir_Kind_File_Declaration then + Set_Default_Value (First, Default_Value); + end if; + Object := First; while Object /= Null_Iir loop - if Object = First then - Set_Subtype_Indication (Object, Object_Type); - else - Set_Subtype_Indication (Object, Null_Iir); - end if; - if Kind = Iir_Kind_File_Declaration then - Set_Mode (Object, Mode); - Set_File_Open_Kind (Object, Open_Kind); - Set_File_Logical_Name (Object, Logical_Name); - Set_Has_Mode (Object, Has_Mode); - else - Set_Default_Value (Object, Default_Value); - if Kind = Iir_Kind_Signal_Declaration then + case Kind is + when Iir_Kind_File_Declaration => + Set_Mode (Object, Mode); + Set_File_Open_Kind (Object, Open_Kind); + Set_File_Logical_Name (Object, Logical_Name); + Set_Has_Mode (Object, Has_Mode); + when Iir_Kind_Signal_Declaration => Set_Signal_Kind (Object, Signal_Kind); - end if; - end if; + when others => + null; + end case; + Set_Is_Ref (Object, Object /= First); Object := Get_Chain (Object); end loop; + + -- ';' is not eaten. Expect (Tok_Semi_Colon); + return First; end Parse_Object_Declaration; @@ -3039,7 +3079,7 @@ package body Parse is if Current_Token = Tok_Left_Bracket then Name := Res; Res := Parse_Signature; - Set_Prefix (Res, Name); + Set_Signature_Prefix (Res, Name); end if; return Res; end Parse_Entity_Designator; @@ -244,7 +244,7 @@ package body Sem is Obj_Type := Get_Type (Obj); if Get_Kind (Obj_Type) in Iir_Kinds_Subtype_Definition then - return Get_Resolution_Function (Obj_Type); + return Get_Resolution_Indication (Obj_Type); else return Null_Iir; end if; @@ -1189,15 +1189,17 @@ package body Sem is | Iir_Kind_Enumeration_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition => - if Get_Base_Type (Left) /= Get_Base_Type (Right) - or else Get_Resolution_Function (Left) - /= Get_Resolution_Function (Right) - then + if Get_Base_Type (Left) /= Get_Base_Type (Right) then return False; end if; if Get_Type_Declarator (Left) /= Get_Type_Declarator (Right) then return False; end if; + if not Are_Trees_Equal (Get_Resolution_Indication (Left), + Get_Resolution_Indication (Right)) + then + return False; + end if; if Are_Trees_Equal (Get_Range_Constraint (Left), Get_Range_Constraint (Right)) = False then @@ -1205,9 +1207,11 @@ package body Sem is end if; return True; when Iir_Kind_Array_Subtype_Definition => - if Get_Base_Type (Left) /= Get_Base_Type (Right) - or else (Get_Resolution_Function (Left) - /= Get_Resolution_Function (Right)) + if Get_Base_Type (Left) /= Get_Base_Type (Right) then + return False; + end if; + if not Are_Trees_Equal (Get_Resolution_Indication (Left), + Get_Resolution_Indication (Right)) then return False; end if; @@ -1227,9 +1231,11 @@ package body Sem is end; return True; when Iir_Kind_Record_Subtype_Definition => - if Get_Base_Type (Left) /= Get_Base_Type (Right) - or else (Get_Resolution_Function (Left) - /= Get_Resolution_Function (Right)) + if Get_Base_Type (Left) /= Get_Base_Type (Right) then + return False; + end if; + if not Are_Trees_Equal (Get_Resolution_Indication (Left), + Get_Resolution_Indication (Right)) then return False; end if; @@ -2386,10 +2392,8 @@ package body Sem is -- LRM08 4.9 Package Instantiation Declaration procedure Sem_Package_Instantiation_Declaration (Decl : Iir) is - use Sem_Inst; Name : Iir; Pkg : Iir; - Header : Iir; Bod : Iir_Design_Unit; begin Sem_Scopes.Add_Name (Decl); @@ -2420,13 +2424,12 @@ package body Sem is -- actual with each formal generic (or member thereof) in the -- corresponding package declaration. Each formal generic (or member -- thereof) shall be associated at most once. - Header := Get_Package_Header (Pkg); - Sem_Generic_Association_Chain (Header, Decl); - Set_Generic_Chain - (Decl, Instantiate_Declaration_Chain (Get_Generic_Chain (Header))); - Set_Declaration_Chain - (Decl, Instantiate_Declaration_Chain (Get_Declaration_Chain (Pkg))); + -- GHDL: the generics are first instantiated (ie copied) and then + -- the actuals are associated with the instantiated formal. + -- FIXME: do it in Instantiate_Package_Declaration ? + Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg); + Sem_Generic_Association_Chain (Decl, Decl); -- FIXME: unless the parent is a package declaration library unit, the -- design unit depends on the body. diff --git a/sem_assocs.adb b/sem_assocs.adb index dcec12c98..ee43e30ef 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -1162,7 +1162,7 @@ package body Sem_Assocs is Set_Parameter_Association_Chain (Res, Null_Iir); Set_Type (Res, Get_Return_Type (Func)); Set_Expr_Staticness (Res, None); - Set_Use_Flag (Func, True); + Mark_Subprogram_Used (Func); when Iir_Kind_Subtype_Declaration | Iir_Kind_Type_Declaration => Res := Create_Iir (Iir_Kind_Type_Conversion); diff --git a/sem_decls.adb b/sem_decls.adb index abc51ea4e..f8647684c 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -122,7 +122,7 @@ package body Sem_Decls is if False and (Get_Kind (A_Type) not in Iir_Kinds_Subtype_Definition - or else Get_Resolution_Function (A_Type) = Null_Iir) + or else Get_Resolution_Indication (A_Type) = Null_Iir) then Error_Msg_Sem (Disp_Node (A_Type) @@ -319,12 +319,6 @@ package body Sem_Decls is end loop; end Sem_Interface_Chain; - function Is_One_Dimensional (Array_Def : Iir) return Boolean - is - begin - return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Def)) = 1; - end Is_One_Dimensional; - -- LRM93 7.2.2 -- A discrete array is a one-dimensional array whose elements are of a -- discrete type. @@ -339,7 +333,7 @@ package body Sem_Decls is raise Internal_Error; -- return False; end case; - if not Is_One_Dimensional (Def) then + if not Is_One_Dimensional_Array_Type (Def) then return False; end if; if Get_Kind (Get_Element_Subtype (Def)) @@ -779,7 +773,7 @@ package body Sem_Decls is Element_Type := Get_Element_Subtype (Type_Definition); - if Is_One_Dimensional (Type_Definition) then + if Is_One_Dimensional_Array_Type (Type_Definition) then -- LRM93 7.2.4 Adding operators -- The concatenation operator & is predefined for any -- one-dimensional array type. @@ -1989,7 +1983,7 @@ package body Sem_Decls is -- LRM93 4.3.3.1 -- This type must not be a multi-dimensional array type. if Get_Kind (N_Type) in Iir_Kinds_Array_Type_Definition then - if not Is_Unidim_Array_Type (N_Type) then + if not Is_One_Dimensional_Array_Type (N_Type) then Error_Msg_Sem ("aliased name must not be a multi-dimensional array type", Alias); @@ -2392,9 +2386,9 @@ package body Sem_Decls is Name := Get_Name (Alias); if Get_Kind (Name) = Iir_Kind_Signature then Sig := Name; - Name := Get_Prefix (Sig); + Name := Get_Signature_Prefix (Sig); Sem_Name (Name); - Set_Prefix (Sig, Name); + Set_Signature_Prefix (Sig, Name); else Sem_Name (Name); Sig := Null_Iir; diff --git a/sem_expr.adb b/sem_expr.adb index 9b8c9bbcb..309a2480b 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -209,7 +209,7 @@ package body Sem_Expr is begin -- LRM 7.3.1 -- [...] the type of the literal must be a one-dimensional array ... - if not Is_Unidim_Array_Type (Base_Type) then + if not Is_One_Dimensional_Array_Type (Base_Type) then return False; end if; -- LRM 7.3.1 @@ -1133,7 +1133,7 @@ package body Sem_Expr is Subprg : constant Iir := Get_Current_Subprogram; begin Set_Function_Call_Staticness (Expr, Imp); - Set_Use_Flag (Imp, True); + Mark_Subprogram_Used (Imp); -- Check purity/wait/passive. @@ -2130,7 +2130,7 @@ package body Sem_Expr is -- the expression must be one of the following: -- FIXME: to complete. Sel_Type := Get_Type (Sel); - if not Is_Unidim_Array_Type (Sel_Type) then + if not Is_One_Dimensional_Array_Type (Sel_Type) then Error_Msg_Sem ("expression must be discrete or one-dimension array subtype", Sel); return; @@ -3571,7 +3571,7 @@ package body Sem_Expr is -- A subtype indication that is part of an allocator must -- not include a resolution function. if Is_Anonymous_Type_Definition (Arg) - and then Get_Resolution_Function (Arg) /= Null_Iir + and then Get_Resolution_Indication (Arg) /= Null_Iir then Error_Msg_Sem ("subtype indication must not include" & " a resolution function", Expr); @@ -4187,7 +4187,7 @@ package body Sem_Expr is El := Get_Nth_Element (List, I); exit when El = Null_Iir; if Get_Kind (El) in Iir_Kinds_Discrete_Type_Definition - or else Is_Unidim_Array_Type (El) + or else Is_One_Dimensional_Array_Type (El) then if Res = Null_Iir then Res := El; diff --git a/sem_inst.adb b/sem_inst.adb new file mode 100644 index 000000000..c368e1f69 --- /dev/null +++ b/sem_inst.adb @@ -0,0 +1,423 @@ +-- Package (and subprograms) instantiations + +-- When a package is instantiated, we need to 'duplicate' its declaration. +-- This looks useless for analysis but it isn't: a type from a package +-- instantiated twice declares two different types. Without duplication, we +-- need to attach to each declaration its instance, which looks more expansive +-- that duplicating the declaration. +-- +-- Furthermore, for generic type interface, it looks a good idea to duplicate +-- the body (macro expansion). +-- +-- Duplicating is not trivial: internal links must be kept and external +-- links preserved. A table is used to map nodes from the uninstantiated +-- package to its duplicated node. Links from instantiated declaration to +-- the original declaration are also stored in that table. + +with GNAT.Table; +with Nodes; +with Nodes_Meta; +with Types; use Types; +with Iirs_Utils; use Iirs_Utils; + +package body Sem_Inst is + -- Table of origin. This is an extension of vhdl nodes to track the + -- origin of a node. If a node has a non-null origin, then the node was + -- instantiated for the origin node. + -- + -- Furthermore, during instantiation, we need to keep track of instantiated + -- nodes (ie nodes created by instantiation) used by references. As an + -- instance cannot be uninstantiated, there is no collisions, as soon as + -- such entries are cleaned after instantiation. + -- + -- As an example, here are declarations of an uninstantiated package: + -- type Nat is range 0 to 1023; + -- constant N : Nat := 5; + -- A node Nat1 will be created from node Nat (an integer type definition). + -- The origin of Nat1 is Nat and this is true forever. During + -- instantiation, the instance of Nat is Nat1, so that the type of N will + -- be set to Nat1. + package Origin_Table is new GNAT.Table + (Table_Component_Type => Iir, + Table_Index_Type => Iir, + Table_Low_Bound => 2, + Table_Initial => 1024, + Table_Increment => 100); + + procedure Expand_Origin_Table + is + use Nodes; + Last : constant Iir := Iirs.Get_Last_Node; + El: Iir; + begin + El := Origin_Table.Last; + if El < Last then + Origin_Table.Set_Last (Last); + Origin_Table.Table (El + 1 .. Last) := (others => Null_Iir); + end if; + end Expand_Origin_Table; + + -- This is the public function; the table may not have been extended. + function Get_Origin (N : Iir) return Iir + is + -- Make the '<=' operator visible. + use Nodes; + begin + if N <= Origin_Table.Last then + return Origin_Table.Table (N); + else + return Null_Iir; + end if; + end Get_Origin; + + -- This is the private function: the table *must* have been extended. + function Get_Instance (N : Iir) return Iir + is + -- Make '<=' operator visible for the assert. + use Nodes; + begin + pragma Assert (N <= Origin_Table.Last); + return Origin_Table.Table (N); + end Get_Instance; + + procedure Set_Origin (N : Iir; Orig : Iir) is + begin + -- As nodes are created, we need to expand origin table. + Expand_Origin_Table; + + pragma Assert (Orig = Null_Iir + or else Origin_Table.Table (N) = Null_Iir); + Origin_Table.Table (N) := Orig; + end Set_Origin; + + type Instance_Entry_Type is record + -- Node + N : Iir; + + -- Old value in Origin_Table. + Old_Origin : Iir; + end record; + + type Instance_Index_Type is new Natural; + + -- Table of previous values in Origin_Table. The first purpose of this + -- table is to be able to revert the calls to Set_Instance, so that a unit + -- can be instantiated several times. Keep the nodes that have been + -- instantiated is cheaper than walking the tree a second time. + -- The second purpose of this table is not yet implemented: being able to + -- have uninstantiated packages in instantiated packages. In that case, + -- the slot in Origin_Table cannot be the origin and the instance at the + -- same time. + package Prev_Instance_Table is new GNAT.Table + (Table_Component_Type => Instance_Entry_Type, + Table_Index_Type => Instance_Index_Type, + Table_Low_Bound => 1, + Table_Initial => 256, + Table_Increment => 100); + + procedure Set_Instance (Orig : Iir; N : Iir) + is + use Nodes; + begin + pragma Assert (Orig <= Origin_Table.Last); + + -- Save the old entry + Prev_Instance_Table.Append + (Instance_Entry_Type'(N => Orig, + Old_Origin => Origin_Table.Table (Orig))); + + -- Set the entry. + Origin_Table.Table (Orig) := N; + end Set_Instance; + + procedure Restore_Origin (Mark : Instance_Index_Type) is + begin + for I in reverse Mark + 1 .. Prev_Instance_Table.Last loop + declare + El : Instance_Entry_Type renames Prev_Instance_Table.Table (I); + begin + Origin_Table.Table (El.N) := El.Old_Origin; + end; + end loop; + Prev_Instance_Table.Set_Last (Mark); + end Restore_Origin; + + -- The location to be used while instantiated nodes. + Instantiate_Loc : Location_Type; + + function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir; + + -- Instantiate a list. Simply create a new list and instantiate nodes of + -- that list. + function Instantiate_Iir_List (L : Iir_List; Is_Ref : Boolean) + return Iir_List + is + Res : Iir_List; + El : Iir; + begin + case L is + when Null_Iir_List + | Iir_List_All + | Iir_List_Others => + return L; + when others => + Res := Create_Iir_List; + for I in Natural loop + El := Get_Nth_Element (L, I); + exit when El = Null_Iir; + Append_Element (Res, Instantiate_Iir (El, Is_Ref)); + end loop; + return Res; + end case; + end Instantiate_Iir_List; + + -- Instantiate a chain. This is a special case to reduce stack depth. + function Instantiate_Iir_Chain (N : Iir) return Iir + is + First : Iir; + Last : Iir; + Next_N : Iir; + Next_R : Iir; + begin + if N = Null_Iir then + return Null_Iir; + end if; + + First := Instantiate_Iir (N, False); + Last := First; + Next_N := Get_Chain (N); + while Next_N /= Null_Iir loop + Next_R := Instantiate_Iir (Next_N, False); + Set_Chain (Last, Next_R); + Last := Next_R; + Next_N := Get_Chain (Next_N); + end loop; + + return First; + end Instantiate_Iir_Chain; + + procedure Instantiate_Iir_Field + (Res : Iir; N : Iir; F : Nodes_Meta.Fields_Enum) + is + use Nodes_Meta; + begin + case Get_Field_Type (F) is + when Type_Iir => + declare + S : constant Iir := Get_Iir (N, F); + R : Iir; + begin + case Get_Field_Attribute (F) is + when Attr_None => + R := Instantiate_Iir (S, False); + when Attr_Ref => + R := Instantiate_Iir (S, True); + when Attr_Maybe_Ref => + R := Instantiate_Iir (S, Get_Is_Ref (N)); + when Attr_Chain => + R := Instantiate_Iir_Chain (S); + when Attr_Chain_Next => + R := Null_Iir; + when Attr_Of_Ref => + -- Can only appear in list. + raise Internal_Error; + end case; + Set_Iir (Res, F, R); + end; + when Type_Iir_List => + declare + S : constant Iir_List := Get_Iir_List (N, F); + R : Iir_List; + begin + case Get_Field_Attribute (F) is + when Attr_None => + R := Instantiate_Iir_List (S, False); + when Attr_Of_Ref => + R := Instantiate_Iir_List (S, True); + when others => + -- Ref is specially handled in Instantiate_Iir. + -- Others cannot appear for lists. + raise Internal_Error; + end case; + Set_Iir_List (Res, F, R); + end; + when Type_PSL_NFA + | Type_PSL_Node => + -- TODO + raise Internal_Error; + when Type_String_Id => + Set_String_Id (Res, F, Get_String_Id (N, F)); + when Type_Source_Ptr => + Set_Source_Ptr (Res, F, Get_Source_Ptr (N, F)); + when Type_Date_Type + | Type_Date_State_Type + | Type_Time_Stamp_Id => + -- Can this happen ? + raise Internal_Error; + when Type_Base_Type => + Set_Base_Type (Res, F, Get_Base_Type (N, F)); + when Type_Iir_Constraint => + Set_Iir_Constraint (Res, F, Get_Iir_Constraint (N, F)); + when Type_Iir_Mode => + Set_Iir_Mode (Res, F, Get_Iir_Mode (N, F)); + when Type_Iir_Index32 => + Set_Iir_Index32 (Res, F, Get_Iir_Index32 (N, F)); + when Type_Iir_Int64 => + Set_Iir_Int64 (Res, F, Get_Iir_Int64 (N, F)); + when Type_Boolean => + Set_Boolean (Res, F, Get_Boolean (N, F)); + when Type_Iir_Staticness => + Set_Iir_Staticness (Res, F, Get_Iir_Staticness (N, F)); + when Type_Iir_All_Sensitized => + Set_Iir_All_Sensitized (Res, F, Get_Iir_All_Sensitized (N, F)); + when Type_Iir_Signal_Kind => + Set_Iir_Signal_Kind (Res, F, Get_Iir_Signal_Kind (N, F)); + when Type_Tri_State_Type => + Set_Tri_State_Type (Res, F, Get_Tri_State_Type (N, F)); + when Type_Iir_Pure_State => + Set_Iir_Pure_State (Res, F, Get_Iir_Pure_State (N, F)); + when Type_Iir_Delay_Mechanism => + Set_Iir_Delay_Mechanism (Res, F, Get_Iir_Delay_Mechanism (N, F)); + when Type_Iir_Lexical_Layout_Type => + Set_Iir_Lexical_Layout_Type + (Res, F, Get_Iir_Lexical_Layout_Type (N, F)); + when Type_Iir_Predefined_Functions => + Set_Iir_Predefined_Functions + (Res, F, Get_Iir_Predefined_Functions (N, F)); + when Type_Iir_Direction => + Set_Iir_Direction (Res, F, Get_Iir_Direction (N, F)); + when Type_Location_Type => + Set_Location_Type (Res, F, Instantiate_Loc); + when Type_Iir_Int32 => + Set_Iir_Int32 (Res, F, Get_Iir_Int32 (N, F)); + when Type_Int32 => + Set_Int32 (Res, F, Get_Int32 (N, F)); + when Type_Iir_Fp64 => + Set_Iir_Fp64 (Res, F, Get_Iir_Fp64 (N, F)); + when Type_Token_Type => + Set_Token_Type (Res, F, Get_Token_Type (N, F)); + when Type_Name_Id => + Set_Name_Id (Res, F, Get_Name_Id (N, F)); + end case; + end Instantiate_Iir_Field; + + function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir + is + Res : Iir; + begin + -- Nothing to do for null node. + if N = Null_Iir then + return Null_Iir; + end if; + + -- For a reference, do not create a new node. + if Is_Ref then + Res := Get_Instance (N); + if Res /= Null_Iir then + -- There is an instance for N. + return Res; + else + -- Reference outside the instance. + return N; + end if; + end if; + + declare + use Nodes_Meta; + Kind : constant Iir_Kind := Get_Kind (N); + Fields : constant Fields_Array := Get_Fields (Kind); + F : Fields_Enum; + begin + Res := Get_Instance (N); + + if Kind = Iir_Kind_Constant_Interface_Declaration + and then Get_Identifier (N) = Null_Identifier + and then Res /= Null_Iir + then + -- Anonymous constant interface declarations are the only nodes + -- that can be shared. Handle that very special case. + return Res; + end if; + + pragma Assert (Res = Null_Iir); + + -- Create a new node. + Res := Create_Iir (Kind); + + -- The origin of this new node is N. + Set_Origin (Res, N); + + -- And the instance of N is RES. + Set_Instance (N, Res); + + Set_Location (Res, Instantiate_Loc); + + for I in Fields'Range loop + F := Fields (I); + + case F is + when Field_Index_Subtype_List => + declare + List : Iir_List; + begin + case Kind is + when Iir_Kind_Array_Type_Definition => + List := Get_Index_Subtype_Definition_List (Res); + when Iir_Kind_Array_Subtype_Definition => + List := Get_Index_Constraint_List (Res); + if List = Null_Iir_List then + List := Get_Index_Subtype_List + (Get_Denoted_Type_Mark (Res)); + end if; + when others => + -- All the nodes where Index_Subtype_List appears + -- are handled above. + raise Internal_Error; + end case; + Set_Index_Subtype_List (Res, List); + end; + + when others => + -- Common case. + Instantiate_Iir_Field (Res, N, F); + end case; + end loop; + + case Kind is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + -- Subprogram body is a forward declaration. + Set_Subprogram_Body (Res, Null_Iir); + when others => + null; + end case; + + return Res; + end; + end Instantiate_Iir; + + procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir) + is + Header : constant Iir := Get_Package_Header (Pkg); + Prev_Loc : constant Location_Type := Instantiate_Loc; + Mark : constant Instance_Index_Type := Prev_Instance_Table.Last; + begin + Instantiate_Loc := Get_Location (Inst); + + -- Be sure Get_Origin_Priv can be called on existing nodes. + Expand_Origin_Table; + + -- For Parent: the instance of PKG is INST. + Set_Origin (Pkg, Inst); + + Set_Generic_Chain + (Inst, Instantiate_Iir_Chain (Get_Generic_Chain (Header))); + Set_Declaration_Chain + (Inst, Instantiate_Iir_Chain (Get_Declaration_Chain (Pkg))); + + Set_Origin (Pkg, Null_Iir); + + Instantiate_Loc := Prev_Loc; + Restore_Origin (Mark); + end Instantiate_Package_Declaration; +end Sem_Inst; diff --git a/sem_inst.ads b/sem_inst.ads new file mode 100644 index 000000000..da8cd5d27 --- /dev/null +++ b/sem_inst.ads @@ -0,0 +1,26 @@ +-- Package (and subprograms) instantiations + +-- When a package is instantiated, we need to 'duplicate' its declaration. +-- This looks useless for analysis but it isn't: a type from a package +-- instantiated twice declares two different types. Without duplication, we +-- need to attach to each declaration its instance, which looks more expansive +-- that duplicating the declaration. +-- +-- Furthermore, for generic type interface, it looks a good idea to duplicate +-- the body (macro expansion). +-- +-- Duplicating is not trivial: internal links must be kept and external +-- links preserved. A table is used to map nodes from the uninstantiated +-- package to its duplicated node. Links from instantiated declaration to +-- the original declaration are also stored in that table. + +with Iirs; use Iirs; + +package Sem_Inst is + -- Return the origin of node N, the node from which N was instantiated. + -- If N is not an instance, this function returns Null_Iir. + function Get_Origin (N : Iir) return Iir; + + -- Create declaration chain and generic declarations for INST from PKG. + procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir); +end Sem_Inst; diff --git a/sem_names.adb b/sem_names.adb index 3cf273b8c..2958753e5 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -329,11 +329,12 @@ package body Sem_Names is null; when Iir_Kind_Package_Declaration => null; + when Iir_Kind_Package_Instantiation_Declaration => + Iterator_Decl_Chain (Get_Generic_Chain (Decl), Id); when Iir_Kind_Block_Statement => declare - Header : Iir; + Header : constant Iir := Get_Block_Header (Decl); begin - Header := Get_Block_Header (Decl); if Header /= Null_Iir then Iterator_Decl_Chain (Get_Generic_Chain (Header), Id); Iterator_Decl_Chain (Get_Port_Chain (Header), Id); @@ -362,7 +363,8 @@ package body Sem_Names is | Iir_Kind_Block_Statement => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); Iterator_Decl_Chain (Get_Concurrent_Statement_Chain (Decl), Id); - when Iir_Kind_Package_Declaration => + when Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration => Iterator_Decl_Chain (Get_Declaration_Chain (Decl), Id); when Iir_Kind_Process_Statement | Iir_Kind_Sensitized_Process_Statement => @@ -511,17 +513,14 @@ package body Sem_Names is procedure Finish_Sem_Indexed_Name (Expr : Iir) is - Prefix : Iir; - Prefix_Type : Iir; + Prefix : constant Iir := Get_Prefix (Expr); + Prefix_Type : constant Iir := Get_Type (Prefix); + Index_List : constant Iir_List := Get_Index_List (Expr); Index_Subtype : Iir; - Index_List : Iir_List; Index : Iir; Expr_Staticness : Iir_Staticness; begin - Prefix := Get_Prefix (Expr); - Prefix_Type := Get_Type (Prefix); Expr_Staticness := Locally; - Index_List := Get_Index_List (Expr); -- LRM93 §6.4: there must be one such expression for each index -- position of the array and each expression must be of the @@ -704,13 +703,12 @@ package body Sem_Names is Set_Signal_Type_Flag (Expr_Type, Get_Signal_Type_Flag (Prefix_Base_Type)); Append_Element (Get_Index_Subtype_List (Expr_Type), Slice_Type); - Set_Element_Subtype_Indication - (Expr_Type, Get_Element_Subtype_Indication (Prefix_Type)); - if Get_Kind (Prefix_Type) /= Iir_Kind_Array_Type_Definition then - Set_Resolution_Function - (Expr_Type, Get_Resolution_Function (Prefix_Type)); + Set_Element_Subtype (Expr_Type, Get_Element_Subtype (Prefix_Type)); + if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then + Set_Resolution_Indication + (Expr_Type, Get_Resolution_Indication (Prefix_Type)); else - Set_Resolution_Function (Expr_Type, Null_Iir); + Set_Resolution_Indication (Expr_Type, Null_Iir); end if; Set_Type_Staticness (Expr_Type, Min (Get_Type_Staticness (Prefix_Type), @@ -1853,6 +1851,7 @@ package body Sem_Names is | Iir_Kind_Architecture_Body | Iir_Kind_Entity_Declaration | Iir_Kind_Package_Declaration + | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Generate_Statement | Iir_Kind_Block_Statement | Iir_Kind_For_Loop_Statement => @@ -1884,7 +1883,9 @@ package body Sem_Names is -- LRM93 §6.3 -- This form of expanded name is only allowed within the -- construct itself. - if Get_Kind (Prefix) /= Iir_Kind_Package_Declaration + if not Kind_In (Prefix, + Iir_Kind_Package_Declaration, + Iir_Kind_Package_Instantiation_Declaration) and then not Get_Is_Within_Flag (Prefix) then Error_Msg_Sem diff --git a/sem_specs.adb b/sem_specs.adb index ed418759e..4c16a078d 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -582,7 +582,7 @@ package body Sem_Specs is -- Sem_Name cannot be used here (at least not directly) because only -- the declarations of the current scope are considered. - Prefix := Get_Prefix (Sig); + Prefix := Get_Signature_Prefix (Sig); Inter := Get_Interpretation (Get_Identifier (Prefix)); while Valid_Interpretation (Inter) loop exit when not Is_In_Current_Declarative_Region (Inter); @@ -614,7 +614,7 @@ package body Sem_Specs is Set_Named_Entity (Prefix, Name); Prefix := Finish_Sem_Name (Prefix); - Set_Prefix (Sig, Prefix); + Set_Signature_Prefix (Sig, Prefix); Attribute_A_Decl (Name, Attr, True, True); end Sem_Signature_Entity_Designator; diff --git a/sem_stmts.adb b/sem_stmts.adb index b95b3e510..d9758073b 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -944,7 +944,7 @@ package body Sem_Stmts is (Chain, Choice_Type, False, True, Loc, Low, High); when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Array_Type_Definition => - if not Is_Unidim_Array_Type (Choice_Type) then + if not Is_One_Dimensional_Array_Type (Choice_Type) then Error_Msg_Sem ("expression must be of a one-dimensional array type", Choice); diff --git a/sem_types.adb b/sem_types.adb index 6f54e9e3e..27eee590a 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -25,6 +25,7 @@ with Sem_Expr; use Sem_Expr; with Sem_Scopes; use Sem_Scopes; with Sem_Names; use Sem_Names; with Sem_Decls; +with Sem_Inst; with Name_Table; with Std_Names; with Iirs_Utils; use Iirs_Utils; @@ -33,7 +34,26 @@ with Ieee.Std_Logic_1164; with Xrefs; use Xrefs; package body Sem_Types is - procedure Set_Type_Has_Signal (Atype : Iir) is + -- Mark the resolution function (this may be required by the back-end to + -- generate resolver). + procedure Mark_Resolution_Function (Subtyp : Iir) + is + Func : Iir_Function_Declaration; + begin + if not Get_Resolved_Flag (Subtyp) then + return; + end if; + + Func := Has_Resolution_Function (Subtyp); + -- Maybe the type is resolved through its elements. + if Func /= Null_Iir then + Set_Resolution_Function_Flag (Func, True); + end if; + end Mark_Resolution_Function; + + procedure Set_Type_Has_Signal (Atype : Iir) + is + Orig : Iir; begin -- Sanity check: ATYPE can be a signal type (eg: not an access type) if not Get_Signal_Type_Flag (Atype) then @@ -49,6 +69,12 @@ package body Sem_Types is -- This type is used to declare a signal. Set_Has_Signal_Flag (Atype, True); + -- If this type was instantiated, also mark the origin. + Orig := Sem_Inst.Get_Origin (Atype); + if Orig /= Null_Iir then + Set_Type_Has_Signal (Orig); + end if; + -- Mark resolution function, and for composite types, also mark type -- of elements. case Get_Kind (Atype) is @@ -57,22 +83,14 @@ package body Sem_Types is | Iir_Kind_Physical_Type_Definition | Iir_Kind_Floating_Type_Definition => null; - when Iir_Kinds_Subtype_Definition => - declare - Func : Iir_Function_Declaration; - begin - Set_Type_Has_Signal (Get_Base_Type (Atype)); - -- Mark the resolution function (this may be required by the - -- back-end to generate resolver). - if Get_Resolved_Flag (Atype) then - Func := Get_Resolution_Function (Atype); - -- Maybe the type is resolved through its elements. - if Func /= Null_Iir then - Func := Get_Named_Entity (Func); - Set_Resolution_Function_Flag (Func, True); - end if; - end if; - end; + when Iir_Kinds_Scalar_Subtype_Definition + | Iir_Kind_Record_Subtype_Definition => + Set_Type_Has_Signal (Get_Base_Type (Atype)); + Mark_Resolution_Function (Atype); + when Iir_Kind_Array_Subtype_Definition => + Set_Type_Has_Signal (Get_Base_Type (Atype)); + Mark_Resolution_Function (Atype); + Set_Type_Has_Signal (Get_Element_Subtype (Atype)); when Iir_Kind_Array_Type_Definition => Set_Type_Has_Signal (Get_Element_Subtype (Atype)); when Iir_Kind_Record_Type_Definition => @@ -114,6 +132,19 @@ package body Sem_Types is if Left = Null_Iir or Right = Null_Iir then return Null_Iir; end if; + + -- Emit error message for overflow and replace with a value to avoid + -- error storm. + if Get_Kind (Left) = Iir_Kind_Overflow_Literal then + Error_Msg_Sem ("overflow in left bound", Left); + Left := Build_Extreme_Value + (Get_Direction (Expr) = Iir_Downto, Left); + end if; + if Get_Kind (Right) = Iir_Kind_Overflow_Literal then + Error_Msg_Sem ("overflow in right bound", Right); + Right := Build_Extreme_Value + (Get_Direction (Expr) = Iir_To, Right); + end if; Set_Left_Limit (Expr, Left); Set_Right_Limit (Expr, Right); @@ -455,10 +486,8 @@ package body Sem_Types is end case; end Check_No_File_Type; - -- Semantize the array_element type of DEF. - -- Set type_staticness and resolved_flag of DEF. - -- type_staticness of DEF (before calling this function) must be the - -- staticness of the array indexes. + -- Semantize the array_element type of array type DEF. + -- Set resolved_flag of DEF. procedure Sem_Array_Element (Def : Iir) is El_Type : Iir; @@ -473,6 +502,7 @@ package body Sem_Types is Set_Element_Subtype_Indication (Def, El_Type); El_Type := Get_Type_Of_Subtype_Indication (El_Type); + Set_Element_Subtype (Def, El_Type); Check_No_File_Type (El_Type, Def); Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (El_Type)); @@ -487,8 +517,6 @@ package body Sem_Types is Error_Msg_Sem ("array element of unconstrained " & Disp_Node (El_Type) & " is not allowed", Def); end if; - Set_Type_Staticness (Def, Min (Get_Type_Staticness (El_Type), - Get_Type_Staticness (Def))); Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type)); end Sem_Array_Element; @@ -686,7 +714,6 @@ package body Sem_Types is Close_Declarative_Region; end Sem_Protected_Type_Body; - -- Return the constraint state from CONST (the initial state) and ATYPE, -- as if ATYPE was a new element of a record. function Update_Record_Constraint (Const : Iir_Constraint; Atype : Iir) @@ -868,7 +895,8 @@ package body Sem_Types is function Sem_Unbounded_Array_Type_Definition (Def: Iir) return Iir is - Index_List : constant Iir_List := Get_Index_Subtype_List (Def); + Index_List : constant Iir_List := + Get_Index_Subtype_Definition_List (Def); Index_Type : Iir; begin Set_Base_Type (Def, Def); @@ -889,11 +917,14 @@ package body Sem_Types is end if; end loop; - -- According to LRM93 7.4.1, an unconstrained array type is not static. - Set_Type_Staticness (Def, None); + Set_Index_Subtype_List (Def, Index_List); Sem_Array_Element (Def); Set_Constraint_State (Def, Get_Array_Constraint (Def)); + + -- According to LRM93 7.4.1, an unconstrained array type is not static. + Set_Type_Staticness (Def, None); + return Def; end Sem_Unbounded_Array_Type_Definition; @@ -920,6 +951,7 @@ package body Sem_Types is Index_Name : Iir; Index_List : Iir_List; Base_Index_List : Iir_List; + El_Type : Iir; Staticness : Iir_Staticness; -- array_type_definition, which is the same as the subtype, @@ -957,10 +989,11 @@ package body Sem_Types is Set_Base_Type (Base_Type, Base_Type); Set_Type_Declarator (Base_Type, Decl); Base_Index_List := Create_Iir_List; + Set_Index_Subtype_Definition_List (Base_Type, Base_Index_List); Set_Index_Subtype_List (Base_Type, Base_Index_List); Staticness := Locally; - Index_List := Get_Index_Subtype_List (Def); + Index_List := Get_Index_Constraint_List (Def); for I in Natural loop Index_Type := Get_Nth_Element (Index_List, I); exit when Index_Type = Null_Iir; @@ -981,7 +1014,9 @@ package body Sem_Types is Staticness := Min (Staticness, Get_Type_Staticness (Index_Type)); -- Set the index subtype definition for the array base type. - if Get_Kind (Index_Name) not in Iir_Kinds_Denoting_Name then + if Get_Kind (Index_Name) in Iir_Kinds_Denoting_Name then + Index_Type := Index_Name; + else pragma Assert (Get_Kind (Index_Name) in Iir_Kinds_Subtype_Definition); Index_Type := Get_Subtype_Type_Mark (Index_Name); @@ -999,17 +1034,22 @@ package body Sem_Types is end if; Append_Element (Base_Index_List, Index_Type); end loop; - Set_Type_Staticness (Def, Staticness); + Set_Index_Subtype_List (Def, Index_List); -- Element type. - Sem_Array_Element (Def); + Set_Element_Subtype_Indication (Base_Type, Get_Element_Subtype (Def)); + Sem_Array_Element (Base_Type); + El_Type := Get_Element_Subtype (Base_Type); + Set_Element_Subtype (Def, El_Type); + + Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Base_Type)); - Set_Element_Subtype_Indication - (Base_Type, Get_Element_Subtype_Indication (Def)); - Set_Signal_Type_Flag (Base_Type, Get_Signal_Type_Flag (Def)); -- According to LRM93 §7.4.1, an unconstrained array type -- is not static. Set_Type_Staticness (Base_Type, None); + Set_Type_Staticness (Def, Min (Staticness, + Get_Type_Staticness (El_Type))); + Set_Type_Declarator (Base_Type, Decl); Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def)); Set_Index_Constraint_Flag (Def, True); @@ -1072,7 +1112,7 @@ package body Sem_Types is -- LRM 3.4 -- If the base type is an array type, it must be a one -- dimensional array type. - if not Is_Unidim_Array_Type (Type_Mark) then + if not Is_One_Dimensional_Array_Type (Type_Mark) then Error_Msg_Sem ("multi-dimensional " & Disp_Node (Type_Mark) & " cannot be a file type", Def); @@ -1214,7 +1254,7 @@ package body Sem_Types is if Get_Kind (Decl_Type) /= Iir_Kind_Array_Type_Definition then return False; end if; - if Get_Nbr_Elements (Get_Index_Subtype_List (Decl_Type)) /= 1 then + if not Is_One_Dimensional_Array_Type (Decl_Type) then return False; end if; -- LRM93 2.4 @@ -1301,9 +1341,9 @@ package body Sem_Types is & Disp_Node (Name), Atype); else Name1 := Finish_Sem_Name (Name); - Set_Use_Flag (Res, True); + Mark_Subprogram_Used (Res); Set_Resolved_Flag (Atype, True); - Set_Resolution_Function (Atype, Name1); + Set_Resolution_Indication (Atype, Name1); end if; end Sem_Resolution_Function; @@ -1319,10 +1359,10 @@ package body Sem_Types is (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir is + El_Type : constant Iir := Get_Element_Subtype (Type_Mark); Res : Iir; Type_Index, Subtype_Index: Iir; Base_Type : Iir; - El_Type : Iir; El_Def : Iir; Staticness : Iir_Staticness; Error_Seen : Boolean; @@ -1332,23 +1372,21 @@ package body Sem_Types is Resolv_El : Iir := Null_Iir; begin if Resolution /= Null_Iir then + -- A resolution indication is present. case Get_Kind (Resolution) is when Iir_Kinds_Denoting_Name => Resolv_Func := Resolution; - when Iir_Kind_Array_Subtype_Definition => - Resolv_El := Get_Element_Subtype (Resolution); - Free_Iir (Resolution); - when Iir_Kind_Record_Subtype_Definition => + when Iir_Kind_Array_Element_Resolution => + Resolv_El := Get_Resolution_Indication (Resolution); + when Iir_Kind_Record_Resolution => Error_Msg_Sem - ("record element resolution not allowed for array subtype", + ("record resolution not allowed for array subtype", Resolution); when others => Error_Kind ("sem_array_constraint(resolution)", Resolution); end case; end if; - El_Type := Get_Element_Subtype (Type_Mark); - if Def = Null_Iir then -- There is no element_constraint. pragma Assert (Resolution /= Null_Iir); @@ -1387,12 +1425,13 @@ package body Sem_Types is Base_Type := Get_Base_Type (Type_Mark); Set_Base_Type (Def, Base_Type); - El_Def := Get_Element_Subtype_Indication (Def); + El_Def := Get_Element_Subtype (Def); Staticness := Get_Type_Staticness (El_Type); Error_Seen := False; - Type_Index_List := Get_Index_Subtype_List (Base_Type); - Subtype_Index_List := Get_Index_Subtype_List (Def); + Type_Index_List := + Get_Index_Subtype_Definition_List (Base_Type); + Subtype_Index_List := Get_Index_Constraint_List (Def); -- LRM08 5.3.2.2 -- If an array constraint of the first form (including an index @@ -1463,6 +1502,7 @@ package body Sem_Types is (Subtype_Index_List, I, Subtype_Index); end if; end loop; + Set_Index_Subtype_List (Def, Subtype_Index_List); Set_Index_Constraint_Flag (Def, True); end if; Set_Type_Staticness (Def, Staticness); @@ -1492,23 +1532,22 @@ package body Sem_Types is El_Def := Sem_Subtype_Constraint (El_Def, El_Type, Resolv_El); end if; if El_Def = Null_Iir then - El_Def := Get_Element_Subtype_Indication (Type_Mark); + El_Def := Get_Element_Subtype (Type_Mark); end if; - Set_Element_Subtype_Indication (Res, El_Def); + Set_Element_Subtype (Res, El_Def); Set_Constraint_State (Res, Get_Array_Constraint (Res)); if Resolv_Func /= Null_Iir then Sem_Resolution_Function (Resolv_Func, Res); + elsif Resolv_El /= Null_Iir then + Set_Resolution_Indication (Res, Resolution); + -- FIXME: may a resolution indication for a record be incomplete ? + Set_Resolved_Flag (Res, Get_Resolved_Flag (El_Def)); elsif Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition then - Set_Resolution_Function (Res, Get_Resolution_Function (Type_Mark)); - end if; - if Get_Resolved_Flag (Res) - or else Get_Resolved_Flag (Get_Element_Subtype (Type_Mark)) - then - Set_Resolved_Flag (Res, True); - else - Set_Resolved_Flag (Res, False); + Set_Resolution_Indication + (Res, Get_Resolution_Indication (Type_Mark)); + Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark)); end if; return Res; @@ -1610,7 +1649,7 @@ package body Sem_Types is end if; else El_List := Create_Iir_List; - Set_Index_Subtype_List (Res, El_List); + Set_Index_Constraint_List (Res, El_List); while Chain /= Null_Iir loop if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression or else Get_Formal (Chain) /= Null_Iir @@ -1656,7 +1695,8 @@ package body Sem_Types is Set_Base_Type (Res, Get_Base_Type (Type_Mark)); Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark)); if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then - Set_Resolution_Function (Res, Get_Resolution_Function (Type_Mark)); + Set_Resolution_Indication + (Res, Get_Resolution_Indication (Type_Mark)); end if; case Get_Kind (Def) is @@ -1671,7 +1711,7 @@ package body Sem_Types is if Get_Kind (Def) /= Iir_Kind_Array_Subtype_Definition then raise Internal_Error; end if; - Index_List := Get_Index_Subtype_List (Def); + Index_List := Get_Index_Constraint_List (Def); El_List := Create_Iir_List; Set_Elements_Declaration_List (Res, El_List); for I in Natural loop @@ -1870,7 +1910,7 @@ package body Sem_Types is end if; Location_Copy (Res, Def); Set_Base_Type (Res, Get_Base_Type (Type_Mark)); - Set_Resolution_Function (Res, Get_Resolution_Function (Def)); + Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); A_Range := Get_Range_Constraint (Def); if A_Range = Null_Iir then A_Range := Get_Range_Constraint (Type_Mark); @@ -2058,7 +2098,7 @@ package body Sem_Types is end if; Res := Sem_Subtype_Constraint - (Def, Type_Mark, Get_Resolution_Function (Def)); + (Def, Type_Mark, Get_Resolution_Indication (Def)); Set_Subtype_Type_Mark (Res, Type_Mark_Name); return Res; end Sem_Subtype_Indication; @@ -2074,7 +2114,8 @@ package body Sem_Types is | Iir_Kind_Physical_Subtype_Definition => Res := Create_Iir (Get_Kind (Def)); Set_Range_Constraint (Res, Get_Range_Constraint (Def)); - Set_Resolution_Function (Res, Get_Resolution_Function (Def)); + Set_Resolution_Indication + (Res, Get_Resolution_Indication (Def)); when Iir_Kind_Enumeration_Type_Definition => Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); Set_Range_Constraint (Res, Get_Range_Constraint (Def)); @@ -2088,18 +2129,18 @@ package body Sem_Types is Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); - Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def)); - Set_Element_Subtype_Indication - (Res, Get_Element_Subtype_Indication (Def)); + Set_Index_Constraint_List (Res, Null_Iir_List); + Set_Index_Subtype_List + (Res, Get_Index_Subtype_Definition_List (Def)); + Set_Element_Subtype (Res, Get_Element_Subtype (Def)); Set_Index_Constraint_Flag (Res, False); Set_Constraint_State (Res, Get_Constraint_State (Def)); when Iir_Kind_Array_Subtype_Definition => Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); - Set_Resolution_Function (Res, Get_Resolution_Function (Def)); + Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def)); - Set_Element_Subtype_Indication - (Res, Get_Element_Subtype_Indication (Def)); + Set_Element_Subtype (Res, Get_Element_Subtype (Def)); Set_Index_Constraint_Flag (Res, Get_Index_Constraint_Flag (Def)); Set_Constraint_State (Res, Get_Constraint_State (Def)); @@ -2108,9 +2149,9 @@ package body Sem_Types is | Iir_Kind_Record_Subtype_Definition => Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); Set_Type_Staticness (Res, Get_Type_Staticness (Def)); - if Get_Kind (Def) /= Iir_Kind_Record_Type_Definition then - Set_Resolution_Function - (Res, Get_Resolution_Function (Def)); + if Get_Kind (Def) = Iir_Kind_Record_Subtype_Definition then + Set_Resolution_Indication + (Res, Get_Resolution_Indication (Def)); end if; Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); Set_Constraint_State (Res, Get_Constraint_State (Def)); diff --git a/std_package.adb b/std_package.adb index 5fedc8bf9..ea2a6916f 100644 --- a/std_package.adb +++ b/std_package.adb @@ -268,10 +268,12 @@ package body Std_Package is Set_Base_Type (Def, Def); Index_List := Create_Iir_List; + Set_Index_Subtype_Definition_List (Def, Index_List); Set_Index_Subtype_List (Def, Index_List); Append_Element (Index_List, Index); Set_Element_Subtype_Indication (Def, Element); + Set_Element_Subtype (Def, Get_Type (El_Decl)); Set_Type_Staticness (Def, None); Set_Signal_Type_Flag (Def, True); Set_Has_Signal_Flag (Def, not Flags.Flag_Whole_Analyze); @@ -1000,8 +1002,12 @@ package body Std_Package is Index_List := Create_Iir_List; Append_Element (Index_List, Create_Std_Type_Mark (Positive_Subtype_Declaration)); + Set_Index_Subtype_Definition_List (String_Type_Definition, + Index_List); Set_Index_Subtype_List (String_Type_Definition, Index_List); Set_Element_Subtype_Indication (String_Type_Definition, Element); + Set_Element_Subtype (String_Type_Definition, + Character_Type_Definition); Set_Type_Staticness (String_Type_Definition, None); Set_Signal_Type_Flag (String_Type_Definition, True); Set_Has_Signal_Flag (String_Type_Definition, diff --git a/translate/gcc/dist-common.sh b/translate/gcc/dist-common.sh index 473ebb142..b0b142b47 100644 --- a/translate/gcc/dist-common.sh +++ b/translate/gcc/dist-common.sh @@ -43,6 +43,8 @@ nodes.ads nodes.adb nodes_gc.ads nodes_gc.adb +nodes_meta.ads +nodes_meta.adb options.ads options.adb psl-errors.ads diff --git a/translate/translation.adb b/translate/translation.adb index d43a02f77..af703ef59 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -34,9 +34,11 @@ with Std_Names; with Configuration; with Interfaces.C_Streams; with Sem_Names; +with Sem_Inst; with Sem; with Iir_Chains; use Iir_Chains; with Nodes; +with Nodes_Meta; with GNAT.Table; with Ieee.Std_Logic_1164; with Canon; @@ -296,7 +298,7 @@ package body Translation is -- Reset the identifier. type Id_Mark_Type is limited private; - type Local_Identifier_Type is limited private; + type Local_Identifier_Type is private; procedure Reset_Identifier_Prefix; procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type; @@ -393,6 +395,27 @@ package body Translation is function Is_Var_Field (Var : Var_Type) return Boolean; function Get_Var_Offset (Var : Var_Type; Otype : O_Tnode) return O_Cnode; function Get_Var_Label (Var : Var_Type) return O_Dnode; + + -- For package instantiation. + + -- Associate INST_SCOPE as the instantiated scope for ORIG_SCOPE. + procedure Push_Instantiate_Var_Scope + (Inst_Scope : Var_Scope_Acc; Orig_Scope : Var_Scope_Acc); + + -- Remove the association for INST_SCOPE. + procedure Pop_Instantiate_Var_Scope + (Inst_Scope : Var_Scope_Acc); + + -- Get the associated instantiated scope for SCOPE. + function Instantiated_Var_Scope (Scope : Var_Scope_Acc) + return Var_Scope_Acc; + + -- Create a copy of VAR using instantiated scope (if needed). + function Instantiate_Var (Var : Var_Type) return Var_Type; + + -- Create a copy of SCOPE using instantiated scope (if needed). + function Instantiate_Var_Scope (Scope : Var_Scope_Type) + return Var_Scope_Type; private type Local_Identifier_Type is new Natural; type Id_Mark_Type is record @@ -483,6 +506,7 @@ package body Translation is Null_Var_Scope : constant Var_Scope_Type := (Scope_Type => O_Tnode_Null, Kind => Var_Scope_None); + end Chap10; use Chap10; @@ -627,6 +651,9 @@ package body Translation is procedure Start_Subprg_Instance_Use (Subprg : Iir); procedure Finish_Subprg_Instance_Use (Subprg : Iir); + + function Instantiate_Subprg_Instance (Inst : Subprg_Instance_Type) + return Subprg_Instance_Type; private type Subprg_Instance_Type is record Inter : O_Dnode; @@ -840,6 +867,7 @@ package body Translation is ( Kind_Type, Kind_Incomplete_Type, + Kind_Index, Kind_Expr, Kind_Subprg, Kind_Object, @@ -862,8 +890,6 @@ package body Translation is Kind_Library ); - type O_Fnode_Arr is array (Natural range <>) of O_Fnode; - type O_Fnode_Arr_Acc is access O_Fnode_Arr; type Ortho_Info_Type_Kind is ( Kind_Type_Scalar, @@ -915,9 +941,6 @@ package body Translation is Base_Field : O_Fnode_Array; Bounds_Field : O_Fnode_Array; - -- Field declaration for each dimension (1 based). - Bounds_Vector : O_Fnode_Arr_Acc; - -- True if the array bounds are static. Static_Bounds : Boolean; @@ -974,7 +997,6 @@ package body Translation is Bounds_Ptr_Type => O_Tnode_Null, Base_Field => (O_Fnode_Null, O_Fnode_Null), Bounds_Field => (O_Fnode_Null, O_Fnode_Null), - Bounds_Vector => null, Static_Bounds => False, Array_Bounds => Null_Var, Array_1bound => Null_Var, @@ -1296,6 +1318,10 @@ package body Translation is Incomplete_Type : Iir; Incomplete_Array : Ortho_Info_Acc; + when Kind_Index => + -- Field declaration for array dimension. + Index_Field : O_Fnode; + when Kind_Expr => -- Ortho tree which represents the expression, used for -- enumeration literals. @@ -1541,6 +1567,9 @@ package body Translation is -- Elaboration procedure for the instance. Package_Instance_Elab_Subprg : O_Dnode; + Package_Instance_Spec_Scope : aliased Var_Scope_Type; + Package_Instance_Body_Scope : aliased Var_Scope_Type; + when Kind_Assoc => -- Association informations. Assoc_In : Assoc_Conv_Info; @@ -1569,6 +1598,7 @@ package body Translation is subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type); subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type); + subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index); subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg); subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object); subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias); @@ -1643,25 +1673,8 @@ package body Translation is end if; end Free_Info; - procedure Free_Type_Info (Info : in out Type_Info_Acc; Full : Boolean) - is - procedure Free is new Ada.Unchecked_Deallocation - (O_Fnode_Arr, O_Fnode_Arr_Acc); + procedure Free_Type_Info (Info : in out Type_Info_Acc) is begin - case Info.T.Kind is - when Kind_Type_Scalar => - null; - when Kind_Type_Array => - if Full then - Free (Info.T.Bounds_Vector); - end if; - when Kind_Type_Record => - null; - when Kind_Type_File => - null; - when Kind_Type_Protected => - null; - end case; if Info.C /= null then Free_Complex_Type_Info (Info.C); end if; @@ -1847,14 +1860,13 @@ package body Translation is -- for this subtype. --procedure Translate_Literal_Subtype (Def : Iir); - -- Translation of a type definition: + -- Translation of a type definition or subtype indication. -- 1. Create corresponding Ortho type. -- 2. Create bounds type -- 3. Create bounds declaration -- 4. Create bounds constructor -- 5. Create type descriptor declaration -- 6. Create type descriptor constructor - procedure Translate_Type_Definition (Def : Iir; With_Vars : Boolean := True); @@ -5597,6 +5609,194 @@ package body Translation is Finish_Subprogram_Body; end Elab_Package_Body; + procedure Instantiate_Iir_Info (N : Iir); + + procedure Instantiate_Iir_Chain_Info (Chain : Iir) + is + N : Iir; + begin + N := Chain; + while N /= Null_Iir loop + Instantiate_Iir_Info (N); + N := Get_Chain (N); + end loop; + end Instantiate_Iir_Chain_Info; + + procedure Instantiate_Iir_List_Info (L : Iir_List) + is + El : Iir; + begin + case L is + when Null_Iir_List + | Iir_List_All + | Iir_List_Others => + return; + when others => + for I in Natural loop + El := Get_Nth_Element (L, I); + exit when El = Null_Iir; + Instantiate_Iir_Info (El); + end loop; + end case; + end Instantiate_Iir_List_Info; + + procedure Instantiate_Iir_Info (N : Iir) is + begin + -- Nothing to do for null node. + if N = Null_Iir then + return; + end if; + + declare + use Nodes_Meta; + Kind : constant Iir_Kind := Get_Kind (N); + Fields : constant Fields_Array := Get_Fields (Kind); + F : Fields_Enum; + Orig : constant Iir := Sem_Inst.Get_Origin (N); + pragma Assert (Orig /= Null_Iir); + Orig_Info : constant Ortho_Info_Acc := Get_Info (Orig); + Info : Ortho_Info_Acc; + begin + if Orig_Info /= null then + Info := Add_Info (N, Orig_Info.Kind); + + case Info.Kind is + when Kind_Type => + Info.all := (Kind => Kind_Type, + Type_Mode => Orig_Info.Type_Mode, + Type_Incomplete => Orig_Info.Type_Incomplete, + Type_Locally_Constrained => + Orig_Info.Type_Locally_Constrained, + C => null, + Ortho_Type => Orig_Info.Ortho_Type, + Ortho_Ptr_Type => Orig_Info.Ortho_Ptr_Type, + Type_Transient_Chain => Null_Iir, + T => Orig_Info.T, + Type_Rti => Orig_Info.Type_Rti); + pragma Assert (Orig_Info.C = null); + pragma Assert (Orig_Info.Type_Transient_Chain = Null_Iir); + when Kind_Object => + pragma Assert (Orig_Info.Object_Driver = Null_Var); + pragma Assert (Orig_Info.Object_Function = O_Dnode_Null); + Info.all := + (Kind => Kind_Object, + Object_Static => Orig_Info.Object_Static, + Object_Var => Instantiate_Var (Orig_Info.Object_Var), + Object_Driver => Null_Var, + Object_Rti => Orig_Info.Object_Rti, + Object_Function => O_Dnode_Null); + when Kind_Subprg => + Info.Subprg_Frame_Scope := + Instantiate_Var_Scope (Orig_Info.Subprg_Frame_Scope); + Push_Instantiate_Var_Scope + (Info.Subprg_Frame_Scope'Access, + Orig_Info.Subprg_Frame_Scope'Access); + Info.all := + (Kind => Kind_Subprg, + Use_Stack2 => Orig_Info.Use_Stack2, + Ortho_Func => Orig_Info.Ortho_Func, + Res_Interface => Orig_Info.Res_Interface, + Res_Record_Var => + Instantiate_Var (Orig_Info.Res_Record_Var), + Res_Record_Type => Orig_Info.Res_Record_Type, + Res_Record_Ptr => Orig_Info.Res_Record_Ptr, + Subprg_Frame_Scope => Info.Subprg_Frame_Scope, + Subprg_Instance => Instantiate_Subprg_Instance + (Orig_Info.Subprg_Instance), + Subprg_Resolv => null, + Subprg_Local_Id => Orig_Info.Subprg_Local_Id, + Subprg_Exit => Orig_Info.Subprg_Exit, + Subprg_Result => Orig_Info.Subprg_Result); + when Kind_Interface => + Info.all := (Kind => Kind_Interface, + Interface_Node => Orig_Info.Interface_Node, + Interface_Field => Orig_Info.Interface_Field, + Interface_Type => Orig_Info.Interface_Type); + when Kind_Index => + Info.all := (Kind => Kind_Index, + Index_Field => Orig_Info.Index_Field); + when others => + raise Internal_Error; + end case; + end if; + + for I in Fields'Range loop + F := Fields (I); + case Get_Field_Type (F) is + when Type_Iir => + case Get_Field_Attribute (F) is + when Attr_None => + Instantiate_Iir_Info (Get_Iir (N, F)); + when Attr_Ref => + null; + when Attr_Maybe_Ref => + if not Get_Is_Ref (N) then + Instantiate_Iir_Info (Get_Iir (N, F)); + end if; + when Attr_Chain => + Instantiate_Iir_Chain_Info (Get_Iir (N, F)); + when Attr_Chain_Next => + null; + when Attr_Of_Ref => + raise Internal_Error; + end case; + when Type_Iir_List => + case Get_Field_Attribute (F) is + when Attr_None => + Instantiate_Iir_List_Info (Get_Iir_List (N, F)); + when Attr_Ref => + null; + when others => + raise Internal_Error; + end case; + when Type_PSL_NFA + | Type_PSL_Node => + -- TODO + raise Internal_Error; + when Type_Date_Type + | Type_Date_State_Type + | Type_Time_Stamp_Id => + -- Can this happen ? + raise Internal_Error; + when Type_String_Id + | Type_Source_Ptr + | Type_Base_Type + | Type_Iir_Constraint + | Type_Iir_Mode + | Type_Iir_Index32 + | Type_Iir_Int64 + | Type_Boolean + | Type_Iir_Staticness + | Type_Iir_All_Sensitized + | Type_Iir_Signal_Kind + | Type_Tri_State_Type + | Type_Iir_Pure_State + | Type_Iir_Delay_Mechanism + | Type_Iir_Lexical_Layout_Type + | Type_Iir_Predefined_Functions + | Type_Iir_Direction + | Type_Location_Type + | Type_Iir_Int32 + | Type_Int32 + | Type_Iir_Fp64 + | Type_Token_Type + | Type_Name_Id => + null; + end case; + end loop; + + if Info /= null then + case Info.Kind is + when Kind_Subprg => + Pop_Instantiate_Var_Scope + (Info.Subprg_Frame_Scope'Access); + when others => + null; + end case; + end if; + end; + end Instantiate_Iir_Info; + procedure Translate_Package_Instantiation_Declaration (Inst : Iir) is Spec : constant Iir := @@ -5608,6 +5808,19 @@ package body Translation is begin Info := Add_Info (Inst, Kind_Package_Instance); + Push_Instantiate_Var_Scope + (Info.Package_Instance_Spec_Scope'Access, + Pkg_Info.Package_Spec_Scope'Access); + Push_Instantiate_Var_Scope + (Info.Package_Instance_Body_Scope'Access, + Pkg_Info.Package_Body_Scope'Access); + Instantiate_Iir_Chain_Info (Get_Generic_Chain (Inst)); + Instantiate_Iir_Chain_Info (Get_Declaration_Chain (Inst)); + Pop_Instantiate_Var_Scope + (Info.Package_Instance_Body_Scope'Access); + Pop_Instantiate_Var_Scope + (Info.Package_Instance_Spec_Scope'Access); + -- FIXME: if the instantiation occurs within a package declaration, -- the variable must be declared extern (and public in the body). Info.Package_Instance_Var := Create_Var @@ -5616,11 +5829,11 @@ package body Translation is -- FIXME: this is correct only for global instantiation, and only if -- there is only one. - Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope, + Set_Scope_Via_Decl (Info.Package_Instance_Body_Scope, Get_Var_Label (Info.Package_Instance_Var)); - Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope, + Set_Scope_Via_Field (Info.Package_Instance_Spec_Scope, Pkg_Info.Package_Spec_Field, - Pkg_Info.Package_Body_Scope'Access); + Info.Package_Instance_Body_Scope'Access); -- Declare elaboration procedure Start_Procedure_Decl @@ -5643,9 +5856,14 @@ package body Translation is Chap5.Elab_Generic_Map_Aspect (Inst); + -- Call the elaborator of the generic. The generic must be + -- temporary associated with the instance variable. Start_Association (Constr, Pkg_Info.Package_Elab_Body_Subprg); + Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope, + Get_Var_Label (Info.Package_Instance_Var)); Add_Subprg_Instance_Assoc (Constr, Pkg_Info.Package_Elab_Body_Instance); + Clear_Scope (Pkg_Info.Package_Body_Scope); New_Procedure_Call (Constr); -- Chap2.Finish_Subprg_Instance_Use @@ -5875,6 +6093,15 @@ package body Translation is begin Finish_Subprg_Instance_Use (Get_Info (Subprg).Subprg_Instance); end Finish_Subprg_Instance_Use; + + function Instantiate_Subprg_Instance (Inst : Subprg_Instance_Type) + return Subprg_Instance_Type is + begin + return Subprg_Instance_Type' + (Inter => Inst.Inter, + Inter_Type => Inst.Inter_Type, + Scope => Instantiated_Var_Scope (Inst.Scope)); + end Instantiate_Subprg_Instance; end Chap2; package body Chap3 is @@ -5882,6 +6109,11 @@ package body Translation is return O_Cnode; procedure Create_Scalar_Type_Range (Def : Iir; Target : O_Lnode); + -- For scalar subtypes: creates info from the base type. + procedure Create_Subtype_Info_From_Type (Def : Iir; + Subtype_Info : Type_Info_Acc; + Base_Info : Type_Info_Acc); + -- Finish a type definition: declare the type, define and declare a -- pointer to the type. procedure Finish_Type_Definition @@ -6040,6 +6272,7 @@ package body Translation is ------------------ -- Enumeration -- ------------------ + function Translate_Enumeration_Literal (Lit : Iir_Enumeration_Literal) return O_Ident is @@ -6139,6 +6372,7 @@ package body Translation is --------------- -- Integer -- --------------- + -- Return the number of bits (32 or 64) required to represent the -- (integer or physical) type definition DEF. type Type_Precision is (Precision_32, Precision_64); @@ -6189,6 +6423,7 @@ package body Translation is ---------------------- -- Floating types -- ---------------------- + procedure Translate_Floating_Type (Def : Iir_Floating_Type_Definition) is Info : Type_Info_Acc; @@ -6207,6 +6442,7 @@ package body Translation is ---------------- -- Physical -- ---------------- + procedure Translate_Physical_Type (Def : Iir_Physical_Type_Definition) is Info : Type_Info_Acc; @@ -6245,6 +6481,7 @@ package body Translation is ------------ -- File -- ------------ + procedure Translate_File_Type (Def : Iir_File_Type_Definition) is Info : Type_Info_Acc; @@ -6350,6 +6587,7 @@ package body Translation is ------------- -- Array -- ------------- + function Type_To_Last_Object_Kind (Def : Iir) return Object_Kind_Type is begin if Get_Has_Signal_Flag (Def) then @@ -6409,32 +6647,34 @@ package body Translation is (Create_Identifier, Info.Ortho_Type (Mode_Value)); end Translate_Incomplete_Array_Type; + -- Declare the bounds types for DEF. procedure Translate_Array_Type_Bounds (Def : Iir_Array_Type_Definition; Info : Type_Info_Acc; Complete : Boolean) is - Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def); + Indexes_List : constant Iir_List := + Get_Index_Subtype_Definition_List (Def); Constr : O_Element_List; Dim : String (1 .. 8); N : Natural; P : Natural; Index : Iir; - Mark : Id_Mark_Type; + Index_Info : Index_Info_Acc; + Index_Type_Mark : Iir; begin Start_Record_Type (Constr); - Info.T.Bounds_Vector := - new O_Fnode_Arr (1 .. Get_Nbr_Elements (Indexes_List)); for I in Natural loop - Index := Get_Index_Type (Indexes_List, I); - exit when Index = Null_Iir; - if Is_Anonymous_Type_Definition (Index) then - -- Can this happen ? This is a type mark. - Push_Identifier_Prefix (Mark, "DIM", Iir_Int32 (I + 1)); - Translate_Type_Definition (Index, True); - Pop_Identifier_Prefix (Mark); - raise Program_Error; - end if; + Index_Type_Mark := Get_Nth_Element (Indexes_List, I); + exit when Index_Type_Mark = Null_Iir; + Index := Get_Index_Type (Index_Type_Mark); + + -- Index comes from a type mark. + pragma Assert (not Is_Anonymous_Type_Definition (Index)); + + Index_Info := Add_Info (Index_Type_Mark, Kind_Index); + + -- Build the name N := I + 1; P := Dim'Last; loop @@ -6445,7 +6685,8 @@ package body Translation is end loop; P := P - 3; Dim (P .. P + 3) := "dim_"; - New_Record_Field (Constr, Info.T.Bounds_Vector (I + 1), + + New_Record_Field (Constr, Index_Info.Index_Field, Get_Identifier (Dim (P .. Dim'Last)), Get_Info (Get_Base_Type (Index)).T.Range_Type); end loop; @@ -6603,16 +6844,15 @@ package body Translation is Close_Temp; end Translate_Dynamic_Unidimensional_Array_Length_One; - procedure Translate_Array_Type (Def : Iir_Array_Type_Definition) + procedure Translate_Array_Type_Definition + (Def : Iir_Array_Type_Definition) is - Info : Type_Info_Acc; - El_Tinfo : Type_Info_Acc; + Info : constant Type_Info_Acc := Get_Info (Def); -- If true, INFO was already partially filled, by a previous access -- type definition to this incomplete array type. - Completion : Boolean; + Completion : constant Boolean := Info.Type_Mode = Type_Mode_Fat_Array; + El_Tinfo : Type_Info_Acc; begin - Info := Get_Info (Def); - Completion := Info.Type_Mode = Type_Mode_Fat_Array; if not Completion then Info.Type_Mode := Type_Mode_Fat_Array; Info.T := Ortho_Info_Type_Array_Init; @@ -6642,7 +6882,7 @@ package body Translation is end loop; end if; Info.Type_Incomplete := False; - end Translate_Array_Type; + end Translate_Array_Type_Definition; -- Get the length of DEF, ie the number of elements. -- If the length is not statically defined, returns -1. @@ -6667,18 +6907,17 @@ package body Translation is return Len; end Get_Array_Subtype_Length; - procedure Translate_Array_Subtype (Def : Iir_Array_Subtype_Definition) + procedure Translate_Array_Subtype_Definition + (Def : Iir_Array_Subtype_Definition) is - Info : Type_Info_Acc; - Binfo : Type_Info_Acc; + Info : constant Type_Info_Acc := Get_Info (Def); + Base_Type : constant Iir := Get_Base_Type (Def); + Binfo : constant Type_Info_Acc := Get_Info (Base_Type); Len : Iir_Int64; Id : O_Ident; begin - Info := Get_Info (Def); - Binfo := Get_Info (Get_Base_Type (Def)); - -- Note: info of indexes subtype are not created! Len := Get_Array_Subtype_Length (Def); @@ -6716,7 +6955,40 @@ package body Translation is New_Type_Decl (Id, Info.Ortho_Type (I)); end loop; end if; - end Translate_Array_Subtype; + end Translate_Array_Subtype_Definition; + + procedure Translate_Array_Subtype_Element_Subtype + (Def : Iir_Array_Subtype_Definition) + is + El_Type : constant Iir := Get_Element_Subtype (Def); + Type_Mark : constant Iir := Get_Denoted_Type_Mark (Def); + Tm_El_Type : Iir; + begin + if Type_Mark = Null_Iir then + -- Array subtype for constained array definition. Same element + -- subtype as the base type. + return; + end if; + + Tm_El_Type := Get_Element_Subtype (Type_Mark); + if El_Type = Tm_El_Type then + -- Same element subtype as the type mark. + return; + end if; + + case Get_Kind (El_Type) is + when Iir_Kinds_Scalar_Subtype_Definition => + declare + El_Info : Ortho_Info_Acc; + begin + El_Info := Add_Info (El_Type, Kind_Type); + Create_Subtype_Info_From_Type + (El_Type, El_Info, Get_Info (Tm_El_Type)); + end; + when others => + Error_Kind ("translate_array_subtype_element_subtype", El_Type); + end case; + end Translate_Array_Subtype_Element_Subtype; function Create_Static_Array_Subtype_Bounds (Def : Iir_Array_Subtype_Definition) @@ -6742,8 +7014,11 @@ package body Translation is procedure Create_Array_Subtype_Bounds (Def : Iir_Array_Subtype_Definition; Target : O_Lnode) is - Baseinfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Def)); + Base_Type : constant Iir := Get_Base_Type (Def); + Baseinfo : constant Type_Info_Acc := Get_Info (Base_Type); Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def); + Indexes_Def_List : constant Iir_List := + Get_Index_Subtype_Definition_List (Base_Type); Index : Iir; Targ : Mnode; begin @@ -6761,13 +7036,15 @@ package body Translation is declare Index_Type : constant Iir := Get_Base_Type (Index); Index_Info : constant Type_Info_Acc := Get_Info (Index_Type); + Base_Index_Info : constant Index_Info_Acc := + Get_Info (Get_Nth_Element (Indexes_Def_List, I)); D : O_Dnode; begin Open_Temp; D := Create_Temp_Ptr (Index_Info.T.Range_Ptr_Type, New_Selected_Element (M2Lv (Targ), - Baseinfo.T.Bounds_Vector (I + 1))); + Base_Index_Info.Index_Field)); Chap7.Translate_Discrete_Range_Ptr (D, Index); Close_Temp; end; @@ -7512,10 +7789,7 @@ package body Translation is begin case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => + | Iir_Kinds_Scalar_Subtype_Definition => return Create_Static_Scalar_Type_Range (Def); when Iir_Kind_Array_Subtype_Definition => @@ -7536,10 +7810,7 @@ package body Translation is begin case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition => + | Iir_Kinds_Scalar_Subtype_Definition => Target := Get_Var (Get_Info (Def).T.Range_Var); Create_Scalar_Type_Range (Def, Target); @@ -7581,6 +7852,132 @@ package body Translation is end case; end Create_Type_Definition_Type_Range; + -- Return TRUE iff LIT is equal to the high (IS_HI=TRUE) or low + -- (IS_HI=false) limit of the base type of DEF. MODE is the mode of + -- DEF. + function Is_Equal_Limit (Lit : Iir; + Is_Hi : Boolean; + Def : Iir; + Mode : Type_Mode_Type) return Boolean + is + begin + case Mode is + when Type_Mode_B1 => + declare + V : Iir_Int32; + begin + V := Iir_Int32 (Eval_Pos (Lit)); + if Is_Hi then + return V = 1; + else + return V = 0; + end if; + end; + when Type_Mode_E8 => + declare + V : Iir_Int32; + Base_Type : Iir; + begin + V := Iir_Int32 (Eval_Pos (Lit)); + if Is_Hi then + Base_Type := Get_Base_Type (Def); + return V = Iir_Int32 + (Get_Nbr_Elements + (Get_Enumeration_Literal_List (Base_Type))) - 1; + else + return V = 0; + end if; + end; + when Type_Mode_I32 => + declare + V : Iir_Int32; + begin + V := Iir_Int32 (Get_Value (Lit)); + if Is_Hi then + return V = Iir_Int32'Last; + else + return V = Iir_Int32'First; + end if; + end; + when Type_Mode_P32 => + declare + V : Iir_Int32; + begin + V := Iir_Int32 (Get_Physical_Value (Lit)); + if Is_Hi then + return V = Iir_Int32'Last; + else + return V = Iir_Int32'First; + end if; + end; + when Type_Mode_I64 => + declare + V : Iir_Int64; + begin + V := Get_Value (Lit); + if Is_Hi then + return V = Iir_Int64'Last; + else + return V = Iir_Int64'First; + end if; + end; + when Type_Mode_P64 => + declare + V : Iir_Int64; + begin + V := Get_Physical_Value (Lit); + if Is_Hi then + return V = Iir_Int64'Last; + else + return V = Iir_Int64'First; + end if; + end; + when Type_Mode_F64 => + declare + V : Iir_Fp64; + begin + V := Get_Fp_Value (Lit); + if Is_Hi then + return V = Iir_Fp64'Last; + else + return V = Iir_Fp64'First; + end if; + end; + when others => + Error_Kind ("is_equal_limit " & Type_Mode_Type'Image (Mode), + Lit); + end case; + end Is_Equal_Limit; + + -- For scalar subtypes: creates info from the base type. + procedure Create_Subtype_Info_From_Type (Def : Iir; + Subtype_Info : Type_Info_Acc; + Base_Info : Type_Info_Acc) + is + Rng : Iir; + Lo, Hi : Iir; + begin + Subtype_Info.Ortho_Type := Base_Info.Ortho_Type; + Subtype_Info.Ortho_Ptr_Type := Base_Info.Ortho_Ptr_Type; + Subtype_Info.Type_Mode := Base_Info.Type_Mode; + Subtype_Info.T := Base_Info.T; + + Rng := Get_Range_Constraint (Def); + if Get_Expr_Staticness (Rng) /= Locally then + -- Bounds are not known. + -- Do the checks. + Subtype_Info.T.Nocheck_Hi := False; + Subtype_Info.T.Nocheck_Low := False; + else + -- Bounds are locally static. + Get_Low_High_Limit (Rng, Lo, Hi); + Subtype_Info.T.Nocheck_Hi := + Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode); + Subtype_Info.T.Nocheck_Low := + Is_Equal_Limit (Lo, False, Def, Base_Info.Type_Mode); + end if; + end Create_Subtype_Info_From_Type; + procedure Create_Record_Size_Var (Def : Iir; Kind : Object_Kind_Type) is Info : constant Type_Info_Acc := Get_Info (Def); @@ -7766,131 +8163,6 @@ package body Translation is end case; end Handle_Anonymous_Subtypes; - -- Return TRUE iff LIT is equal to the high (IS_HI=TRUE) or low - -- (IS_HI=false) limit of the base type of DEF. MODE is the mode of - -- DEF. - function Is_Equal_Limit (Lit : Iir; - Is_Hi : Boolean; - Def : Iir; - Mode : Type_Mode_Type) return Boolean - is - begin - case Mode is - when Type_Mode_B1 => - declare - V : Iir_Int32; - begin - V := Iir_Int32 (Eval_Pos (Lit)); - if Is_Hi then - return V = 1; - else - return V = 0; - end if; - end; - when Type_Mode_E8 => - declare - V : Iir_Int32; - Base_Type : Iir; - begin - V := Iir_Int32 (Eval_Pos (Lit)); - if Is_Hi then - Base_Type := Get_Base_Type (Def); - return V = Iir_Int32 - (Get_Nbr_Elements - (Get_Enumeration_Literal_List (Base_Type))) - 1; - else - return V = 0; - end if; - end; - when Type_Mode_I32 => - declare - V : Iir_Int32; - begin - V := Iir_Int32 (Get_Value (Lit)); - if Is_Hi then - return V = Iir_Int32'Last; - else - return V = Iir_Int32'First; - end if; - end; - when Type_Mode_P32 => - declare - V : Iir_Int32; - begin - V := Iir_Int32 (Get_Physical_Value (Lit)); - if Is_Hi then - return V = Iir_Int32'Last; - else - return V = Iir_Int32'First; - end if; - end; - when Type_Mode_I64 => - declare - V : Iir_Int64; - begin - V := Get_Value (Lit); - if Is_Hi then - return V = Iir_Int64'Last; - else - return V = Iir_Int64'First; - end if; - end; - when Type_Mode_P64 => - declare - V : Iir_Int64; - begin - V := Get_Physical_Value (Lit); - if Is_Hi then - return V = Iir_Int64'Last; - else - return V = Iir_Int64'First; - end if; - end; - when Type_Mode_F64 => - declare - V : Iir_Fp64; - begin - V := Get_Fp_Value (Lit); - if Is_Hi then - return V = Iir_Fp64'Last; - else - return V = Iir_Fp64'First; - end if; - end; - when others => - Error_Kind ("is_equal_limit " & Type_Mode_Type'Image (Mode), - Lit); - end case; - end Is_Equal_Limit; - - procedure Create_Subtype_Info_From_Type (Def : Iir; - Subtype_Info : Type_Info_Acc; - Base_Info : Type_Info_Acc) - is - Rng : Iir; - Lo, Hi : Iir; - begin - Subtype_Info.Ortho_Type := Base_Info.Ortho_Type; - Subtype_Info.Ortho_Ptr_Type := Base_Info.Ortho_Ptr_Type; - Subtype_Info.Type_Mode := Base_Info.Type_Mode; - Subtype_Info.T := Base_Info.T; - - Rng := Get_Range_Constraint (Def); - if Get_Expr_Staticness (Rng) /= Locally then - -- Bounds are not known. - -- Do the checks. - Subtype_Info.T.Nocheck_Hi := False; - Subtype_Info.T.Nocheck_Low := False; - else - -- Bounds are locally static. - Get_Low_High_Limit (Rng, Lo, Hi); - Subtype_Info.T.Nocheck_Hi := - Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode); - Subtype_Info.T.Nocheck_Low := - Is_Equal_Limit (Lo, False, Def, Base_Info.Type_Mode); - end if; - end Create_Subtype_Info_From_Type; - -- Note: boolean types are translated by translate_bool_type_definition! procedure Translate_Type_Definition (Def : Iir; With_Vars : Boolean := True) @@ -7910,9 +8182,11 @@ package body Translation is Info := Get_Info (Def); if Info /= null then if Info.Kind = Kind_Type then + -- The subtype was already translated. return; end if; if Info.Kind = Kind_Incomplete_Type then + -- Type is being completed. Complete_Info := Info; Clear_Info (Def); if Complete_Info.Incomplete_Array /= null then @@ -7957,10 +8231,7 @@ package body Translation is Translate_Floating_Type (Def); Create_Scalar_Type_Range_Type (Def, False); - when Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition => + when Iir_Kinds_Scalar_Subtype_Definition => Create_Subtype_Info_From_Type (Def, Info, Base_Info); if With_Vars then Create_Type_Range_Var (Def); @@ -7980,8 +8251,7 @@ package body Translation is Pop_Identifier_Prefix (Mark); end if; end; - Translate_Array_Type (Def); - -- Info.Type_Range_Type := Create_Array_Type_Bounds_Type (Def, Id); + Translate_Array_Type_Definition (Def); when Iir_Kind_Array_Subtype_Definition => if Get_Index_Constraint_Flag (Def) then @@ -7995,16 +8265,19 @@ package body Translation is Base_Info := Get_Info (Base_Type); end; end if; - Translate_Array_Subtype (Def); + Translate_Array_Subtype_Definition (Def); Info.T := Base_Info.T; --Info.Type_Range_Type := Base_Info.Type_Range_Type; if With_Vars then Create_Array_Subtype_Bounds_Var (Def, False); end if; else + -- An unconstrained array subtype. Use same infos as base + -- type. Free_Info (Def); Set_Info (Def, Base_Info); end if; + Translate_Array_Subtype_Element_Subtype (Def); when Iir_Kind_Record_Type_Definition => Translate_Record_Type (Def); @@ -8196,7 +8469,7 @@ package body Translation is Type_Info : Type_Info_Acc; begin Type_Info := Get_Info (Atype); - Free_Type_Info (Type_Info, False); + Free_Type_Info (Type_Info); Clear_Info (Atype); end Destroy_Type_Info; @@ -8256,14 +8529,18 @@ package body Translation is function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive) return Mnode is - Tinfo : constant Type_Info_Acc := Get_Type_Info (B); - Index_Type : constant Iir := - Get_Index_Type (Get_Base_Type (Atype), Dim - 1); + Indexes_List : constant Iir_List := + Get_Index_Subtype_Definition_List (Get_Base_Type (Atype)); + Index_Type_Mark : constant Iir := + Get_Nth_Element (Indexes_List, Dim - 1); + Index_Type : constant Iir := Get_Index_Type (Index_Type_Mark); + Base_Index_Info : constant Index_Info_Acc := + Get_Info (Index_Type_Mark); Iinfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Index_Type)); begin return Lv2M (New_Selected_Element (M2Lv (B), - Tinfo.T.Bounds_Vector (Dim)), + Base_Index_Info.Index_Field), Iinfo, Get_Object_Kind (B), Iinfo.T.Range_Type, @@ -9832,10 +10109,9 @@ package body Translation is -- Add func and instance. procedure Add_Associations_For_Resolver - (Assoc : in out O_Assoc_List; Func_Name : Iir) + (Assoc : in out O_Assoc_List; Func_Decl : Iir) is - Func : constant Iir := Get_Named_Entity (Func_Name); - Func_Info : constant Subprg_Info_Acc := Get_Info (Func); + Func_Info : constant Subprg_Info_Acc := Get_Info (Func_Decl); Resolv_Info : constant Subprg_Resolv_Info_Acc := Func_Info.Subprg_Resolv; Val : O_Enode; @@ -9930,7 +10206,7 @@ package body Translation is New_Association (Assoc, New_Convert_Ov (Init_Val, Conv)); if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then - Func := Get_Resolution_Function (Targ_Type); + Func := Has_Resolution_Function (Targ_Type); else Func := Null_Iir; end if; @@ -9963,7 +10239,7 @@ package body Translation is begin Res := Data; if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then - Func := Get_Resolution_Function (Targ_Type); + Func := Has_Resolution_Function (Targ_Type); if Func /= Null_Iir and then not Data.Already_Resolved then if Data.Check_Null then Res.If_Stmt := new O_If_Block; @@ -10910,6 +11186,7 @@ package body Translation is Arr_Type : Iir; Base_Type : Iir; Base_Info : Type_Info_Acc; + Index_Info : Index_Info_Acc; -- Type of parameter element. El_Type : Iir; @@ -10956,6 +11233,8 @@ package body Translation is Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func)); Base_Type := Get_Base_Type (Arr_Type); + Index_Info := Get_Info + (Get_First_Element (Get_Index_Subtype_Definition_List (Base_Type))); Base_Info := Get_Info (Base_Type); El_Type := Get_Element_Subtype (Arr_Type); @@ -11014,7 +11293,7 @@ package body Translation is New_Assign_Stmt (New_Obj (Var_Range_Ptr), New_Address (New_Selected_Element (New_Obj (Var_Bound), - Base_Info.T.Bounds_Vector (1)), + Index_Info.Index_Field), Index_Tinfo.T.Range_Ptr_Type)); -- Create range from length @@ -23188,7 +23467,7 @@ package body Translation is then Info := Get_Info (Atype); if Info /= null then - Free_Type_Info (Info, False); + Free_Type_Info (Info); Clear_Info (Atype); end if; end if; @@ -24915,6 +25194,106 @@ package body Translation is Res.Id := Create_Uniq_Identifier; return Res; end Create_Uniq_Identifier; + + type Instantiate_Var_Stack; + type Instantiate_Var_Stack_Acc is access Instantiate_Var_Stack; + + type Instantiate_Var_Stack is record + Orig_Scope : Var_Scope_Acc; + Inst_Scope : Var_Scope_Acc; + Prev : Instantiate_Var_Stack_Acc; + end record; + + Top_Instantiate_Var_Stack : Instantiate_Var_Stack_Acc := null; + Free_Instantiate_Var_Stack : Instantiate_Var_Stack_Acc := null; + + procedure Push_Instantiate_Var_Scope + (Inst_Scope : Var_Scope_Acc; Orig_Scope : Var_Scope_Acc) + is + Inst : Instantiate_Var_Stack_Acc; + begin + if Free_Instantiate_Var_Stack = null then + Inst := new Instantiate_Var_Stack; + else + Inst := Free_Instantiate_Var_Stack; + Free_Instantiate_Var_Stack := Inst.Prev; + end if; + Inst.all := (Orig_Scope => Orig_Scope, + Inst_Scope => Inst_Scope, + Prev => Top_Instantiate_Var_Stack); + Top_Instantiate_Var_Stack := Inst; + end Push_Instantiate_Var_Scope; + + procedure Pop_Instantiate_Var_Scope (Inst_Scope : Var_Scope_Acc) + is + Item : constant Instantiate_Var_Stack_Acc := + Top_Instantiate_Var_Stack; + begin + pragma Assert (Item /= null); + pragma Assert (Item.Inst_Scope = Inst_Scope); + Top_Instantiate_Var_Stack := Item.Prev; + Item.all := (Orig_Scope => null, + Inst_Scope => null, + Prev => Free_Instantiate_Var_Stack); + Free_Instantiate_Var_Stack := Item; + end Pop_Instantiate_Var_Scope; + + function Instantiated_Var_Scope (Scope : Var_Scope_Acc) + return Var_Scope_Acc + is + Item : Instantiate_Var_Stack_Acc; + begin + if Scope = null then + return null; + end if; + + Item := Top_Instantiate_Var_Stack; + loop + pragma Assert (Item /= null); + if Item.Orig_Scope = Scope then + return Item.Inst_Scope; + end if; + Item := Item.Prev; + end loop; + end Instantiated_Var_Scope; + + function Instantiate_Var (Var : Var_Type) return Var_Type is + begin + case Var.Kind is + when Var_None + | Var_Global + | Var_Local => + return Var; + when Var_Scope => + return Var_Type' + (Kind => Var_Scope, + I_Field => Var.I_Field, + I_Scope => Instantiated_Var_Scope (Var.I_Scope)); + end case; + end Instantiate_Var; + + function Instantiate_Var_Scope (Scope : Var_Scope_Type) + return Var_Scope_Type is + begin + case Scope.Kind is + when Var_Scope_None + | Var_Scope_Ptr + | Var_Scope_Decl => + return Scope; + when Var_Scope_Field => + return Var_Scope_Type' + (Kind => Var_Scope_Field, + Scope_Type => Scope.Scope_Type, + Field => Scope.Field, + Up_Link => Instantiated_Var_Scope (Scope.Up_Link)); + when Var_Scope_Field_Ptr => + return Var_Scope_Type' + (Kind => Var_Scope_Field_Ptr, + Scope_Type => Scope.Scope_Type, + Field => Scope.Field, + Up_Link => Instantiated_Var_Scope (Scope.Up_Link)); + end case; + end Instantiate_Var_Scope; end Chap10; package body Chap14 is @@ -30174,11 +30553,11 @@ package body Translation is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition => - Free_Type_Info (Info, True); + Free_Type_Info (Info); when Iir_Kind_Array_Subtype_Definition => if Get_Index_Constraint_Flag (I) then Info.T := Ortho_Info_Type_Array_Init; - Free_Type_Info (Info, True); + Free_Type_Info (Info); end if; when Iir_Kind_Implicit_Function_Declaration => case Get_Implicit_Definition (I) is diff --git a/xtools/Makefile b/xtools/Makefile index 599e0da81..6504fbc84 100644 --- a/xtools/Makefile +++ b/xtools/Makefile @@ -17,19 +17,19 @@ DEPS=../iirs.ads ../nodes.ads ./pnodes.py -all: ../iirs.adb ../disp_tree.adb ../nodes_gc.adb +all: ../iirs.adb ../nodes_meta.ads ../nodes_meta.adb ../iirs.adb: ../iirs.adb.in $(DEPS) $(RM) $@ ./pnodes.py body > $@ chmod -w $@ -../disp_tree.adb: ../disp_tree.adb.in $(DEPS) +../nodes_meta.ads: ../nodes_meta.ads.in $(DEPS) $(RM) $@ - ./pnodes.py disp_tree > $@ + ./pnodes.py meta_specs > $@ chmod -w $@ -../nodes_gc.adb: ../nodes_gc.adb.in $(DEPS) +../nodes_meta.adb: ../nodes_meta.adb.in $(DEPS) $(RM) $@ - ./pnodes.py mark_tree > $@ + ./pnodes.py meta_body > $@ chmod -w $@ diff --git a/xtools/pnodes.py b/xtools/pnodes.py index a9fbc214b..c6f67f656 100755 --- a/xtools/pnodes.py +++ b/xtools/pnodes.py @@ -7,21 +7,19 @@ import argparse field_file = "../nodes.ads" spec_file = "../iirs.ads" template_file = "../iirs.adb.in" -template_disp_file = "../disp_tree.adb.in" -template_mark_file = "../nodes_gc.adb.in" +meta_base_file = "../nodes_meta" prefix_name = "Iir_Kind_" prefix_range_name = "Iir_Kinds_" type_name = "Iir_Kind" conversions = ['uc', 'pos'] class FuncDesc: - def __init__(self, name, field, conv, acc, display, + def __init__(self, name, field, conv, acc, pname, ptype, rname, rtype): self.name = name self.field = field self.conv = conv - self.acc = acc - self.display = display # List of display attributes + self.acc = acc # access: Chain, Chain_Next, Ref, Of_Ref, Maybe_Ref self.pname = pname # Parameter mame self.ptype = ptype # Parameter type self.rname = rname # value name (for procedure) @@ -221,10 +219,10 @@ def read_kinds(filename): # Read functions funcs = [] - pat_display = re.compile(' -- Display:(.*)\n') - pat_field = re.compile(' -- Field: (\w+)' - + '( Ref| Chain_Next| Chain)?( .*)?\n') - pat_conv = re.compile(' \((\w+)\)') + pat_field = re.compile( + ' -- Field: (\w+)' + + '( Of_Ref| Ref| Maybe_Ref| Chain_Next| Chain)?( .*)?\n') + pat_conv = re.compile('^ \((\w+)\)$') pat_func = \ re.compile(' function Get_(\w+) \((\w+) : (\w+)\) return (\w+);\n') pat_proc = \ @@ -233,16 +231,7 @@ def read_kinds(filename): l = lr.get() if l == 'end Iirs;\n': break - md = pat_display.match(l) - if md: - display = md.group(1).split() - l = lr.get() - m = pat_field.match(l) - if not m: - raise ParseError(lr, 'Field: expected after Display:') - else: - display = [] - m = pat_field.match(l) + m = pat_field.match(l) if m: # Extract conversion acc = m.group(2) @@ -280,7 +269,7 @@ def read_kinds(filename): raise ParseError(lr, 'parameter type mismatch with function') if mf.group(4) != mp.group(5): raise ParseError(lr, 'result type mismatch with function') - funcs.append(FuncDesc(mf.group(1), m.group(1), conv, acc, display, + funcs.append(FuncDesc(mf.group(1), m.group(1), conv, acc, mp.group(2), mp.group(3), mp.group(4), mp.group(5))) @@ -424,31 +413,23 @@ def gen_get_format(formats, nodes, kinds): print ' end case;' print ' end Get_Format;' -# Generate the Check_Kind_For_XXX function -def gen_check_kind(func, nodes, kinds): - pname = 'Target' - ptype = 'Iir' - print ' procedure Check_Kind_For_' + func.name + ' (' + pname \ - + ' : ' + ptype + ') is' - print ' begin' - print ' case Get_Kind (' + pname + ') is' - choices = [k for k in kinds if func.name in nodes[k].attrs] - gen_choices(choices) - print ' null;' - print ' when others =>' - print ' Failed ("' + func.name + '", ' + pname + ');' - print ' end case;' - print ' end Check_Kind_For_' + func.name + ';' - print - def gen_subprg_header(decl): if len(decl) < 76: print decl + ' is' else: print decl - print ' is' + print ' is' print ' begin' +def gen_assert(func): + print ' pragma Assert (' + func.pname + ' /= Null_Iir);' + cond = '(Has_' + func.name + ' (Get_Kind (' + func.pname + ')));' + if len (cond) < 60: + print ' pragma Assert ' + cond + else: + print ' pragma Assert' + print ' ' + cond + # Generate Get_XXX/Set_XXX subprograms for FUNC. def gen_get_set(func, nodes, fields): g = 'Get_' + func.field + ' (' + func.pname + ')' @@ -469,7 +450,7 @@ def gen_get_set(func, nodes, fields): subprg = ' function Get_' + func.name + ' (' + func.pname \ + ' : ' + func.ptype + ') return ' + func.rtype gen_subprg_header(subprg) - print ' Check_Kind_For_' + func.name + ' (' + func.pname + ');' + gen_assert(func) print ' return ' + g + ';' print ' end Get_' + func.name + ';' print @@ -477,170 +458,29 @@ def gen_get_set(func, nodes, fields): + func.pname + ' : ' + func.ptype + '; ' \ + func.rname + ' : ' + func.rtype + ')' gen_subprg_header(subprg) - print ' Check_Kind_For_' + func.name + ' (' + func.pname + ');' - print ' Set_' + func.field + ' (' + func.pname + ', ' \ - + s + ');' + gen_assert(func) + print ' Set_' + func.field + ' (' + func.pname + ', ' + s + ');' print ' end Set_' + func.name + ';' print -def gen_image_field(func, param): - getter = 'Get_' + func.name + ' (' + param + ')' - if 'Image' in func.display: - return func.rtype + '\'Image (' + getter + ')' - else: - return 'Image_' + func.rtype + ' (' + getter + ')' - -def gen_disp_header(kinds, nodes): - print ' procedure Disp_Header (N : Iir) is' - print ' begin' - print ' if N = Null_Iir then' - print ' Put_Line ("*null*");' - print ' return;' - print ' end if;' - print - print ' case Get_Kind (N) is' - for k in kinds: - inlines = [f for f in nodes[k].attrs.values() if 'Inline' in f.display] - if len(inlines) > 1: - raise Error - print ' when ' + prefix_name + k + ' =>' - if inlines: - print ' Put ("' + k.lower() + ' " &' - print ' ' + \ - gen_image_field(inlines[0], 'N') + ');' - else: - print ' Put ("' + k.lower() + '");' - print ' end case;' - print ' Put (\' \');' - print ' Disp_Iir_Number (N);' - print ' New_Line;' - print ' end Disp_Header;' - print - def funcs_of_node(n): return sorted([fv.name for fv in n.fields.values() if fv]) -def gen_disp(kinds, nodes): - print ' procedure Disp_Iir (N : Iir;' - print ' Indent : Natural := 1;' - print ' Flat : Boolean := False)' - print ' is' - print ' Sub_Indent : constant Natural := Indent + 1;' - print ' begin' - print ' Disp_Header (N);' - print - print ' if Flat or else N = Null_Iir then' - print ' return;' - print ' end if;' - print - print ' Header ("location: ", Indent);' - print ' Put_Line (Image_Location_Type (Get_Location (N)));' - print - print ' -- Protect against infinite recursions.' - print ' if Indent > 20 then' - print ' Put_Indent (Indent);' - print ' Put_Line ("...");' - print ' return;' - print ' end if;' - print - print ' case Get_Kind (N) is' - done = [] - for k in kinds: - if k in done: - continue - v = nodes[k] - # Find other kinds with the same set of functions. - vfuncs = funcs_of_node(v) - ks = [k1 for k1 in kinds if \ - k1 not in done and funcs_of_node(nodes[k1]) == vfuncs] - gen_choices(ks) - done += ks - flds = [fk for fk, fv in v.fields.items() if fv] - if flds: - for fk in sorted(flds): - func = v.fields[fk] - if func.acc == 'Chain_Next': - continue - print ' ' + \ - 'Header ("' + func.name.lower() + ': ", Indent);' - str = ' ' - if func.acc == 'Chain': - str += 'Disp_Chain (Get_' + func.name \ - + ' (N), Sub_Indent);' - print str - elif func.rtype in [ 'Iir', 'Iir_List', 'PSL_Node', 'PSL_NFA' ]: - str += 'Disp_' + func.rtype + \ - ' (Get_' + func.name + ' (N), Sub_Indent' - if func.acc == 'Ref': - str += ', True' - str += ');' - print str - else: - str += 'Put_Line (' - if len(func.rtype) <= 20: - str += gen_image_field(func, 'N') - print str + ');' - else: - # Inline version due to length - str += 'Image_' + func.rtype - print str - print ' (' + \ - 'Get_' + func.name + ' (N)));' - else: - print ' null;' - print ' end case;' - print ' end Disp_Iir;' - print - -def gen_mark(kinds, nodes): - print ' procedure Mark_Iir (N : Iir) is' - print ' begin' - print ' if N = Null_Iir then' - print ' return;' - print ' elsif Markers (N) then' - print ' Already_Marked (N);' - print ' return;' - print ' else' - print ' Markers (N) := True;' - print ' end if;' - print - print ' case Get_Kind (N) is' - done = [] - for k in kinds: - if k in done: - continue - v = nodes[k] - # Find other kinds with the same set of functions. - vfuncs = funcs_of_node(v) - ks = [k1 for k1 in kinds if \ - k1 not in done and funcs_of_node(nodes[k1]) == vfuncs] - gen_choices(ks) - done += ks - flds = [fk for fk, fv in v.fields.items() if fv] - empty = True - for fk in sorted(flds): - func = v.fields[fk] - if func.acc in ['Ref', 'Chain_Next']: - continue - elif func.acc in [ 'Chain' ]: - print ' ' + \ - 'Mark_Chain (Get_' + func.name + ' (N));' - empty = False - elif func.rtype in [ 'Iir', 'Iir_List', 'PSL_Node', 'PSL_NFA' ]: - print ' ' + \ - 'Mark_' + func.rtype + ' (Get_' + func.name + ' (N));' - empty = False - if empty: - print ' null;' - print ' end case;' - print ' end Mark_Iir;' - print +def gen_has_func_spec(name, suff): + spec=' function Has_' + f.name + ' (K : Iir_Kind)' + ret=' return Boolean' + suff; + if len(spec) < 60: + print spec + ret + else: + print spec + print ' ' + ret parser = argparse.ArgumentParser(description='Meta-grammar processor') parser.add_argument('action', choices=['disp-nodes', 'disp-kinds', - 'disp-fields', 'disp-funcs', - 'disp_tree', 'mark_tree', - 'get_format', 'body'], + 'disp-formats', 'disp-funcs', + 'disp-types', + 'get_format', 'body', + 'meta_specs', 'meta_body'], default='disp-nodes') args = parser.parse_args() @@ -655,7 +495,7 @@ except ParseError as e: "in {0}:{1}:{2}".format(e.lr.filename, e.lr.lineno, e.lr.l) sys.exit(1) -if args.action == 'disp-fields': +if args.action == 'disp-formats': for fmt in fields: print "Fields of Format_"+fmt fld=fields[fmt] @@ -668,13 +508,20 @@ elif args.action == 'disp-kinds': elif args.action == 'disp-funcs': print "Functions are:" for f in funcs: - s = '{0} ({1}'.format(f.name, f.field) + s = '{0} ({1}: {2}'.format(f.name, f.field, f.rtype) if f.acc: s += ' acc:' + f.acc if f.conv: s += ' conv:' + f.conv s += ')' print s +elif args.action == 'disp-types': + print "Types are:" + s = set([]) + for f in funcs: + s |= set([f.rtype]) + for t in sorted(s): + print ' ' + t elif args.action == 'disp-nodes': for k in kinds: v = nodes[k] @@ -693,26 +540,167 @@ elif args.action == 'body': gen_get_format(formats, nodes, kinds) print for f in funcs: - gen_check_kind(f, nodes, kinds) gen_get_set(f, nodes, fields) if l[0:3] == 'end': break -elif args.action == 'disp_tree': - lr = linereader(template_disp_file) +elif args.action == 'meta_specs': + lr = linereader(meta_base_file + '.ads.in') + # Build list of types + s = set([]) + for f in funcs: + s |= set([f.rtype]) + types = [t for t in sorted(s)] while True: l = lr.get().rstrip() - print l - if l == ' -- Subprograms': - gen_disp_header(kinds, nodes) - gen_disp(kinds, nodes) - if l[0:3] == 'end': + if l == ' -- TYPES': + last = None + for t in types: + if last: + print last + ',' + last = ' Type_' + t + print last + elif l == ' -- FIELDS': + last = None + for f in funcs: + if last: + print last + ',' + last = ' Field_' + f.name + print last + elif l == ' -- FUNCS': + for t in types: + print ' function Get_' + t + print ' (N : Iir; F : Fields_Enum) return ' + t + ';' + print ' procedure Set_' + t + print ' (N : Iir; F : Fields_Enum; V: ' + t + ');' + print + for f in funcs: + gen_has_func_spec(f.name, ';') + elif l[0:3] == 'end': + print l break -elif args.action == 'mark_tree': - lr = linereader(template_mark_file) + else: + print l +elif args.action == 'meta_body': + lr = linereader(meta_base_file + '.adb.in') while True: l = lr.get().rstrip() - print l - if l == ' -- Subprograms': - gen_mark(kinds,nodes) - if l[0:3] == 'end': + if l == ' -- FIELDS_TYPE': + last = None + for f in funcs: + if last: + print last + ',' + last = ' Field_' + f.name + ' => Type_' + f.rtype + print last + elif l == ' -- FIELD_IMAGE': + for f in funcs: + print ' when Field_' + f.name + ' =>' + print ' return "' + f.name.lower() + '";' + elif l == ' -- IIR_IMAGE': + for k in kinds: + print ' when ' + prefix_name + k + ' =>' + print ' return "' + k.lower() + '";' + elif l == ' -- FIELD_ATTRIBUTE': + for f in funcs: + print ' when Field_' + f.name + ' =>' + if f.acc: + attr = f.acc + else: + attr = 'None' + print ' return Attr_' + attr + ';' + elif l == ' -- FIELDS_ARRAY': + last = None + nodes_types = ['Iir', 'Iir_List'] + ref_names = ['Ref', 'Of_Ref', 'Maybe_Ref'] + for k in kinds: + v = nodes[k] + if last: + print last + ',' + last = None + print ' -- ' + prefix_name + k + # Sort fields: first non Iir and non Iir_List, + # then Iir and Iir_List that aren't references + # then Maybe_Ref + # then Ref and Ref_Of + flds = sorted([fk for fk, fv in v.fields.items() \ + if fv and fv.rtype not in nodes_types]) + flds += sorted([fk for fk, fv in v.fields.items() \ + if fv and fv.rtype in nodes_types \ + and fv.acc not in ref_names]) + flds += sorted([fk for fk, fv in v.fields.items() \ + if fv and fv.rtype in nodes_types\ + and fv.acc in ['Maybe_Ref']]) + flds += sorted([fk for fk, fv in v.fields.items() \ + if fv and fv.rtype in nodes_types\ + and fv.acc in ['Ref', 'Of_Ref']]) + for fk in flds: + if last: + print last + ',' + last = ' Field_' + v.fields[fk].name + if last: + print last + elif l == ' -- FIELDS_ARRAY_POS': + pos = -1 + last = None + for k in kinds: + v = nodes[k] + flds = [fk for fk, fv in v.fields.items() if fv] + pos += len(flds) + if last: + print last + ',' + last = ' ' + prefix_name + k + ' => {}'.format(pos) + print last + elif l == ' -- FUNCS_BODY': + # Build list of types + s = set([]) + for f in funcs: + s |= set([f.rtype]) + types = [t for t in sorted(s)] + for t in types: + print ' function Get_' + t + print ' (N : Iir; F : Fields_Enum) return ' + t + ' is' + print ' begin' + print ' pragma Assert (Fields_Type (F) = Type_' + t + ');' + print ' case F is' + for f in funcs: + if f.rtype == t: + print ' when Field_' + f.name + ' =>' + print ' return Get_' + f.name + ' (N);'; + print ' when others =>' + print ' raise Internal_Error;' + print ' end case;' + print ' end Get_' + t + ';' + print + print ' procedure Set_' + t + print ' (N : Iir; F : Fields_Enum; V: ' + t + ') is' + print ' begin' + print ' pragma Assert (Fields_Type (F) = Type_' + t + ');' + print ' case F is' + for f in funcs: + if f.rtype == t: + print ' when Field_' + f.name + ' =>' + print ' Set_' + f.name + ' (N, V);'; + print ' when others =>' + print ' raise Internal_Error;' + print ' end case;' + print ' end Set_' + t + ';' + print + for f in funcs: + gen_has_func_spec(f.name, ' is') + print ' begin' + choices = [k for k in kinds if f.name in nodes[k].attrs] + if len(choices) == 1: + print ' return K = ' + prefix_name + choices[0] + ';' + else: + print ' case K is' + gen_choices(choices) + print ' return True;' + print ' when others =>' + print ' return False;' + print ' end case;' + print ' end Has_' + f.name + ';' + print + elif l[0:3] == 'end': + print l break + else: + print l |