| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- P A R . C H 8 -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT 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 GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| pragma Style_Checks (All_Checks); |
| -- Turn off subprogram body ordering check. Subprograms are in order |
| -- by RM section rather than alphabetical |
| |
| separate (Par) |
| package body Ch8 is |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| procedure Append_Use_Clause |
| (Item_List : List_Id; |
| Use_Node : Node_Id; |
| Is_First : in out Boolean; |
| Is_Last : in out Boolean); |
| -- Append a use_clause to the Item_List, appropriately setting the Prev_Ids |
| -- and More_Ids flags for each split use node. The flags Is_First and |
| -- Is_Last track position of subtype_marks or names within the original |
| -- use_clause. |
| |
| procedure P_Use_Package_Clause (Item_List : List_Id); |
| procedure P_Use_Type_Clause (Item_List : List_Id); |
| |
| ----------------------- |
| -- Append_Use_Clause -- |
| ----------------------- |
| |
| procedure Append_Use_Clause |
| (Item_List : List_Id; |
| Use_Node : Node_Id; |
| Is_First : in out Boolean; |
| Is_Last : in out Boolean) |
| is |
| begin |
| if Token /= Tok_Comma then |
| if not Is_First then |
| Set_Prev_Ids (Use_Node); |
| end if; |
| |
| Append (Use_Node, Item_List); |
| Is_Last := True; |
| |
| else |
| Set_More_Ids (Use_Node); |
| |
| if not Is_First then |
| Set_Prev_Ids (Use_Node); |
| else |
| Is_First := False; |
| end if; |
| |
| Append (Use_Node, Item_List); |
| Scan; -- Past comma |
| end if; |
| end Append_Use_Clause; |
| |
| --------------------- |
| -- 8.4 Use Clause -- |
| --------------------- |
| |
| -- USE_CLAUSE ::= USE_PACKAGE_CLAUSE | USE_TYPE_CLAUSE |
| |
| -- The caller has checked that the initial token is USE |
| |
| -- Error recovery: cannot raise Error_Resync |
| |
| procedure P_Use_Clause (Item_List : List_Id) is |
| begin |
| Scan; -- past USE |
| |
| if Token = Tok_Type or else Token = Tok_All then |
| P_Use_Type_Clause (Item_List); |
| else |
| P_Use_Package_Clause (Item_List); |
| end if; |
| end P_Use_Clause; |
| |
| ----------------------------- |
| -- 8.4 Use Package Clause -- |
| ----------------------------- |
| |
| -- USE_PACKAGE_CLAUSE ::= use package_NAME {, package_NAME}; |
| |
| -- The caller has scanned out the USE keyword |
| |
| -- Error recovery: cannot raise Error_Resync |
| |
| procedure P_Use_Package_Clause (Item_List : List_Id) is |
| Is_First : Boolean := True; |
| Is_Last : Boolean := False; |
| Use_Node : Node_Id; |
| Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; |
| |
| begin |
| if Token = Tok_Package then |
| Error_Msg_SC ("PACKAGE should not appear here"); |
| Scan; -- Past PACKAGE |
| end if; |
| |
| -- Loop through names in a single use_package_clause, generating an |
| -- N_Use_Package_Clause node for each name encountered. |
| |
| loop |
| Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc); |
| Set_Name (Use_Node, P_Qualified_Simple_Name); |
| |
| -- Locally chain each name's use-package node |
| |
| Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last); |
| exit when Is_Last; |
| end loop; |
| |
| TF_Semicolon; |
| end P_Use_Package_Clause; |
| |
| -------------------------- |
| -- 8.4 Use Type Clause -- |
| -------------------------- |
| |
| -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK}; |
| |
| -- The caller has checked that the initial token is USE, scanned it out |
| -- and that the current token is either ALL or TYPE. |
| |
| -- Note: Use of ALL is an Ada 2012 feature |
| |
| -- Error recovery: cannot raise Error_Resync |
| |
| procedure P_Use_Type_Clause (Item_List : List_Id) is |
| Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; |
| |
| All_Present : Boolean; |
| Is_First : Boolean := True; |
| Is_Last : Boolean := False; |
| Use_Node : Node_Id; |
| |
| begin |
| if Token = Tok_All then |
| Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr); |
| All_Present := True; |
| Scan; -- Past ALL |
| |
| if Token /= Tok_Type then |
| Error_Msg_SC ("TYPE expected"); |
| end if; |
| |
| else |
| pragma Assert (Token = Tok_Type); |
| All_Present := False; |
| end if; |
| |
| if Ada_Version = Ada_83 then |
| Error_Msg_SC ("(Ada 83) use type not allowed!"); |
| end if; |
| |
| Scan; -- Past TYPE |
| |
| -- Loop through subtype_marks in one use_type_clause, generating a |
| -- separate N_Use_Type_Clause node for each subtype_mark encountered. |
| |
| loop |
| Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc); |
| Set_All_Present (Use_Node, All_Present); |
| Set_Used_Operations (Use_Node, No_Elist); |
| |
| Set_Subtype_Mark (Use_Node, P_Subtype_Mark); |
| |
| No_Constraint; |
| |
| -- Locally chain each subtype_mark's use-type node |
| |
| Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last); |
| exit when Is_Last; |
| end loop; |
| |
| TF_Semicolon; |
| end P_Use_Type_Clause; |
| |
| ------------------------------- |
| -- 8.5 Renaming Declaration -- |
| ------------------------------- |
| |
| -- Object renaming declarations and exception renaming declarations |
| -- are parsed by P_Identifier_Declaration (3.3.1) |
| |
| -- Subprogram renaming declarations are parsed by P_Subprogram (6.1) |
| |
| -- Package renaming declarations are parsed by P_Package (7.1) |
| |
| -- Generic renaming declarations are parsed by P_Generic (12.1) |
| |
| ---------------------------------------- |
| -- 8.5.1 Object Renaming Declaration -- |
| ---------------------------------------- |
| |
| -- Parsed by P_Identifier_Declarations (3.3.1) |
| |
| ------------------------------------------- |
| -- 8.5.2 Exception Renaming Declaration -- |
| ------------------------------------------- |
| |
| -- Parsed by P_Identifier_Declarations (3.3.1) |
| |
| ----------------------------------------- |
| -- 8.5.3 Package Renaming Declaration -- |
| ----------------------------------------- |
| |
| -- Parsed by P_Package (7.1) |
| |
| -------------------------------------------- |
| -- 8.5.4 Subprogram Renaming Declaration -- |
| -------------------------------------------- |
| |
| -- Parsed by P_Subprogram (6.1) |
| |
| ----------------------------------------- |
| -- 8.5.2 Generic Renaming Declaration -- |
| ----------------------------------------- |
| |
| -- Parsed by P_Generic (12.1) |
| |
| end Ch8; |
