----------------------------------------------- --------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.EXPANDER.COMPONENTS.FEATURES -- -- -- -- 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 Locations; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Annotations; with Ocarina.Entities.Components; with Ocarina.Expander.Messages; with Ocarina.Expander.Namespaces; package body Ocarina.Expander.Components.Features is use Locations; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; use Ocarina.Annotations; use Ocarina.Entities.Components; use Ocarina.Expander.Messages; use Ocarina.Expander.Namespaces; function Expand_Corresponding_Entity (Instance_Root : node_id; Feature : node_id; Container : node_id) return node_id; function Expand_Port_Group_Type (Instance_Root : node_id; Port_Group : node_id; Feature_List : list_id; Container : node_id; Inverse : Boolean := False) return Boolean; -- Recursively expand a port group type, with extensions, features -- and inverses. Return True if everything was OK, else False -------------------- -- Expand_Feature -- -------------------- function Expand_Feature (Instance_Root : node_id; Feature : node_id; Inverse : Boolean := False) return node_id is pragma assert (Kind (Instance_Root) = k_architecture_instance); pragma assert (Kind (Feature) = k_subcomponent_access 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_port_spec); New_Instance : node_id := No_Node; New_Subinstance : node_id := No_Node; Container : constant node_id := Container_Component (Feature); Port_Group : node_id := No_Node; Success : Boolean := True; begin case Kind (Feature) is when k_port_spec => New_Instance := New_Node (k_port_spec_instance, Loc (Feature)); Set_Is_In (New_Instance, Is_In (Feature)); Set_Is_Out (New_Instance, Is_Out (Feature)); Set_Is_Event (New_Instance, Is_Event (Feature)); Set_Is_Data (New_Instance, Is_Data (Feature)); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Feature))); Set_Sources (New_Instance, New_List (k_list_id, No_Location)); Set_Destinations (New_Instance, New_List (k_list_id, No_Location)); if Is_Data (Feature) then -- We expand the corresponding Data component for data -- and event data ports. New_Subinstance := Expand_Corresponding_Entity (Instance_Root, Feature, Container); if Present (New_Subinstance) then Set_Corresponding_Instance (New_Instance, New_Subinstance); else Success := False; end if; end if; when k_port_group_spec => if Entity_Ref (Feature) /= No_Node and then Get_Referenced_Entity (Entity_Ref (Feature)) /= No_Node then New_Instance := New_Node (k_port_group_spec_instance, Loc (Feature)); Set_Features (New_Instance, New_List (k_list_id, Loc (Feature))); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Feature))); Port_Group := Get_Referenced_Entity (Entity_Ref (Feature)); Success := Expand_Port_Group_Type (Instance_Root, Port_Group, Ocarina.Nodes.Features (New_Instance), Container, Inverse); else Display_No_Entity_Ref (Feature); Success := False; end if; when k_parameter => New_Instance := New_Node (k_parameter_instance, Loc (Feature)); Set_Is_In (New_Instance, Is_In (Feature)); Set_Is_Out (New_Instance, Is_Out (Feature)); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Feature))); Set_Sources (New_Instance, New_List (k_list_id, No_Location)); Set_Destinations (New_Instance, New_List (k_list_id, No_Location)); New_Subinstance := Expand_Corresponding_Entity (Instance_Root, Feature, Container); if Present (New_Subinstance) then Set_Corresponding_Instance (New_Instance, New_Subinstance); else Success := False; end if; when k_subprogram_spec => New_Instance := New_Node (k_subprogram_spec_instance, Loc (Feature)); Set_Is_Server (New_Instance, Is_Server (Feature)); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Feature))); Set_Sources (New_Instance, New_List (k_list_id, No_Location)); Set_Destinations (New_Instance, New_List (k_list_id, No_Location)); -- Expand the corresponding subprogram component New_Subinstance := Expand_Corresponding_Entity (Instance_Root, Feature, Container); if Present (New_Subinstance) then Set_Corresponding_Instance (New_Instance, New_Subinstance); else Success := False; end if; when k_subcomponent_access => New_Instance := New_Node (k_subcomponent_access_instance, Loc (Feature)); Set_Is_Provided (New_Instance, Is_Provided (Feature)); Set_Is_Data (New_Instance, component_category'val (Subcomponent_Category (Feature)) = cc_data); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Feature))); Set_Sources (New_Instance, New_List (k_list_id, No_Location)); Set_Destinations (New_Instance, New_List (k_list_id, No_Location)); -- Expand the corresponding component -- FIXME: This is definitely a WRONG design. We MUST: -- 1 - NOT expand the component corresponding to an -- access. -- 2 - POSTPONE the resolution of this at the connection -- expansion. New_Subinstance := Expand_Corresponding_Entity (Instance_Root, Feature, Container); if Present (New_Subinstance) then Set_Corresponding_Instance (New_Instance, New_Subinstance); else Success := False; end if; when others => raise Program_Error with "Unknown feature kind " & Kind (Feature)'img; end case; if Success then Set_Corresponding_Declaration (New_Instance, Feature); return New_Instance; else Display_Expansion_Error (Feature); return No_Node; end if; end Expand_Feature; --------------------------------- -- Expand_Corresponding_Entity -- --------------------------------- function Expand_Corresponding_Entity (Instance_Root : node_id; Feature : node_id; Container : node_id) return node_id is pragma assert (Kind (Instance_Root) = k_architecture_instance); pragma assert (Kind (Feature) = k_subcomponent_access 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_port_spec); Namespace_Model : node_id; Namespace_Instance : node_id; C : node_id; New_Subinstance : node_id := No_Node; begin if No (Entity_Ref (Feature)) then -- Abort the expansion of the corresponding entity if there -- is no such corresponding entity. return No_Node; else C := Get_Referenced_Entity (Entity_Ref (Feature)); -- Annotate the component with container Annotate (C, Container); -- Getting the component namespace Namespace_Model := Namespace (C); Namespace_Instance := Expand_Namespace (Instance_Root, Namespace_Model); -- Verify whether the component has been expanded or not New_Subinstance := Get_First_Contained_Homonym (Declarations (Namespace_Instance), Get_Referenced_Entity (Entity_Ref (Feature))); -- If the component is already expanded, return it if Present (New_Subinstance) then return New_Subinstance; end if; -- If the component isn't expanded yet, expand it... New_Subinstance := Expand_Component (Instance_Root, C); if Present (New_Subinstance) then -- Expansion is successful, append the compoent to the -- declarations of its namespace. If the component has -- subcomponents, they will be added recursivly. -- The namespace declaration list is a node container -- list because we cannot append the same node in two -- different lists. Append_To_Namespace_Instance (Instance_Root, New_Subinstance); else -- Something went wrong, propagate the information by -- returning No_Node. return No_Node; end if; end if; return New_Subinstance; end Expand_Corresponding_Entity; ---------------------------- -- Expand_Port_Group_Type -- ---------------------------- function Expand_Port_Group_Type (Instance_Root : node_id; Port_Group : node_id; Feature_List : list_id; Container : node_id; Inverse : Boolean := False) return Boolean is pragma assert (Feature_List /= No_List); pragma assert (Kind (Instance_Root) = k_architecture_instance); pragma assert (Kind (Port_Group) = k_port_group_type); Success : Boolean := True; List_Node : node_id := No_Node; Expandable_Node : node_id := No_Node; New_Subinstance : node_id := No_Node; begin -- Annotate the parent port group with the container node Annotate (Port_Group, Container); -- Parent port group if Present (Parent (Port_Group)) and then Present (Get_Referenced_Entity (Parent (Port_Group))) then -- Expand the parent port group Success := Expand_Port_Group_Type (Instance_Root, Get_Referenced_Entity (Parent (Port_Group)), Feature_List, Container, Inverse); end if; -- Features if not Is_Empty (Ocarina.Nodes.Features (Port_Group)) then List_Node := First_Node (Ocarina.Nodes.Features (Port_Group)); while Present (List_Node) loop if not Is_Implicit_Inverse (List_Node) then if Inverse then Expandable_Node := Inversed_Entity (List_Node); else Expandable_Node := List_Node; end if; New_Subinstance := Expand_Feature (Instance_Root, Expandable_Node, Inverse); if Present (New_Subinstance) then Append_Node_To_List (New_Subinstance, Feature_List); else Success := False; end if; end if; List_Node := Next_Node (List_Node); end loop; end if; -- Inverse Of if Present (Inverse_Of (Port_Group)) and then Present (Get_Referenced_Entity (Inverse_Of (Port_Group))) then Success := Expand_Port_Group_Type (Instance_Root, Get_Referenced_Entity (Inverse_Of (Port_Group)), Feature_List, Container, not Inverse) and then Success; end if; return Success; end Expand_Port_Group_Type; end Ocarina.Expander.Components.Features;