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