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