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