------------------------------------------------------------ -------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . P A R S E R -- -- -- -- 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 Charset; with Namet; with Utils; with Ocarina.Nodes; with Ocarina.Entities; with Ocarina.Messages; with GNAT.OS_Lib; with GNAT.Table; package body Ocarina.Parser is use Charset; use Namet; use Utils; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Messages; use GNAT.OS_Lib; type parser_function is record File_Extension : name_id; Parser_Access : process_function_access; end record; package Ocarina_Parsers is new GNAT.Table (parser_function, nat, 1, 5, 20); package Search_Paths is new GNAT.Table (name_id, nat, 1, 5, 20); S_Custom_Table : array (standard_property_sets) of Boolean := (others => False); O_Custom_Table : array (ocarina_property_sets) of Boolean := (others => False); S_Default_Table : array (standard_property_sets) of Boolean := (others => False); O_Default_Table : array (ocarina_property_sets) of Boolean := (others => False); -- To save the results of the 'Custom' and 'Default' functions for -- each enumerator. ------------ -- Custom -- ------------ function Custom (S : standard_property_sets) return Boolean is begin return S_Custom_Table (S); end Custom; ------------ -- Custom -- ------------ function Custom (O : ocarina_property_sets) return Boolean is begin return O_Custom_Table (O); end Custom; ------------- -- Default -- ------------- function Default (S : standard_property_sets) return Boolean is begin return S_Default_Table (S); end Default; ------------- -- Default -- ------------- function Default (O : ocarina_property_sets) return Boolean is begin return O_Default_Table (O); end Default; ----------- -- Image -- ----------- function Image (S : standard_property_sets) return String is Result : constant String := To_Lower (standard_property_sets'image (S)); begin return Result (Result'first + 2 .. Result'last); end Image; ----------- -- Image -- ----------- function Image (O : ocarina_property_sets) return String is Result : constant String := To_Lower (ocarina_property_sets'image (O)); begin case O is when o_cheddar_properties => return "Cheddar_Properties"; when others => return Result (Result'first + 2 .. Result'last); end case; end Image; --------------------- -- Add_Search_Path -- --------------------- procedure Add_Search_Path (Path_Name : String) is use Search_Paths; New_Path : name_id; begin if Path_Name'length > 0 then Set_Str_To_Name_Buffer (Path_Name); New_Path := Name_Find; Increment_Last; Table (Last) := New_Path; end if; end Add_Search_Path; ----------- -- Parse -- ----------- function Parse (File_Name : String; AADL_Root : node_id) return node_id is use Ocarina_Parsers; Index : nat := First; begin -- First, find the adequate parser while Index <= Last loop Get_Name_String (Table (Index).File_Extension); if File_Name'length > Name_Len and then File_Name (File_Name'last - Name_Len + 1 .. File_Name'last) = Name_Buffer (Name_Buffer'first .. Name_Len) then exit; end if; Index := Index + 1; end loop; -- We then parse the file if Index <= Last then return Table (Index).Parser_Access.all (File_Name, AADL_Root); else Ocarina.Messages.Display_No_Suitable_Parser (File_Name); return AADL_Root; end if; end Parse; --------------------- -- Register_Parser -- --------------------- procedure Register_Parser (File_Extension : String; Parser : process_function_access) is use Ocarina_Parsers; The_Parser : parser_function; begin if File_Extension'length > 0 then Set_Str_To_Name_Buffer (File_Extension); The_Parser.File_Extension := Name_Find; The_Parser.Parser_Access := Parser; Increment_Last; Table (Last) := The_Parser; end if; end Register_Parser; ------------------- -- Reset_Parsers -- ------------------- procedure Reset_Parsers is begin Ocarina_Parsers.Init; Search_Paths.Init; end Reset_Parsers; ---------------------- -- Search_And_Parse -- ---------------------- function Search_And_Parse (Entity_Name : String; AADL_Root : node_id; Display_Debug_Messages : Boolean) return node_id is package OP renames Ocarina_Parsers; package SP renames Search_Paths; File_Base_Name : name_id; Search_Path_Index : nat := SP.First; Parser_Index : nat; New_Root : node_id := No_Node; List_Node : node_id := No_Node; Success : Boolean := False; begin Name_Len := 0; -- get the file base name from the entity name for Index in Entity_Name'range loop if Entity_Name (Index) = ':' then Add_Char_To_Name_Buffer ('-'); elsif Entity_Name (Index) = '.' then Add_Char_To_Name_Buffer ('-'); else Add_Char_To_Name_Buffer (Entity_Name (Index)); end if; end loop; File_Base_Name := Name_Find; -- look for an appropriate file in each registered path while Search_Path_Index <= SP.Last and then not Success loop Parser_Index := OP.First; while Parser_Index <= OP.Last and then not Success loop Get_Name_String (SP.Table (Search_Path_Index)); Add_Char_To_Name_Buffer ('/'); Get_Name_String_And_Append (File_Base_Name); Get_Name_String_And_Append (OP.Table (Parser_Index).File_Extension); -- if the file exists, then parse it and return if Is_Regular_File (Name_Buffer (Name_Buffer'first .. Name_Len)) then if Display_Debug_Messages then Display_Parse_Additional_File (Name_Buffer (Name_Buffer'first .. Name_Len), Entity_Name); end if; New_Root := OP.Table (Parser_Index).Parser_Access.all (Name_Buffer (Name_Buffer'first .. Name_Len), AADL_Root); -- We must check if the entity we searched is now -- present. Else, this means we failed. if New_Root /= No_Node then List_Node := First_Node (Declarations (New_Root)); while List_Node /= No_Node loop if (Kind (List_Node) = k_property_set or else Kind (List_Node) = k_package_specification or else Kind (List_Node) = k_component_type or else Kind (List_Node) = k_component_implementation or else Kind (List_Node) = k_port_group_type) and then Get_Name_Of_Entity (List_Node, False) = To_Lower (Entity_Name) then Success := True; exit; end if; List_Node := Next_Node (List_Node); end loop; end if; end if; Parser_Index := Parser_Index + 1; end loop; Search_Path_Index := Search_Path_Index + 1; end loop; if not Success then New_Root := No_Node; end if; return New_Root; end Search_And_Parse; ---------------------------------- -- Parse_Standard_Property_Sets -- ---------------------------------- function Parse_Standard_Property_Sets (AADL_Root : node_id) return node_id is New_Root : node_id := AADL_Root; begin for S in standard_property_sets loop if not S_Custom_Table (S) then -- It is important to set the 'Default' flag to True -- before the parsing. S_Default_Table (S) := True; New_Root := Search_And_Parse (Image (S), New_Root, False); end if; end loop; return New_Root; end Parse_Standard_Property_Sets; --------------------------------- -- Parse_Ocarina_Property_Sets -- --------------------------------- function Parse_Ocarina_Property_Sets (AADL_Root : node_id) return node_id is New_Root : node_id := AADL_Root; Do_Parse : Boolean := True; begin -- We do not parser the Ocarina Property Sets if the Default -- standard property sets were not parsed. for S in standard_property_sets loop Do_Parse := Default (S) and then not Custom (S); exit when not Do_Parse; end loop; if Do_Parse then for O in ocarina_property_sets loop if not O_Custom_Table (O) then -- It is important to set the 'Default' flag to True -- before the parsing. O_Default_Table (O) := True; New_Root := Search_And_Parse (Image (O), New_Root, False); end if; end loop; end if; return New_Root; end Parse_Ocarina_Property_Sets; ---------------------------- -- Set_Property_Set_Flags -- ---------------------------- procedure Set_Property_Set_Flags (Identifier : node_id) is pragma assert (Kind (Identifier) = k_identifier); begin -- See whether this is a Standard property set declare S : constant String := "S_" & Get_Name_String (To_Lower (Name (Identifier))); E : standard_property_sets; begin E := standard_property_sets'value (S); if not S_Default_Table (E) then S_Custom_Table (E) := True; end if; return; exception when others => null; -- This does not correspond to a valid enumerator. end; -- See whether this is an Ocarina property set declare O : constant String := "O_" & Get_Name_String (To_Lower (Name (Identifier))); E : ocarina_property_sets; begin E := ocarina_property_sets'value (O); if not O_Default_Table (E) then O_Custom_Table (E) := True; end if; return; exception when others => null; -- This does not correspond to a valid enumerator. end; end Set_Property_Set_Flags; end Ocarina.Parser;