------------------------------------ -------------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . B U I L D E R . C O M P O N E N T S . F E A T U R E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-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 Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Builder.Components; with Ocarina.Entities; package body Ocarina.Builder.Components.Features is function Add_New_Feature (Loc : location; Name : node_id; Container : node_id; Feature_Kind : Ocarina.Nodes.node_kind; Is_Refinement : Boolean := False) return node_id; -- The generic function to create a new feature. This is meant to -- be called by Add_New_* functions ------------------------------ -- Add_Property_Association -- ------------------------------ function Add_Property_Association (Feature : node_id; Property_Association : node_id) return Boolean is use Ocarina.Nodes; use Ocarina.Nutils; pragma assert (Kind (Feature) = k_feature or else Kind (Feature) = k_port_spec or else Kind (Feature) = k_port_group_spec or else Kind (Feature) = k_subprogram_spec or else Kind (Feature) = k_parameter or else Kind (Feature) = k_subcomponent_access); pragma assert (Present (Property_Association)); begin if Is_Empty (Ocarina.Nodes.Properties (Feature)) then Set_Properties (Feature, New_List (k_list_id, Loc (Property_Association))); end if; Append_Node_To_List (Property_Association, Ocarina.Nodes.Properties (Feature)); return True; end Add_Property_Association; --------------------- -- Add_New_Feature -- --------------------- function Add_New_Feature (Loc : location; Name : node_id; Container : node_id; Feature_Kind : Ocarina.Nodes.node_kind; Is_Refinement : Boolean := False) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Builder.Components; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node and then (Kind (Container) = k_port_group_type or else Kind (Container) = k_component_implementation or else Kind (Container) = k_component_type)); pragma assert (Feature_Kind = k_port_spec or else Feature_Kind = k_port_group_spec or else Feature_Kind = k_subprogram_spec or else Feature_Kind = k_parameter or else Feature_Kind = k_subcomponent_access); Node : constant node_id := New_Node (Feature_Kind, Loc); Success : Boolean; begin Set_Identifier (Node, Name); Set_Corresponding_Entity (Name, Node); Set_Properties (Node, No_List); Set_Property_Scope (Node, New_Node (k_scope_definition, Loc)); Set_Corresponding_Entity (Property_Scope (Node), Node); Set_Is_Refinement (Node, Is_Refinement); Set_Entity_Ref (Node, No_Node); Set_Is_Implicit_Inverse (Node, False); Set_Inversed_Entity (Node, Node); -- By default, a feature is its own inverse if Kind (Container) = k_component_type or else Kind (Container) = k_port_group_type then Success := Add_Feature (Container, Node); elsif Kind (Container) = k_component_implementation then Success := Add_Refined_Type (Container, Node); end if; if Success then return Node; else return No_Node; end if; end Add_New_Feature; ----------------------- -- Add_New_Port_Spec -- ----------------------- function Add_New_Port_Spec (Loc : location; Name : node_id; Container : node_id; Is_In : Boolean; Is_Out : Boolean; Is_Data : Boolean; Is_Event : Boolean; Is_Refinement : Boolean := False; Associated_Entity : node_id := No_Node) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); Node, Inversed_Node : node_id; begin Node := Add_New_Feature (Loc => Loc, Name => Name, Container => Container, Feature_Kind => k_port_spec, Is_Refinement => Is_Refinement); Set_Is_In (Node, Is_In); Set_Is_Out (Node, Is_Out); Set_Is_Data (Node, Is_Data); Set_Is_Event (Node, Is_Event); Set_Entity_Ref (Node, Associated_Entity); -- We only create an inversed feature for in or out features -- (not in out) if Kind (Container) = k_port_group_type and then Is_In /= Is_Out then -- Port group types can be inversed; hence we add an -- implicit inversed port Inversed_Node := Add_New_Feature (Loc => Loc, Name => Duplicate_Identifier (Name), Container => Container, Feature_Kind => k_port_spec, Is_Refinement => Is_Refinement); Set_Is_Implicit_Inverse (Inversed_Node, True); Set_Inversed_Entity (Node, Inversed_Node); Set_Inversed_Entity (Inversed_Node, Node); Set_Is_In (Inversed_Node, not Is_In or else Is_Out); Set_Is_Out (Inversed_Node, not Is_Out or else Is_In); Set_Is_Data (Inversed_Node, Is_Data); Set_Is_Event (Inversed_Node, Is_Event); Set_Entity_Ref (Inversed_Node, Associated_Entity); end if; return Node; end Add_New_Port_Spec; ----------------------------- -- Add_New_Port_Group_Spec -- ----------------------------- function Add_New_Port_Group_Spec (Loc : location; Name : node_id; Container : node_id; Is_Refinement : Boolean := False) return node_id is use Ocarina.Nodes; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); begin return Add_New_Feature (Loc, Name, Container, k_port_group_spec, Is_Refinement); -- Port group spec are not inversed, since the corresponding -- port group type will contain the implicit inversed features. end Add_New_Port_Group_Spec; ------------------------------- -- Add_New_Server_Subprogram -- ------------------------------- function Add_New_Server_Subprogram (Loc : location; Name : node_id; Container : node_id; Is_Refinement : Boolean := False) return node_id is use Ocarina.Nodes; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); Node : node_id; begin Node := Add_New_Feature (Loc, Name, Container, k_subprogram_spec, Is_Refinement); Set_Is_Server (Node, True); return Node; end Add_New_Server_Subprogram; ---------------------------------- -- Add_New_Data_Subprogram_Spec -- ---------------------------------- function Add_New_Data_Subprogram_Spec (Loc : location; Name : node_id; Container : node_id; Is_Refinement : Boolean := False) return node_id is use Ocarina.Nodes; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); Node : node_id; begin Node := Add_New_Feature (Loc, Name, Container, k_subprogram_spec, Is_Refinement); Set_Is_Server (Node, False); return Node; end Add_New_Data_Subprogram_Spec; --------------------------------- -- Add_New_Subcomponent_Access -- --------------------------------- function Add_New_Subcomponent_Access (Loc : location; Name : node_id; Container : node_id; Is_Refinement : Boolean := False; Category : Ocarina.Entities.Components.component_category; Is_Provided : Boolean) return node_id is use Ocarina.Nodes; use Ocarina.Entities.Components; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); Node : node_id; begin Node := Add_New_Feature (Loc, Name, Container, k_subcomponent_access, Is_Refinement); if Node /= No_Node then Set_Subcomponent_Category (Node, component_category'pos (Category)); Set_Is_Provided (Node, Is_Provided); end if; return Node; end Add_New_Subcomponent_Access; ----------------------- -- Add_New_Parameter -- ----------------------- function Add_New_Parameter (Loc : location; Name : node_id; Container : node_id; Is_In : Boolean := True; Is_Out : Boolean := True; Is_Refinement : Boolean := False) return node_id is use Ocarina.Nodes; use Ocarina.Entities; pragma assert (Name /= No_Node and then Kind (Name) = k_identifier); pragma assert (Container /= No_Node); Node, Inversed_Node : node_id; begin Node := Add_New_Feature (Loc, Name, Container, k_parameter, Is_Refinement); Set_Is_In (Node, Is_In); Set_Is_Out (Node, Is_Out); -- We only create an inversed feature for in or out features -- (not in out) if Kind (Container) = k_port_group_type and then Is_In /= Is_Out then -- Port group types can be inversed; hence we add an -- implicit inversed parameter Inversed_Node := Add_New_Feature (Loc => Loc, Name => Duplicate_Identifier (Name), Container => Container, Feature_Kind => k_parameter, Is_Refinement => Is_Refinement); Set_Is_Implicit_Inverse (Inversed_Node, True); Set_Inversed_Entity (Inversed_Node, Node); Set_Inversed_Entity (Node, Inversed_Node); Set_Is_In (Inversed_Node, not Is_In or else Is_Out); Set_Is_Out (Inversed_Node, not Is_Out or else Is_In); end if; return Node; end Add_New_Parameter; end Ocarina.Builder.Components.Features;