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