1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P A R . C H 8 -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26pragma Style_Checks (All_Checks); 27-- Turn off subprogram body ordering check. Subprograms are in order 28-- by RM section rather than alphabetical 29 30separate (Par) 31package body Ch8 is 32 33 ----------------------- 34 -- Local Subprograms -- 35 ----------------------- 36 37 procedure Append_Use_Clause 38 (Item_List : List_Id; 39 Use_Node : Node_Id; 40 Is_First : in out Boolean; 41 Is_Last : in out Boolean); 42 -- Append a use_clause to the Item_List, appropriately setting the Prev_Ids 43 -- and More_Ids flags for each split use node. The flags Is_First and 44 -- Is_Last track position of subtype_marks or names within the original 45 -- use_clause. 46 47 procedure P_Use_Package_Clause (Item_List : List_Id); 48 procedure P_Use_Type_Clause (Item_List : List_Id); 49 50 ----------------------- 51 -- Append_Use_Clause -- 52 ----------------------- 53 54 procedure Append_Use_Clause 55 (Item_List : List_Id; 56 Use_Node : Node_Id; 57 Is_First : in out Boolean; 58 Is_Last : in out Boolean) 59 is 60 begin 61 if Token /= Tok_Comma then 62 if not Is_First then 63 Set_Prev_Ids (Use_Node); 64 end if; 65 66 Append (Use_Node, Item_List); 67 Is_Last := True; 68 69 else 70 Set_More_Ids (Use_Node); 71 72 if not Is_First then 73 Set_Prev_Ids (Use_Node); 74 else 75 Is_First := False; 76 end if; 77 78 Append (Use_Node, Item_List); 79 Scan; -- Past comma 80 end if; 81 end Append_Use_Clause; 82 83 --------------------- 84 -- 8.4 Use Clause -- 85 --------------------- 86 87 -- USE_CLAUSE ::= USE_PACKAGE_CLAUSE | USE_TYPE_CLAUSE 88 89 -- The caller has checked that the initial token is USE 90 91 -- Error recovery: cannot raise Error_Resync 92 93 procedure P_Use_Clause (Item_List : List_Id) is 94 begin 95 Scan; -- past USE 96 97 if Token = Tok_Type or else Token = Tok_All then 98 P_Use_Type_Clause (Item_List); 99 else 100 P_Use_Package_Clause (Item_List); 101 end if; 102 end P_Use_Clause; 103 104 ----------------------------- 105 -- 8.4 Use Package Clause -- 106 ----------------------------- 107 108 -- USE_PACKAGE_CLAUSE ::= use package_NAME {, package_NAME}; 109 110 -- The caller has scanned out the USE keyword 111 112 -- Error recovery: cannot raise Error_Resync 113 114 procedure P_Use_Package_Clause (Item_List : List_Id) is 115 Is_First : Boolean := True; 116 Is_Last : Boolean := False; 117 Use_Node : Node_Id; 118 Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; 119 120 begin 121 if Token = Tok_Package then 122 Error_Msg_SC ("PACKAGE should not appear here"); 123 Scan; -- Past PACKAGE 124 end if; 125 126 -- Loop through names in a single use_package_clause, generating an 127 -- N_Use_Package_Clause node for each name encountered. 128 129 loop 130 Use_Node := New_Node (N_Use_Package_Clause, Use_Sloc); 131 Set_Name (Use_Node, P_Qualified_Simple_Name); 132 133 -- Locally chain each name's use-package node 134 135 Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last); 136 exit when Is_Last; 137 end loop; 138 139 TF_Semicolon; 140 end P_Use_Package_Clause; 141 142 -------------------------- 143 -- 8.4 Use Type Clause -- 144 -------------------------- 145 146 -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK}; 147 148 -- The caller has checked that the initial token is USE, scanned it out 149 -- and that the current token is either ALL or TYPE. 150 151 -- Note: Use of ALL is an Ada 2012 feature 152 153 -- Error recovery: cannot raise Error_Resync 154 155 procedure P_Use_Type_Clause (Item_List : List_Id) is 156 Use_Sloc : constant Source_Ptr := Prev_Token_Ptr; 157 158 All_Present : Boolean; 159 Is_First : Boolean := True; 160 Is_Last : Boolean := False; 161 Use_Node : Node_Id; 162 163 begin 164 if Token = Tok_All then 165 Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr); 166 All_Present := True; 167 Scan; -- Past ALL 168 169 if Token /= Tok_Type then 170 Error_Msg_SC ("TYPE expected"); 171 end if; 172 173 else 174 pragma Assert (Token = Tok_Type); 175 All_Present := False; 176 end if; 177 178 if Ada_Version = Ada_83 then 179 Error_Msg_SC ("(Ada 83) use type not allowed!"); 180 end if; 181 182 Scan; -- Past TYPE 183 184 -- Loop through subtype_marks in one use_type_clause, generating a 185 -- separate N_Use_Type_Clause node for each subtype_mark encountered. 186 187 loop 188 Use_Node := New_Node (N_Use_Type_Clause, Use_Sloc); 189 Set_All_Present (Use_Node, All_Present); 190 Set_Used_Operations (Use_Node, No_Elist); 191 192 Set_Subtype_Mark (Use_Node, P_Subtype_Mark); 193 194 No_Constraint; 195 196 -- Locally chain each subtype_mark's use-type node 197 198 Append_Use_Clause (Item_List, Use_Node, Is_First, Is_Last); 199 exit when Is_Last; 200 end loop; 201 202 TF_Semicolon; 203 end P_Use_Type_Clause; 204 205 ------------------------------- 206 -- 8.5 Renaming Declaration -- 207 ------------------------------- 208 209 -- Object renaming declarations and exception renaming declarations 210 -- are parsed by P_Identifier_Declaration (3.3.1) 211 212 -- Subprogram renaming declarations are parsed by P_Subprogram (6.1) 213 214 -- Package renaming declarations are parsed by P_Package (7.1) 215 216 -- Generic renaming declarations are parsed by P_Generic (12.1) 217 218 ---------------------------------------- 219 -- 8.5.1 Object Renaming Declaration -- 220 ---------------------------------------- 221 222 -- Parsed by P_Identifier_Declarations (3.3.1) 223 224 ------------------------------------------- 225 -- 8.5.2 Exception Renaming Declaration -- 226 ------------------------------------------- 227 228 -- Parsed by P_Identifier_Declarations (3.3.1) 229 230 ----------------------------------------- 231 -- 8.5.3 Package Renaming Declaration -- 232 ----------------------------------------- 233 234 -- Parsed by P_Package (7.1) 235 236 -------------------------------------------- 237 -- 8.5.4 Subprogram Renaming Declaration -- 238 -------------------------------------------- 239 240 -- Parsed by P_Subprogram (6.1) 241 242 ----------------------------------------- 243 -- 8.5.2 Generic Renaming Declaration -- 244 ----------------------------------------- 245 246 -- Parsed by P_Generic (12.1) 247 248end Ch8; 249