------------------------------------------------- ------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P R I N T E R -- -- -- -- 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 Utils; with Ocarina.Debug; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Expander; with Ocarina.Analyzer.Queries; with Ocarina.Entities.Components; with Ocarina.AADL.Printer.Namespaces; with Ocarina.AADL.Printer.Components; with Ocarina.AADL.Printer.Identifiers; package body Ocarina.AADL.Printer is use Namet; use Output; use Utils; use Ocarina.Debug; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Expander; use Ocarina.Analyzer.Queries; use Ocarina.Entities.Components; use Ocarina.AADL.Printer.Namespaces; use Ocarina.AADL.Printer.Components; use Ocarina.AADL.Printer.Identifiers; ---------- -- Init -- ---------- procedure Init is begin Register_Printer ("aadl", Print_Subtree'Access); Register_Printer ("aadl_min", Print_Minimal_Node_Trees'Access); end Init; --------------------------- -- Print_Item_Refined_To -- --------------------------- procedure Print_Item_Refined_To (Node : Node_Id) is begin Print_Identifier (Identifier (Node)); Write_Space; Print_Token (T_Colon); if Is_Refinement (Node) then Write_Space; Print_Tokens ((T_Refined, T_To)); end if; end Print_Item_Refined_To; ------------------------------- -- Print_Constrained_Subtree -- ------------------------------- procedure Print_Constrained_Subtree (Node : Node_Id; Criterion : Node_Id := No_Node; Options : Output_Options := Default_Output_Options) is pragma Assert (Present (Node)); -- Some internal procedures procedure Internal_Print_AADL_Specification is new Print_Constrained_AADL_Specification ( Is_Printable); procedure Internal_Print_Package is new Print_Constrained_Package ( Is_Printable); procedure Internal_Print_Property_Set is new Print_Constrained_Property_Set ( Is_Printable); begin Set_Output (Create_Output_File (Options)); case Kind (Node) is when K_AADL_Specification => Internal_Print_AADL_Specification (Node, Criterion, Options); when K_Package_Specification => Internal_Print_Package (Node, Criterion, Options); when K_Component_Type => if Is_Printable (Node, Criterion) then Print_Component_Type (Node, Options); end if; when K_Component_Implementation => if Is_Printable (Node, Criterion) then Print_Component_Implementation (Node, Options); end if; when K_Port_Group_Type => if Is_Printable (Node, Criterion) then Print_Port_Group_Type (Node, Options); end if; when K_Property_Set => Internal_Print_Property_Set (Node, Criterion, Options); when others => Node_Not_Handled (Node); -- This case should not happen end case; Set_Standard_Output; end Print_Constrained_Subtree; ---------------- -- Print_Node -- ---------------- procedure Print_Subtree (Node : Node_Id; Options : Output_Options := Default_Output_Options) is pragma Assert (Present (Node)); procedure Internal_Print_Subtree is new Print_Constrained_Subtree ( Always_Printable); begin -- This simply a particular case of Print_Constrained_Subtree Internal_Print_Subtree (Node, No_Node, Options); end Print_Subtree; -------------------------- -- Print_None_Statement -- -------------------------- procedure Print_None_Statement is begin Write_Indentation; Print_Token (T_None); Print_Token (T_Semicolon); end Print_None_Statement; ----------------- -- Print_Token -- ----------------- procedure Print_Token (Token : AADL.Tokens.Token_Type) is begin Write_Str (Image (Token)); end Print_Token; ------------------ -- Print_Tokens -- ------------------ procedure Print_Tokens (Tokens : AADL.Tokens.Token_List_Type) is begin for Index in Tokens'Range loop Print_Token (Tokens (Index)); if Index < Tokens'Last then Write_Space; end if; end loop; end Print_Tokens; ---------------------- -- Node_Not_Handled -- ---------------------- procedure Node_Not_Handled (Node : Node_Id) is pragma Assert (Node /= No_Node); begin W_Str ("*** This node is not handled by the AADL printer: "); W_Node_Header (Node); raise Program_Error; end Node_Not_Handled; ---------------------- -- Always_Printable -- ---------------------- function Always_Printable (Node : Node_Id; Criterion : Node_Id) return Boolean is pragma Unreferenced (Node, Criterion); begin return True; end Always_Printable; ------------------------------ -- Print_Minimal_Node_Trees -- ------------------------------ procedure Print_Minimal_Node_Trees (Node : Node_Id; Options : Output_Options := Default_Output_Options) is procedure Internal_Print_Minimal_Tree is new Print_Constrained_Subtree ( Needed_By); -- This procedure prints for the AADL source corresponding to -- components or properties that are needed by its given -- criterion. Expanded_Root : constant Node_Id := Expand_Model (Node); Node_Options : Output_Options := Options; RS : Node_Id; N : Node_Id; C : Node_Id; begin if No (Expanded_Root) then raise Program_Error with "Cannot instantiate the AADL model"; end if; -- Get the root system of the architecture instance RS := Root_System (Expanded_Root); if not Is_Empty (Subcomponents (RS)) then N := First_Node (Subcomponents (RS)); while Present (N) loop C := Corresponding_Instance (N); if Get_Category_Of_Component (C) = CC_Process then -- Create a new filename if the user gave an output -- directory name. if Node_Options.Output_Directory /= No_Name then Get_Name_String (To_Lower (Name (Identifier (N)))); Add_Str_To_Name_Buffer (".aadl"); Node_Options.Output_File := Name_Find; end if; Internal_Print_Minimal_Tree (Node, Corresponding_Declaration (C), Node_Options); W_Str ("-- This was node "); Write_Name (Name (Identifier (N))); W_Eol; end if; N := Next_Node (N); end loop; end if; end Print_Minimal_Node_Trees; end Ocarina.AADL.Printer;