-------------------------------------- ------------------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . V I S I T O R . P R O P E R T I E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2006, 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 Ocarina.Nodes; package body Ocarina.Visitor.Properties is function Visit_Property_Associations (Properties : Types.list_id; Root, Container : Types.node_id; Callback : property_callback) return Boolean; function Visit_Property_Associations_Of_Component_Type (Root, Component : Types.node_id; Callback : property_callback) return Boolean; function Visit_Property_Associations_Of_Component_Implementation (Root, Component : Types.node_id; Callback : property_callback) return Boolean; function Visit_Properties_Of_Component_Implementation (Root, Component : Types.node_id; Callback : property_callback) return Boolean renames Visit_Property_Associations_Of_Component_Implementation; function Visit_Property_Associations_Of_Port_Group_Type (Root, Port_Group : Types.node_id; Callback : property_callback) return Boolean; --------------------------------- -- Visit_Property_Associations -- --------------------------------- function Visit_Property_Associations (Properties : Types.list_id; Root, Container : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Container /= No_Node); Success : Boolean := True; List_Node : node_id; begin if Properties /= No_List then List_Node := First_Node (Properties); while List_Node /= No_Node loop pragma assert (List_Node /= No_Node and then Kind (List_Node) = k_property_association); Success := Callback (Root => Root, Container => Container, Property => List_Node) and then Success; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Visit_Property_Associations; --------------------------------------------------- -- Visit_Property_Associations_Of_Component_Type -- --------------------------------------------------- function Visit_Property_Associations_Of_Component_Type (Root, Component : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Component /= No_Node and then Kind (Component) = k_component_type); Success : Boolean := True; List_Node : node_id; begin -- Features if Features (Component) /= No_List then List_Node := First_Node (Features (Component)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Flows if Flows (Component) /= No_List then List_Node := First_Node (Flows (Component)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Properties Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (Component), Container => Component, Callback => Callback) and then Success; return Success; end Visit_Property_Associations_Of_Component_Type; ------------------------------------------------------------- -- Visit_Property_Associations_Of_Component_Implementation -- ------------------------------------------------------------- function Visit_Property_Associations_Of_Component_Implementation (Root, Component : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Component /= No_Node and then Kind (Component) = k_component_implementation); Success : Boolean := True; List_Node, Call_List_Node : node_id; begin -- Type refinements if Refines_Type (Component) /= No_List then List_Node := First_Node (Refines_Type (Component)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Subcomponents if Subcomponents (Component) /= No_List then List_Node := First_Node (Subcomponents (Component)); while Present (List_Node) loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Call sequences -- Some call sequences are anonymous if Calls (Component) /= No_List then List_Node := First_Node (Calls (Component)); while List_Node /= No_Node loop if Subprogram_Calls (List_Node) /= No_List then Call_List_Node := First_Node (Subprogram_Calls (List_Node)); while Call_List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (Call_List_Node), Container => Call_List_Node, Callback => Callback) and then Success; Call_List_Node := Next_Node (Call_List_Node); end loop; end if; List_Node := Next_Node (List_Node); end loop; end if; -- Connections -- Some connections are anonymous if Connections (Component) /= No_List then List_Node := First_Node (Connections (Component)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Flows if Flows (Component) /= No_List then List_Node := First_Node (Flows (Component)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Modes if Modes (Component) /= No_List then List_Node := First_Node (Modes (Component)); while Present (List_Node) loop if Kind (List_Node) = k_mode then Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; end if; List_Node := Next_Node (List_Node); end loop; end if; -- Properties Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (Component), Container => Component, Callback => Callback) and then Success; return Success; end Visit_Property_Associations_Of_Component_Implementation; ---------------------------------------------------- -- Visit_Property_Associations_Of_Port_Group_Type -- ---------------------------------------------------- function Visit_Property_Associations_Of_Port_Group_Type (Root, Port_Group : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Port_Group /= No_Node and then Kind (Port_Group) = k_port_group_type); Success : Boolean := True; List_Node : node_id; begin -- Features if Features (Port_Group) /= No_List then List_Node := First_Node (Features (Port_Group)); while List_Node /= No_Node loop Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; List_Node := Next_Node (List_Node); end loop; end if; -- Properties Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (Port_Group), Container => Port_Group, Callback => Callback) and then Success; return Success; end Visit_Property_Associations_Of_Port_Group_Type; ------------------------------------- -- Visit_All_Property_Associations -- ------------------------------------- function Visit_All_Property_Associations (Root : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Root /= No_Node and then Kind (Root) = k_aadl_specification); Success : Boolean := True; List_Node, Package_List_Node : node_id; begin if Declarations (Root) /= No_List then List_Node := First_Node (Declarations (Root)); while List_Node /= No_Node loop case Kind (List_Node) is when k_component_implementation => Success := Visit_Property_Associations_Of_Component_Implementation (Root => Root, Component => List_Node, Callback => Callback) and then Success; when k_component_type => Success := Visit_Property_Associations_Of_Component_Type (Root => Root, Component => List_Node, Callback => Callback) and then Success; when k_port_group_type => Success := Visit_Property_Associations_Of_Port_Group_Type (Root => Root, Port_Group => List_Node, Callback => Callback) and then Success; when k_package_specification => Success := Visit_Property_Associations (Root => Root, Properties => Ocarina.Nodes.Properties (List_Node), Container => List_Node, Callback => Callback) and then Success; if Declarations (List_Node) /= No_List then Package_List_Node := First_Node (Declarations (List_Node)); while Package_List_Node /= No_Node loop case Kind (Package_List_Node) is when k_component_implementation => Success := Visit_Properties_Of_Component_Implementation (Root => Root, Component => Package_List_Node, Callback => Callback) and then Success; when k_component_type => Success := Visit_Property_Associations_Of_Component_Type (Root => Root, Component => Package_List_Node, Callback => Callback) and then Success; when k_port_group_type => Success := Visit_Property_Associations_Of_Port_Group_Type (Root => Root, Port_Group => Package_List_Node, Callback => Callback) and then Success; when others => null; end case; Package_List_Node := Next_Node (Package_List_Node); end loop; end if; when others => null; end case; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Visit_All_Property_Associations; ------------------------------ -- Visit_All_Property_Names -- ------------------------------ function Visit_All_Property_Names (Root : Types.node_id; Callback : property_callback) return Boolean is use Types; use Ocarina.Nodes; pragma assert (Root /= No_Node and then Kind (Root) = k_aadl_specification); Success : Boolean := True; List_Node, Property_Set_List_Node : node_id; begin if Declarations (Root) /= No_List then List_Node := First_Node (Declarations (Root)); while List_Node /= No_Node loop case Kind (List_Node) is when k_property_set => if Declarations (List_Node) /= No_List then Property_Set_List_Node := First_Node (Declarations (List_Node)); while Property_Set_List_Node /= No_Node loop case Kind (Property_Set_List_Node) is when k_property_name_declaration => Success := Callback (Root => Root, Container => List_Node, Property => Property_Set_List_Node) and then Success; when others => null; end case; Property_Set_List_Node := Next_Node (Property_Set_List_Node); end loop; end if; when others => null; end case; List_Node := Next_Node (List_Node); end loop; end if; return Success; end Visit_All_Property_Names; end Ocarina.Visitor.Properties;