----------------------------------------------- --------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . E N T I T I E S . P R O P E R T I E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina 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 distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Namet; with Charset; with Ocarina.Nodes; with Ocarina.Entities; with Ocarina.Entities.Messages; package body Ocarina.Entities.Properties is function Get_Type_Of_Literal (Literal : Types.Node_Id) return Property_Type; ------------------------- -- Get_Type_Of_Literal -- ------------------------- function Get_Type_Of_Literal (Literal : Types.Node_Id) return Property_Type is use Ocarina.Nodes; use Types; use Ocarina.AADL_Values; pragma Assert (Literal /= No_Node and then Kind (Literal) = K_Literal); Literal_Value : constant Value_Type := Get_Value_Type (Value (Literal)); begin case (Literal_Value.T) is when LT_Boolean => return PT_Boolean; when LT_String => return PT_String; when LT_Real => return PT_Float; when LT_Integer => return PT_Integer; when LT_Enumeration => return PT_Enumeration; end case; end Get_Type_Of_Literal; ------------------------------------------------ -- Value_Of_Property_Association_Is_Undefined -- ------------------------------------------------ function Value_Of_Property_Association_Is_Undefined (Property : Types.Node_Id) return Boolean is use Ocarina.Nodes; use Types; pragma Assert (Property /= No_Node and then Kind (Property) = K_Property_Association); pragma Assert (Single_Value (Property_Association_Value (Property)) /= No_Node or else Multi_Value (Property_Association_Value (Property)) /= No_List); begin -- the value of a property association is undefined if there is -- no expanded value, and the raw values either are empty, or -- if the expanded values are set to an empty list return Expanded_Single_Value (Property_Association_Value (Property)) = No_Node and then (Expanded_Multi_Value (Property_Association_Value (Property)) = No_List); end Value_Of_Property_Association_Is_Undefined; -------------------------------- -- Type_Of_Property_Is_A_List -- -------------------------------- function Type_Of_Property_Is_A_List (Property : Types.Node_Id) return Boolean is use Ocarina.Nodes; use Ocarina.AADL_Values; use Types; pragma Assert (Property /= No_Node and then (Kind (Property) = K_Property_Association or else Kind (Property) = K_Property_Name_Declaration or else Kind (Property) = K_Property_Type_Declaration)); begin case Kind (Property) is when K_Property_Association => if Expanded_Single_Value (Property_Association_Value (Property)) = No_Node and then Expanded_Multi_Value (Property_Association_Value (Property)) = No_List then return Multi_Value (Property_Association_Value (Property)) /= No_List; -- If the property value has not been expanded yet, we -- use the raw property value else return Expanded_Multi_Value (Property_Association_Value (Property)) /= No_List; end if; when K_Property_Name_Declaration => return Is_List (Property_Name_Type (Property)); when K_Property_Type_Declaration => return False; when others => return False; end case; end Type_Of_Property_Is_A_List; -------------------------- -- Get_Type_Of_Property -- -------------------------- function Get_Type_Of_Property (Property : Types.Node_Id; Use_Evaluated_Values : Boolean := True) return Property_Type is use Ocarina.Nodes; use Ocarina.AADL_Values; use Types; pragma Assert (Property /= No_Node and then (Kind (Property) = K_Property_Association or else Kind (Property) = K_Property_Name_Declaration or else Kind (Property) = K_Property_Type_Declaration)); begin case Kind (Property) is when K_Property_Association => return Get_Type_Of_Property_Value (Property_Association_Value (Property), Use_Evaluated_Values); when K_Property_Name_Declaration => declare Associated_Type : Node_Id; begin if Use_Evaluated_Values and then Expanded_Type_Designator (Property_Name_Type (Property)) /= No_Node then Associated_Type := Expanded_Type_Designator (Property_Name_Type (Property)); else Associated_Type := Property_Type_Designator (Property_Name_Type (Property)); end if; case Kind (Associated_Type) is when K_Unique_Property_Type_Identifier => return PT_Other; when K_String_Type => return PT_String; when K_Boolean_Type => return PT_Boolean; when K_Real_Type => return PT_Float; when K_Integer_Type => return PT_Integer; when K_Range_Type => return PT_Range; when K_Enumeration_Type => return PT_Enumeration; when K_Reference_Type => return PT_Reference; when K_Classifier_Type => return PT_Classifier; when others => return PT_Other; end case; end; when K_Property_Type_Declaration => case Kind (Property_Type_Designator (Property)) is when K_Integer_Type => return PT_Integer; when K_Real_Type => return PT_Float; when K_Boolean_Type => return PT_Boolean; when K_String_Type => return PT_String; when K_Unique_Property_Type_Identifier => return PT_Other; when K_Range_Type => return PT_Range; when K_Enumeration_Type => return PT_Enumeration; when K_Reference_Type => return PT_Reference; when K_Classifier_Type => return PT_Classifier; when K_Units_Type => return PT_Other; when others => return PT_Other; end case; when others => raise Program_Error; end case; end Get_Type_Of_Property; -------------------------------- -- Get_Type_Of_Property_Value -- -------------------------------- function Get_Type_Of_Property_Value (Property_Value : Types.Node_Id; Use_Evaluated_Values : Boolean := True) return Property_Type is use Types; use Ocarina.Nodes; use Ocarina.Entities.Messages; pragma Assert (Property_Value = No_Node or else Kind (Property_Value) = K_Property_Value or else Kind (Property_Value) = K_Literal or else Kind (Property_Value) = K_Minus_Numeric_Term or else Kind (Property_Value) = K_Signed_AADLNumber or else Kind (Property_Value) = K_Number_Range_Term or else Kind (Property_Value) = K_Not_Boolean_Term or else Kind (Property_Value) = K_And_Boolean_Term or else Kind (Property_Value) = K_Or_Boolean_Term or else Kind (Property_Value) = K_Parenthesis_Boolean_Term or else Kind (Property_Value) = K_Reference_Term or else Kind (Property_Value) = K_Property_Term or else Kind (Property_Value) = K_Component_Classifier_Term or else DNKE (Property_Value)); Value_Type : Property_Type; Value_Node : Node_Id; begin if Property_Value = No_Node then Value_Node := No_Node; elsif Kind (Property_Value) = K_Property_Value then if Use_Evaluated_Values then if Expanded_Single_Value (Property_Value) /= No_Node then Value_Node := Expanded_Single_Value (Property_Value); elsif Expanded_Multi_Value (Property_Value) /= No_List then Value_Node := First_Node (Expanded_Multi_Value (Property_Value)); -- If we are dealing with a list of value, only -- consider the first value, assuming the other ones -- are of the same type else Value_Node := No_Node; end if; else if Single_Value (Property_Value) /= No_Node then Value_Node := Single_Value (Property_Value); elsif Multi_Value (Property_Value) /= No_List then Value_Node := First_Node (Multi_Value (Property_Value)); else Value_Node := No_Node; end if; end if; else Value_Node := Property_Value; end if; if Value_Node /= No_Node then case Kind (Value_Node) is when K_Literal => Value_Type := Get_Type_Of_Literal (Value_Node); when K_Minus_Numeric_Term => Value_Type := Get_Type_Of_Property_Value (Numeric_Term (Value_Node), Use_Evaluated_Values); when K_Signed_AADLNumber => Value_Type := Get_Type_Of_Property_Value (Number_Value (Value_Node), Use_Evaluated_Values); when K_Number_Range_Term => Value_Type := PT_Range; when K_Not_Boolean_Term | K_And_Boolean_Term | K_Or_Boolean_Term | K_Parenthesis_Boolean_Term => Value_Type := PT_Boolean_Expression; when K_Reference_Term => Value_Type := PT_Reference; when K_Component_Classifier_Term => Value_Type := PT_Classifier; when others => Value_Type := PT_Other; end case; else Value_Type := PT_Other; end if; return Value_Type; end Get_Type_Of_Property_Value; ----------------------------------- -- Get_Integer_Of_Property_Value -- ----------------------------------- function Get_Integer_Of_Property_Value (Property_Value : Types.Node_Id) return Types.Unsigned_Long_Long is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Number_Value (Property_Value)) = K_Literal); begin return Get_Value_Type (Value (Number_Value (Property_Value))).IVal; end Get_Integer_Of_Property_Value; --------------------------------- -- Get_Float_Of_Property_Value -- --------------------------------- function Get_Float_Of_Property_Value (Property_Value : Types.Node_Id) return Long_Long_Float is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Number_Value (Property_Value)) = K_Literal); begin return Get_Value_Type (Value (Number_Value (Property_Value))).RVal; end Get_Float_Of_Property_Value; ---------------------------------- -- Get_String_Of_Property_Value -- ---------------------------------- function Get_String_Of_Property_Value (Property_Value : Types.Node_Id) return Types.Name_Id is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Property_Value) = K_Literal); begin return Get_Value_Type (Value (Property_Value)).SVal; end Get_String_Of_Property_Value; ---------------------------------- -- Get_String_Of_Property_Value -- ---------------------------------- function Get_String_Of_Property_Value (Property_Value : Types.Node_Id) return String is use Namet; use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Property_Value) = K_Literal); begin return Get_Name_String (Get_String_Of_Property_Value (Property_Value)); end Get_String_Of_Property_Value; --------------------------------------- -- Get_Enumeration_Of_Property_Value -- --------------------------------------- function Get_Enumeration_Of_Property_Value (Property_Value : Types.Node_Id) return Types.Name_Id is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Property_Value) = K_Literal and then Get_Value_Type (Value (Property_Value)).T = LT_Enumeration); begin return Get_Value_Type (Value (Property_Value)).EVal; end Get_Enumeration_Of_Property_Value; --------------------------------------- -- Get_Enumeration_Of_Property_Value -- --------------------------------------- function Get_Enumeration_Of_Property_Value (Property_Value : Types.Node_Id) return String is use Types; use Ocarina.Nodes; use Namet; use Ocarina.AADL_Values; pragma Assert (Kind (Property_Value) = K_Literal and then Get_Value_Type (Value (Property_Value)).T = LT_Enumeration); begin return Get_Name_String (Get_Enumeration_Of_Property_Value (Property_Value)); end Get_Enumeration_Of_Property_Value; ----------------------------------- -- Get_Boolean_Of_Property_Value -- ----------------------------------- function Get_Boolean_Of_Property_Value (Property_Value : Types.Node_Id) return Boolean is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Kind (Property_Value) = K_Literal); begin return Get_Value_Type (Value (Property_Value)).BVal; end Get_Boolean_Of_Property_Value; ------------------------------------- -- Get_Reference_Of_Property_Value -- ------------------------------------- function Get_Reference_Of_Property_Value (Property_Value : Types.Node_Id) return Types.Node_Id is use Types; use Ocarina.Nodes; use Ocarina.Entities; pragma Assert (Property_Value /= No_Node and then Kind (Property_Value) = K_Reference_Term); begin return Get_Referenced_Entity (Property_Value); end Get_Reference_Of_Property_Value; -------------------------------------- -- Get_Classifier_Of_Property_Value -- -------------------------------------- function Get_Classifier_Of_Property_Value (Property_Value : Types.Node_Id) return Types.Node_Id is use Types; use Ocarina.Nodes; use Ocarina.Entities; pragma Assert (Property_Value /= No_Node and then Kind (Property_Value) = K_Component_Classifier_Term); begin return Get_Referenced_Entity (Property_Value); end Get_Classifier_Of_Property_Value; --------------------------------------- -- Get_Value_Of_Property_Association -- --------------------------------------- function Get_Value_Of_Property_Association (Property : Types.Node_Id) return Ocarina.AADL_Values.Value_Type is use Types; use Ocarina.Nodes; use Ocarina.AADL_Values; pragma Assert (Property /= No_Node and then Kind (Property) = K_Property_Association and then Property_Association_Value (Property) /= No_Node and then Single_Value (Property_Association_Value (Property)) /= No_Node and then (Kind (Single_Value (Property_Association_Value (Property))) = K_Literal or else Kind (Number_Value (Single_Value (Property_Association_Value (Property)))) = K_Literal)); begin if Kind (Single_Value (Property_Association_Value (Property))) = K_Literal then return Get_Value_Type (Value (Single_Value (Property_Association_Value (Property)))); else return Get_Value_Type (Value (Number_Value (Single_Value (Property_Association_Value (Property))))); end if; end Get_Value_Of_Property_Association; ----------------------------------------- -- Find_Property_Association_From_Name -- ----------------------------------------- function Find_Property_Association_From_Name (Property_List : Types.List_Id; Property_Name : Types.Name_Id) return Types.Node_Id is use Types; use Ocarina.Nodes; List_Node : Node_Id; Property_Node : Node_Id := No_Node; begin if Property_List /= No_List then List_Node := First_Node (Property_List); while List_Node /= No_Node loop if Name (Identifier (List_Node)) = Property_Name then Property_Node := List_Node; exit; end if; List_Node := Next_Node (List_Node); end loop; end if; return Property_Node; end Find_Property_Association_From_Name; ----------------------------------------- -- Find_Property_Association_From_Name -- ----------------------------------------- function Find_Property_Association_From_Name (Property_List : Types.List_Id; Property_Name : String) return Types.Node_Id is use Charset; use Namet; use Types; Name : Name_Id; begin Set_Str_To_Name_Buffer (To_Lower (Property_Name)); Name := Name_Find; return Find_Property_Association_From_Name (Property_List, Name); end Find_Property_Association_From_Name; end Ocarina.Entities.Properties;