------------------------------------------ -------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P R I N T E R . N A M E S P A C E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-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 Namet; with Output; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Entities; with Ocarina.Parser; with Ocarina.AADL.Printer.Components; with Ocarina.AADL.Printer.Properties; with Ocarina.AADL.Printer.Identifiers; package body Ocarina.AADL.Printer.Namespaces is use Namet; use Output; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; use Ocarina.Parser; use Ocarina.AADL.Printer.Components; use Ocarina.AADL.Printer.Properties; use Ocarina.AADL.Printer.Identifiers; ------------------------------------ -- Print_Constrained_Property_Set -- ------------------------------------ procedure Print_Constrained_Property_Set (Node : Node_Id; Criterion : Node_Id; Options : Output_Options) is Ident : constant Node_Id := Identifier (Node); List_Node : Node_Id; Someting_To_Print : Boolean := False; begin -- First of all see whether the constraint let us some -- declarations to print. if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop Someting_To_Print := Is_Printable (List_Node, Criterion) or else Someting_To_Print; exit when Someting_To_Print; List_Node := Next_Node (List_Node); end loop; end if; if not Someting_To_Print then return; end if; -- We do not print standard property sets (AADL Properties and -- AADL Project) unless: -- 1 - The user requested it explicitly (via the -- Print_Standard_Property_Sets flag) -- OR -- 2 - The user gave his own custom standard property sets. if not Options.Print_Standard_Property_Sets then -- Standard property sets for S in Standard_Property_Sets loop if Default (S) and then Get_Name_String (Get_Name_Of_Entity (Node, False)) = Image (S) then return; end if; end loop; -- Ocarina property sets for O in Ocarina_Property_Sets loop if Default (O) and then Get_Name_String (Get_Name_Of_Entity (Node, False)) = Image (O) then return; end if; end loop; end if; Print_Tokens ((T_Property, T_Set)); Write_Space; Print_Identifier (Ident); Write_Space; Print_Token (T_Is); Write_Eol; if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); Increment_Indentation; while Present (List_Node) loop if Is_Printable (List_Node, Criterion) then case Kind (List_Node) is when K_Property_Name_Declaration => Print_Property_Name_Declaration (List_Node, Options); when K_Property_Type_Declaration => Print_Property_Type_Declaration (List_Node, Options); when K_Constant_Property_Declaration => Print_Constant_Property (List_Node, Options); when others => Node_Not_Handled (List_Node); end case; end if; List_Node := Next_Node (List_Node); end loop; Decrement_Indentation; end if; Write_Indentation; Print_Token (T_End); Write_Space; Print_Identifier (Ident); Print_Token (T_Semicolon); Write_Eol; end Print_Constrained_Property_Set; ------------------------ -- Print_Property_Set -- ------------------------ procedure Print_Property_Set (Node : Node_Id; Options : Output_Options) is procedure Internal_Print_Property_Set is new Print_Constrained_Property_Set ( Always_Printable); begin Internal_Print_Property_Set (Node, No_Node, Options); end Print_Property_Set; ------------------------------- -- Print_Constrained_Package -- ------------------------------- procedure Print_Constrained_Package (Node : Node_Id; Criterion : Node_Id; Options : Output_Options) is pragma Assert (Kind (Node) = K_Package_Specification); Pack_Identifier : constant Node_Id := Identifier (Node); List_Node : Node_Id; Someting_To_Print : Boolean := False; Has_Public : Boolean := False; Has_Private : Boolean := False; begin -- First of all see whether the constraint let us some -- declarations to print. if Has_Public_Part (Node) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop Someting_To_Print := Is_Printable (List_Node, Criterion) or else Someting_To_Print; Has_Public := Has_Public or else not Is_Private (List_Node); Has_Private := Has_Private or else Is_Private (List_Node); List_Node := Next_Node (List_Node); end loop; end if; if not Someting_To_Print then return; end if; Increment_Indentation; Print_Token (T_Package); Write_Space; Print_Identifier (Pack_Identifier); Write_Eol; -- Public part if Has_Public then Print_Token (T_Public); Write_Eol; List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop if not Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then case Kind (List_Node) is when K_Component_Type => Print_Component_Type (List_Node, Options); when K_Component_Implementation => Print_Component_Implementation (List_Node, Options); when K_Port_Group_Type => Print_Port_Group_Type (List_Node, Options); when others => raise Program_Error; end case; end if; Write_Eol; List_Node := Next_Node (List_Node); end loop; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then declare Number_Of_Properties : Integer := 0; begin List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop if not Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then Number_Of_Properties := Number_Of_Properties + 1; end if; List_Node := Next_Node (List_Node); end loop; if Number_Of_Properties > 0 then Print_Token (T_Properties); Write_Eol; end if; end; List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop if not Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then Print_Property_Association (List_Node, Options); end if; List_Node := Next_Node (List_Node); end loop; end if; end if; -- private part if Has_Private then Print_Token (T_Private); Write_Eol; List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop if Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then case Kind (List_Node) is when K_Component_Type => Print_Component_Type (List_Node, Options); when K_Component_Implementation => Print_Component_Implementation (List_Node, Options); when K_Port_Group_Type => Print_Port_Group_Type (List_Node, Options); when others => raise Program_Error; end case; end if; Write_Eol; List_Node := Next_Node (List_Node); end loop; if not Is_Empty (Ocarina.Nodes.Properties (Node)) then declare Number_Of_Properties : Integer := 0; begin List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop if Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then Number_Of_Properties := Number_Of_Properties + 1; end if; List_Node := Next_Node (List_Node); end loop; if Number_Of_Properties > 0 then Print_Token (T_Properties); Write_Eol; end if; end; List_Node := First_Node (Ocarina.Nodes.Properties (Node)); while Present (List_Node) loop if Is_Private (List_Node) and then Is_Printable (List_Node, Criterion) then Print_Property_Association (List_Node, Options); end if; List_Node := Next_Node (List_Node); end loop; end if; end if; Print_Token (T_End); Write_Space; Print_Identifier (Pack_Identifier); Print_Token (T_Semicolon); Write_Eol; Decrement_Indentation; end Print_Constrained_Package; ------------------- -- Print_Package -- ------------------- procedure Print_Package (Node : Node_Id; Options : Output_Options) is procedure Internal_Print_Package is new Print_Constrained_Package ( Always_Printable); begin Internal_Print_Package (Node, No_Node, Options); end Print_Package; ------------------------------------------ -- Print_Constrained_AADL_Specification -- ------------------------------------------ procedure Print_Constrained_AADL_Specification (Node : Node_Id; Criterion : Node_Id; Options : Output_Options) is pragma Assert (Kind (Node) = K_AADL_Specification); -- Some internal procedures procedure Internal_Print_Package is new Print_Constrained_Package ( Is_Printable); procedure Internal_Print_Property_Set is new Print_Constrained_Property_Set ( Is_Printable); List_Node : Node_Id; begin if not Is_Empty (Declarations (Node)) then List_Node := First_Node (Declarations (Node)); while Present (List_Node) loop case Kind (List_Node) is when K_Component_Type => if Is_Printable (List_Node, Criterion) then Print_Component_Type (List_Node, Options); end if; when K_Component_Implementation => if Is_Printable (List_Node, Criterion) then Print_Component_Implementation (List_Node, Options); end if; when K_Port_Group_Type => if Is_Printable (List_Node, Criterion) then Print_Port_Group_Type (List_Node, Options); end if; when K_Package_Specification => Internal_Print_Package (List_Node, Criterion, Options); when K_Property_Set => Internal_Print_Property_Set (List_Node, Criterion, Options); when others => raise Program_Error; end case; Write_Eol; List_Node := Next_Node (List_Node); end loop; end if; end Print_Constrained_AADL_Specification; ------------------------------ -- Print_AADL_Specification -- ------------------------------ procedure Print_AADL_Specification (Node : Node_Id; Options : Output_Options) is procedure Internal_Print_AADL_Specification is new Print_Constrained_AADL_Specification ( Always_Printable); begin Internal_Print_AADL_Specification (Node, No_Node, Options); end Print_AADL_Specification; end Ocarina.AADL.Printer.Namespaces;