------------------------------------------------ -------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.AADL.PARSER.PROPERTIES.VALUES -- -- -- -- 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 Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.AADL_Values; with Ocarina.AADL.Lexer; with Ocarina.AADL.Tokens; with Ocarina.AADL.Parser.Identifiers; with Ocarina.AADL.Parser.Components; 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.Values is type number_category is (nc_integer, nc_real, nc_unknown); function P_Or_Boolean_Term return node_id; -- ATTENTION: This is the entry point for parsing boolean -- expression since OR is the operator with the lowest precedence. function P_Or_Boolean_Term_Aux (Bool_Term : node_id) return node_id; -- Bool_Term is the previous parsed And_Boolean_Term function P_And_Boolean_Term return node_id; function P_And_Boolean_Term_Aux (Bool_Term : node_id) return node_id; -- Bool_Term is the previous parsed Boolean_Term function P_Boolean_Term return node_id; -- ATTENTION: This is not the entry point to parse boolean -- expression. The entry point is P_Or_Boolean term, the lowest -- precedence operator expression. function P_Classifier_Type return node_id; -- Current token must be 'classifier' function P_Component_Classifier_Term return node_id; -- Current token must be the first token of component_category function P_Constant_Property_Value (Container : node_id) return node_id; function P_Enumeration_Type return node_id; -- Current token must be 'enumeration' function P_Number_Type return node_id; -- Current token must be 'aadlreal' or 'aadlinteger' function P_Numeric_Term (Code : parsing_code) return node_id; function P_Minus_Numeric_Term (Code : parsing_code) return node_id; function P_Signed_AADLNumber (Number_Cat : number_category; Code : parsing_code) return node_id; -- If Number_Cat = NC_Real then parse Signed_AADLReal else if -- Number_Cat = NC_Integer then parse Signed_AADLInteger else -- parse Signed_AADLReal or Signed_AADLInteger. function P_Number_Range (Number_Cat : number_category) return node_id; -- If Number_Cat = NC_Real then parse Real_Range. If Number_Cat = -- NC_Integer then parse Integer_Range. If Number_Cat = NC_Unknown -- then parse Real_Range or Integer_Range. function P_Property_Type_Designator return node_id; function P_Signed_Number_Or_Range (First_Term : node_id) return node_id; -- Parse Signed_AADLInteger or Signed_AADLReal or -- Integer_Range_Term or Real_Range_Term. This function is used to -- factorize codes for parsing Property_Expression and Single_ / -- Multi_Valued_Property_Constant. function P_Reference_Term return node_id; -- Current token must be 'component' function P_Range_Type return node_id; -- Current token must be 'range' function P_Referable_Element_Category (Container : node_id) return node_id; function P_Reference_Type return node_id; -- Current token must be 'reference' function P_Value_Unique_Property_Identifier (Code : parsing_code) return node_id; -- Current token must be 'value' function P_Unit_Definition (Container : node_id) return node_id; function P_Units_Type return node_id; -- Curent token must be 'units' ------------------------ -- P_And_Boolean_Term -- ------------------------ -- boolean_term [ and boolean_term ] function P_And_Boolean_Term return node_id is Bool_Term : node_id; begin Bool_Term := P_Boolean_Term; if No (Bool_Term) then return No_Node; else return P_And_Boolean_Term_Aux (Bool_Term); end if; end P_And_Boolean_Term; ---------------------------- -- P_And_Boolean_Term_Aux -- ---------------------------- -- [ and boolean_term ] function P_And_Boolean_Term_Aux (Bool_Term : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; And_Term : node_id; Second_Bool_Term : node_id; Loc : location; begin Save_Lexer (Loc); Scan_Token; if Token = t_and then Second_Bool_Term := P_Boolean_Term; if No (Second_Bool_Term) then return No_Node; else And_Term := New_Node (k_and_boolean_term, Ocarina.Nodes.Loc (Bool_Term)); Set_First_Term (And_Term, Bool_Term); Set_Second_Term (And_Term, Second_Bool_Term); return P_And_Boolean_Term_Aux (And_Term); end if; else Restore_Lexer (Loc); return Bool_Term; end if; end P_And_Boolean_Term_Aux; -------------------- -- P_Boolean_Term -- -------------------- -- boolean_term ::= -- boolean_value -- | boolean_property_constant_term -- | not boolean_term -- | boolean_term and boolean_term -- | boolean_term or boolean_term -- | ( boolean_term ) -- boolean_value ::= true | false function P_Boolean_Term return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Lexer; use Tokens; Bool_Term : node_id; -- output Temp_Node : node_id; -- used to save temporary result Loc : location; begin Scan_Token; case Token is when t_true => Bool_Term := New_Node (k_literal, Token_Location); Set_Value (Bool_Term, New_Boolean_Value (True)); return Bool_Term; when t_false => Bool_Term := New_Node (k_literal, Token_Location); Set_Value (Bool_Term, New_Boolean_Value (False)); return Bool_Term; when t_value => Bool_Term := P_Value_Unique_Property_Identifier (pc_boolean_property_term); if No (Bool_Term) then return No_Node; else Set_Kind (Bool_Term, k_property_term); return Bool_Term; end if; when t_not => Save_Lexer (Loc); Temp_Node := P_Boolean_Term; if No (Temp_Node) then return No_Node; else Bool_Term := New_Node (k_not_boolean_term, Loc); Set_Boolean_Term (Bool_Term, Temp_Node); return Bool_Term; end if; when t_left_parenthesis => Save_Lexer (Loc); Temp_Node := P_Or_Boolean_Term; if No (Temp_Node) then Skip_Tokens (t_right_parenthesis); return No_Node; else Scan_Token; if Token /= t_right_parenthesis then DPE (pc_boolean_term, t_right_parenthesis); return No_Node; else Bool_Term := New_Node (k_parenthesis_boolean_term, Loc); Set_Boolean_Term (Bool_Term, Temp_Node); return Bool_Term; end if; end if; when others => DPE (pc_boolean_term, (t_true, t_false, t_value, t_not, t_left_parenthesis)); return No_Node; end case; end P_Boolean_Term; ----------------------- -- P_Classifier_Type -- ----------------------- -- classifier_type ::= -- classifier [ ( component_category { , component_category }* ) ] function P_Classifier_Type return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Components; Class_Type : list_id; Start_Loc : location; begin Save_Lexer (Start_Loc); Scan_Token; if Token /= t_left_parenthesis then -- classifier_type is empty Restore_Lexer (Start_Loc); Class_Type := New_List (k_classifier_type, Start_Loc); else Class_Type := P_Items_List (P_Component_Category'access, No_Node, t_comma, t_right_parenthesis, pc_classifier_type); if No (Class_Type) then -- error when parsing classifier elements, quit return No_Node; end if; Set_Kind (node_id (Class_Type), k_classifier_type); Set_Loc (node_id (Class_Type), Start_Loc); end if; return node_id (Class_Type); end P_Classifier_Type; --------------------------------- -- P_Component_Classifier_Term -- --------------------------------- -- component_classifier_term ::= -- component_category [ unique_component_type_identifier -- [ . component_implementation_identifier ] ] function P_Component_Classifier_Term return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; use Ocarina.AADL.Parser.Components; Class_Term : node_id; Category : component_category; Start_Loc : location; Loc : location; begin Save_Lexer (Start_Loc); Category := P_Component_Category; Save_Lexer (Loc); Scan_Token; if Token = t_identifier then Restore_Lexer (Loc); Class_Term := P_Entity_Reference (pc_component_classifier_term); if Class_Term = No_Node then return No_Node; else Set_Kind (Class_Term, k_component_classifier_term); end if; else Class_Term := New_Node (k_component_classifier_term, Start_Loc); Restore_Lexer (Loc); end if; Set_Component_Cat (Class_Term, component_category'pos (Category)); return Class_Term; end P_Component_Classifier_Term; ------------------------------- -- P_Constant_Property_Value -- ------------------------------- function P_Constant_Property_Value (Container : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; pragma unreferenced (Container); Const : node_id; -- output Loc : location; begin Save_Lexer (Loc); Scan_Token; case Token is when t_string_literal | t_true | t_false => Const := New_Node (k_literal, Token_Location); if Token = t_string_literal then Set_Value (Const, New_String_Value (String_Literal_Value)); elsif Token = t_true then Set_Value (Const, New_Boolean_Value (True)); else Set_Value (Const, New_Boolean_Value (False)); end if; return Const; when t_identifier => Const := New_Node (k_literal, Token_Location); Set_Value (Const, New_Enum_Value (Token_Display_Name)); return Const; when t_plus | t_minus | t_integer_literal | t_real_literal => Restore_Lexer (Loc); Const := P_Numeric_Term (pc_constant_property_value); if Present (Const) then -- Signed_AADLNumber was parsed successfully, -- try to determine Number_Term or Range_Term return P_Signed_Number_Or_Range (Const); else return No_Node; end if; when others => DPE (pc_constant_property_value); Restore_Lexer (Loc); return No_Node; end case; end P_Constant_Property_Value; ------------------------ -- P_Enumeration_Type -- ------------------------ -- enumeration_type ::= -- enumeration ( defining_enumeration_literal_identifier -- { , defining_enumeration_literal_identifier }* ) function P_Enumeration_Type return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Enum : node_id; Items : list_id; Item : node_id; begin Enum := New_Node (k_enumeration_type, Token_Location); Scan_Token; if Token /= t_left_parenthesis then DPE (pc_enumeration_type, t_left_parenthesis); return No_Node; end if; Items := P_Items_List (P_Identifier'access, No_Node, t_comma, False); if No (Items) then DPE (pc_enumeration_type, t_identifier); return No_Node; end if; Scan_Token; if Token /= t_right_parenthesis then DPE (pc_enumeration_type, t_right_parenthesis); return No_Node; end if; Set_Identifiers (Enum, Items); -- add enumeration_literal_identifiers to current_context Item := First_Node (Items); while Present (Item) loop Set_Corresponding_Entity (Item, Enum); Item := Next_Node (Item); end loop; return Enum; end P_Enumeration_Type; ----------------------------- -- P_Multi_Valued_Property -- ----------------------------- -- multi_valued_property ::= list of property_type_designator -- [ => ( [ default_property_expression -- { , default_property_expression }* ] ) ] function P_Multi_Valued_Property return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL.Parser.Properties.Values; use Lexer; use Tokens; Valued_Property : node_id; -- output; Property_Type_Designator : node_id; Property_Expressions : list_id; Loc : location; begin Valued_Property := New_Node (k_multi_valued_property, Token_Location); Scan_Token; if Token /= t_of then DPE (pc_multi_valued_property, t_of); return No_Node; end if; Property_Type_Designator := P_Property_Type_Designator; if No (Property_Type_Designator) then -- error when parsing Property_Type_Designator, quit return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = t_association then Scan_Token; if Token /= t_left_parenthesis then DPE (pc_multi_valued_property, t_left_parenthesis); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token /= t_right_parenthesis then Restore_Lexer (Loc); Property_Expressions := P_Items_List (Func => P_Property_Expression'access, Container => No_Node, Separator => t_comma, Delimiter => t_right_parenthesis, Code => pc_multi_valued_property); else Property_Expressions := New_List (k_list_id, Token_Location); end if; else Restore_Lexer (Loc); Property_Expressions := No_List; end if; Set_Property_Type_Designator (Valued_Property, Property_Type_Designator); Set_Property_Expressions (Valued_Property, Property_Expressions); return Valued_Property; end P_Multi_Valued_Property; -------------------- -- P_Numeric_Term -- -------------------- -- signed_aadlreal_or_constant ::= -- ( signed_aadlreal | [ sign ] real_property_constant_term ) -- signed_aadlinteger_or_constant ::= -- ( signed_aadlinteger | [ sign ] integer_property_constant_term ) -- sign ::= + | - -- signed_aadlinteger ::= -- [ sign ] integer_literal [ unit_identifier ] -- signed_aadlreal ::= -- [ sign ] real_literal [ unit_identifier ] function P_Numeric_Term (Code : parsing_code) return node_id is use Ocarina.Nutils; use Ocarina.Nodes; use Ocarina.AADL.Lexer; use Ocarina.AADL.Tokens; Loc : location; Term : node_id; begin Save_Lexer (Loc); Scan_Token; case Token is when t_minus => return P_Minus_Numeric_Term (Code); when t_plus => Scan_Token; case Token is when t_real_literal | t_integer_literal => Restore_Lexer (Loc); return P_Signed_AADLNumber (nc_unknown, Code); when t_value => Term := P_Value_Unique_Property_Identifier (Code); if Term /= No_Node then Set_Kind (Term, k_property_term); end if; return Term; when others => DPE (Code); return No_Node; end case; when t_real_literal | t_integer_literal => Restore_Lexer (Loc); return P_Signed_AADLNumber (nc_unknown, Code); when t_value => Term := P_Value_Unique_Property_Identifier (Code); if Term /= No_Node then Set_Kind (Term, k_property_term); end if; return Term; when others => DPE (Code); return No_Node; end case; end P_Numeric_Term; -------------------------- -- P_Minus_Numeric_Term -- -------------------------- function P_Minus_Numeric_Term (Code : parsing_code) return node_id is use Ocarina.Nutils; use Ocarina.Nodes; use Ocarina.AADL.Lexer; use Ocarina.AADL.Tokens; Loc : location; Numeric_Term : constant node_id := New_Node (k_minus_numeric_term, No_Location); Subterm : node_id; begin Save_Lexer (Loc); Set_Loc (Numeric_Term, Loc); Scan_Token; case Token is when t_real_literal | t_integer_literal => Restore_Lexer (Loc); Subterm := P_Signed_AADLNumber (nc_unknown, pc_property_expression); when t_value => Subterm := P_Value_Unique_Property_Identifier (pc_unique_property_constant_identifier); if Subterm /= No_Node then Set_Kind (Subterm, k_property_term); end if; when others => DPE (Code); Subterm := No_Node; end case; if Subterm = No_Node then return No_Node; else Set_Numeric_Term (Numeric_Term, Subterm); end if; return Numeric_Term; end P_Minus_Numeric_Term; -------------------- -- P_Number_Range -- -------------------- -- real_range ::= real_lower_bound .. real_upper_bound -- real_lower_bound ::= signed_aadlreal -- real_upper_bound ::= signed_aadlreal -- integer_range ::= integer_lower_bound .. integer_upper_bound -- integer_lower_bound ::= signed_aadlinteger -- integer_upper_bound ::= signed_aadlinteger function P_Number_Range (Number_Cat : number_category) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; Number_Range : node_id; Lower_Bound : node_id; Upper_Bound : node_id; Code : parsing_code; begin case Number_Cat is when nc_real => Code := pc_real_range; when nc_integer => Code := pc_integer_range; when nc_unknown => Code := pc_number_range; end case; Lower_Bound := P_Numeric_Term (Code); if No (Lower_Bound) then return No_Node; end if; Scan_Token; if Token /= t_interval then DPE (Code, t_interval); return No_Node; end if; Upper_Bound := P_Numeric_Term (Code); if No (Upper_Bound) then return No_Node; end if; Number_Range := New_Node (k_number_range, Loc (Lower_Bound)); Set_Lower_Bound (Number_Range, Lower_Bound); Set_Upper_Bound (Number_Range, Upper_Bound); return Number_Range; end P_Number_Range; ------------------- -- P_Number_Type -- ------------------- -- number_type ::= -- aadlreal [ real_range ] [ units unit_designator ] -- | aadlinteger [ integer_range ] [ units unit_designator ] -- unit_designator ::= units_unique_property_type_identifier -- | units_list -- unique_property_type_identifier ::= -- [ property_set_identifier :: ] property_type_identifier function P_Number_Type return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Number_Type : node_id; Type_Range : node_id; Unit_Designator : node_id; Number_Cat : number_category; Loc : location; begin if Token = t_aadlreal then Number_Type := New_Node (k_real_type, Token_Location); Number_Cat := nc_real; else Number_Type := New_Node (k_integer_type, Token_Location); Number_Cat := nc_integer; end if; Save_Lexer (Loc); Scan_Token; if Token = t_real_literal or else Token = t_integer_literal or else Token = t_minus or else Token = t_plus or else Token = t_value then Restore_Lexer (Loc); Type_Range := P_Number_Range (Number_Cat); if No (Type_Range) then return No_Node; end if; else Type_Range := No_Node; Restore_Lexer (Loc); end if; Save_Lexer (Loc); Scan_Token; if Token = t_units then Save_Lexer (Loc); Scan_Token; if Token = t_left_parenthesis then Restore_Lexer (Loc); Unit_Designator := P_Units_Type; if No (Unit_Designator) then return No_Node; end if; elsif Token = t_identifier then Restore_Lexer (Loc); Unit_Designator := P_Entity_Reference (pc_unique_property_type_identifier); if Present (Unit_Designator) then Set_Kind (Unit_Designator, k_unique_property_type_identifier); else return No_Node; end if; end if; else Unit_Designator := No_Node; Restore_Lexer (Loc); end if; Set_Type_Range (Number_Type, Type_Range); Set_Unit_Designator (Number_Type, Unit_Designator); return Number_Type; end P_Number_Type; ----------------------- -- P_Or_Boolean_Term -- ----------------------- -- boolean_term [ and boolean_term ] [ or boolean_term ] -- We add the [ and boolean_term ] since this is the entry point -- for parsing boolean expressions. function P_Or_Boolean_Term return node_id is Bool_Term : node_id; begin Bool_Term := P_And_Boolean_Term; if No (Bool_Term) then return No_Node; else return P_Or_Boolean_Term_Aux (Bool_Term); end if; end P_Or_Boolean_Term; --------------------------- -- P_Or_Boolean_Term_Aux -- --------------------------- -- [ or boolean_term ] function P_Or_Boolean_Term_Aux (Bool_Term : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; Or_Term : node_id; Second_Bool_Term : node_id; Loc : location; begin Save_Lexer (Loc); Scan_Token; if Token = t_or then Second_Bool_Term := P_And_Boolean_Term; if No (Second_Bool_Term) then return No_Node; else Or_Term := New_Node (k_or_boolean_term, Ocarina.Nodes.Loc (Bool_Term)); Set_First_Term (Or_Term, Bool_Term); Set_Second_Term (Or_Term, Second_Bool_Term); return P_Or_Boolean_Term_Aux (Or_Term); end if; else Restore_Lexer (Loc); return Bool_Term; end if; end P_Or_Boolean_Term_Aux; ------------------------- -- P_Property_Constant -- ------------------------- -- property_constant ::= single_valued_property_constant -- | multi_valued_property_constant -- single_valued_property_constant ::= -- defining_property_constant_identifier : constant -- ( ( aadlinteger -- | aadlreal ) [ units_unique_property_type_identifier ] -- | aadlstring | aadlboolean -- | enumeration_unique_property_type_identifier -- | integer_range_unique_property_type_identifier -- | real_range_unique_property_type_identifier -- | integer_unique_property_type_identifer -- | real_unique_property_type_identifer ) -- => constant_property_value ; -- multi_valued_property_constant ::= -- defining_property_constant_identifier : constant list of -- ( ( aadlinteger -- | aadlreal ) [ units_unique_property_type_identifier ] -- | aadlstring | aadlboolean -- | enumeration_unique_property_type_identifier -- | integer_range_unique_property_type_identifier -- | real_range_unique_property_type_identifier -- | integer_unique_property_type_identifer -- | real_unique_property_type_identifer ) -- => ( [ constant_property_value { , constant_property_value }* ] ) ; function P_Property_Constant (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.Identifiers; use Ocarina.Builder.Properties; Property : node_id; -- output Constant_Type : node_id; Unit_Ident : node_id := No_Node; -- used only for AADLInteger and AADLReal Property_Value : node_id := No_Node; -- only for --single_valued_property Property_Values : list_id := No_List; -- only for multi_valued_property Code : parsing_code; Loc : location; begin Save_Lexer (Loc); Scan_Token; if Token = t_list then Code := pc_multi_valued_property_constant; Scan_Token; if Token /= t_of then DPE (Code, t_of); Skip_Tokens (t_semicolon); return No_Node; end if; else Restore_Lexer (Loc); Code := pc_single_valued_property_constant; end if; Save_Lexer (Loc); Scan_Token; case Token is when t_aadlinteger | t_aadlreal => if Token = t_aadlinteger then Constant_Type := New_Node (k_integer_type, Token_Location); else Constant_Type := New_Node (k_real_type, Token_Location); end if; Set_Type_Range (Constant_Type, No_Node); Set_Unit_Designator (Constant_Type, No_Node); -- try to parse unit_identifier Save_Lexer (Loc); Scan_Token; if Token = t_identifier then Restore_Lexer (Loc); Unit_Ident := P_Entity_Reference (Code); if No (Unit_Ident) then Skip_Tokens (t_semicolon); return No_Node; end if; Set_Kind (Unit_Ident, k_unique_property_type_identifier); else Restore_Lexer (Loc); end if; when t_aadlstring => Constant_Type := New_Node (k_string_type, Token_Location); when t_aadlboolean => Constant_Type := New_Node (k_boolean_type, Token_Location); when t_identifier => -- parse xxxxxx_unique_property_type_identifier Restore_Lexer (Loc); Constant_Type := P_Entity_Reference (Code); if No (Constant_Type) then Skip_Tokens (t_semicolon); return No_Node; else -- update constant_type node kind Set_Kind (Constant_Type, k_unique_property_type_identifier); end if; when others => if Code = pc_single_valued_property_constant then DPE (pc_property_constant, (t_list, t_aadlinteger, t_aadlreal, t_aadlstring, t_aadlboolean, t_identifier)); else DPE (Code, (t_aadlinteger, t_aadlreal, t_aadlstring, t_aadlboolean, t_identifier)); end if; Skip_Tokens (t_semicolon); return No_Node; end case; Scan_Token; if Token /= t_association then DPE (Code, t_association); Skip_Tokens (t_semicolon); return No_Node; end if; if Code = pc_single_valued_property_constant then Property_Value := P_Constant_Property_Value (No_Node); if No (Property_Value) then -- error when parsing Constant_Property_Value, quit Skip_Tokens (t_semicolon); return No_Node; end if; else Scan_Token; if Token /= t_left_parenthesis then DPE (Code, t_left_parenthesis); Skip_Tokens (t_semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = t_right_parenthesis then -- Constant_Property_Value list is empty, they are optional Property_Values := No_List; else Restore_Lexer (Loc); Property_Values := P_Items_List (P_Constant_Property_Value'access, No_Node, t_comma, t_right_parenthesis, Code); if No (Property_Values) then -- error when parsing Constant_Property_Value list, quit Skip_Tokens (t_semicolon); return No_Node; end if; end if; end if; Save_Lexer (Loc); Scan_Token; if Token /= t_semicolon then DPE (Code, t_semicolon); Restore_Lexer (Loc); return No_Node; end if; Property := Add_New_Property_Constant_Declaration (Loc => Ocarina.Nodes.Loc (Identifier), Name => Identifier, Property_Set => Property_Set, Single_Value => Property_Value, Multiple_Values => Property_Values, Unit_Identifier => Unit_Ident, Constant_Type => Constant_Type); return Property; end P_Property_Constant; --------------------------------- -- P_Property_Type_Declaration -- --------------------------------- -- property_type_declaration ::= -- defining_property_type_identifier : type property_type_designator ; function P_Property_Type_Declaration (Identifier : node_id; Property_Set : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.Builder.Properties; Property : node_id; Designator : node_id; Loc : location; begin Designator := P_Property_Type_Designator; if No (Designator) then -- error when parsing property_type_designator, quit Skip_Tokens (t_semicolon); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token /= t_semicolon then DPE (pc_property_type_declaration, t_semicolon); Restore_Lexer (Loc); return No_Node; end if; Property := Add_New_Property_Type_Declaration (Loc => Ocarina.Nodes.Loc (Identifier), Property_Set => Property_Set, Name => Identifier, Type_Designator => Designator); return Property; end P_Property_Type_Declaration; -------------------------------- -- P_Property_Type_Designator -- -------------------------------- -- property_type_designator ::= property_type -- | unique_property_type_identifier -- property_type ::= aadlboolean | aadlstring | enumeration_type -- | units_type | number_type | range_type -- | classifier_type | reference_type -- unique_property_type_identifier ::= -- [ property_set_identifier :: ] property_type_identifier function P_Property_Type_Designator return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Properties.Values; use Ocarina.AADL.Parser.Identifiers; Prop_Id : node_id; Loc : location; begin Save_Lexer (Loc); Scan_Token; case Token is when t_aadlboolean => return New_Node (k_boolean_type, Token_Location); when t_aadlstring => return New_Node (k_string_type, Token_Location); when t_enumeration => return P_Enumeration_Type; when t_units => return P_Units_Type; when t_aadlreal | t_aadlinteger => return P_Number_Type; when t_range => return P_Range_Type; when t_classifier => return P_Classifier_Type; when t_reference => return P_Reference_Type; when t_identifier => Restore_Lexer (Loc); Prop_Id := P_Entity_Reference (pc_property_type_designator); if Present (Prop_Id) then Set_Kind (Prop_Id, k_unique_property_type_identifier); end if; return Prop_Id; when others => DPE (pc_property_type_designator, (t_aadlboolean, t_aadlstring, t_aadlinteger, t_aadlreal, t_enumeration, t_units, t_range, t_classifier, t_reference, t_identifier)); return No_Node; end case; end P_Property_Type_Designator; ------------------ -- P_Range_Type -- ------------------ -- range_type ::= range of number_type -- | range of number_unique_property_type_identifier function P_Range_Type 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; Range_Type : node_id; -- output Number_Type : node_id; Loc : location; begin Range_Type := New_Node (k_range_type, Token_Location); Scan_Token; if Token /= t_of then DPE (pc_range_type, t_of); return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = t_aadlreal or else Token = t_aadlinteger then Number_Type := P_Number_Type; if No (Number_Type) then return No_Node; end if; elsif Token = t_identifier then Restore_Lexer (Loc); Number_Type := P_Entity_Reference (pc_unique_property_type_identifier); if Present (Number_Type) then Set_Kind (Number_Type, k_unique_property_type_identifier); else return No_Node; end if; else DPE (pc_range_type, (t_aadlinteger, t_aadlreal, t_identifier)); return No_Node; end if; Set_Number_Type (Range_Type, Number_Type); return Range_Type; end P_Range_Type; ---------------------------------- -- P_Referable_Element_Category -- ---------------------------------- -- referable_element_category ::= component_category -- | connections -- | server subprogram function P_Referable_Element_Category (Container : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Components; pragma unreferenced (Container); Referable_Elt : node_id; Category : referable_element_category; Comp_Cat : component_category; begin Scan_Token; Referable_Elt := New_Node (k_referable_element_category, Token_Location); case Token is when t_connections => Comp_Cat := cc_unknown; Category := rec_connections; when t_server => Scan_Token; if Token /= t_subprogram then DPE (pc_referable_element_category, t_subprogram); return No_Node; end if; Comp_Cat := cc_unknown; Category := rec_server_subprogram; when t_data | t_subprogram | t_thread | t_process | t_memory | t_processor | t_bus | t_device | t_system => Comp_Cat := P_Component_Category; Category := rec_component_category; when others => DPE (pc_referable_element_category); return No_Node; end case; Set_Component_Cat (Referable_Elt, component_category'pos (Comp_Cat)); Set_Category (Referable_Elt, referable_element_category'pos (Category)); return Referable_Elt; end P_Referable_Element_Category; ---------------------- -- P_Reference_Type -- ---------------------- -- reference_type ::= component [ ( referable_element_category -- { , referable_element_category }* ) ] function P_Reference_Type return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; Ref_Type : list_id; Start_Loc : location; begin Save_Lexer (Start_Loc); Scan_Token; if Token /= t_left_parenthesis then -- reference_type is empty Restore_Lexer (Start_Loc); Ref_Type := New_List (k_reference_type, Start_Loc); else Ref_Type := P_Items_List (P_Referable_Element_Category'access, No_Node, t_comma, t_right_parenthesis, pc_reference_type); if No (Ref_Type) then -- error when parsing classifier elements, quit return No_Node; end if; Set_Kind (node_id (Ref_Type), k_reference_type); Set_Loc (node_id (Ref_Type), Start_Loc); end if; return node_id (Ref_Type); end P_Reference_Type; ------------------------- -- P_Signed_AADLNumber -- ------------------------- function P_Signed_AADLNumber (Number_Cat : number_category; Code : parsing_code) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Signed_Number : node_id; -- output Number_Value : node_id; Unit_Ident : node_id; Unitable : Boolean := False; Loc : location; begin Save_Lexer (Loc); Scan_Token; Signed_Number := New_Node (k_signed_aadlnumber, Token_Location); if Token /= t_minus and then Token /= t_plus then Restore_Lexer (Loc); end if; -- Sign is actually ignored, since it should have been parsed -- before. Scan_Token; case Token is when t_real_literal => if Number_Cat = nc_integer then DPE (Code, t_integer_literal); return No_Node; end if; Number_Value := New_Node (k_literal, Token_Location); Set_Value (Number_Value, New_Real_Value (Float_Literal_Value, False, Numeric_Literal_Base, Numeric_Literal_Exp)); Unitable := True; when t_integer_literal => Number_Value := New_Node (k_literal, Token_Location); Set_Value (Number_Value, New_Integer_Value (Integer_Literal_Value, False, Numeric_Literal_Base, Numeric_Literal_Exp)); Unitable := True; when t_value => Number_Value := P_Value_Unique_Property_Identifier (pc_unique_property_constant_identifier); if No (Number_Value) then return No_Node; else Set_Kind (Number_Value, k_unique_property_const_identifier); end if; when others => case Number_Cat is when nc_real => DPE (Code, (t_value, t_real_literal)); when nc_integer => DPE (Code, (t_value, t_integer_literal)); when nc_unknown => DPE (Code, (t_value, t_real_literal, t_integer_literal)); end case; return No_Node; end case; if Unitable then -- try to parse unit_identifier Unit_Ident := P_Identifier (No_Node); else -- no unit for property_constant_term Unit_Ident := No_Node; end if; Set_Number_Value (Signed_Number, Number_Value); Set_Unit_Identifier (Signed_Number, Unit_Ident); return Signed_Number; end P_Signed_AADLNumber; ------------------------------ -- P_Signed_Number_Or_Range -- ------------------------------ -- Number_Term [ .. Number_Term [ delta Number_Term ] ] function P_Signed_Number_Or_Range (First_Term : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; Range_Term : node_id; -- output Second_Term : node_id; Delta_Term : node_id; Loc : location; begin -- First_Term contains a Real_Term or an Integer_Term -- Continue parsing to distinguish Number_Term and Number_Range_Term Save_Lexer (Loc); Scan_Token; if Token /= t_interval then Restore_Lexer (Loc); return First_Term; end if; -- Token '..' is found, parse Integer_Range_Term or Real_Range_Term Second_Term := P_Numeric_Term (pc_number_range_term); if No (Second_Term) then return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = t_delta then Delta_Term := P_Numeric_Term (pc_number_range_term); if No (Delta_Term) then return No_Node; end if; else Restore_Lexer (Loc); Delta_Term := No_Node; end if; Range_Term := New_Node (k_number_range_term, Ocarina.Nodes.Loc (First_Term)); Set_Lower_Bound (Range_Term, First_Term); Set_Upper_Bound (Range_Term, Second_Term); Set_Delta_Term (Range_Term, Delta_Term); return Range_Term; end P_Signed_Number_Or_Range; ------------------------------ -- P_Single_Valued_Property -- ------------------------------ -- single_valued_property ::= -- property_type_designator [ => default_property_expression ] function P_Single_Valued_Property return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL.Parser.Properties.Values; use Lexer; use Tokens; Valued_Property : node_id; Property_Type_Designator : node_id; Property_Expression : node_id; Loc : location; begin Property_Type_Designator := P_Property_Type_Designator; if No (Property_Type_Designator) then -- error when parsing Property_Type_Designator, quit return No_Node; end if; Save_Lexer (Loc); Scan_Token; if Token = t_association then Property_Expression := P_Property_Expression (No_Node); if No (Property_Expression) then -- error when parsing Property_Expression, quit return No_Node; end if; else Restore_Lexer (Loc); Property_Expression := No_Node; end if; Valued_Property := New_Node (k_single_valued_property, Ocarina.Nodes.Loc (Property_Type_Designator)); Set_Property_Type_Designator (Valued_Property, Property_Type_Designator); Set_Property_Expression (Valued_Property, Property_Expression); return Valued_Property; end P_Single_Valued_Property; --------------------------- -- P_Property_Expression -- --------------------------- -- property_expression ::= -- boolean_term -- | real_term -- | integer_term -- | string_term -- | enumeration_term -- | real_range_term -- | integer_range_term -- | property_term -- | component_classifier_term -- | reference_term function P_Property_Expression (Container : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Lexer; use Tokens; pragma unreferenced (Container); Property : node_id; -- output First_Num_Term : node_id; Loc : location; begin Save_Lexer (Loc); Scan_Token; case Token is when t_true | t_false | t_not | t_left_parenthesis => Restore_Lexer (Loc); return P_Or_Boolean_Term; when t_value => Property := P_Value_Unique_Property_Identifier (pc_property_term); if No (Property) then return No_Node; end if; -- Check whether the parsed Property is a boolean_property_term -- or an integer_term or an number_term Save_Lexer (Loc); Scan_Token; case Token is when t_and => Restore_Lexer (Loc); Set_Kind (Property, k_property_term); return P_And_Boolean_Term_Aux (Property); when t_or => Restore_Lexer (Loc); Set_Kind (Property, k_property_term); return P_Or_Boolean_Term_Aux (Property); when t_interval => -- restore lexer location, update First_Num_Term Restore_Lexer (Loc); First_Num_Term := New_Node (k_signed_aadlnumber, Ocarina.Nodes.Loc (Property)); Set_Number_Value (First_Num_Term, Property); Set_Unit_Identifier (First_Num_Term, No_Node); when others => Restore_Lexer (Loc); Set_Kind (Property, k_property_term); return Property; end case; when t_real_literal | t_integer_literal | t_plus | t_minus => Restore_Lexer (Loc); First_Num_Term := P_Numeric_Term (pc_property_expression); if No (First_Num_Term) then return No_Node; end if; when t_string_literal => Property := New_Node (k_literal, Token_Location); Set_Value (Property, New_String_Value (String_Literal_Value)); return Property; when t_identifier => Property := New_Node (k_literal, Token_Location); Set_Value (Property, New_Enum_Value (Token_Name)); -- The value is not the raw string, but the string -- normalized lower case. This way, the value are case -- insensitive. return Property; when t_data | t_subprogram | t_thread | t_process | t_memory | t_processor | t_bus | t_device | t_system => return P_Component_Classifier_Term; when t_reference => return P_Reference_Term; when others => DPE (pc_property_expression); return No_Node; end case; return P_Signed_Number_Or_Range (First_Num_Term); end P_Property_Expression; ---------------------- -- P_Reference_Term -- ---------------------- -- reference_term ::= component -- ( subcomponent_identifier { . subcomponent_identifier }* -- | subcomponent_identifier { . connection_identifier }* -- | subcomponent_identifier { . server_subprogram_identifier }* ) function P_Reference_Term return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Ref_Term : node_id; Start_Loc : location; begin Save_Lexer (Start_Loc); Ref_Term := P_Entity_Reference (pc_reference_term); if No (Ref_Term) then DPE (pc_reference_term, t_identifier); return No_Node; end if; Set_Kind (Ref_Term, k_reference_term); Set_Loc (Ref_Term, Start_Loc); return Ref_Term; end P_Reference_Term; ---------------------------------------- -- P_Value_Unique_Property_Identifier -- ---------------------------------------- -- unique_property_constant_identifier ::= -- value ( [ property_set_identifier :: ] property_constant_identifier ) -- property_term ::= -- value ( [ property_set_identifier :: ] property_name_identifier ) function P_Value_Unique_Property_Identifier (Code : parsing_code) return node_id is use Ocarina.Nodes; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Property : node_id; begin Scan_Token; if Token /= t_left_parenthesis then DPE (Code, t_left_parenthesis); return No_Node; end if; Property := P_Entity_Reference (Code); if No (Property) then return No_Node; end if; Scan_Token; if Token /= t_right_parenthesis then DPE (Code, t_right_parenthesis); return No_Node; end if; return Property; end P_Value_Unique_Property_Identifier; ----------------------- -- P_Unit_Definition -- ----------------------- -- defining_unit_identifier => unit_identifier * numeric_literal function P_Unit_Definition (Container : node_id) return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.AADL_Values; use Tokens; use Lexer; use Ocarina.AADL.Parser.Identifiers; Definition : node_id; Identifier : node_id; Unit_Identifier : node_id; Numeric_Literal : node_id; Literal_Value : value_id; begin -- To be able to access to both the units type and the unit -- definition, we link the defining identifier of the unit -- definition to the unit definition node and the unit -- identifier of the unit definition to the units type. Scan_Token; if Token /= t_identifier then DPE (pc_unit_definition, t_identifier); return No_Node; end if; Definition := New_Node (k_unit_definition, Token_Location); Identifier := Make_Current_Identifier (Definition); Set_Identifier (Definition, Identifier); Scan_Token; if Token /= t_association then DPE (pc_unit_definition, t_association); return No_Node; end if; Scan_Token; if Token /= t_identifier then DPE (pc_unit_definition, t_identifier); return No_Node; end if; Unit_Identifier := Make_Current_Identifier (Container); Scan_Token; if Token /= t_multiply then DPE (pc_unit_definition, t_multiply); return No_Node; end if; Scan_Token; if Token = t_integer_literal then Literal_Value := New_Integer_Value (Integer_Literal_Value, False, Numeric_Literal_Base, Numeric_Literal_Exp); elsif Token = t_real_literal then Literal_Value := New_Real_Value (Float_Literal_Value, False, Numeric_Literal_Base, Numeric_Literal_Exp); else DPE (pc_unit_definition, (t_integer_literal, t_real_literal)); return No_Node; end if; Numeric_Literal := New_Node (k_literal, Token_Location); Ocarina.Nodes.Set_Value (Numeric_Literal, Literal_Value); Set_Unit_Identifier (Definition, Unit_Identifier); Set_Numeric_Literal (Definition, Numeric_Literal); return Definition; end P_Unit_Definition; ------------------ -- P_Units_Type -- ------------------ -- units_type ::= -- units units_list -- units_list ::= -- ( defining_unit_identifier -- { , defining_unit_identifier => unit_identifier * numeric_literal }* ) function P_Units_Type return node_id is use Ocarina.Nodes; use Ocarina.Nutils; use Lexer; use Tokens; use Ocarina.AADL.Parser.Identifiers; Units : node_id; Base : node_id; Items : list_id; begin Units := New_Node (k_units_type, Token_Location); Scan_Token; if Token /= t_left_parenthesis then DPE (pc_units_type, t_left_parenthesis); return No_Node; end if; Scan_Token; if Token /= t_identifier then DPE (pc_units_type, t_identifier); return No_Node; end if; Base := Make_Current_Identifier (Units); Scan_Token; if Token = t_comma then Items := P_Items_List (P_Unit_Definition'access, Units, t_comma, t_right_parenthesis, pc_units_type); if No (Items) then -- error when parsing units elements, quit return No_Node; end if; elsif Token = t_right_parenthesis then Items := No_List; else DPE (pc_units_type, (t_comma, t_right_parenthesis)); return No_Node; end if; Set_Base_Identifier (Units, Base); Set_Unit_Definitions (Units, Items); return Units; end P_Units_Type; end Ocarina.AADL.Parser.Properties.Values;