------------------------------------------- ------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.AADL.PRINTER.PROPERTIES.VALUES -- -- -- -- 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.AADL_Values; with Ocarina.Entities.Properties; with Ocarina.AADL.Printer.Identifiers; with Ocarina.AADL.Printer.Components; package body Ocarina.AADL.Printer.Properties.Values is use Output; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Ocarina.Entities.Properties; use Ocarina.AADL.Printer.Identifiers; use Ocarina.AADL.Printer.Components; procedure Print_And_Boolean_Term (Node : node_id); procedure Print_Not_Boolean_Term (Node : node_id); procedure Print_Parenthesis_Boolean_Term (Node : node_id); procedure Print_Boolean_Term (Node : node_id); procedure Print_Number_Range_Term (Node : node_id); procedure Print_Referable_Element_Category (Node : node_id); procedure Print_Reference_Term (Node : node_id); procedure Print_Numeric_Term (Node : node_id); procedure Print_Minus_Numeric_Term (Node : node_id); procedure Print_Signed_AADLNumber (Node : node_id); procedure Print_Unique_Property_Constant_Identifier (Node : node_id); procedure Print_Unit_Definition (Node : node_id); procedure Print_Component_Classifier_Term (Node : node_id); ------------------------------------- -- Print_Component_Classifier_Term -- ------------------------------------- procedure Print_Component_Classifier_Term (Node : node_id) is begin Print_Component_Category (Component_Cat (Node)); if Identifier (Node) /= No_Node then Write_Space; Print_Entity_Reference (Node); end if; end Print_Component_Classifier_Term; ---------------------------- -- Print_Not_Boolean_Term -- ---------------------------- procedure Print_Not_Boolean_Term (Node : node_id) is begin Print_Token (t_not); Write_Space; Print_Boolean_Term (Boolean_Term (Node)); end Print_Not_Boolean_Term; ----------------------------- -- Print_Number_Range_Term -- ----------------------------- procedure Print_Number_Range_Term (Node : node_id) is pragma assert (Kind (Node) = k_number_range_term); Delta_Term : constant node_id := Ocarina.Nodes.Delta_Term (Node); begin Print_Numeric_Term (Lower_Bound (Node)); Write_Space; Print_Token (t_interval); Write_Space; Print_Numeric_Term (Upper_Bound (Node)); if Present (Delta_Term) then Write_Space; Print_Token (t_delta); Write_Space; Print_Numeric_Term (Delta_Term); end if; end Print_Number_Range_Term; ----------------------- -- Print_Number_Type -- ----------------------- procedure Print_Number_Type (Node : node_id) is Number_Kind : constant node_kind := Kind (Node); Type_Range : constant node_id := Ocarina.Nodes.Type_Range (Node); Unit_Design : constant node_id := Unit_Designator (Node); begin if Number_Kind = k_real_type then Print_Token (t_aadlreal); else Print_Token (t_aadlinteger); end if; if Present (Type_Range) then Write_Space; Print_Range (Type_Range); end if; if Present (Unit_Design) then Write_Space; if Kind (Unit_Design) = k_units_type then Print_Units_Type (Unit_Design); else Print_Token (t_units); Write_Space; Print_Entity_Reference (Unit_Design); end if; end if; end Print_Number_Type; ------------------------ -- Print_Boolean_Term -- ------------------------ procedure Print_Boolean_Term (Node : node_id) is begin case Kind (Node) is when k_literal => Print_Literal (Node); when k_not_boolean_term => Print_Not_Boolean_Term (Node); when k_and_boolean_term => Print_And_Boolean_Term (Node); when k_or_boolean_term => Print_Or_Boolean_Term (Node); when k_parenthesis_boolean_term => Print_Parenthesis_Boolean_Term (Node); when k_property_term => Print_Unique_Property_Constant_Identifier (Node); when others => Node_Not_Handled (Node); end case; end Print_Boolean_Term; --------------------------- -- Print_Or_Boolean_Term -- --------------------------- procedure Print_Or_Boolean_Term (Node : node_id) is begin Print_Boolean_Term (First_Term (Node)); Write_Space; Print_Token (t_or); Write_Space; Print_Boolean_Term (Second_Term (Node)); end Print_Or_Boolean_Term; ------------------------------------ -- Print_Parenthesis_Boolean_Term -- ------------------------------------ procedure Print_Parenthesis_Boolean_Term (Node : node_id) is begin Print_Token (t_left_parenthesis); Print_Boolean_Term (Boolean_Term (Node)); Print_Token (t_right_parenthesis); end Print_Parenthesis_Boolean_Term; ----------------- -- Print_Range -- ----------------- procedure Print_Range (Node : node_id) is begin Print_Numeric_Term (Lower_Bound (Node)); Write_Space; Print_Token (t_interval); Write_Space; Print_Numeric_Term (Upper_Bound (Node)); end Print_Range; ---------------------- -- Print_Range_Type -- ---------------------- procedure Print_Range_Type (Node : node_id) is pragma assert (Kind (Node) = k_range_type); Number_Type : constant node_id := Nodes.Number_Type (Node); Range_Type_Kind : constant node_kind := Kind (Number_Type); begin Print_Tokens ((t_range, t_of)); Write_Space; if Range_Type_Kind = k_integer_type or else Range_Type_Kind = k_real_type then Print_Number_Type (Number_Type); else Print_Entity_Reference (Number_Type); end if; end Print_Range_Type; -------------------------------------- -- Print_Referable_Element_Category -- -------------------------------------- procedure Print_Referable_Element_Category (Node : node_id) is begin case referable_element_category'val (Category (Node)) is when rec_component_category => Print_Component_Category (Component_Cat (Node)); when rec_connections => Print_Token (t_connections); when rec_server_subprogram => Print_Tokens ((t_server, t_subprogram)); end case; end Print_Referable_Element_Category; -------------------------- -- Print_Reference_Term -- -------------------------- procedure Print_Reference_Term (Node : node_id) is begin Print_Token (t_reference); Write_Space; Print_Entity_Reference (Node); end Print_Reference_Term; -------------------------- -- Print_Reference_Type -- -------------------------- procedure Print_Reference_Type (L : list_id) is List_Node : node_id; begin Print_Token (t_reference); if not Is_Empty (L) then Write_Space; Print_Token (t_left_parenthesis); Write_Eol; if not Is_Empty (L) then List_Node := First_Node (L); while Present (List_Node) loop if List_Node /= First_Node (L) then Print_Token (t_comma); Write_Space; end if; case Kind (List_Node) is when k_referable_element_category => Print_Referable_Element_Category (List_Node); when others => Node_Not_Handled (List_Node); end case; List_Node := Next_Node (List_Node); end loop; end if; Print_Token (t_right_parenthesis); end if; end Print_Reference_Type; ------------------------ -- Print_Numeric_Term -- ------------------------ procedure Print_Numeric_Term (Node : node_id) is pragma assert (Kind (Node) = k_minus_numeric_term or else Kind (Node) = k_signed_aadlnumber or else Kind (Node) = k_property_term or else Kind (Node) = k_entity_reference); begin case Kind (Node) is when k_minus_numeric_term => Print_Minus_Numeric_Term (Node); when k_signed_aadlnumber => Print_Signed_AADLNumber (Node); when k_property_term | k_entity_reference => Print_Unique_Property_Constant_Identifier (Node); when others => raise Program_Error; end case; end Print_Numeric_Term; ------------------------------ -- Print_Minus_Numeric_Term -- ------------------------------ procedure Print_Minus_Numeric_Term (Node : node_id) is pragma assert (Kind (Node) = k_minus_numeric_term); begin Print_Token (t_minus); Print_Numeric_Term (Numeric_Term (Node)); end Print_Minus_Numeric_Term; ----------------------------- -- Print_Signed_AADLNumber -- ----------------------------- procedure Print_Signed_AADLNumber (Node : node_id) is pragma assert (Kind (Node) = k_signed_aadlnumber); Value : constant node_id := Number_Value (Node); Unit : constant node_id := Unit_Identifier (Node); begin if Kind (Value) = k_literal then -- Node is a Signed_AADLReal or a Signed_AADLInteger Print_Literal (Value); if Present (Unit) then Write_Space; Print_Identifier (Unit); end if; else Print_Unique_Property_Constant_Identifier (Value); end if; end Print_Signed_AADLNumber; -------------------------- -- Print_Property_Value -- -------------------------- procedure Print_Property_Value (Node : node_id) is begin case Kind (Node) is when k_identifier => Print_Identifier (Node); when k_signed_aadlnumber | k_minus_numeric_term => Print_Numeric_Term (Node); when k_literal => Print_Literal (Node); when k_number_range_term => Print_Number_Range_Term (Node); when k_not_boolean_term | k_and_boolean_term | k_or_boolean_term | k_parenthesis_boolean_term => Print_Boolean_Term (Node); when k_unique_property_const_identifier | k_property_term => Print_Unique_Property_Constant_Identifier (Node); when k_reference_term => Print_Reference_Term (Node); when k_component_classifier_term => Print_Component_Classifier_Term (Node); when others => Node_Not_Handled (Node); end case; end Print_Property_Value; ------------------------------------ -- Print_Property_Type_Designator -- ------------------------------------ procedure Print_Property_Type_Designator (Node : node_id) is pragma assert (Kind (Node) = k_unique_property_type_identifier or else Kind (Node) = k_string_type or else Kind (Node) = k_boolean_type or else Kind (Node) = k_real_type or else Kind (Node) = k_integer_type or else Kind (Node) = k_range_type or else Kind (Node) = k_enumeration_type or else Kind (Node) = k_reference_type or else Kind (Node) = k_classifier_type or else Kind (Node) = k_units_type); begin case Kind (Node) is when k_unique_property_type_identifier => Print_Entity_Reference (Node); when k_string_type => Print_Token (t_aadlstring); when k_boolean_type => Print_Token (t_aadlboolean); when k_real_type | k_integer_type => Print_Number_Type (Node); when k_range_type => Print_Range_Type (Node); when k_enumeration_type => Print_Enumeration_Type (Node); when k_reference_type => Print_Reference_Type (list_id (Node)); when k_classifier_type => Print_Classifier_Type (list_id (Node)); when k_units_type => Print_Units_Type (Node); when others => Node_Not_Handled (Node); end case; end Print_Property_Type_Designator; ----------------------------------------------- -- Print_Unique_Property_Constant_Identifier -- ----------------------------------------------- procedure Print_Unique_Property_Constant_Identifier (Node : node_id) is pragma assert (Kind (Node) = k_unique_property_const_identifier or else Kind (Node) = k_property_term or else Kind (Node) = k_entity_reference); begin Print_Tokens ((t_value, t_left_parenthesis)); case Kind (Node) is when k_entity_reference | k_unique_property_type_identifier | k_property_term | k_unique_property_const_identifier => Print_Entity_Reference (Node); when k_real_type | k_integer_type => Print_Number_Type (Node); when others => Node_Not_Handled (Node); end case; Print_Token (t_right_parenthesis); end Print_Unique_Property_Constant_Identifier; --------------------------- -- Print_Unit_Definition -- --------------------------- procedure Print_Unit_Definition (Node : node_id) is pragma assert (Kind (Node) = k_unit_definition); begin Print_Identifier (Identifier (Node)); Write_Space; Print_Token (t_association); Write_Space; Print_Identifier (Unit_Identifier (Node)); Write_Space; Print_Token (t_multiply); Write_Space; Print_Literal (Numeric_Literal (Node)); end Print_Unit_Definition; ---------------------- -- Print_Units_Type -- ---------------------- procedure Print_Units_Type (Node : node_id) is Definitions : constant list_id := Unit_Definitions (Node); List_Node : node_id; begin Print_Tokens ((t_units, t_left_parenthesis)); if No (Definitions) then Print_Identifier (Base_Identifier (Node)); Print_Token (t_right_parenthesis); else Write_Eol; Increment_Indentation; Write_Indentation; Decrement_Indentation; Print_Identifier (Base_Identifier (Node)); Print_Token (t_comma); Write_Eol; if not Is_Empty (Definitions) then List_Node := First_Node (Definitions); while Present (List_Node) loop if List_Node /= First_Node (Definitions) then Print_Token (t_comma); Write_Space; end if; case Kind (List_Node) is when k_unit_definition => Print_Unit_Definition (List_Node); when others => Node_Not_Handled (List_Node); end case; List_Node := Next_Node (List_Node); end loop; end if; Print_Token (t_right_parenthesis); end if; end Print_Units_Type; ---------------------------- -- Print_And_Boolean_Term -- ---------------------------- procedure Print_And_Boolean_Term (Node : node_id) is begin Print_Boolean_Term (First_Term (Node)); Write_Space; Print_Token (t_and); Write_Space; Print_Boolean_Term (Second_Term (Node)); end Print_And_Boolean_Term; ------------------- -- Print_Literal -- ------------------- procedure Print_Literal (Node : node_id) is pragma assert (Kind (Node) = k_literal); begin Write_Str (Ocarina.AADL_Values.Image (Value (Node))); end Print_Literal; --------------------------- -- Print_Classifier_Type -- --------------------------- procedure Print_Classifier_Type (L : list_id) is List_Node : node_id; begin Print_Token (t_classifier); if not Is_Empty (L) then Write_Space; Print_Token (t_left_parenthesis); Write_Eol; if not Is_Empty (L) then List_Node := First_Node (L); while Present (List_Node) loop if List_Node /= First_Node (L) then Print_Token (t_comma); Write_Space; end if; case Kind (List_Node) is when k_component_category => Print_Component_Category (Category (List_Node)); when others => Node_Not_Handled (List_Node); end case; List_Node := Next_Node (List_Node); end loop; end if; Print_Token (t_right_parenthesis); end if; end Print_Classifier_Type; ---------------------------- -- Print_Enumeration_Type -- ---------------------------- procedure Print_Enumeration_Type (Node : node_id) is List_Node : node_id; begin Print_Tokens ((t_enumeration, t_left_parenthesis)); if not Is_Empty (Ocarina.Nodes.Identifiers (Node)) then List_Node := First_Node (Ocarina.Nodes.Identifiers (Node)); while Present (List_Node) loop if List_Node /= First_Node (Ocarina.Nodes.Identifiers (Node)) then Print_Token (t_comma); Write_Space; end if; case Kind (List_Node) is when k_identifier => Print_Identifier (List_Node); when others => Node_Not_Handled (Node); end case; List_Node := Next_Node (List_Node); end loop; end if; Print_Token (t_right_parenthesis); end Print_Enumeration_Type; end Ocarina.AADL.Printer.Properties.Values;