----------------------------------------------- --------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . E X P A N D E R . P R O P E R T I 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 Locations; with Ocarina.Entities; with Ocarina.Expander.Components; with Ocarina.Expander.Components.Subprogram_Calls; with Ocarina.Expander.Components.Modes; with Ocarina.Expander.Messages; with Ocarina.Expander.Finder; package body Ocarina.Expander.Properties is use Ocarina.Nodes; use Ocarina.Nutils; use Locations; use Ocarina.Entities; use Ocarina.Expander.Components; use Ocarina.Expander.Components.Subprogram_Calls; use Ocarina.Expander.Components.Modes; use Ocarina.Expander.Messages; use Ocarina.Expander.Finder; function Duplicate_Property_Value (Instance_Root : Node_Id; Property_Value : Node_Id; Instance : Node_Id; Former_Property_Instance_Value : Node_Id := No_Node) return Node_Id; function Instantiate_Property_Value (Instance_Root : Node_Id; Property_Value : Node_Id; Instance : Node_Id) return Node_Id; function Expand_Reference_Term (Instance_Root : Node_Id; Reference_Instance : Node_Id; Reference_Term : Node_Id) return Node_Id; pragma Unreferenced (Expand_Reference_Term); -- Return an equivalent of Path, but containing instances instead -- of declarations. ---------------------- -- Apply_Properties -- ---------------------- function Apply_Properties (Instance_Root : Node_Id; Instance : Node_Id; Property_List : List_Id) return Boolean is pragma Assert (Kind (Instance_Root) = K_Architecture_Instance); pragma Assert (Present (Instance)); Property_List_Node : Node_Id; Success : Boolean := True; begin -- We then apply the attached properties if Property_List /= No_List then Property_List_Node := First_Node (Property_List); while Present (Property_List_Node) loop Success := Add_Property_Instance (Instance_Root, Instance, Property_List_Node) and then Success; Property_List_Node := Next_Node (Property_List_Node); end loop; end if; return Success; end Apply_Properties; --------------------------- -- Add_Property_Instance -- --------------------------- function Add_Property_Instance (Instance_Root : Node_Id; Entity_Instance : Node_Id; Property_Association : Node_Id) return Boolean is pragma Assert (Kind (Entity_Instance) = K_Component_Instance or else Kind (Entity_Instance) = K_Port_Spec_Instance or else Kind (Entity_Instance) = K_Port_Group_Spec_Instance or else Kind (Entity_Instance) = K_Parameter_Instance or else Kind (Entity_Instance) = K_Subcomponent_Access_Instance or else Kind (Entity_Instance) = K_Subprogram_Spec_Instance or else Kind (Entity_Instance) = K_Connection_Instance or else Kind (Entity_Instance) = K_Mode_Instance); pragma Assert (Kind (Property_Association) = K_Property_Association); Property_Instance : Node_Id; Pointed_Instance : Node_Id; Success : Boolean := True; begin -- We first find the instance on which the property applies Pointed_Instance := Find_Instance (Instance_Root, Entity_Instance, Applies_To_Prop (Property_Association)); if No (Pointed_Instance) then Display_Expansion_Error (Property_Association); Success := False; else if Ocarina.Nodes.Properties (Pointed_Instance) = No_List then Set_Properties (Pointed_Instance, New_List (K_List_Id, No_Location)); end if; -- We then check if the property is already set in the pointed -- instance Property_Instance := Get_First_Homonym (Ocarina.Nodes.Properties (Pointed_Instance), Property_Association); if No (Property_Instance) then Property_Instance := New_Node (K_Property_Association, Loc (Property_Association)); Set_Identifier (Property_Instance, Duplicate_Identifier (Identifier (Property_Association))); Set_Corresponding_Entity (Identifier (Property_Instance), Property_Instance); Set_Property_Name (Property_Instance, Property_Name (Property_Association)); Set_Is_Additive_Association (Property_Instance, Is_Additive_Association (Property_Association)); Set_Is_Constant (Property_Instance, Is_Constant (Property_Association)); Set_Is_Private (Property_Instance, Is_Private (Property_Association)); Set_Is_Access (Property_Instance, Is_Access (Property_Association)); Set_Applies_To_Prop (Property_Instance, No_List); Set_In_Binding (Property_Instance, In_Binding (Property_Association)); -- Expand property "in modes". The fact that a property -- association of a mode has an "in modes" clause, has -- absolutely no sense. It should have been detected as -- error during analysis. declare Container_Component : Node_Id := No_Node; begin -- The modes belong to the container component -- implementation. case Kind (Entity_Instance) is when K_Component_Instance => Container_Component := Entity_Instance; when K_Port_Spec_Instance | K_Port_Group_Spec_Instance | K_Parameter_Instance | K_Subcomponent_Access_Instance | K_Subprogram_Spec_Instance | K_Connection_Instance => Container_Component := Parent_Component (Entity_Instance); when others => null; end case; -- Workaround to fetch the in_modes of the original -- property association scince there is no -- property_association_instance node kind. Set_In_Modes (Property_Instance, In_Modes (Property_Association)); if Present (Container_Component) then Expand_In_Modes (Container_Component, Property_Instance); end if; end; if Present (Property_Association_Value (Property_Association)) then Set_Property_Association_Value (Property_Instance, Duplicate_Property_Value (Instance_Root, Property_Association_Value (Property_Association), Entity_Instance)); -- Beware: we use entity_instance, where the property -- has been declared, as the reference node to -- duplicate the property, and not pointed_instance, -- which is the node on which the property -- applies. Indeed, for properties that are -- references, the reference path is set from -- entity_instance. end if; Append_Node_To_List (Property_Instance, Ocarina.Nodes.Properties (Pointed_Instance)); else -- If the property is already there if Is_Additive_Association (Property_Association) then Set_Property_Association_Value (Property_Instance, Duplicate_Property_Value (Instance_Root, Property_Association_Value (Property_Association), Entity_Instance, Property_Association_Value (Property_Instance))); else Set_Property_Association_Value (Property_Instance, Duplicate_Property_Value (Instance_Root, Property_Association_Value (Property_Association), Entity_Instance)); end if; end if; end if; return Success; end Add_Property_Instance; ------------------------------ -- Duplicate_Property_Value -- ------------------------------ function Duplicate_Property_Value (Instance_Root : Node_Id; Property_Value : Node_Id; Instance : Node_Id; Former_Property_Instance_Value : Node_Id := No_Node) return Node_Id is pragma Assert (No (Property_Value) or else Kind (Property_Value) = K_Property_Value); pragma Assert (No (Former_Property_Instance_Value) or else No (Single_Value (Former_Property_Instance_Value))); -- If we are extending a former property value, this one must -- be a list. Duplicated_Property_Value : Node_Id; List_Node : Node_Id; begin if No (Former_Property_Instance_Value) then if No (Property_Value) then Duplicated_Property_Value := No_Node; else Duplicated_Property_Value := New_Node (K_Property_Value, Loc (Property_Value)); if Present (Single_Value (Property_Value)) then -- We set the value calculated at analysis time Set_Single_Value (Duplicated_Property_Value, Instantiate_Property_Value (Instance_Root, Expanded_Single_Value (Property_Value), Instance)); Set_Expanded_Single_Value (Duplicated_Property_Value, Single_Value (Duplicated_Property_Value)); end if; if Multi_Value (Property_Value) /= No_List then -- We set the value calculated at analysis time Set_Multi_Value (Duplicated_Property_Value, New_List (K_List_Id, Loc (Node_Id (Multi_Value (Property_Value))))); Set_Expanded_Multi_Value (Duplicated_Property_Value, Multi_Value (Duplicated_Property_Value)); List_Node := First_Node (Expanded_Multi_Value (Property_Value)); while Present (List_Node) loop Append_Node_To_List (Instantiate_Property_Value (Instance_Root, List_Node, Instance), Multi_Value (Duplicated_Property_Value)); List_Node := Next_Node (List_Node); end loop; end if; end if; else -- We first duplicate the values of the former property -- association. Duplicated_Property_Value := New_Node (K_Property_Value, Loc (Property_Value)); Set_Multi_Value (Duplicated_Property_Value, New_List (K_List_Id, Loc (Node_Id (Multi_Value (Property_Value))))); Set_Expanded_Multi_Value (Duplicated_Property_Value, Multi_Value (Duplicated_Property_Value)); List_Node := First_Node (Multi_Value (Former_Property_Instance_Value)); while Present (List_Node) loop Append_Node_To_List (Instantiate_Property_Value (Instance_Root, List_Node, Instance), Multi_Value (Duplicated_Property_Value)); List_Node := Next_Node (List_Node); end loop; -- Then, we append the new values if Present (Single_Value (Property_Value)) then Append_Node_To_List (Instantiate_Property_Value (Instance_Root, Single_Value (Property_Value), Instance), Multi_Value (Duplicated_Property_Value)); elsif Multi_Value (Property_Value) /= No_List then List_Node := First_Node (Multi_Value (Property_Value)); while Present (List_Node) loop Append_Node_To_List (Instantiate_Property_Value (Instance_Root, List_Node, Instance), Multi_Value (Duplicated_Property_Value)); List_Node := Next_Node (List_Node); end loop; end if; end if; Set_Value_Container (Duplicated_Property_Value, Instance); -- The container of the property is the instance in which it is -- declared. This way, we know in what context we have to -- evaluate its value. return Duplicated_Property_Value; end Duplicate_Property_Value; -------------------------------- -- Instantiate_Property_Value -- -------------------------------- function Instantiate_Property_Value (Instance_Root : Node_Id; Property_Value : Node_Id; Instance : Node_Id) return Node_Id is pragma Assert (No (Property_Value) or else Kind (Property_Value) = K_Literal or else Kind (Property_Value) = K_Property_Term or else Kind (Property_Value) = K_Number_Range_Term or else Kind (Property_Value) = K_Reference_Term or else Kind (Property_Value) = K_Minus_Numeric_Term or else Kind (Property_Value) = K_Signed_AADLNumber 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_Component_Classifier_Term); pragma Assert (Present (Instance)); Instantiated_Value : Node_Id := No_Node; begin case Kind (Property_Value) is when K_Literal => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Value (Instantiated_Value, Value (Property_Value)); when K_Property_Term => Instantiated_Value := Instantiate_Property_Value (Instance_Root, Find_Instance (Instance_Root, Instance_Root, Path (Property_Value)), Instance_Root); when K_Number_Range_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Lower_Bound (Instantiated_Value, Lower_Bound (Property_Value)); Set_Upper_Bound (Instantiated_Value, Upper_Bound (Property_Value)); Set_Delta_Term (Instantiated_Value, Delta_Term (Property_Value)); when K_Reference_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Path (Instantiated_Value, Path (Property_Value)); Set_Identifier (Instantiated_Value, Duplicate_Identifier (Identifier (Property_Value))); when K_Minus_Numeric_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Numeric_Term (Instantiated_Value, Numeric_Term (Property_Value)); when K_Signed_AADLNumber => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Number_Value (Instantiated_Value, Number_Value (Property_Value)); Set_Unit_Identifier (Instantiated_Value, Unit_Identifier (Property_Value)); when K_And_Boolean_Term | K_Or_Boolean_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_First_Term (Instantiated_Value, Instantiate_Property_Value (Instance_Root, First_Term (Property_Value), Instance)); Set_Second_Term (Instantiated_Value, Instantiate_Property_Value (Instance_Root, Second_Term (Property_Value), Instance)); when K_Not_Boolean_Term | K_Parenthesis_Boolean_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Boolean_Term (Instantiated_Value, Instantiate_Property_Value (Instance_Root, Boolean_Term (Property_Value), Instance)); when K_Component_Classifier_Term => Instantiated_Value := New_Node (Kind (Property_Value), Loc (Property_Value)); Set_Referenced_Entity (Instantiated_Value, Get_Referenced_Entity (Property_Value)); Set_Component_Cat (Instantiated_Value, Component_Cat (Property_Value)); when others => raise Program_Error; end case; return Instantiated_Value; end Instantiate_Property_Value; --------------------------- -- Expand_Reference_Term -- --------------------------- function Expand_Reference_Term (Instance_Root : Node_Id; Reference_Instance : Node_Id; Reference_Term : Node_Id) return Node_Id is pragma Assert (Kind (Instance_Root) = K_Architecture_Instance); pragma Assert (Present (Reference_Instance)); pragma Assert (Kind (Reference_Instance) = K_Component_Instance or else Kind (Reference_Instance) = K_Subcomponent_Instance); List_Node : Node_Id; Identifier_Of_Instance : Node_Id; Pointed_Instance : Node_Id; New_Reference_Term : constant Node_Id := New_Node (K_Reference_Term, Loc (Reference_Term)); Initial_Path : constant List_Id := Path (Reference_Term); begin -- The expansion of a reference path returns a path that leads -- to the component instance, while the reference path itself -- was likely to point to a subcomponent or a subprogram, -- etc. which was associated to a component declaration. if Initial_Path = No_List then Set_Path (New_Reference_Term, No_List); else if Kind (Reference_Instance) = K_Component_Instance then Pointed_Instance := Reference_Instance; else Pointed_Instance := Corresponding_Instance (Reference_Instance); end if; List_Node := First_Node (Initial_Path); while Present (List_Node) loop pragma Assert (Kind (Item (List_Node)) = K_Identifier); Pointed_Instance := Find_Local_Instance (Pointed_Instance, Item (List_Node)); if No (Pointed_Instance) then Set_Path (New_Reference_Term, No_List); exit; elsif Kind (Pointed_Instance) = K_Call_Instance then Pointed_Instance := Corresponding_Instance (Pointed_Instance); Identifier_Of_Instance := Duplicate_Identifier (Identifier (Pointed_Instance)); Add_Path_Element_To_Entity_Reference (New_Reference_Term, Identifier_Of_Instance); Pointed_Instance := Duplicate_Subprogram_Call_Instance (Instance_Root, Pointed_Instance); elsif Kind (Pointed_Instance) = K_Subcomponent_Instance then Pointed_Instance := Corresponding_Instance (Pointed_Instance); Identifier_Of_Instance := Duplicate_Identifier (Identifier (Pointed_Instance)); Add_Path_Element_To_Entity_Reference (New_Reference_Term, Identifier_Of_Instance); end if; List_Node := Next_Node (List_Node); end loop; end if; return New_Reference_Term; end Expand_Reference_Term; end Ocarina.Expander.Properties;