-------------------------------------------- ------------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P A R S E R . I D E N T I F I E R S -- -- -- -- 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 Ocarina.AADL.Tokens; with Ocarina.AADL.Lexer; with Namet; with Ocarina.Nutils; with Locations; with Ocarina.Nodes; with Ocarina.Entities; package body Ocarina.AADL.Parser.Identifiers is ----------------------------- -- Make_Current_Identifier -- ----------------------------- function Make_Current_Identifier (Entity : node_id) return node_id is use Tokens; use Lexer; use Ocarina.Nutils; use Ocarina.Nodes; Node : constant node_id := New_Node (k_identifier, Token_Location); begin Set_Name (Node, Token_Name); Set_Display_Name (Node, Token_Display_Name); Set_Corresponding_Entity (Node, Entity); return Node; end Make_Current_Identifier; --------------------------- -- P_Expected_Identifier -- --------------------------- function P_Expected_Identifier (Expected_Id : node_id) return Boolean is use Locations; use Tokens; use Lexer; use Ocarina.Nodes; Loc : location; begin Save_Lexer (Loc); Scan_Token; if Token = t_identifier and then Token_Name = Name (Expected_Id) then return True; else DPE (pc_defining_identifier, Display_Name (Expected_Id)); Restore_Lexer (Loc); return False; end if; end P_Expected_Identifier; ---------------------------- -- P_Expected_Identifiers -- ---------------------------- function P_Expected_Identifiers (Identifiers : list_id; Delimiter : Ocarina.AADL.Tokens.token_type) return Boolean is use Locations; use Tokens; use Lexer; use Ocarina.Nodes; use Ocarina.Nutils; Identifier : node_id; -- Current identifier in list of identifiers Current_Name : name_id; -- Name of current identifier Loc : location; begin if Is_Empty (Identifiers) then return True; end if; Identifier := First_Node (Identifiers); while Present (Identifier) loop Current_Name := Name (Identifier); Save_Lexer (Loc); Scan_Token; if Token = t_identifier then if Token_Name /= Current_Name then DPE (pc_defining_name, Display_Name (Identifier)); Restore_Lexer (Loc); return False; end if; else DPE (pc_defining_name, Display_Name (Identifier)); Restore_Lexer (Loc); return False; end if; Identifier := Next_Node (Identifier); if Present (Identifier) then -- Parse delimiter Save_Lexer (Loc); Scan_Token; if Token /= Delimiter then DPE (pc_defining_name, Delimiter); Restore_Lexer (Loc); return False; end if; end if; end loop; return True; end P_Expected_Identifiers; ------------------ -- P_Identifier -- ------------------ function P_Identifier (Container : Types.node_id) return node_id is use Locations; use Tokens; use Lexer; use Ocarina.Nutils; pragma unreferenced (Container); Loc : location; begin Save_Lexer (Loc); Scan_Token; if Token = t_identifier then return Make_Current_Identifier (No_Node); else Restore_Lexer (Loc); return No_Node; end if; end P_Identifier; ----------------------------- -- P_Identifier_Refined_To -- ----------------------------- -- ( Identifier : [ refined to ] ) or ( [ Identifier : ] [ refined to ] ) procedure P_Identifier_Refined_To (Option : refinement_type; Optional_Identifier : Boolean; Code : parsing_code; Refinement_Code : parsing_code; Skip_Until_Token : Ocarina.AADL.Tokens.token_type; Identifier : out node_id; Is_Refinement : out Boolean; OK : out Boolean) is use Locations; use Tokens; use Lexer; use Ocarina.Nodes; use Ocarina.Nutils; Loc : location; begin Save_Lexer (Loc); Scan_Token; -- parse identifier if Token /= t_identifier then Restore_Lexer (Loc); if not Optional_Identifier then OK := False; return; end if; Identifier := No_Node; else Identifier := Make_Current_Identifier (No_Node); Scan_Token; -- parse ':' if Token /= t_colon then if Option = rt_refinement then DPE (Refinement_Code, t_colon); else DPE (Code, t_colon); end if; Skip_Tokens (Skip_Until_Token); OK := False; return; end if; end if; Save_Lexer (Loc); Scan_Token; if Token = t_refined then if No (Identifier) then DPE (Code, emc_no_defining_identifier); DPE (Code, emc_refinement_is_not_allowed); Skip_Tokens (Skip_Until_Token); OK := False; return; end if; if Option = rt_not_refinable then DPE (Code, emc_refinement_is_not_allowed); Skip_Tokens (Skip_Until_Token); OK := False; return; end if; Scan_Token; if Token /= t_to then DPE (Refinement_Code, t_to); Skip_Tokens (t_semicolon); OK := False; return; end if; Is_Refinement := True; else if Option = rt_refinement then DPE (Refinement_Code, t_refined); Skip_Tokens (Skip_Until_Token); OK := False; return; end if; Restore_Lexer (Loc); Is_Refinement := False; end if; OK := True; end P_Identifier_Refined_To; ------------------------ -- P_Entity_Reference -- ------------------------ -- [ package_name :: ]* identifier [.identifier]* function P_Entity_Reference (Code : parsing_code) return node_id is use Tokens; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; use Namet; use Locations; use Ocarina.AADL.Lexer; Loc : location; Loc2 : location; Entity_Loc : location; Current_Identifier : node_id; Processing_Namespace : Boolean := True; Location_Set : Boolean := False; Unique_Name : constant node_id := New_Node (k_entity_reference, No_Location); begin Set_Entity (Unique_Name, No_Node); Save_Lexer (Loc); loop Scan_Token; Save_Lexer (Loc2); Save_Lexer (Entity_Loc); if not Location_Set then Set_Loc (Unique_Name, Entity_Loc); Set_Path (Unique_Name, New_List (k_list_id, Entity_Loc)); Set_Namespace_Path (Unique_Name, New_List (k_list_id, Entity_Loc)); Location_Set := True; end if; if Token = t_identifier then Current_Identifier := New_Node (k_identifier, Token_Location); Set_Name (Current_Identifier, Token_Name); Set_Display_Name (Current_Identifier, Token_Display_Name); if Processing_Namespace then Append_Node_To_List (Current_Identifier, Namespace_Path (Unique_Name)); else Add_Path_Element_To_Entity_Reference (Unique_Name, Current_Identifier); end if; Save_Lexer (Loc2); Scan_Token; if Token = t_colon_colon then if not Processing_Namespace then DPE (Code, t_identifier); Restore_Lexer (Loc); return No_Node; end if; elsif Token = t_dot then declare Node : node_id; begin if Processing_Namespace then Node := Remove_Last_Node_From_List (Namespace_Path (Unique_Name)); if Node /= No_Node then -- The last identifier was in fact the first -- element of the entity name, not an element -- of the namespace name. Add_Path_Element_To_Entity_Reference (Unique_Name, Node); else DPE (Code, t_identifier); Restore_Lexer (Loc); return No_Node; end if; Processing_Namespace := False; end if; end; else -- There is nothing more to parse if Processing_Namespace then declare Node : node_id; begin Node := Remove_Last_Node_From_List (Namespace_Path (Unique_Name)); if Node /= No_Node then Add_Path_Element_To_Entity_Reference (Unique_Name, Node); else DPE (Code, t_identifier); Restore_Lexer (Loc); return No_Node; end if; end; end if; Restore_Lexer (Loc2); declare List_Node : node_id; begin if First_Node (Namespace_Path (Unique_Name)) /= No_Node then -- set the namespace name Set_Namespace_Identifier (Unique_Name, New_Node (k_identifier, Entity_Loc)); Set_Corresponding_Entity (Namespace_Identifier (Unique_Name), Unique_Name); List_Node := First_Node (Namespace_Path (Unique_Name)); while List_Node /= No_Node loop if List_Node = First_Node (Namespace_Path (Unique_Name)) then Get_Name_String (Name (List_Node)); else Add_Str_To_Name_Buffer (Image (t_colon_colon)); Get_Name_String_And_Append (Name (List_Node)); end if; List_Node := Next_Node (List_Node); end loop; Set_Name (Namespace_Identifier (Unique_Name), Name_Find); -- set the namespace display name List_Node := First_Node (Namespace_Path (Unique_Name)); while List_Node /= No_Node loop if List_Node = First_Node (Namespace_Path (Unique_Name)) then Get_Name_String (Display_Name (List_Node)); else Add_Str_To_Name_Buffer (Image (t_colon_colon)); Get_Name_String_And_Append (Display_Name (List_Node)); end if; List_Node := Next_Node (List_Node); end loop; Set_Display_Name (Namespace_Identifier (Unique_Name), Name_Find); else Set_Namespace_Identifier (Unique_Name, No_Node); end if; -- set the entity name Set_Identifier (Unique_Name, New_Node (k_identifier, Entity_Loc)); Set_Corresponding_Entity (Identifier (Unique_Name), Unique_Name); List_Node := First_Node (Path (Unique_Name)); while List_Node /= No_Node loop if List_Node = First_Node (Path (Unique_Name)) then Get_Name_String (Name (Item (List_Node))); else Add_Str_To_Name_Buffer (Image (t_dot)); Get_Name_String_And_Append (Name (Item (List_Node))); end if; List_Node := Next_Node (List_Node); end loop; Set_Name (Identifier (Unique_Name), Name_Find); -- set the entity display name List_Node := First_Node (Path (Unique_Name)); while List_Node /= No_Node loop if List_Node = First_Node (Path (Unique_Name)) then Set_Str_To_Name_Buffer (Get_Name_String (Display_Name (Item (List_Node)))); else Add_Str_To_Name_Buffer (Image (t_dot)); Get_Name_String_And_Append (Display_Name (Item (List_Node))); end if; List_Node := Next_Node (List_Node); end loop; Set_Display_Name (Identifier (Unique_Name), Name_Find); end; Set_Full_Identifier (Unique_Name, New_Node (k_identifier, Entity_Loc)); Set_Corresponding_Entity (Full_Identifier (Unique_Name), Unique_Name); if Namespace_Identifier (Unique_Name) /= No_Node then Get_Name_String (Name (Namespace_Identifier (Unique_Name))); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Get_Name_String_And_Append (Name (Identifier (Unique_Name))); Set_Name (Full_Identifier (Unique_Name), Name_Find); Get_Name_String (Display_Name (Namespace_Identifier (Unique_Name))); Add_Str_To_Name_Buffer (Image (t_colon_colon)); Get_Name_String_And_Append (Display_Name (Identifier (Unique_Name))); Set_Display_Name (Full_Identifier (Unique_Name), Name_Find); else Set_Name (Full_Identifier (Unique_Name), Name (Identifier (Unique_Name))); Set_Display_Name (Full_Identifier (Unique_Name), Display_Name (Identifier (Unique_Name))); end if; return Unique_Name; end if; else DPE (Code, t_identifier); Restore_Lexer (Loc); return No_Node; end if; end loop; end P_Entity_Reference; end Ocarina.AADL.Parser.Identifiers;