----------------------------------------------- --------------------------------- -- -- -- 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;