------------------------------------------- ------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P A R S E R . N A M E S P A C E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-2006, 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 Locations; with Ocarina.Nodes; with Ocarina.Nutils; with Namet; with Ocarina.AADL.Lexer; with Ocarina.AADL.Tokens; with Ocarina.AADL.Parser.Annexes; with Ocarina.AADL.Parser.Components; with Ocarina.AADL.Parser.Properties; with Ocarina.Entities.Namespaces; with Ocarina.Builder.Namespaces; package body Ocarina.AADL.Parser.Namespaces is function P_Expected_Package_Name (Expected_Id : node_id) return Boolean; function P_Package_Declaration (Package_Spec : Types.node_id; Private_Declarations : Boolean) return Integer; ------------------------ -- P_AADL_Declaration -- ------------------------ -- AADL_global_declaration ::= package_spec | property_set -- AADL_declaration ::= component_classifier -- | port_group_classifier -- | annex_library -- component_classifier ::= component_type -- | component_type_extension -- | component_implementation -- | component_implementation_extension -- port_group_classifier ::= port_group_type | port_group_type_extension -- NOTES: -- package_spec begins with 'package' -- property_set begins with 'property set' -- component_classifier begins with a component_category -- port_group_classifier begins with 'port type' -- annex_library begins with 'annex' function P_AADL_Declaration (AADL_Specification : Types.node_id) return node_id is use Locations; use Tokens; use Lexer; use Parser.Components; use Parser.Properties; Loc : location; begin Scan_Token; case Token is when t_package => return P_Package_Specification (AADL_Specification); when t_property => Save_Lexer (Loc); Scan_Token; if Token = t_set then return P_Property_Set (AADL_Specification, Loc); else DPE (pc_property_set, t_set); Skip_Tokens (t_semicolon); return No_Node; end if; when t_data | t_subprogram | t_thread | t_process | t_memory | t_processor | t_bus | t_device | t_system => return P_Component (AADL_Specification); when t_port => Save_Lexer (Loc); Scan_Token; if Token = t_group then return P_Port_Group_Type (AADL_Specification, Loc); else DPE (pc_port_group_type, t_group); Skip_Tokens (t_semicolon); return No_Node; end if; when others => DPE (pc_aadl_declaration); Skip_Tokens (t_semicolon); return No_Node; end case; end P_AADL_Declaration; -------------------------- -- P_AADL_Specification -- -------------------------- -- AADL_specification ::= { AADL_global_declaration | AADL_declaration }+ function P_AADL_Specification (AADL_Specification : Types.node_id) return node_id is use Tokens; use Lexer; use Locations; use Ocarina.Nutils; use Ocarina.Builder.Namespaces; Declaration : node_id; OK : Boolean := True; Loc : location; Specification : node_id; begin if AADL_Specification = No_Node then Specification := Initialize_Unnamed_Namespace (Token_Location); else Specification := AADL_Specification; end if; loop Save_Lexer (Loc); Scan_Token; exit when Token = t_eof; Restore_Lexer (Loc); Declaration := P_AADL_Declaration (Specification); if Declaration = No_Node then -- or else Add_Element (Specification, Declaration) = --No_Node -- then OK := False; -- try to parse another declaration end if; end loop; if OK then return Specification; else return No_Node; end if; end P_AADL_Specification; ----------------------------- -- P_Expected_Package_Name -- ----------------------------- function P_Expected_Package_Name (Expected_Id : node_id) return Boolean is use Locations; use Tokens; use Lexer; use Ocarina.Nodes; use Namet; use Ocarina.Nutils; Loc2, Start_Loc : location; Node : constant node_id := New_Node (k_identifier, Token_Location); begin Set_Corresponding_Entity (Node, No_Node); Save_Lexer (Start_Loc); Loc2 := Start_Loc; Scan_Token; if Token = t_identifier then Set_Name (Node, Token_Name); Set_Display_Name (Node, Token_Display_Name); else Restore_Lexer (Start_Loc); return False; end if; loop Save_Lexer (Loc2); Scan_Token; if Token = t_colon_colon then Get_Name_String (Name (Node)); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Set_Name (Node, Name_Find); Get_Name_String (Display_Name (Node)); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Set_Display_Name (Node, Name_Find); else Restore_Lexer (Loc2); if Name (Node) = Name (Expected_Id) then return True; else DPE (pc_defining_identifier, Display_Name (Expected_Id)); Restore_Lexer (Start_Loc); return False; end if; end if; Scan_Token; if Token = t_identifier then Get_Name_String (Name (Node)); Get_Name_String_And_Append (Token_Name); Set_Name (Node, Name_Find); Get_Name_String (Display_Name (Node)); Get_Name_String_And_Append (Token_Display_Name); Set_Display_Name (Node, Name_Find); else Restore_Lexer (Start_Loc); return False; end if; end loop; end P_Expected_Package_Name; --------------------------- -- P_Package_Declaration -- --------------------------- -- package_declaration ::= { aadl_declaration }+ -- [ properties ( { property_association }+ | none_statement ) ] function P_Package_Declaration (Package_Spec : Types.node_id; Private_Declarations : Boolean) return Integer is use Locations; use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Parser.Annexes; use Parser.Components; use Parser.Properties; pragma assert (Package_Spec /= No_Node and then Kind (Package_Spec) = k_package_specification); -- pragma Assert ((not Has_Private_Part (Package_Declaration --(Package_Spec)) -- and then Private_Declarations) -- or else (not Has_Public_Part -- (Package_Declaration (Package_Spec)) -- and then not Private_Declarations)); Properties : list_id := No_List; Declaration : node_id; Loc : location; Nb_Items : Integer := 0; Success : Boolean := True; begin -- Parse declarations loop Save_Lexer (Loc); Scan_Token; case Token is when t_data | t_subprogram | t_thread | t_process | t_memory | t_processor | t_bus | t_device | t_system => Declaration := P_Component (Package_Spec, Private_Declaration => Private_Declarations); when t_port => Save_Lexer (Loc); Scan_Token; if Token = t_group then Declaration := P_Port_Group_Type (Package_Spec, Loc, Private_Declaration => Private_Declarations); else DPE (pc_port_group_type, t_group); Skip_Tokens (t_semicolon); Success := False; end if; when t_annex => Declaration := P_Annex_Library (Package_Spec, Private_Declaration => Private_Declarations); when others => Restore_Lexer (Loc); exit; end case; if Present (Declaration) then Set_Is_Private (Declaration, Private_Declarations); Nb_Items := Nb_Items + 1; -- Append_Node_To_List (Declaration, Declarations); else Success := False; end if; end loop; -- Parse properties Save_Lexer (Loc); Scan_Token; if Token = t_properties then Properties := P_Items_List (P_Property_Association'access, Package_Spec, pc_properties); if No (Properties) then -- Error when parsing properties, quit Success := False; else declare P : node_id := First_Node (Properties); begin while Present (P) loop Set_Is_Private (P, Private_Declarations); P := Next_Node (P); end loop; end; end if; else -- No property declared Restore_Lexer (Loc); end if; -- Return result -- Set_Declarations (Package_Decl, Declarations); -- Set_Properties (Package_Decl, Properties); -- XXX properties are deactivated if Success then return Nb_Items; else return 0; end if; end P_Package_Declaration; ----------------------------- -- P_Package_Specification -- ----------------------------- -- package_spec ::= -- package defining_package_name -- ( public package_declaration [ private package_declaration ] | -- private package_declaration ) -- end defining_package_name; function P_Package_Specification (Namespace : Types.node_id) return node_id is use Locations; use Ocarina.Nodes; use Ocarina.Nutils; use Tokens; use Lexer; use Parser.Properties; use Ocarina.Builder.Namespaces; use Ocarina.Entities.Namespaces; pragma assert (Namespace /= No_Node and then Kind (Namespace) = k_aadl_specification); Package_Spec : node_id; -- result Defining_Name : node_id; -- package name Loc : location; Success : Boolean := True; Nb_Public_Items : Integer := 0; Nb_Private_Items : Integer := 0; Private_Section, Public_Section : Boolean := False; begin Defining_Name := P_Package_Name; if No (Defining_Name) then -- Defining_Package_Name is not parsed correctly, quit DPE (pc_defining_name, t_identifier); Skip_Tokens ((t_end, t_semicolon)); return No_Node; end if; Package_Spec := Add_New_Package (Token_Location, Defining_Name, Namespace); -- we do not know the parent of this package context -- Ex: P1::P2 is parent of P1::P2::P3 but NOT the unnamed namespace -- context parent will be determined in analyse phase Save_Lexer (Loc); Scan_Token; if Token = t_public then Public_Section := True; if Package_Has_Public_Declarations_Or_Properties (Package_Spec) then Success := False; DPE (pc_package_specification); -- XXX We should display a more explicative message to -- indicate that a public part already exists in this -- package end if; Nb_Public_Items := P_Package_Declaration (Package_Spec, Private_Declarations => False); if Nb_Public_Items = 0 then Save_Lexer (Loc); while (Token /= t_private) and then (Token /= t_end) loop Save_Lexer (Loc); Scan_Token; end loop; if Token = t_private then Restore_Lexer (Loc); else Skip_Tokens (t_semicolon); return No_Node; end if; end if; else Restore_Lexer (Loc); end if; Save_Lexer (Loc); Scan_Token; if Token = t_private then Private_Section := True; if Package_Has_Private_Declarations_Or_Properties (Package_Spec) then Success := False; DPE (pc_package_specification); end if; Nb_Private_Items := P_Package_Declaration (Package_Spec, Private_Declarations => True); if Nb_Private_Items = 0 then while Token /= t_end loop Save_Lexer (Loc); Scan_Token; end loop; Skip_Tokens (t_semicolon); Success := False; return No_Node; end if; else Restore_Lexer (Loc); end if; Scan_Token; if Token /= t_end then if Nb_Private_Items = 0 then if Nb_Public_Items = 0 then DPE (pc_package_specification, (t_public, t_private, t_end)); else DPE (pc_package_specification, (t_private, t_end)); end if; else DPE (pc_package_specification, t_end); end if; Skip_Tokens ((t_end, t_semicolon)); return No_Node; else if not Public_Section and then not Private_Section then -- If the package was empty DPE (pc_package_specification, (t_public, t_private)); Skip_Tokens ((t_end, t_semicolon)); return No_Node; end if; end if; if not P_Expected_Package_Name (Defining_Name) then -- Error when parsing Defining_Name, quit Skip_Tokens (t_semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token /= t_semicolon then DPE (pc_package_specification, t_semicolon); Restore_Lexer (Loc); return No_Node; end if; if Success then return Package_Spec; else return No_Node; end if; end P_Package_Specification; -------------------- -- P_Package_Name -- -------------------- -- package_name ::= -- { package_identifier :: }* package_identifier function P_Package_Name return node_id is use Locations; use Tokens; use Lexer; use Ocarina.Nodes; use Namet; use Ocarina.Nutils; Loc, Loc2 : location; Node : constant node_id := New_Node (k_identifier, Token_Location); begin Set_Corresponding_Entity (Node, No_Node); Save_Lexer (Loc); Loc2 := Loc; Scan_Token; if Token = t_identifier then Set_Name (Node, Token_Name); Set_Display_Name (Node, Token_Display_Name); else Restore_Lexer (Loc); return No_Node; end if; loop Save_Lexer (Loc2); Scan_Token; if Token = t_colon_colon then Get_Name_String (Name (Node)); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Set_Name (Node, Name_Find); Get_Name_String (Display_Name (Node)); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Set_Display_Name (Node, Name_Find); else Restore_Lexer (Loc2); return Node; end if; Scan_Token; if Token = t_identifier then Get_Name_String (Name (Node)); Get_Name_String_And_Append (Token_Name); Set_Name (Node, Name_Find); Get_Name_String (Display_Name (Node)); Get_Name_String_And_Append (Token_Display_Name); Set_Display_Name (Node, Name_Find); else Restore_Lexer (Loc); return No_Node; end if; end loop; end P_Package_Name; end Ocarina.AADL.Parser.Namespaces;