------------------------------------------------ -------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P A R S E R . P R O P E R T I E S -- -- -- -- 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 Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Parser; with Ocarina.AADL.Lexer; with Ocarina.AADL.Tokens; with Ocarina.AADL.Parser.Identifiers; with Ocarina.AADL.Parser.Components; with Ocarina.AADL.Parser.Components.Modes; with Ocarina.AADL.Parser.Properties.Values; with Ocarina.Builder.Properties; with Ocarina.Entities.Properties; with Ocarina.Entities.Components; use Ocarina.Entities.Properties; use Ocarina.Entities.Components; package body Ocarina.AADL.Parser.Properties is function P_Property_Name_Declaration (Identifier : Node_Id; Property_Set : Node_Id) return Node_Id; -- Current token is ':' function P_Property_Owner_Category (Container : Types.Node_Id) return Node_Id; ---------------------------- -- P_Property_Association -- ---------------------------- function P_Property_Association (Container : Node_Id) return Node_Id is begin return P_Property_Association (Container => Container, Property_Type => PAT_Simple); end P_Property_Association; -------------------------------------------------------- -- P_Property_Association_In_Component_Implementation -- -------------------------------------------------------- function P_Property_Association_In_Component_Implementation (Container : Node_Id) return Node_Id is begin return P_Property_Association (Container => Container, Property_Type => PAT_Simple_Or_Contained); end P_Property_Association_In_Component_Implementation; ---------------------------- -- P_Property_Association -- ---------------------------- -- property_association ::= -- [ property_set_identifier :: ] property_name_identifier ( => | +=> ) -- [ constant ] property_value [ in_binding ] [ in_modes ] ; -- access_property_association ::= -- [ property_set_identifier :: ] property_name_identifier ( => | +=> ) -- [ constant ] access property_value [ in_binding ] [ in_modes ] ; -- contained_property_association ::= -- [ property_set_identifier :: ] property_name_identifier ( => | +=> ) -- [ constant ] property_value -- applies to contained_unit_identifier { . contained_unit_identifier }* -- [ in_binding ] [ in_modes ] ; -- property_value ::= single_property_value | property_list_value -- single_property_value ::= property_expression -- property_list_value ::= -- ( [ property_expression { , property_expression }* ] ) -- in_binding ::= in binding ( platform_classifier_reference -- { , platform_classifier_reference }* ) -- platform_classifier_reference ::= processor_classifier_reference -- | memory_classifier_reference -- | bus_classsifer_reference function P_Property_Association (Container : Node_Id; Property_Type : Property_Association_Type) return Node_Id is use Ocarina.Nodes; use Ocarina.Nutils; use Namet; use Lexer; use Tokens; use Ocarina.AADL.Parser.Components.Modes; use Ocarina.Builder.Properties; use Ocarina.AADL.Parser.Identifiers; use Ocarina.AADL.Parser.Properties.Values; pragma Assert (Container /= No_Node); Property : Node_Id; -- output Property_Name_Identifier : Node_Id; Is_Additive : Boolean; Is_Constant : Boolean; Is_Access : Boolean; Prop_Value : Node_Id; Applies : List_Id := No_List; In_Binding : Node_Id := No_Node; In_Modes : Node_Id := No_Node; Code : Parsing_Code; Binding_Loc : Location; Loc : Location; Property_Loc : Location; Item : Node_Id; begin Save_Lexer (Loc); Scan_Token; Save_Lexer (Property_Loc); if Token /= T_Identifier then -- can not parse Property_Association, try another stuff Restore_Lexer (Loc); return No_Node; else Restore_Lexer (Loc); end if; case Property_Type is when PAT_Simple => Code := PC_Property_Association; when PAT_Access => Code := PC_Access_Property_Association; when PAT_Simple_Or_Contained => Code := PC_Property_Association_Or_Contained_Property_Association; end case; Property_Name_Identifier := P_Entity_Reference (Code); if No (Property_Name_Identifier) then -- error when parsing identifiers, quit Skip_Tokens (T_Semicolon); return No_Node; end if; Scan_Token; if Token = T_Association then Is_Additive := False; elsif Token = T_Additive_Association then Is_Additive := True; else DPE (Code, (T_Association, T_Additive_Association)); Skip_Tokens (T_Semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = T_Constant then Is_Constant := True; else Restore_Lexer (Loc); Is_Constant := False; end if; Save_Lexer (Loc); Scan_Token; if Token = T_Access then if Property_Type = PAT_Access then Is_Access := True; else DPE (Code, EMC_Access_Property_Association_Is_Not_Allowed); Skip_Tokens (T_Semicolon); return No_Node; end if; else if Property_Type = PAT_Access then if Is_Constant then DPE (Code, T_Access); else DPE (Code, (T_Constant, T_Access)); end if; Skip_Tokens (T_Semicolon); return No_Node; else Restore_Lexer (Loc); Is_Access := False; end if; end if; -- Parse Property_Value Save_Lexer (Loc); Scan_Token; if Token = T_Left_Parenthesis then Save_Lexer (Loc); Scan_Token; if Token = T_Right_Parenthesis then -- Property_List_Value is empty Prop_Value := Node_Id (New_List (K_List_Id, Loc)); Set_Kind (Prop_Value, K_Property_List_Value); Set_First_Node (List_Id (Prop_Value), No_Node); Set_Last_Node (List_Id (Prop_Value), No_Node); else Restore_Lexer (Loc); Prop_Value := Node_Id (P_Items_List (P_Property_Expression'Access, No_Node, T_Comma, T_Right_Parenthesis, PC_Property_List_Value)); if No (Prop_Value) then -- error when parsing Property_Expression list, quit Skip_Tokens (T_Semicolon); return No_Node; end if; Set_Kind (Prop_Value, K_Property_List_Value); end if; else Restore_Lexer (Loc); Prop_Value := P_Property_Expression (No_Node); if No (Prop_Value) then -- error when parsing Property_Expression, quit Skip_Tokens (T_Semicolon); return No_Node; end if; end if; -- Parse 'applies to ...' Save_Lexer (Loc); Scan_Token; if Token = T_Applies then if Property_Type /= PAT_Simple_Or_Contained then DPE (Code, EMC_Contained_Property_Association_Is_Not_Allowed); Skip_Tokens (T_Semicolon); return No_Node; end if; -- now we know that Contained_Property_Association is being parsed Code := PC_Contained_Property_Association; Scan_Token; if Token /= T_To then DPE (Code, T_To); Skip_Tokens (T_Semicolon); return No_Node; end if; Applies := P_Items_List (P_Identifier'Access, No_Node, T_Dot, False); if No (Applies) then DPE (Code, T_Identifier); Skip_Tokens (T_Semicolon); return No_Node; end if; else Restore_Lexer (Loc); Applies := No_List; end if; -- Parse In_Binding Save_Lexer (Loc); Scan_Token; if Token = T_In then Save_Lexer (Binding_Loc); Scan_Token; if Token = T_Binding then Scan_Token; if Token /= T_Left_Parenthesis then DPE (Code, T_Left_Parenthesis); Skip_Tokens (T_Semicolon); return No_Node; end if; In_Binding := New_Node (K_In_Binding, Binding_Loc); Set_Binding (In_Binding, New_List (K_List_Id, Binding_Loc)); loop Save_Lexer (Loc); Scan_Token; if Token = T_Right_Parenthesis then Restore_Lexer (Loc); exit; end if; Restore_Lexer (Loc); Item := P_Entity_Reference (Code); if Present (Item) then Append_Node_To_List (Item, Binding (In_Binding)); else Skip_Tokens (T_Right_Parenthesis, False); In_Binding := No_Node; exit; end if; Scan_Token; if Token = T_Right_Parenthesis then exit; end if; if Token /= T_Comma then Skip_Tokens (T_Right_Parenthesis, False); In_Binding := No_Node; end if; end loop; if No (In_Binding) then -- error when parsing In_Binding, quit Skip_Tokens (T_Semicolon); return No_Node; end if; elsif Token = T_Modes then -- In_Modes will be parsed in next section Restore_Lexer (Loc); In_Binding := No_Node; else DPE (Code, (T_Binding, T_Modes)); Skip_Tokens (T_Semicolon); return No_Node; end if; else Restore_Lexer (Loc); In_Binding := No_Node; end if; -- Parse In_Modes Save_Lexer (Loc); Scan_Token; if Token = T_In then In_Modes := P_In_Modes (PC_In_Modes); if No (In_Modes) then -- error when parsing In_Modes, quit Skip_Tokens (T_Semicolon); return No_Node; end if; else Restore_Lexer (Loc); In_Modes := No_Node; end if; -- Parse ';' Save_Lexer (Loc); Scan_Token; if Token /= T_Semicolon then DPE (Code, T_Semicolon); Restore_Lexer (Loc); return No_Node; end if; -- The actual name of the property association is the -- concatenation of its property set and its name inside -- this property set. declare Full_Name_Identifier : constant Node_Id := New_Node (K_Identifier, Property_Loc); Prop_Set_Id : constant Node_Id := Namespace_Identifier (Property_Name_Identifier); Prop_Name_Id : constant Node_Id := Identifier (Property_Name_Identifier); begin if Prop_Set_Id /= No_Node then Get_Name_String (Name (Prop_Set_Id)); Add_Str_To_Name_Buffer (Image (T_Colon_Colon)); Add_Str_To_Name_Buffer (Get_Name_String (Name (Prop_Name_Id))); Set_Name (Full_Name_Identifier, Name_Find); Get_Name_String (Ocarina.Nodes.Display_Name (Prop_Set_Id)); Add_Str_To_Name_Buffer (Image (T_Colon_Colon)); Add_Str_To_Name_Buffer (Get_Name_String (Display_Name (Prop_Name_Id))); Set_Display_Name (Full_Name_Identifier, Name_Find); else Get_Name_String (Name (Prop_Name_Id)); Set_Name (Full_Name_Identifier, Name_Find); Get_Name_String (Display_Name (Prop_Name_Id)); Set_Display_Name (Full_Name_Identifier, Name_Find); end if; Property := Add_New_Property_Association (Loc => Ocarina.Nodes.Loc (Full_Name_Identifier), Name => Full_Name_Identifier, Container => Container, Property_Name => Property_Name_Identifier, Is_Additive => Is_Additive, Is_Constant => Is_Constant, Is_Access => Is_Access, Property_Value => Prop_Value, In_Binding => In_Binding, Applies_To => Applies, In_Modes => In_Modes); end; pragma Assert (Property /= No_Node); -- Container may be No_Node if it is to be created later. Then -- the parser will parse again the property associations, -- giving the container. So, we just check the syntax this -- time. return Property; end P_Property_Association; ----------------------------- -- P_Property_Associations -- ----------------------------- -- ( [ { { Property_Association }+ } ] ) -- or ( { { Property_Association }+ } ) function P_Property_Associations (Container : Node_Id; Optional : Boolean; Property_Type : Property_Association_Type; Code : Parsing_Code) return Boolean is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; pragma Assert (Container /= No_Node); Property : Node_Id; Loc : Location; Success : Boolean := True; Number_Of_Items : Integer := 0; begin Save_Lexer (Loc); Scan_Token; if Token = T_Left_Curly_Bracket then loop Save_Lexer (Loc); Property := P_Property_Association (Container => Container, Property_Type => Property_Type); if not Present (Property) then if Token_Location = Loc then -- Error when parsing the first token of -- property_association, display error message DPE (Code, (T_Identifier, T_Right_Curly_Bracket)); end if; Skip_Tokens (T_Semicolon); Success := False; else Number_Of_Items := Number_Of_Items + 1; end if; Save_Lexer (Loc); Scan_Token; exit when Token = T_Right_Curly_Bracket; Restore_Lexer (Loc); end loop; Success := Number_Of_Items /= 0 and then Success; else if not Optional then -- Property_Associations must be defined DPE (Code, T_Left_Curly_Bracket); Skip_Tokens (T_Semicolon); Success := False; else Restore_Lexer (Loc); end if; end if; return Success; end P_Property_Associations; --------------------------------- -- P_Property_Name_Declaration -- --------------------------------- -- property_name_declaration ::= -- defining_property_name_identifier : [ access ] [ inherit ] -- ( single_valued_property | multi_valued_property ) -- applies to ( ( property_owner_category -- { , property_owner_category }* | all ) ) ; function P_Property_Name_Declaration (Identifier : Node_Id; Property_Set : Node_Id) return Node_Id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Properties.Values; use Ocarina.Builder.Properties; Is_Access : Boolean; Is_All : Boolean; Is_Inherit : Boolean; Is_A_List : Boolean; Property : Node_Id; Single_Default_Value : Node_Id; Property_Name_Value : Node_Id; Multiple_Default_Value : List_Id; Owner_Categories : List_Id; Loc : Location; begin Save_Lexer (Loc); Scan_Token; if Token = T_Access then Is_Access := True; else Is_Access := False; Restore_Lexer (Loc); end if; Save_Lexer (Loc); Scan_Token; if Token = T_Inherit then Is_Inherit := True; else Is_Inherit := False; Restore_Lexer (Loc); end if; Save_Lexer (Loc); Scan_Token; if Token = T_List then Is_A_List := True; Property_Name_Value := P_Multi_Valued_Property; Single_Default_Value := No_Node; if Property_Name_Value /= No_Node then Multiple_Default_Value := Property_Expressions (Property_Name_Value); else Multiple_Default_Value := No_List; end if; else Restore_Lexer (Loc); Is_A_List := False; Property_Name_Value := P_Single_Valued_Property; Multiple_Default_Value := No_List; if Property_Name_Value /= No_Node then Single_Default_Value := Property_Expression (Property_Name_Value); else Single_Default_Value := No_Node; end if; end if; if Property_Name_Value = No_Node then -- error when parsing Single_Valued_Property, quit -- Note that a Multi_Valued_Property can be empty Skip_Tokens (T_Semicolon); return No_Node; end if; Scan_Token; if Token /= T_Applies then DPE (PC_Property_Name_Declaration, T_Applies); Skip_Tokens (T_Semicolon); return No_Node; end if; Scan_Token; if Token /= T_To then DPE (PC_Property_Name_Declaration, T_To); Skip_Tokens (T_Semicolon); return No_Node; end if; Scan_Token; if Token /= T_Left_Parenthesis then DPE (PC_Property_Name_Declaration, T_Left_Parenthesis); Skip_Tokens (T_Semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = T_All then Is_All := True; Owner_Categories := No_List; Scan_Token; if Token /= T_Right_Parenthesis then DPE (PC_Property_Name_Declaration, T_Right_Parenthesis); Skip_Tokens (T_Semicolon); return No_Node; end if; else Is_All := False; Restore_Lexer (Loc); Owner_Categories := P_Items_List (P_Property_Owner_Category'Access, No_Node, T_Comma, T_Right_Parenthesis, PC_Property_Name_Declaration); if No (Owner_Categories) then -- error when parsing property_owner_category list, quit Skip_Tokens (T_Semicolon); return No_Node; end if; end if; Save_Lexer (Loc); Scan_Token; if Token /= T_Semicolon then DPE (PC_Property_Name_Declaration, T_Semicolon); Restore_Lexer (Loc); return No_Node; end if; Property := Add_New_Property_Name_Declaration (Loc => Ocarina.Nodes.Loc (Identifier), Property_Set => Property_Set, Name => Identifier, Is_Access => Is_Access, Is_Inherit => Is_Inherit, Single_Default_Value => Single_Default_Value, Multiple_Default_Value => Multiple_Default_Value, Property_Name_Type => Property_Type_Designator (Property_Name_Value), Property_Type_Is_A_List => Is_A_List, Applies_To_All => Is_All, Applies_To => Owner_Categories); return Property; end P_Property_Name_Declaration; ------------------------------- -- P_Property_Owner_Category -- ------------------------------- -- property_owner_category ::= -- component_category [ classifier_reference ] -- | mode | port group | flow -- | [ event ] [ data ] port -- | server subprogram -- | [ connection_type ] connections -- connection_type ::= port group | [ event ] [ data ] port | access function P_Property_Owner_Category (Container : Node_Id) return Node_Id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Builder.Properties; use Lexer; use Tokens; use AADL.Parser.Identifiers; use AADL.Parser.Components; pragma Unreferenced (Container); Owner_Category : Node_Id; Category : Property_Owner_Category; Comp_Cat : Component_Category := CC_Unknown; Classifier_Ref : Node_Id := No_Node; Loc : Location; begin Scan_Token; Owner_Category := New_Node (K_Property_Owner_Category, Token_Location); case Token is when T_Mode => Category := POC_Mode; when T_Port => Save_Lexer (Loc); Scan_Token; case Token is when T_Group => Save_Lexer (Loc); Scan_Token; if Token = T_Connections then Category := POC_Port_Group_Connections; else Restore_Lexer (Loc); Category := POC_Port_Group; end if; when T_Connections => Category := POC_Port_Connections; when others => Restore_Lexer (Loc); Category := POC_Port; end case; when T_Flow => Category := POC_Flow; when T_Event => Scan_Token; case Token is when T_Port => Save_Lexer (Loc); Scan_Token; if Token = T_Connections then Category := POC_Event_Port_Connections; else Restore_Lexer (Loc); Category := POC_Event_Port; end if; when T_Data => Scan_Token; if Token /= T_Port then DPE (PC_Property_Owner_Category, T_Port); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = T_Connections then Category := POC_Event_Data_Port_Connections; else Restore_Lexer (Loc); Category := POC_Event_Data_Port; end if; when others => DPE (PC_Property_Owner_Category, (T_Port, T_Data)); return No_Node; end case; when T_Data => Save_Lexer (Loc); Scan_Token; if Token = T_Port then Save_Lexer (Loc); Scan_Token; if Token = T_Connections then Category := POC_Data_Port_Connections; else Restore_Lexer (Loc); Category := POC_Data_Port; end if; else Restore_Lexer (Loc); Category := POC_Component_Category; Comp_Cat := CC_Data; end if; when T_Server => Scan_Token; if Token /= T_Subprogram then DPE (PC_Property_Owner_Category, T_Subprogram); return No_Node; end if; Category := POC_Server_Subprogram; when T_Parameter => Save_Lexer (Loc); Scan_Token; if Token = T_Connections then Category := POC_Parameter_Connections; else Restore_Lexer (Loc); Category := POC_Parameter; end if; when T_Access => Scan_Token; if Token /= T_Connections then DPE (PC_Property_Owner_Category, T_Connections); return No_Node; end if; Category := POC_Access_Connections; when T_Connections => Category := POC_Connections; when T_Subprogram | T_Thread | T_Process | T_Memory | T_Processor | T_Bus | T_Device | T_System => Category := POC_Component_Category; Comp_Cat := P_Component_Category; when others => DPE (PC_Property_Owner_Category); return No_Node; end case; if Category = POC_Component_Category then Save_Lexer (Loc); Scan_Token; if Token = T_Identifier then Restore_Lexer (Loc); Classifier_Ref := P_Entity_Reference (PC_Property_Owner_Category); if No (Classifier_Ref) then -- error when parsing Classifier_Reference, quit return No_Node; end if; else Restore_Lexer (Loc); end if; end if; Set_Category (Owner_Category, Property_Owner_Category'Pos (Category)); Set_Component_Cat (Owner_Category, Component_Category'Pos (Comp_Cat)); Set_Classifier_Ref (Owner_Category, Classifier_Ref); return Owner_Category; end P_Property_Owner_Category; -------------------- -- P_Property_Set -- -------------------- -- property set defining_property_set_identifier is -- { property_type_declaration | -- property_name_declaration | -- property_constant }+ -- end defining_property_set_identifier ; function P_Property_Set (AADL_Spec : Node_Id; Start_Loc : Location) return Node_Id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; use Ocarina.AADL.Parser.Properties.Values; use Ocarina.Builder.Properties; Property_Set : Node_Id; Identifier : Node_Id; Decl_Ident : Node_Id; -- identifier of current declaration Current_Decl : Node_Id; Loc : Location; begin Scan_Token; if Token /= T_Identifier then DPE (PC_Property_Set, T_Identifier); Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Identifier := Make_Current_Identifier (No_Node); -- Check whether the property set is a standard property set -- and set properly the parser flags. Ocarina.Parser.Set_Property_Set_Flags (Identifier); Scan_Token; if Token /= T_Is then DPE (PC_Property_Set, T_Is); Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Property_Set := Add_New_Property_Set (Start_Loc, Identifier, AADL_Spec); if Property_Set = No_Node then Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Scan_Token; loop if Token /= T_Identifier then DPE (PC_Property_Declaration, T_Identifier); Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Decl_Ident := Make_Current_Identifier (No_Node); Scan_Token; if Token /= T_Colon then DPE (PC_Property_Declaration, T_Colon); Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Save_Lexer (Loc); Scan_Token; case Token is when T_Type => Current_Decl := P_Property_Type_Declaration (Identifier => Decl_Ident, Property_Set => Property_Set); when T_Constant => Current_Decl := P_Property_Constant (Identifier => Decl_Ident, Property_Set => Property_Set); when others => Restore_Lexer (Loc); Current_Decl := P_Property_Name_Declaration (Identifier => Decl_Ident, Property_Set => Property_Set); end case; if No (Current_Decl) then -- Error when parsing property declaration, quit Skip_Tokens ((T_End, T_Semicolon)); return No_Node; end if; Scan_Token; exit when Token = T_End; end loop; if not P_Expected_Identifier (Identifier) then -- Error when parsing defining_identifier, quit Skip_Tokens (T_Semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token /= T_Semicolon then DPE (PC_Property_Set, T_Semicolon); Restore_Lexer (Loc); return No_Node; end if; return Property_Set; end P_Property_Set; end Ocarina.AADL.Parser.Properties;