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