-- Meta description of Elocations. -- Copyright (C) 2017 Tristan Gingold -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Vhdl.Elocations; use Vhdl.Elocations; package body Vhdl.Elocations_Meta is function Get_Field_Image (F : Fields_Enum) return String is begin case F is when Field_Start_Location => return "start_location"; when Field_Right_Paren_Location => return "right_paren_location"; when Field_End_Location => return "end_location"; when Field_Is_Location => return "is_location"; when Field_Begin_Location => return "begin_location"; when Field_Then_Location => return "then_location"; when Field_Use_Location => return "use_location"; when Field_Loop_Location => return "loop_location"; when Field_Generate_Location => return "generate_location"; when Field_Generic_Location => return "generic_location"; when Field_Port_Location => return "port_location"; when Field_Generic_Map_Location => return "generic_map_location"; when Field_Port_Map_Location => return "port_map_location"; when Field_Arrow_Location => return "arrow_location"; when Field_Colon_Location => return "colon_location"; when Field_Assign_Location => return "assign_location"; end case; end Get_Field_Image; type Field_Type is (Type_Location_Type); function Fields_Type (F : Fields_Enum) return Field_Type is pragma Unreferenced (F); begin return Type_Location_Type; end Fields_Type; pragma Warnings (Off, """others"" choice is redundant"); 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_Start_Location => return Get_Start_Location (N); when Field_Right_Paren_Location => return Get_Right_Paren_Location (N); when Field_End_Location => return Get_End_Location (N); when Field_Is_Location => return Get_Is_Location (N); when Field_Begin_Location => return Get_Begin_Location (N); when Field_Then_Location => return Get_Then_Location (N); when Field_Use_Location => return Get_Use_Location (N); when Field_Loop_Location => return Get_Loop_Location (N); when Field_Generate_Location => return Get_Generate_Location (N); when Field_Generic_Location => return Get_Generic_Location (N); when Field_Port_Location => return Get_Port_Location (N); when Field_Generic_Map_Location => return Get_Generic_Map_Location (N); when Field_Port_Map_Location => return Get_Port_Map_Location (N); when Field_Arrow_Location => return Get_Arrow_Location (N); when Field_Colon_Location => return Get_Colon_Location (N); when Field_Assign_Location => return Get_Assign_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_Start_Location => Set_Start_Location (N, V); when Field_Right_Paren_Location => Set_Right_Paren_Location (N, V); when Field_End_Location => Set_End_Location (N, V); when Field_Is_Location => Set_Is_Location (N, V); when Field_Begin_Location => Set_Begin_Location (N, V); when Field_Then_Location => Set_Then_Location (N, V); when Field_Use_Location => Set_Use_Location (N, V); when Field_Loop_Location => Set_Loop_Location (N, V); when Field_Generate_Location => Set_Generate_Location (N, V); when Field_Generic_Location => Set_Generic_Location (N, V); when Field_Port_Location => Set_Port_Location (N, V); when Field_Generic_Map_Location => Set_Generic_Map_Location (N, V); when Field_Port_Map_Location => Set_Port_Map_Location (N, V); when Field_Arrow_Location => Set_Arrow_Location (N, V); when Field_Colon_Location => Set_Colon_Location (N, V); when Field_Assign_Location => Set_Assign_Location (N, V); when others => raise Internal_Error; end case; end Set_Location_Type; function Has_Start_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Library_Clause | Iir_Kind_Attribute_Specification | Iir_Kind_Protected_Type_Declaration | Iir_Kind_Protected_Type_Body | Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Context_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Package_Body | Iir_Kind_Architecture_Body | Iir_Kind_Type_Declaration | Iir_Kind_Anonymous_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Component_Declaration | Iir_Kind_Attribute_Declaration | Iir_Kind_Group_Template_Declaration | Iir_Kind_Group_Declaration | Iir_Kind_Function_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_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_File_Declaration | Iir_Kind_Interface_Quantity_Declaration | Iir_Kind_Interface_Terminal_Declaration | Iir_Kind_Interface_Type_Declaration | Iir_Kind_Interface_Package_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Concurrent_Simple_Signal_Assignment | Iir_Kind_Concurrent_Conditional_Signal_Assignment | Iir_Kind_Concurrent_Selected_Signal_Assignment | Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kind_Generate_Statement_Body | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_Simultaneous_Procedural_Statement | Iir_Kind_Simultaneous_If_Statement | Iir_Kind_Simultaneous_Elsif | 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_Start_Location; function Has_Right_Paren_Location (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Parenthesis_Expression; end Has_Right_Paren_Location; function Has_End_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Protected_Type_Declaration | Iir_Kind_Record_Type_Definition | Iir_Kind_Protected_Type_Body | Iir_Kind_Record_Nature_Definition | Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Context_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Package_Body | 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_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kind_Generate_Statement_Body | Iir_Kind_If_Generate_Else_Clause | Iir_Kind_Simultaneous_Procedural_Statement | Iir_Kind_Simultaneous_Case_Statement | Iir_Kind_Simultaneous_If_Statement | Iir_Kind_Simultaneous_Elsif | 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_Location; function Has_Is_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Function_Body | Iir_Kind_Procedure_Body | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Process_Statement | Iir_Kind_Block_Statement | Iir_Kind_Simultaneous_Procedural_Statement => return True; when others => return False; end case; end Has_Is_Location; function Has_Begin_Location (K : Iir_Kind) return Boolean is begin case K is when 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_Body | Iir_Kind_Simultaneous_Procedural_Statement => return True; when others => return False; end case; end Has_Begin_Location; function Has_Then_Location (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_Then_Location; function Has_Use_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Simultaneous_If_Statement | Iir_Kind_Simultaneous_Elsif => return True; when others => return False; end case; end Has_Use_Location; function Has_Loop_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_For_Loop_Statement | Iir_Kind_While_Loop_Statement => return True; when others => return False; end case; end Has_Loop_Location; function Has_Generate_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_If_Generate_Statement | Iir_Kind_For_Generate_Statement | Iir_Kind_If_Generate_Else_Clause => return True; when others => return False; end case; end Has_Generate_Location; function Has_Generic_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Block_Header | Iir_Kind_Entity_Declaration | Iir_Kind_Package_Header | Iir_Kind_Component_Declaration => return True; when others => return False; end case; end Has_Generic_Location; function Has_Port_Location (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_Location; function Has_Generic_Map_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Block_Header | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Package_Header | Iir_Kind_Component_Instantiation_Statement => return True; when others => return False; end case; end Has_Generic_Map_Location; function Has_Port_Map_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Block_Header | Iir_Kind_Component_Instantiation_Statement => return True; when others => return False; end case; end Has_Port_Map_Location; function Has_Arrow_Location (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 | Iir_Kind_Association_Element_Package | Iir_Kind_Association_Element_Type | Iir_Kind_Association_Element_Subprogram | Iir_Kind_Association_Element_Terminal => return True; when others => return False; end case; end Has_Arrow_Location; function Has_Colon_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_File_Declaration | Iir_Kind_Interface_Quantity_Declaration => return True; when others => return False; end case; end Has_Colon_Location; function Has_Assign_Location (K : Iir_Kind) return Boolean is begin case K is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_File_Declaration | Iir_Kind_Interface_Quantity_Declaration => return True; when others => return False; end case; end Has_Assign_Location; pragma Warnings (On, """others"" choice is redundant"); end Vhdl.Elocations_Meta;