--------------------------------------------- ----------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A N A L Y Z E R . Q U E R I E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-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 GNAT.Table; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Annotations; with Ocarina.Entities.Properties; with Ocarina.Entities.Components.Connections; with Ocarina.Entities.Components.Subcomponents; with Ocarina.Entities.Components.Subprogram_Calls; package body Ocarina.Analyzer.Queries is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Annotations; use Ocarina.Entities; use Ocarina.Entities.Properties; use Ocarina.Entities.Components; use Ocarina.Entities.Components.Connections; use Ocarina.Entities.Components.Subcomponents; use Ocarina.Entities.Components.Subprogram_Calls; package ON renames Ocarina.Nodes; -- Shortcut function Get_Category_Of_Entity (Entity : node_id) return property_owner_category; ---------------------------- -- Compute_Property_Value -- ---------------------------- function Compute_Property_Value (Property_Value : node_id) return node_id is pragma assert (Kind (Property_Value) = k_property_value); Property_Expression : node_id; begin if Expanded_Single_Value (Property_Value) /= No_Node then Property_Expression := Expanded_Single_Value (Property_Value); elsif Expanded_Multi_Value (Property_Value) /= No_List then Property_Expression := First_Node (Expanded_Multi_Value (Property_Value)); elsif Single_Value (Property_Value) /= No_Node then Property_Expression := Single_Value (Property_Value); elsif Multi_Value (Property_Value) /= No_List then Property_Expression := First_Node (Multi_Value (Property_Value)); else Property_Expression := No_Node; end if; return Property_Expression; end Compute_Property_Value; -------------------------- -- Get_Boolean_Property -- -------------------------- function Get_Boolean_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_boolean then return Get_Boolean_Of_Property_Value (Property_Value); else return False; end if; else return False; end if; end Get_Boolean_Property; ---------------------------- -- Get_Category_Of_Entity -- ---------------------------- function Get_Category_Of_Entity (Entity : node_id) return property_owner_category is pragma assert (Present (Entity)); begin case Kind (Entity) is when k_component_type | k_component_implementation | k_subcomponent | k_subcomponent_access => return poc_component_category; when k_mode => return poc_mode; when k_port_group_type => return poc_port_group; when k_flow_spec | k_flow_implementation | k_end_to_end_flow_spec | k_flow_implementation_refinement | k_end_to_end_flow_refinement => return poc_flow; when k_port_spec => if Is_Event (Entity) and then Is_Data (Entity) then return poc_event_data_port; elsif Is_Event (Entity) then return poc_event_port; else return poc_data_port; end if; when k_parameter => return poc_parameter; when k_subprogram_spec => if Is_Server (Entity) then return poc_server_subprogram; else return poc_component_category; end if; when k_subprogram_call => return poc_component_category; when k_connection => case Get_Category_Of_Connection (Entity) is when ct_data | ct_data_delayed => return poc_data_port_connections; when ct_event => return poc_event_port_connections; when ct_event_data => return poc_event_data_port_connections; when ct_parameter => return poc_parameter_connections; when ct_port_group => return poc_port_group_connections; when ct_access_bus | ct_access_data | ct_access_subprogram => return poc_access_connections; end case; when others => raise Program_Error; end case; end Get_Category_Of_Entity; ------------------------------ -- Get_Enumeration_Property -- ------------------------------ function Get_Enumeration_Property (Entity : node_id; Name : String) return String is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_enumeration then return Get_Enumeration_Of_Property_Value (Property_Value); else return ""; end if; else return ""; end if; end Get_Enumeration_Property; ------------------------------ -- Get_Enumeration_Property -- ------------------------------ function Get_Enumeration_Property (Entity : node_id; Name : String) return name_id is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_enumeration then return Get_Enumeration_Of_Property_Value (Property_Value); else return No_Name; end if; else return No_Name; end if; end Get_Enumeration_Property; ------------------------ -- Get_Float_Property -- ------------------------ function Get_Float_Property (Entity : node_id; Name : String) return Long_Long_Float is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_float or else Get_Type_Of_Property_Value (Property_Value, True) = pt_unsigned_float then return Get_Float_Of_Property_Value (Property_Value); else return 0.0; end if; else return 0.0; end if; end Get_Float_Property; -------------------------- -- Get_Integer_Property -- -------------------------- function Get_Integer_Property (Entity : node_id; Name : String) return unsigned_long_long is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_integer or else Get_Type_Of_Property_Value (Property_Value, True) = pt_unsigned_integer then return Get_Integer_Of_Property_Value (Property_Value); else return 0; end if; else return 0; end if; end Get_Integer_Property; ---------------------------- -- Get_Reference_Property -- ---------------------------- function Get_Reference_Property (Entity : node_id; Name : String) return node_id is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_reference then return Get_Reference_Of_Property_Value (Property_Value); else return No_Node; end if; else return No_Node; end if; end Get_Reference_Property; ----------------------- -- Get_List_Property -- ----------------------- function Get_List_Property (Entity : node_id; Name : String) return list_id is Property : constant node_id := Find_Property_Association_From_Name (Property_List => ON.Properties (Entity), Property_Name => Name); begin if not Type_Of_Property_Is_A_List (Get_Referenced_Entity (Property_Name (Property))) then return No_List; end if; return Expanded_Multi_Value (Property_Association_Value (Property)); end Get_List_Property; ------------------------- -- Get_String_Property -- ------------------------- function Get_String_Property (Entity : node_id; Name : String) return String is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_string then return Get_String_Of_Property_Value (Property_Value); else return ""; end if; else return ""; end if; end Get_String_Property; ------------------------- -- Get_String_Property -- ------------------------- function Get_String_Property (Entity : node_id; Name : String) return name_id is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then if Get_Type_Of_Property_Value (Property_Value, True) = pt_string then return Get_String_Of_Property_Value (Property_Value); else return No_Name; end if; else return No_Name; end if; end Get_String_Property; --------------------------------------- -- Get_Value_Of_Property_Association -- --------------------------------------- function Get_Value_Of_Property_Association (Entity : node_id; Name : String) return node_id is Property : constant node_id := Find_Property_Association_From_Name (Property_List => ON.Properties (Entity), Property_Name => Name); begin if Property /= No_Node then return Compute_Property_Value (Property_Association_Value (Property)); else return No_Node; end if; end Get_Value_Of_Property_Association; --------------------- -- Is_An_Extension -- --------------------- function Is_An_Extension (Component : node_id; Ancestor : node_id) return Boolean is pragma assert (Kind (Component) = k_component_implementation or else Kind (Component) = k_component_type or else Kind (Component) = k_port_group_type); pragma assert (No (Ancestor) or else Kind (Ancestor) = k_component_implementation or else Kind (Ancestor) = k_component_type or else Kind (Ancestor) = k_port_group_type); Temp_Node : node_id := Component; Type_Node : node_id := Component; begin if Ancestor = No_Node then return False; end if; while Temp_Node /= No_Node loop if Temp_Node = Ancestor then return True; elsif Kind (Component) = k_component_implementation then Type_Node := Corresponding_Entity (Component_Type_Identifier (Temp_Node)); while Type_Node /= No_Node loop if Type_Node = Ancestor then return True; end if; if Parent (Type_Node) /= No_Node then Type_Node := Get_Referenced_Entity (Parent (Type_Node)); else Type_Node := No_Node; end if; end loop; end if; if Parent (Temp_Node) /= No_Node then Temp_Node := Get_Referenced_Entity (Parent (Temp_Node)); else Temp_Node := No_Node; end if; end loop; return False; end Is_An_Extension; --------------------------------- -- Is_Defined_Boolean_Property -- --------------------------------- function Is_Defined_Boolean_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_integer or else Get_Type_Of_Property_Value (Property_Value, True) = pt_unsigned_integer; else return False; end if; end Is_Defined_Boolean_Property; ------------------------------------- -- Is_Defined_Enumeration_Property -- ------------------------------------- function Is_Defined_Enumeration_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_enumeration; else return False; end if; end Is_Defined_Enumeration_Property; ------------------------------- -- Is_Defined_Float_Property -- ------------------------------- function Is_Defined_Float_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_float or else Get_Type_Of_Property_Value (Property_Value, True) = pt_unsigned_float; else return False; end if; end Is_Defined_Float_Property; --------------------------------- -- Is_Defined_Integer_Property -- --------------------------------- function Is_Defined_Integer_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_integer or else Get_Type_Of_Property_Value (Property_Value, True) = pt_unsigned_integer; else return False; end if; end Is_Defined_Integer_Property; ------------------------- -- Is_Defined_Property -- ------------------------- function Is_Defined_Property (Entity : node_id; Name : String) return Boolean is begin -- A property is defined if it exists and has a value return Get_Value_Of_Property_Association (Entity, Name) /= No_Node; end Is_Defined_Property; ----------------------------------- -- Is_Defined_Reference_Property -- ----------------------------------- function Is_Defined_Reference_Property (Entity : node_id; Name : String) return Boolean is Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_reference; else return False; end if; end Is_Defined_Reference_Property; ------------------------------ -- Is_Defined_List_Property -- ------------------------------ function Is_Defined_List_Property (Entity : node_id; Name : String) return Boolean is Property : constant node_id := Find_Property_Association_From_Name (Property_List => ON.Properties (Entity), Property_Name => Name); begin return Present (Property) and then Type_Of_Property_Is_A_List (Get_Referenced_Entity (Property_Name (Property))); end Is_Defined_List_Property; -------------------------------- -- Is_Defined_String_Property -- -------------------------------- function Is_Defined_String_Property (Entity : node_id; Name : String) return Boolean is pragma assert (Present (Entity)); Property_Value : node_id; begin Property_Value := Get_Value_Of_Property_Association (Entity, Name); if Property_Value /= No_Node then return Get_Type_Of_Property_Value (Property_Value, True) = pt_string; else return False; end if; end Is_Defined_String_Property; --------------- -- Needed_By -- --------------- function Needed_By (N : node_id; Entity : node_id) return Boolean is -- During the expansion phase, each component or property -- declaration is annotatated with the components that need -- it. For exemple each AADL component C corresponding to a -- subcomponent S of another component D will be annotated with -- D. Therefore, D "needs" C. -- To see whether N is needed by Entity, we loop through all -- the annotations of N and see whether one of them is eqaul to -- Entity or if it is (recursively) "needed" by Entity. -- To avoid infinite recursion (that may occurs between data -- having a subprogram as a feature and a being access-required -- by the same subprogram), we build a list of the visited -- nodes to guarantee they are checked only once. package Checked_Nodes is new GNAT.Table (node_id, nat, 1, 10, 50); -- This is the list of the already checked "nodes" function Is_Checked (E : node_id) return Boolean; -- See whether E has already been ckecked or not procedure Set_Checked (E : node_id); -- Append E to the checked node table function Need (E : node_id) return Boolean; -- This is the Actual recursive routine. It returns True when -- Entity is an annotation of E or else whether it is "needs" -- one of the annotations of E. ---------------- -- Is_Checked -- ---------------- function Is_Checked (E : node_id) return Boolean is use Checked_Nodes; begin for J in First .. Last loop if Table (J) = E then return True; end if; end loop; return False; end Is_Checked; ----------------- -- Set_Checked -- ----------------- procedure Set_Checked (E : node_id) is use Checked_Nodes; begin Append (E); end Set_Checked; ---------- -- Need -- ---------- function Need (E : node_id) return Boolean is A : node_id; Result : Boolean; begin Set_Checked (E); if Is_Empty (Nodes.Annotations (E)) then Result := False; elsif Annotation_Present (E, Entity) then Result := True; else Result := False; A := First_Node (Nodes.Annotations (E)); while Present (A) loop if not Is_Checked (Annotation_Node (A)) then Result := Need (Annotation_Node (A)); exit when Result; end if; A := Next_Node (A); end loop; end if; return Result; end Need; Result : Boolean; begin -- Always return true when asked for a dependency upon a -- property declaration. Result := Kind (N) = k_property_name_declaration or else Kind (N) = k_property_type_declaration or else Kind (N) = k_constant_property_declaration or else Need (N); -- Deallocate the checked nodes list Checked_Nodes.Free; return Result; end Needed_By; ---------------------------------- -- Property_Can_Apply_To_Entity -- ---------------------------------- function Property_Can_Apply_To_Entity (Property : node_id; Entity : node_id) return Boolean is pragma assert (Kind (Property) = k_property_association); pragma assert (Present (Entity)); Property_Name : constant node_id := Get_Referenced_Entity (Ocarina.Nodes.Property_Name (Property)); pragma assert (Is_All (Applies_To (Property_Name)) or else Owner_Categories (Applies_To (Property_Name)) /= No_List); List_Node : node_id := No_Node; Corresponding_Component : node_id := No_Node; Category_Of_Property_Owner : property_owner_category; Category_Of_Component : component_category; Success : Boolean; Can_Apply : Boolean; begin if Is_All (Applies_To (Property_Name)) then Success := True; else Success := False; Category_Of_Property_Owner := Get_Category_Of_Entity (Entity); -- Get the corresponding component, for some tests if Kind (Entity) = k_subcomponent then Corresponding_Component := Get_Corresponding_Component (Entity); elsif Kind (Entity) = k_subprogram_call then Corresponding_Component := Get_Corresponding_Subprogram (Entity); else Corresponding_Component := Entity; end if; -- Get the category of the entity if Kind (Entity) = k_component_type or else Kind (Entity) = k_component_implementation then Category_Of_Component := Get_Category_Of_Component (Entity); elsif Kind (Entity) = k_subprogram_spec and then not Is_Server (Entity) then Category_Of_Component := cc_subprogram; elsif Kind (Entity) = k_subprogram_call then Category_Of_Component := cc_subprogram; elsif Kind (Entity) = k_subcomponent then Category_Of_Component := Get_Category_Of_Subcomponent (Entity); elsif Kind (Entity) = k_subcomponent_access then Category_Of_Component := component_category'val (Subcomponent_Category (Entity)); end if; -- Only access property names can be applied to subcomponent -- accesses. if Kind (Entity) = k_subcomponent_access and then not Is_Access (Property_Name) then -- No need to go further, it cannot apply return False; end if; -- Check if the property can be applied to the entity List_Node := First_Node (Owner_Categories (Applies_To (Property_Name))); while List_Node /= No_Node and then not Success loop case Category_Of_Property_Owner is when poc_component_category => Can_Apply := (property_owner_category'val (Category (List_Node)) = poc_component_category) and then (Category_Of_Component = component_category'val (Component_Cat (List_Node))); if Present (Classifier_Ref (List_Node)) then if Present (Corresponding_Component) then Can_Apply := Is_An_Extension (Component => Corresponding_Component, Ancestor => Get_Referenced_Entity (Classifier_Ref (List_Node))); else Can_Apply := False; end if; end if; when poc_event_data_port | poc_event_port | poc_data_port | poc_port => Can_Apply := property_owner_category'val (Category (List_Node)) = Category_Of_Property_Owner or else property_owner_category'val (Category (List_Node)) = poc_port; when poc_data_port_connections | poc_event_port_connections | poc_event_data_port_connections => Can_Apply := property_owner_category'val (Category (List_Node)) = Category_Of_Property_Owner or else property_owner_category'val (Category (List_Node)) = poc_port_connections or else property_owner_category'val (Category (List_Node)) = poc_connections; when poc_parameter_connections | poc_port_group_connections | poc_access_connections | poc_connections => Can_Apply := property_owner_category'val (Category (List_Node)) = Category_Of_Property_Owner or else property_owner_category'val (Category (List_Node)) = poc_connections; when others => Can_Apply := property_owner_category'val (Category (List_Node)) = Category_Of_Property_Owner; end case; Success := Success or else Can_Apply; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Property_Can_Apply_To_Entity; end Ocarina.Analyzer.Queries;