------------------------------------ -------------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P R I N T 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 Output; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Entities.Properties; with Ocarina.Entities.Messages; with Ocarina.AADL.Printer.Identifiers; with Ocarina.AADL.Printer.Components; with Ocarina.AADL.Printer.Components.Modes; with Ocarina.AADL.Printer.Properties.Values; package body Ocarina.AADL.Printer.Properties is use Output; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities.Properties; use Ocarina.Entities.Messages; use Ocarina.AADL.Printer.Identifiers; use Ocarina.AADL.Printer.Components; use Ocarina.AADL.Printer.Components.Modes; use Ocarina.AADL.Printer.Properties.Values; procedure Print_Applies_To (Node : node_id); procedure Print_Property_Owner_Category (Node : node_id); procedure Print_Property_Values (Prop_Value : node_id; Options : output_options); ---------------------- -- Print_Applies_To -- ---------------------- procedure Print_Applies_To (Node : node_id) is List_Node : node_id; begin Write_Eol; Increment_Indentation; Write_Indentation; Print_Tokens ((t_applies, t_to, t_left_parenthesis)); if Is_All (Node) then Write_Space; Print_Token (t_all); else if not Is_Empty (Owner_Categories (Node)) then List_Node := First_Node (Owner_Categories (Node)); while Present (List_Node) loop if List_Node /= First_Node (Owner_Categories (Node)) then Print_Token (t_comma); Write_Space; end if; Print_Property_Owner_Category (List_Node); List_Node := Next_Node (List_Node); end loop; end if; end if; Print_Token (t_right_parenthesis); Decrement_Indentation; end Print_Applies_To; ------------------------------------------- -- Print_Contained_Property_Associations -- ------------------------------------------- procedure Print_Contained_Property_Associations (List : list_id; Options : output_options) is List_Node : node_id; begin if not Is_Empty (List) then Write_Eol; Increment_Indentation; List_Node := First_Node (List); while Present (List_Node) loop Write_Indentation; if List_Node = First_Node (List) then Print_Token (t_left_curly_bracket); else Write_Space; end if; Print_Property_Association (List_Node, Options, Contained => True); if List_Node = Last_Node (List) then Print_Token (t_right_curly_bracket); else Write_Eol; end if; List_Node := Next_Node (List_Node); end loop; Decrement_Indentation; end if; end Print_Contained_Property_Associations; -------------------------------- -- Print_Property_Association -- -------------------------------- procedure Print_Property_Association (Node : node_id; Options : output_options; Contained : Boolean := False) is Prop_Value : constant node_id := Property_Association_Value (Node); Applies_To : constant list_id := Applies_To_Prop (Node); Bindings : constant node_id := In_Binding (Node); Modes : constant node_id := In_Modes (Node); List_Node : node_id; begin if not Contained then Write_Indentation; end if; Print_Identifier (Identifier (Node)); Write_Space; if Is_Additive_Association (Node) then Print_Token (t_additive_association); else Print_Token (t_association); end if; Write_Space; if Is_Constant (Node) then Print_Token (t_constant); Write_Space; end if; if Is_Access (Node) then Print_Token (t_access); Write_Space; end if; -- The value associated with the property Print_Property_Values (Prop_Value, Options); -- applies to if not Is_Empty (Applies_To) then Write_Eol; Increment_Indentation; Write_Indentation; Print_Tokens ((t_applies, t_to)); Write_Space; List_Node := First_Node (Applies_To); while Present (List_Node) loop Print_Identifier (List_Node); exit when No (Next_Node (List_Node)); Print_Token (t_dot); List_Node := Next_Node (List_Node); end loop; Decrement_Indentation; end if; -- in bindings if Present (Bindings) then Write_Eol; Increment_Indentation; Write_Indentation; Print_Tokens ((t_in, t_binding, t_left_parenthesis)); List_Node := First_Node (Binding (Bindings)); while Present (List_Node) loop Write_Indentation; Print_Entity_Reference (List_Node); exit when No (Next_Node (List_Node)); Print_Token (t_comma); Write_Space; List_Node := Next_Node (List_Node); end loop; Print_Token (t_right_parenthesis); Decrement_Indentation; end if; -- in modes Print_In_Modes (Modes, Options); Print_Token (t_semicolon); if not Contained then Write_Eol; end if; end Print_Property_Association; ------------------------------------- -- Print_Property_Name_Declaration -- ------------------------------------- procedure Print_Property_Name_Declaration (Node : node_id; Options : output_options) is pragma assert (Kind (Node) = k_property_name_declaration); begin Write_Indentation; Print_Identifier (Identifier (Node)); Write_Space; Print_Token (t_colon); Write_Space; if Is_Access (Node) then Print_Token (t_access); Write_Space; end if; if Is_Inherit (Node) then Print_Token (t_inherit); Write_Space; end if; if Is_List (Property_Name_Type (Node)) then Print_Tokens ((t_list, t_of)); Write_Space; end if; if Options.Print_Evaluated_Property_Values then Print_Property_Type_Designator (Expanded_Type_Designator (Property_Name_Type (Node))); else Print_Property_Type_Designator (Property_Type_Designator (Property_Name_Type (Node))); end if; if Default_Value (Node) /= No_Node then Write_Space; Print_Token (t_association); Write_Space; Print_Property_Values (Default_Value (Node), Options); end if; Print_Applies_To (Applies_To (Node)); Print_Token (t_semicolon); Write_Eol; Write_Eol; end Print_Property_Name_Declaration; ----------------------------------- -- Print_Property_Owner_Category -- ----------------------------------- procedure Print_Property_Owner_Category (Node : node_id) is Class_Ref : constant node_id := Classifier_Ref (Node); begin case property_owner_category'val (Category (Node)) is when poc_mode => Print_Token (t_mode); when poc_port_group => Print_Tokens ((t_port, t_group)); when poc_flow => Print_Token (t_flow); when poc_port => Print_Token (t_port); when poc_event_port => Print_Tokens ((t_event, t_port)); when poc_data_port => Print_Tokens ((t_data, t_port)); when poc_event_data_port => Print_Tokens ((t_event, t_data, t_port)); when poc_server_subprogram => Print_Tokens ((t_server, t_subprogram)); when poc_parameter => Print_Token (t_parameter); when poc_connections => Print_Token (t_connections); when poc_port_group_connections => Print_Tokens ((t_port, t_group, t_connections)); when poc_port_connections => Print_Tokens ((t_port, t_connections)); when poc_event_port_connections => Print_Tokens ((t_event, t_port, t_connections)); when poc_data_port_connections => Print_Tokens ((t_data, t_port, t_connections)); when poc_event_data_port_connections => Print_Tokens ((t_event, t_data, t_port, t_connections)); when poc_access_connections => Print_Tokens ((t_access, t_connections)); when poc_parameter_connections => Print_Tokens ((t_parameter, t_connections)); when poc_component_category => Print_Component_Category (Component_Cat (Node)); if Present (Class_Ref) then Write_Space; Print_Entity_Reference (Class_Ref); end if; end case; end Print_Property_Owner_Category; ------------------------------------- -- Print_Property_Type_Declaration -- ------------------------------------- procedure Print_Property_Type_Declaration (Node : node_id; Options : output_options) is pragma unreferenced (Options); begin Write_Indentation; Print_Identifier (Identifier (Node)); Write_Space; Print_Tokens ((t_colon, t_type)); Write_Space; Print_Property_Type_Designator (Property_Type_Designator (Node)); Print_Token (t_semicolon); Write_Eol; Write_Eol; end Print_Property_Type_Declaration; --------------------------- -- Print_Property_Values -- --------------------------- procedure Print_Property_Values (Prop_Value : node_id; Options : output_options) is pragma assert (Present (Prop_Value) and then (Kind (Prop_Value) = k_property_value or else DNKE (Prop_Value))); List_Node : node_id; begin if Options.Print_Evaluated_Property_Values and then (Expanded_Multi_Value (Prop_Value) /= No_List or else Expanded_Single_Value (Prop_Value) /= No_Node) then -- We only display the evaluated properties if the -- evaluation lead to an actual value if Expanded_Single_Value (Prop_Value) = No_Node then Print_Token (t_left_parenthesis); List_Node := First_Node (Expanded_Multi_Value (Prop_Value)); while Present (List_Node) loop if List_Node /= First_Node (Expanded_Multi_Value (Prop_Value)) then Print_Token (t_comma); Write_Space; end if; Print_Property_Value (List_Node); List_Node := Next_Node (List_Node); end loop; Print_Token (t_right_parenthesis); else Print_Property_Value (Expanded_Single_Value (Prop_Value)); end if; else if Single_Value (Prop_Value) = No_Node then -- Print Property_List_Value with new line and indents Print_Token (t_left_parenthesis); List_Node := First_Node (Multi_Value (Prop_Value)); while Present (List_Node) loop if List_Node /= First_Node (Multi_Value (Prop_Value)) then Print_Token (t_comma); Write_Space; end if; Print_Property_Value (List_Node); List_Node := Next_Node (List_Node); end loop; Print_Token (t_right_parenthesis); else -- Print Property_Expression without new line Print_Property_Value (Single_Value (Prop_Value)); end if; end if; end Print_Property_Values; ----------------------------- -- Print_Constant_Property -- ----------------------------- procedure Print_Constant_Property (Node : node_id; Options : output_options) is pragma unreferenced (Options); -- Constant_Type is -- AADLInteger_Type -- or AADLReal_Type -- or AADLString_Type -- or AADLBoolean_Type -- or Identifier_Identifier -- (see ocarina-nodes.idl for more details) Unit_Ident : constant node_id := Unique_Unit_Identifier (Node); -- Only used when Const_Type is AADLInteger_Type or -- AADLReal_Type. List_Node : node_id; begin Write_Indentation; Print_Identifier (Identifier (Node)); Write_Space; Print_Tokens ((t_colon, t_constant)); Write_Space; if Single_Value (Constant_Value (Node)) = No_Node then Print_Tokens ((t_list, t_of)); Write_Space; end if; case Kind (Constant_Type (Node)) is when k_integer_type => Print_Token (t_aadlinteger); when k_real_type => Print_Token (t_aadlreal); when k_boolean_type => Print_Token (t_aadlboolean); when k_string_type => Print_Token (t_aadlstring); when k_unique_property_type_identifier => Print_Entity_Reference (Constant_Type (Node)); when others => Node_Not_Handled (Constant_Type (Node)); end case; Write_Space; -- try to print unit identifier if Present (Unit_Ident) then Print_Entity_Reference (Unit_Ident); Write_Space; end if; Print_Token (t_association); Write_Space; if Single_Value (Constant_Value (Node)) /= No_Node then Print_Property_Value (Single_Value (Constant_Value (Node))); else Print_Token (t_left_parenthesis); if Multi_Value (Constant_Value (Node)) /= No_List then List_Node := First_Node (Multi_Value (Constant_Value (Node))); while List_Node /= No_Node loop Print_Property_Value (List_Node); List_Node := Next_Node (List_Node); if List_Node /= No_Node then Print_Token (t_comma); Write_Space; end if; end loop; end if; Print_Token (t_right_parenthesis); end if; Print_Token (t_semicolon); Write_Eol; end Print_Constant_Property; end Ocarina.AADL.Printer.Properties;