1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481
  
     | 
    
      ------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                  S E M                                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2024, 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.      --
--                                                                          --
------------------------------------------------------------------------------
with Atree;          use Atree;
with Debug;          use Debug;
with Debug_A;        use Debug_A;
with Einfo;          use Einfo;
with Einfo.Utils;    use Einfo.Utils;
with Elists;         use Elists;
with Exp_SPARK;      use Exp_SPARK;
with Expander;       use Expander;
with Ghost;          use Ghost;
with Lib;            use Lib;
with Lib.Load;       use Lib.Load;
with Nlists;         use Nlists;
with Output;         use Output;
with Restrict;       use Restrict;
with Sem_Attr;       use Sem_Attr;
with Sem_Ch2;        use Sem_Ch2;
with Sem_Ch3;        use Sem_Ch3;
with Sem_Ch4;        use Sem_Ch4;
with Sem_Ch5;        use Sem_Ch5;
with Sem_Ch6;        use Sem_Ch6;
with Sem_Ch7;        use Sem_Ch7;
with Sem_Ch8;        use Sem_Ch8;
with Sem_Ch9;        use Sem_Ch9;
with Sem_Ch10;       use Sem_Ch10;
with Sem_Ch11;       use Sem_Ch11;
with Sem_Ch12;       use Sem_Ch12;
with Sem_Ch13;       use Sem_Ch13;
with Sem_Prag;       use Sem_Prag;
with Sem_Util;       use Sem_Util;
with Sinfo;          use Sinfo;
with Sinfo.Nodes;    use Sinfo.Nodes;
with Sinfo.Utils;    use Sinfo.Utils;
with Stand;          use Stand;
with Stylesw;        use Stylesw;
with Uintp;          use Uintp;
with Uname;          use Uname;
with Ada.Unchecked_Deallocation;
pragma Warnings (Off, Sem_Util);
--  Suppress warnings of unused with for Sem_Util (used only in asserts)
package body Sem is
   Debug_Unit_Walk : Boolean renames Debug_Flag_Dot_WW;
   --  Controls debugging printouts for Walk_Library_Items
   Outer_Generic_Scope : Entity_Id := Empty;
   --  Global reference to the outer scope that is generic. In a non-generic
   --  context, it is empty. At the moment, it is only used for avoiding
   --  freezing of external references in generics.
   Comp_Unit_List : Elist_Id := No_Elist;
   --  Used by Walk_Library_Items. This is a list of N_Compilation_Unit nodes
   --  processed by Semantics, in an appropriate order. Initialized to
   --  No_Elist, because it's too early to call New_Elmt_List; we will set it
   --  to New_Elmt_List on first use.
   generic
      with procedure Action (Withed_Unit : Node_Id);
   procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean);
   --  Walk all the with clauses of CU, and call Action for the with'ed unit.
   --  Ignore limited withs, unless Include_Limited is True. CU must be an
   --  N_Compilation_Unit.
   generic
      with procedure Action (Withed_Unit : Node_Id);
   procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean);
   --  Same as Walk_Withs_Immediate, but also include with clauses on subunits
   --  of this unit, since they count as dependences on their parent library
   --  item. CU must be an N_Compilation_Unit whose Unit is not an N_Subunit.
   -------------
   -- Analyze --
   -------------
   --  WARNING: This routine manages Ghost regions. Return statements must be
   --  replaced by gotos which jump to the end of the routine and restore the
   --  Ghost mode.
   procedure Analyze (N : Node_Id) is
      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
      --  Save the Ghost-related attributes to restore on exit
   begin
      Debug_A_Entry ("analyzing  ", N);
      --  Immediate return if already analyzed
      if Analyzed (N) then
         Debug_A_Exit ("analyzing  ", N, "  (done, analyzed already)");
         return;
      end if;
      --  A declaration may be subject to pragma Ghost. Set the mode now to
      --  ensure that any nodes generated during analysis and expansion are
      --  marked as Ghost.
      if Is_Declaration (N) then
         Mark_And_Set_Ghost_Declaration (N);
      end if;
      --  Otherwise processing depends on the node kind
      case Nkind (N) is
         when N_Abort_Statement =>
            Analyze_Abort_Statement (N);
         when N_Abstract_Subprogram_Declaration =>
            Analyze_Abstract_Subprogram_Declaration (N);
         when N_Accept_Alternative =>
            Analyze_Accept_Alternative (N);
         when N_Accept_Statement =>
            Analyze_Accept_Statement (N);
         when N_Aggregate =>
            Analyze_Aggregate (N);
         when N_Allocator =>
            Analyze_Allocator (N);
         when N_And_Then =>
            Analyze_Short_Circuit (N);
         when N_Assignment_Statement =>
            Analyze_Assignment (N);
         when N_Asynchronous_Select =>
            Analyze_Asynchronous_Select (N);
         when N_At_Clause =>
            Analyze_At_Clause (N);
         when N_Attribute_Reference =>
            Analyze_Attribute (N);
         when N_Attribute_Definition_Clause   =>
            Analyze_Attribute_Definition_Clause (N);
         when N_Block_Statement =>
            Analyze_Block_Statement (N);
         when N_Case_Expression =>
            Analyze_Case_Expression (N);
         when N_Case_Statement =>
            Analyze_Case_Statement (N);
         when N_Character_Literal =>
            Analyze_Character_Literal (N);
         when N_Code_Statement =>
            Analyze_Code_Statement (N);
         when N_Compilation_Unit =>
            Analyze_Compilation_Unit (N);
         when N_Component_Declaration =>
            Analyze_Component_Declaration (N);
         when N_Compound_Statement =>
            Analyze_Compound_Statement (N);
         when N_Conditional_Entry_Call =>
            Analyze_Conditional_Entry_Call (N);
         when N_Delay_Alternative =>
            Analyze_Delay_Alternative (N);
         when N_Delay_Relative_Statement =>
            Analyze_Delay_Relative (N);
         when N_Delay_Until_Statement =>
            Analyze_Delay_Until (N);
         when N_Delta_Aggregate =>
            Analyze_Aggregate (N);
         when N_Entry_Body =>
            Analyze_Entry_Body (N);
         when N_Entry_Body_Formal_Part =>
            Analyze_Entry_Body_Formal_Part (N);
         when N_Entry_Call_Alternative =>
            Analyze_Entry_Call_Alternative (N);
         when N_Entry_Declaration =>
            Analyze_Entry_Declaration (N);
         when N_Entry_Index_Specification =>
            Analyze_Entry_Index_Specification (N);
         when N_Enumeration_Representation_Clause =>
            Analyze_Enumeration_Representation_Clause (N);
         when N_Exception_Declaration =>
            Analyze_Exception_Declaration (N);
         when N_Exception_Renaming_Declaration =>
            Analyze_Exception_Renaming (N);
         when N_Exit_Statement =>
            Analyze_Exit_Statement (N);
         when N_Expanded_Name =>
            Analyze_Expanded_Name (N);
         when N_Explicit_Dereference =>
            Analyze_Explicit_Dereference (N);
         when N_Expression_Function =>
            Analyze_Expression_Function (N);
         when N_Expression_With_Actions =>
            Analyze_Expression_With_Actions (N);
         when N_Extended_Return_Statement =>
            Analyze_Extended_Return_Statement (N);
         when N_Extension_Aggregate =>
            Analyze_Aggregate (N);
         when N_Formal_Object_Declaration =>
            Analyze_Formal_Object_Declaration (N);
         when N_Formal_Package_Declaration =>
            Analyze_Formal_Package_Declaration (N);
         when N_Formal_Subprogram_Declaration =>
            Analyze_Formal_Subprogram_Declaration (N);
         when N_Formal_Type_Declaration =>
            Analyze_Formal_Type_Declaration (N);
         when N_Free_Statement =>
            Analyze_Free_Statement (N);
         when N_Freeze_Entity =>
            Analyze_Freeze_Entity (N);
         when N_Freeze_Generic_Entity =>
            Analyze_Freeze_Generic_Entity (N);
         when N_Full_Type_Declaration =>
            Analyze_Full_Type_Declaration (N);
         when N_Function_Call =>
            Analyze_Function_Call (N);
         when N_Function_Instantiation =>
            Analyze_Function_Instantiation (N);
         when N_Generic_Function_Renaming_Declaration =>
            Analyze_Generic_Function_Renaming (N);
         when N_Generic_Package_Declaration =>
            Analyze_Generic_Package_Declaration (N);
         when N_Generic_Package_Renaming_Declaration =>
            Analyze_Generic_Package_Renaming (N);
         when N_Generic_Procedure_Renaming_Declaration =>
            Analyze_Generic_Procedure_Renaming (N);
         when N_Generic_Subprogram_Declaration =>
            Analyze_Generic_Subprogram_Declaration (N);
         when N_Goto_Statement =>
            Analyze_Goto_Statement (N);
         when N_Goto_When_Statement =>
            Analyze_Goto_When_Statement (N);
         when N_Handled_Sequence_Of_Statements =>
            Analyze_Handled_Statements (N);
         when N_Identifier =>
            Analyze_Identifier (N);
         when N_If_Expression =>
            Analyze_If_Expression (N);
         when N_If_Statement =>
            Analyze_If_Statement (N);
         when N_Implicit_Label_Declaration =>
            Analyze_Implicit_Label_Declaration (N);
         when N_In =>
            Analyze_Membership_Op (N);
         when N_Incomplete_Type_Declaration =>
            Analyze_Incomplete_Type_Decl (N);
         when N_Indexed_Component =>
            Analyze_Indexed_Component_Form (N);
         when N_Integer_Literal =>
            Analyze_Integer_Literal (N);
         when N_Iterator_Specification =>
            Analyze_Iterator_Specification (N);
         when N_Itype_Reference =>
            Analyze_Itype_Reference (N);
         when N_Label =>
            Analyze_Label (N);
         when N_Loop_Parameter_Specification =>
            Analyze_Loop_Parameter_Specification (N);
         when N_Loop_Statement =>
            Analyze_Loop_Statement (N);
         when N_Not_In =>
            Analyze_Membership_Op (N);
         when N_Null =>
            Analyze_Null (N);
         when N_Null_Statement =>
            Analyze_Null_Statement (N);
         when N_Number_Declaration =>
            Analyze_Number_Declaration (N);
         when N_Object_Declaration =>
            Analyze_Object_Declaration (N);
         when N_Object_Renaming_Declaration  =>
            Analyze_Object_Renaming (N);
         when N_Operator_Symbol =>
            Analyze_Operator_Symbol (N);
         when N_Op_Abs =>
            Analyze_Unary_Op (N);
         when N_Op_Add =>
            Analyze_Arithmetic_Op (N);
         when N_Op_And =>
            Analyze_Logical_Op (N);
         when N_Op_Concat =>
            Analyze_Concatenation (N);
         when N_Op_Divide =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Eq =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Expon =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Ge =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Gt =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Le =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Lt =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Minus =>
            Analyze_Unary_Op (N);
         when N_Op_Mod =>
            Analyze_Mod (N);
         when N_Op_Multiply =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Ne =>
            Analyze_Comparison_Equality_Op (N);
         when N_Op_Not =>
            Analyze_Negation (N);
         when N_Op_Or =>
            Analyze_Logical_Op (N);
         when N_Op_Plus =>
            Analyze_Unary_Op (N);
         when N_Op_Rem =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Rotate_Left =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Rotate_Right =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Shift_Left =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Shift_Right =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Shift_Right_Arithmetic =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Subtract =>
            Analyze_Arithmetic_Op (N);
         when N_Op_Xor =>
            Analyze_Logical_Op (N);
         when N_Or_Else =>
            Analyze_Short_Circuit (N);
         when N_Others_Choice =>
            Analyze_Others_Choice (N);
         when N_Package_Body =>
            Analyze_Package_Body (N);
         when N_Package_Body_Stub =>
            Analyze_Package_Body_Stub (N);
         when N_Package_Declaration =>
            Analyze_Package_Declaration (N);
         when N_Package_Instantiation =>
            Analyze_Package_Instantiation (N);
         when N_Package_Renaming_Declaration =>
            Analyze_Package_Renaming (N);
         when N_Package_Specification =>
            Analyze_Package_Specification (N);
         when N_Parameter_Association =>
            Analyze_Parameter_Association (N);
         when N_Pragma =>
            Analyze_Pragma (N);
         when N_Private_Extension_Declaration =>
            Analyze_Private_Extension_Declaration (N);
         when N_Private_Type_Declaration =>
            Analyze_Private_Type_Declaration (N);
         when N_Procedure_Call_Statement =>
            Analyze_Procedure_Call (N);
         when N_Procedure_Instantiation =>
            Analyze_Procedure_Instantiation (N);
         when N_Protected_Body =>
            Analyze_Protected_Body (N);
         when N_Protected_Body_Stub =>
            Analyze_Protected_Body_Stub (N);
         when N_Protected_Definition =>
            Analyze_Protected_Definition (N);
         when N_Protected_Type_Declaration =>
            Analyze_Protected_Type_Declaration (N);
         when N_Qualified_Expression =>
            Analyze_Qualified_Expression (N);
         when N_Quantified_Expression =>
            Analyze_Quantified_Expression (N);
         when N_Raise_Expression =>
            Analyze_Raise_Expression (N);
         when N_Raise_Statement =>
            Analyze_Raise_Statement (N);
         when N_Raise_When_Statement =>
            Analyze_Raise_When_Statement (N);
         when N_Raise_xxx_Error =>
            Analyze_Raise_xxx_Error (N);
         when N_Range =>
            Analyze_Range (N);
         when N_Range_Constraint =>
            Analyze_Range (Range_Expression (N));
         when N_Real_Literal =>
            Analyze_Real_Literal (N);
         when N_Record_Representation_Clause =>
            Analyze_Record_Representation_Clause (N);
         when N_Reference =>
            Analyze_Reference (N);
         when N_Requeue_Statement =>
            Analyze_Requeue (N);
         when N_Return_When_Statement =>
            Analyze_Return_When_Statement (N);
         when N_Simple_Return_Statement =>
            Analyze_Simple_Return_Statement (N);
         when N_Selected_Component =>
            Find_Selected_Component (N);
            --  ??? why not Analyze_Selected_Component, needs comments
         when N_Selective_Accept =>
            Analyze_Selective_Accept (N);
         when N_Single_Protected_Declaration =>
            Analyze_Single_Protected_Declaration (N);
         when N_Single_Task_Declaration =>
            Analyze_Single_Task_Declaration (N);
         when N_Slice =>
            Analyze_Slice (N);
         when N_String_Literal =>
            Analyze_String_Literal (N);
         when N_Interpolated_String_Literal =>
            Analyze_Interpolated_String_Literal (N);
         when N_Subprogram_Body =>
            Analyze_Subprogram_Body (N);
         when N_Subprogram_Body_Stub =>
            Analyze_Subprogram_Body_Stub (N);
         when N_Subprogram_Declaration =>
            Analyze_Subprogram_Declaration (N);
         when N_Subprogram_Renaming_Declaration =>
            Analyze_Subprogram_Renaming (N);
         when N_Subtype_Declaration =>
            Analyze_Subtype_Declaration (N);
         when N_Subtype_Indication =>
            Analyze_Subtype_Indication (N);
         when N_Subunit =>
            Analyze_Subunit (N);
         when N_Target_Name =>
            Analyze_Target_Name (N);
         when N_Task_Body =>
            Analyze_Task_Body (N);
         when N_Task_Body_Stub =>
            Analyze_Task_Body_Stub (N);
         when N_Task_Definition =>
            Analyze_Task_Definition (N);
         when N_Task_Type_Declaration =>
            Analyze_Task_Type_Declaration (N);
         when N_Terminate_Alternative =>
            Analyze_Terminate_Alternative (N);
         when N_Timed_Entry_Call =>
            Analyze_Timed_Entry_Call (N);
         when N_Triggering_Alternative =>
            Analyze_Triggering_Alternative (N);
         when N_Type_Conversion =>
            Analyze_Type_Conversion (N);
         when N_Unchecked_Expression =>
            Analyze_Unchecked_Expression (N);
         when N_Unchecked_Type_Conversion =>
            Analyze_Unchecked_Type_Conversion (N);
         when N_Use_Package_Clause =>
            Analyze_Use_Package (N);
         when N_Use_Type_Clause =>
            Analyze_Use_Type (N);
         when N_Validate_Unchecked_Conversion =>
            null;
         when N_Variant_Part =>
            Analyze_Variant_Part (N);
         when N_With_Clause =>
            Analyze_With_Clause (N);
         --  A call to analyze a marker is ignored because the node does not
         --  have any static and run-time semantics.
         when N_Call_Marker
            | N_Variable_Reference_Marker
         =>
            null;
         --  A call to analyze the Empty node is an error, but most likely it
         --  is an error caused by an attempt to analyze a malformed piece of
         --  tree caused by some other error, so if there have been any other
         --  errors, we just ignore it, otherwise it is a real internal error
         --  which we complain about.
         --  We must also consider the case of call to a runtime function that
         --  is not available in the configurable runtime.
         when N_Empty =>
            pragma Assert (Serious_Errors_Detected /= 0
              or else Configurable_Run_Time_Violations /= 0);
            null;
         --  A call to analyze the error node is simply ignored, to avoid
         --  causing cascaded errors (happens of course only in error cases)
         --  Disable expansion in case it is still enabled, to prevent other
         --  subsequent compiler glitches.
         when N_Error =>
            Expander_Mode_Save_And_Set (False);
            null;
         --  Push/Pop nodes normally don't come through an analyze call. An
         --  exception is the dummy ones bracketing a subprogram body. In any
         --  case there is nothing to be done to analyze such nodes.
         when N_Push_Pop_xxx_Label =>
            null;
         --  SCIL nodes don't need analysis because they are decorated when
         --  they are built. They are added to the tree by Insert_Actions and
         --  the call to analyze them is generated when the full list is
         --  analyzed.
         when N_SCIL_Dispatch_Table_Tag_Init
            | N_SCIL_Dispatching_Call
            | N_SCIL_Membership_Test
         =>
            null;
         --  A quantified expression with a missing "all" or "some" qualifier
         --  looks identical to an iterated component association. By language
         --  definition, the latter must be present within array aggregates. If
         --  this is not the case, then the iterated component association is
         --  really an illegal quantified expression. Diagnose this scenario.
         when N_Iterated_Component_Association =>
            Diagnose_Iterated_Component_Association (N);
         when N_Iterated_Element_Association =>
            null;   --  May require a more precise error if misplaced.
         --  For the remaining node types, we generate compiler abort, because
         --  these nodes are always analyzed within the Sem_Chn routines and
         --  there should never be a case of making a call to the main Analyze
         --  routine for these node kinds. For example, an N_Access_Definition
         --  node appears only in the context of a type declaration, and is
         --  processed by the analyze routine for type declarations.
         when N_Abortable_Part
            | N_Access_Definition
            | N_Access_Function_Definition
            | N_Access_Procedure_Definition
            | N_Access_To_Object_Definition
            | N_Aspect_Specification
            | N_Case_Expression_Alternative
            | N_Case_Statement_Alternative
            | N_Compilation_Unit_Aux
            | N_Component_Association
            | N_Component_Clause
            | N_Component_Definition
            | N_Component_List
            | N_Constrained_Array_Definition
            | N_Contract
            | N_Decimal_Fixed_Point_Definition
            | N_Defining_Character_Literal
            | N_Defining_Identifier
            | N_Defining_Operator_Symbol
            | N_Defining_Program_Unit_Name
            | N_Delta_Constraint
            | N_Derived_Type_Definition
            | N_Designator
            | N_Digits_Constraint
            | N_Discriminant_Association
            | N_Discriminant_Specification
            | N_Elsif_Part
            | N_Entry_Call_Statement
            | N_Enumeration_Type_Definition
            | N_Exception_Handler
            | N_Floating_Point_Definition
            | N_Formal_Decimal_Fixed_Point_Definition
            | N_Formal_Derived_Type_Definition
            | N_Formal_Discrete_Type_Definition
            | N_Formal_Floating_Point_Definition
            | N_Formal_Modular_Type_Definition
            | N_Formal_Ordinary_Fixed_Point_Definition
            | N_Formal_Private_Type_Definition
            | N_Formal_Incomplete_Type_Definition
            | N_Formal_Signed_Integer_Type_Definition
            | N_Function_Specification
            | N_Generic_Association
            | N_Index_Or_Discriminant_Constraint
            | N_Iteration_Scheme
            | N_Mod_Clause
            | N_Modular_Type_Definition
            | N_Ordinary_Fixed_Point_Definition
            | N_Parameter_Specification
            | N_Pragma_Argument_Association
            | N_Procedure_Specification
            | N_Real_Range_Specification
            | N_Record_Definition
            | N_Signed_Integer_Type_Definition
            | N_Unconstrained_Array_Definition
            | N_Unused_At_End
            | N_Unused_At_Start
            | N_Variant
         =>
            raise Program_Error;
      end case;
      Debug_A_Exit ("analyzing  ", N, "  (done)");
      --  Set Is_Not_Self_Hidden flag. RM-8.3(16) says a declaration
      --  is no longer hidden from all visibility after "the end of the
      --  declaration", so we set the flag here (in addition to setting it
      --  elsewhere to handle the "except..." cases of 8.3(16)). However,
      --  we implement 3.8(10) using the same flag, so in that case we
      --  need to defer the setting until the end of the record.
      declare
         E : constant Entity_Id := Defining_Entity_Or_Empty (N);
      begin
         if Present (E) then
            if Ekind (E) = E_Void
              and then Nkind (N) = N_Component_Declaration
              and then Present (Scope (E))
              and then Ekind (Scope (E)) = E_Record_Type
            then
               null; -- Set it later, in Analyze_Component_Declaration
            elsif not Is_Not_Self_Hidden (E) then
               Set_Is_Not_Self_Hidden (E);
            end if;
         end if;
      end;
      --  Mark relevant use-type and use-package clauses as effective
      --  preferring the original node over the analyzed one in the case that
      --  constant folding has occurred and removed references that need to be
      --  examined. Also, if the node in question is overloaded then this is
      --  deferred until resolution.
      declare
         Operat : Node_Id := Empty;
      begin
         --  Attempt to obtain a checkable operator node
         if Nkind (Original_Node (N)) in N_Op then
            Operat := Original_Node (N);
         elsif Nkind (N) in N_Op then
            Operat := N;
         end if;
         --  Mark the operator
         if Present (Operat)
           and then Present (Entity (Operat))
           and then not Is_Overloaded (Operat)
         then
            Mark_Use_Clauses (Operat);
         end if;
      end;
      --  Now that we have analyzed the node, we call the expander to perform
      --  possible expansion. We skip this for subexpressions, because we don't
      --  have the type yet, and the expander will need to know the type before
      --  it can do its job. For subexpression nodes, the call to the expander
      --  happens in Sem_Res.Resolve. A special exception is Raise_xxx_Error,
      --  which can appear in a statement context, and needs expanding now in
      --  the case (distinguished by Etype, as documented in Sinfo).
      --  The Analyzed flag is also set at this point for non-subexpression
      --  nodes (in the case of subexpression nodes, we can't set the flag yet,
      --  since resolution and expansion have not yet been completed). Note
      --  that for N_Raise_xxx_Error we have to distinguish the expression
      --  case from the statement case.
      if Nkind (N) not in N_Subexpr
        or else (Nkind (N) in N_Raise_xxx_Error
                  and then Etype (N) = Standard_Void_Type)
      then
         Expand (N);
      --  Replace a reference to a renaming with the renamed object for SPARK.
      --  In general this modification is performed by Expand_SPARK, however
      --  certain constructs may not reach the resolution or expansion phase
      --  and thus remain unchanged. The replacement is not performed when the
      --  construct is overloaded as resolution must first take place. This is
      --  also not done when analyzing a generic to preserve the original tree
      --  and because the reference may become overloaded in the instance.
      elsif GNATprove_Mode
        and then Nkind (N) in N_Expanded_Name | N_Identifier
        and then not Is_Overloaded (N)
        and then not Inside_A_Generic
      then
         Expand_SPARK_Potential_Renaming (N);
      end if;
      Restore_Ghost_Region (Saved_GM, Saved_IGR);
   end Analyze;
   --  Version with check(s) suppressed
   procedure Analyze (N : Node_Id; Suppress : Check_Id) is
   begin
      if Suppress = All_Checks then
         declare
            Svs : constant Suppress_Array := Scope_Suppress.Suppress;
         begin
            Scope_Suppress.Suppress := (others => True);
            Analyze (N);
            Scope_Suppress.Suppress := Svs;
         end;
      else
         declare
            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
         begin
            Scope_Suppress.Suppress (Suppress) := True;
            Analyze (N);
            Scope_Suppress.Suppress (Suppress) := Svg;
         end;
      end if;
   end Analyze;
   ------------------
   -- Analyze_List --
   ------------------
   procedure Analyze_List (L : List_Id) is
      Node : Node_Id;
   begin
      Node := First (L);
      while Present (Node) loop
         Analyze (Node);
         Next (Node);
      end loop;
   end Analyze_List;
   --  Version with check(s) suppressed
   procedure Analyze_List (L : List_Id; Suppress : Check_Id) is
   begin
      if Suppress = All_Checks then
         declare
            Svs : constant Suppress_Array := Scope_Suppress.Suppress;
         begin
            Scope_Suppress.Suppress := (others => True);
            Analyze_List (L);
            Scope_Suppress.Suppress := Svs;
         end;
      else
         declare
            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
         begin
            Scope_Suppress.Suppress (Suppress) := True;
            Analyze_List (L);
            Scope_Suppress.Suppress (Suppress) := Svg;
         end;
      end if;
   end Analyze_List;
   --------------------------
   -- Copy_Suppress_Status --
   --------------------------
   procedure Copy_Suppress_Status
     (C    : Check_Id;
      From : Entity_Id;
      To   : Entity_Id)
   is
      Found : Boolean;
      pragma Warnings (Off, Found);
      procedure Search_Stack
        (Top   : Suppress_Stack_Entry_Ptr;
         Found : out Boolean);
      --  Search given suppress stack for matching entry for entity. If found
      --  then set Checks_May_Be_Suppressed on To, and push an appropriate
      --  entry for To onto the local suppress stack.
      ------------------
      -- Search_Stack --
      ------------------
      procedure Search_Stack
        (Top   : Suppress_Stack_Entry_Ptr;
         Found : out Boolean)
      is
         Ptr : Suppress_Stack_Entry_Ptr;
      begin
         Ptr := Top;
         while Ptr /= null loop
            if Ptr.Entity = From
              and then (Ptr.Check = All_Checks or else Ptr.Check = C)
            then
               if Ptr.Suppress then
                  Set_Checks_May_Be_Suppressed (To, True);
                  Push_Local_Suppress_Stack_Entry
                    (Entity   => To,
                     Check    => C,
                     Suppress => True);
                  Found := True;
                  return;
               end if;
            end if;
            Ptr := Ptr.Prev;
         end loop;
         Found := False;
         return;
      end Search_Stack;
   --  Start of processing for Copy_Suppress_Status
   begin
      if not Checks_May_Be_Suppressed (From) then
         return;
      end if;
      --  First search the global entity suppress table for a matching entry.
      --  We also search this in reverse order so that if there are multiple
      --  pragmas for the same entity, the last one applies.
      Search_Stack (Global_Suppress_Stack_Top, Found);
      if Found then
         return;
      end if;
      --  Now search the local entity suppress stack, we search this in
      --  reverse order so that we get the innermost entry that applies to
      --  this case if there are nested entries. Note that for the purpose
      --  of this procedure we are ONLY looking for entries corresponding
      --  to a two-argument Suppress, where the second argument matches From.
      Search_Stack (Local_Suppress_Stack_Top, Found);
   end Copy_Suppress_Status;
   -------------------------
   -- Enter_Generic_Scope --
   -------------------------
   procedure Enter_Generic_Scope (S : Entity_Id) is
   begin
      if No (Outer_Generic_Scope) then
         Outer_Generic_Scope := S;
      end if;
   end Enter_Generic_Scope;
   ------------------------
   -- Exit_Generic_Scope --
   ------------------------
   procedure Exit_Generic_Scope  (S : Entity_Id) is
   begin
      if S = Outer_Generic_Scope then
         Outer_Generic_Scope := Empty;
      end if;
   end Exit_Generic_Scope;
   -----------------------
   -- Explicit_Suppress --
   -----------------------
   function Explicit_Suppress (E : Entity_Id; C : Check_Id) return Boolean is
      Ptr : Suppress_Stack_Entry_Ptr;
   begin
      if not Checks_May_Be_Suppressed (E) then
         return False;
      else
         Ptr := Global_Suppress_Stack_Top;
         while Ptr /= null loop
            if Ptr.Entity = E
              and then (Ptr.Check = All_Checks or else Ptr.Check = C)
            then
               return Ptr.Suppress;
            end if;
            Ptr := Ptr.Prev;
         end loop;
      end if;
      return False;
   end Explicit_Suppress;
   -----------------------------
   -- External_Ref_In_Generic --
   -----------------------------
   function External_Ref_In_Generic (E : Entity_Id) return Boolean is
      Scop : Entity_Id;
   begin
      --  Entity is global if defined outside of current Outer_Generic_Scope:
      --  Either the entity has a smaller depth than the outer generic, or it
      --  is in a different compilation unit, or it is defined within a unit
      --  in the same compilation, that is not within the outer generic.
      if No (Outer_Generic_Scope) then
         return False;
      --  It makes no sense to compare depths if not in same unit. Scope_Depth
      --  is not set for inherited operations.
      elsif not In_Same_Source_Unit (E, Outer_Generic_Scope)
        or else not Scope_Depth_Set (Scope (E))
        or else Scope_Depth (Scope (E)) < Scope_Depth (Outer_Generic_Scope)
      then
         return True;
      else
         Scop := Scope (E);
         while Present (Scop) loop
            if Scop = Outer_Generic_Scope then
               return False;
            elsif Scope_Depth (Scop) < Scope_Depth (Outer_Generic_Scope) then
               return True;
            else
               Scop := Scope (Scop);
            end if;
         end loop;
         return True;
      end if;
   end External_Ref_In_Generic;
   ----------------
   -- Initialize --
   ----------------
   procedure Initialize is
      Next : Suppress_Stack_Entry_Ptr;
      procedure Free is new Ada.Unchecked_Deallocation
        (Suppress_Stack_Entry, Suppress_Stack_Entry_Ptr);
   begin
      --  Free any global suppress stack entries from a previous invocation
      --  of the compiler (in the normal case this loop does nothing).
      while Suppress_Stack_Entries /= null loop
         Next := Suppress_Stack_Entries.Next;
         Free (Suppress_Stack_Entries);
         Suppress_Stack_Entries := Next;
      end loop;
      Local_Suppress_Stack_Top := null;
      Global_Suppress_Stack_Top := null;
      --  Clear scope stack, and reset global variables
      Scope_Stack.Init;
      Unloaded_Subunits := False;
   end Initialize;
   ------------------------------
   -- Insert_After_And_Analyze --
   ------------------------------
   procedure Insert_After_And_Analyze (N : Node_Id; M : Node_Id) is
      Node : Node_Id;
   begin
      if Present (M) then
         --  If we are not at the end of the list, then the easiest
         --  coding is simply to insert before our successor.
         if Present (Next (N)) then
            Insert_Before_And_Analyze (Next (N), M);
         --  Case of inserting at the end of the list
         else
            --  Capture the Node_Id of the node to be inserted. This Node_Id
            --  will still be the same after the insert operation.
            Node := M;
            Insert_After (N, M);
            --  Now just analyze from the inserted node to the end of
            --  the new list (note that this properly handles the case
            --  where any of the analyze calls result in the insertion of
            --  nodes after the analyzed node, expecting analysis).
            while Present (Node) loop
               Analyze (Node);
               Mark_Rewrite_Insertion (Node);
               Next (Node);
            end loop;
         end if;
      end if;
   end Insert_After_And_Analyze;
   --  Version with check(s) suppressed
   procedure Insert_After_And_Analyze
     (N        : Node_Id;
      M        : Node_Id;
      Suppress : Check_Id)
   is
   begin
      if Suppress = All_Checks then
         declare
            Svs : constant Suppress_Array := Scope_Suppress.Suppress;
         begin
            Scope_Suppress.Suppress := (others => True);
            Insert_After_And_Analyze (N, M);
            Scope_Suppress.Suppress := Svs;
         end;
      else
         declare
            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
         begin
            Scope_Suppress.Suppress (Suppress) := True;
            Insert_After_And_Analyze (N, M);
            Scope_Suppress.Suppress (Suppress) := Svg;
         end;
      end if;
   end Insert_After_And_Analyze;
   -------------------------------
   -- Insert_Before_And_Analyze --
   -------------------------------
   procedure Insert_Before_And_Analyze (N : Node_Id; M : Node_Id) is
      Node : Node_Id;
   begin
      if Present (M) then
         --  Capture the Node_Id of the first list node to be inserted.
         --  This will still be the first node after the insert operation,
         --  since Insert_List_After does not modify the Node_Id values.
         Node := M;
         Insert_Before (N, M);
         --  The insertion does not change the Id's of any of the nodes in
         --  the list, and they are still linked, so we can simply loop from
         --  the original first node until we meet the node before which the
         --  insertion is occurring. Note that this properly handles the case
         --  where any of the analyzed nodes insert nodes after themselves,
         --  expecting them to get analyzed.
         while Node /= N loop
            Analyze (Node);
            Mark_Rewrite_Insertion (Node);
            Next (Node);
         end loop;
      end if;
   end Insert_Before_And_Analyze;
   --  Version with check(s) suppressed
   procedure Insert_Before_And_Analyze
     (N        : Node_Id;
      M        : Node_Id;
      Suppress : Check_Id)
   is
   begin
      if Suppress = All_Checks then
         declare
            Svs : constant Suppress_Array := Scope_Suppress.Suppress;
         begin
            Scope_Suppress.Suppress := (others => True);
            Insert_Before_And_Analyze (N, M);
            Scope_Suppress.Suppress := Svs;
         end;
      else
         declare
            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
         begin
            Scope_Suppress.Suppress (Suppress) := True;
            Insert_Before_And_Analyze (N, M);
            Scope_Suppress.Suppress (Suppress) := Svg;
         end;
      end if;
   end Insert_Before_And_Analyze;
   --------------------------------------------
   -- Insert_Before_First_Source_Declaration --
   --------------------------------------------
   procedure Insert_Before_First_Source_Declaration
     (Stmt  : Node_Id;
      Decls : List_Id)
   is
      Decl : Node_Id;
   begin
      --  Inspect the declarations of the related subprogram body looking for
      --  the first source declaration.
      pragma Assert (Present (Decls));
      Decl := First (Decls);
      while Present (Decl) loop
         if Comes_From_Source (Decl) then
            Insert_Before (Decl, Stmt);
            return;
         end if;
         Next (Decl);
      end loop;
      --  If we get there, then the subprogram body lacks any source
      --  declarations. The body of _Postconditions now acts as the
      --  last declaration.
      Append (Stmt, Decls);
   end Insert_Before_First_Source_Declaration;
   -----------------------------------
   -- Insert_List_After_And_Analyze --
   -----------------------------------
   procedure Insert_List_After_And_Analyze (N : Node_Id; L : List_Id) is
      After : constant Node_Id := Next (N);
      Node  : Node_Id;
   begin
      if Is_Non_Empty_List (L) then
         --  Capture the Node_Id of the first list node to be inserted.
         --  This will still be the first node after the insert operation,
         --  since Insert_List_After does not modify the Node_Id values.
         Node := First (L);
         Insert_List_After (N, L);
         --  Now just analyze from the original first node until we get to the
         --  successor of the original insertion point (which may be Empty if
         --  the insertion point was at the end of the list). Note that this
         --  properly handles the case where any of the analyze calls result in
         --  the insertion of nodes after the analyzed node (possibly calling
         --  this routine recursively).
         while Node /= After loop
            Analyze (Node);
            Mark_Rewrite_Insertion (Node);
            Next (Node);
         end loop;
      end if;
   end Insert_List_After_And_Analyze;
   ------------------------------------
   -- Insert_List_Before_And_Analyze --
   ------------------------------------
   procedure Insert_List_Before_And_Analyze (N : Node_Id; L : List_Id) is
      Node : Node_Id;
   begin
      if Is_Non_Empty_List (L) then
         --  Capture the Node_Id of the first list node to be inserted. This
         --  will still be the first node after the insert operation, since
         --  Insert_List_After does not modify the Node_Id values.
         Node := First (L);
         Insert_List_Before (N, L);
         --  The insertion does not change the Id's of any of the nodes in
         --  the list, and they are still linked, so we can simply loop from
         --  the original first node until we meet the node before which the
         --  insertion is occurring. Note that this properly handles the case
         --  where any of the analyzed nodes insert nodes after themselves,
         --  expecting them to get analyzed.
         while Node /= N loop
            Analyze (Node);
            Mark_Rewrite_Insertion (Node);
            Next (Node);
         end loop;
      end if;
   end Insert_List_Before_And_Analyze;
   ----------
   -- Lock --
   ----------
   procedure Lock is
   begin
      Scope_Stack.Release;
      Scope_Stack.Locked := True;
   end Lock;
   ------------------------
   -- Preanalysis_Active --
   ------------------------
   function Preanalysis_Active return Boolean is
   begin
      return not Full_Analysis and not Expander_Active;
   end Preanalysis_Active;
   ----------------
   -- Preanalyze --
   ----------------
   procedure Preanalyze (N : Node_Id) is
      Save_Full_Analysis : constant Boolean := Full_Analysis;
   begin
      Full_Analysis := False;
      Expander_Mode_Save_And_Set (False);
      --  See comment in sem_res.adb for Preanalyze_And_Resolve
      if GNATprove_Mode
        or else Nkind (Parent (N)) = N_Simple_Return_Statement
      then
         Analyze (N);
      else
         Analyze (N, Suppress => All_Checks);
      end if;
      Expander_Mode_Restore;
      Full_Analysis := Save_Full_Analysis;
   end Preanalyze;
   --------------------------------------
   -- Push_Global_Suppress_Stack_Entry --
   --------------------------------------
   procedure Push_Global_Suppress_Stack_Entry
     (Entity   : Entity_Id;
      Check    : Check_Id;
      Suppress : Boolean)
   is
   begin
      Global_Suppress_Stack_Top :=
        new Suppress_Stack_Entry'
          (Entity   => Entity,
           Check    => Check,
           Suppress => Suppress,
           Prev     => Global_Suppress_Stack_Top,
           Next     => Suppress_Stack_Entries);
      Suppress_Stack_Entries := Global_Suppress_Stack_Top;
      return;
   end Push_Global_Suppress_Stack_Entry;
   -------------------------------------
   -- Push_Local_Suppress_Stack_Entry --
   -------------------------------------
   procedure Push_Local_Suppress_Stack_Entry
     (Entity   : Entity_Id;
      Check    : Check_Id;
      Suppress : Boolean)
   is
   begin
      Local_Suppress_Stack_Top :=
        new Suppress_Stack_Entry'
          (Entity   => Entity,
           Check    => Check,
           Suppress => Suppress,
           Prev     => Local_Suppress_Stack_Top,
           Next     => Suppress_Stack_Entries);
      Suppress_Stack_Entries := Local_Suppress_Stack_Top;
      return;
   end Push_Local_Suppress_Stack_Entry;
   ---------------
   -- Semantics --
   ---------------
   procedure Semantics (Comp_Unit : Node_Id) is
      procedure Do_Analyze;
      --  Perform the analysis of the compilation unit
      ----------------
      -- Do_Analyze --
      ----------------
      --  WARNING: This routine manages Ghost regions. Return statements must
      --  be replaced by gotos which jump to the end of the routine and restore
      --  the Ghost mode.
      procedure Do_Analyze is
         Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
         Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
         Saved_ISMP : constant Boolean        :=
                        Ignore_SPARK_Mode_Pragmas_In_Instance;
         --  Save Ghost and SPARK mode-related data to restore on exit
         --  Generally style checks are preserved across compilations, with
         --  one exception: s-oscons.ads, which allows arbitrary long lines
         --  unconditionally, and has no restore mechanism, because it is
         --  intended as a lowest-level Pure package.
         Saved_ML  : constant Int     := Style_Max_Line_Length;
         Saved_CML : constant Boolean := Style_Check_Max_Line_Length;
         List : Elist_Id;
      begin
         List := Save_Scope_Stack;
         Push_Scope (Standard_Standard);
         --  Set up a clean environment before analyzing
         Install_Ghost_Region (None, Empty);
         Ignore_SPARK_Mode_Pragmas_In_Instance := False;
         Outer_Generic_Scope := Empty;
         Scope_Suppress      := Suppress_Options;
         Scope_Stack.Table
           (Scope_Stack.Last).Component_Alignment_Default :=
             Configuration_Component_Alignment;
         Scope_Stack.Table
           (Scope_Stack.Last).Is_Active_Stack_Base := True;
         --  Now analyze the top level compilation unit node
         Analyze (Comp_Unit);
         --  Check for scope mismatch on exit from compilation
         pragma Assert (Current_Scope = Standard_Standard
                         or else Comp_Unit = Cunit (Main_Unit));
         --  Then pop entry for Standard, and pop implicit types
         Pop_Scope;
         Restore_Scope_Stack  (List);
         Style_Max_Line_Length := Saved_ML;
         Style_Check_Max_Line_Length := Saved_CML;
         Restore_Ghost_Region (Saved_GM, Saved_IGR);
         Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP;
      end Do_Analyze;
      --  Local variables
      --  The following locations save the corresponding global flags and
      --  variables so that they can be restored on completion. This is needed
      --  so that calls to Rtsfind start with the proper default values for
      --  these variables, and also that such calls do not disturb the settings
      --  for units being analyzed at a higher level.
      S_Current_Sem_Unit  : constant Unit_Number_Type := Current_Sem_Unit;
      S_Full_Analysis     : constant Boolean          := Full_Analysis;
      S_GNAT_Mode         : constant Boolean          := GNAT_Mode;
      S_Global_Dis_Names  : constant Boolean          := Global_Discard_Names;
      S_In_Assertion_Expr : constant Nat              := In_Assertion_Expr;
      S_In_Declare_Expr   : constant Nat              := In_Declare_Expr;
      S_In_Default_Expr   : constant Boolean          := In_Default_Expr;
      S_In_Spec_Expr      : constant Boolean          := In_Spec_Expression;
      S_Inside_A_Generic  : constant Boolean          := Inside_A_Generic;
      S_Outer_Gen_Scope   : constant Entity_Id        := Outer_Generic_Scope;
      S_Style_Check       : constant Boolean          := Style_Check;
      Already_Analyzed : constant Boolean := Analyzed (Comp_Unit);
      Curunit : constant Unit_Number_Type := Get_Cunit_Unit_Number (Comp_Unit);
      --  New value of Current_Sem_Unit
      Generic_Main : constant Boolean :=
        Nkind (Unit (Cunit (Main_Unit))) in N_Generic_Declaration;
      --  If the main unit is generic, every compiled unit, including its
      --  context, is compiled with expansion disabled.
      Is_Main_Unit_Or_Main_Unit_Spec : constant Boolean :=
         Curunit = Main_Unit
           or else
             (Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body
               and then Library_Unit (Cunit (Main_Unit)) = Cunit (Curunit));
      --  Configuration flags have special settings when compiling a predefined
      --  file as a main unit. This applies to its spec as well.
      Ext_Main_Source_Unit : constant Boolean :=
                               In_Extended_Main_Source_Unit (Comp_Unit);
      --  Determine if unit is in extended main source unit
      Save_Config_Attrs : Config_Switches_Type;
      --  Variable used to save values of config switches while we analyze the
      --  new unit, to be restored on exit for proper recursive behavior.
      Save_Cunit_Restrictions : Save_Cunit_Boolean_Restrictions;
      --  Used to save non-partition wide restrictions before processing new
      --  unit. All with'ed units are analyzed with config restrictions reset
      --  and we need to restore these saved values at the end.
      Save_Preanalysis_Counter : constant Nat :=
                                   Inside_Preanalysis_Without_Freezing;
      --  Saves the preanalysis nesting-level counter; required since we may
      --  need to analyze a unit as a consequence of the preanalysis of an
      --  expression without freezing (and the loaded unit must be fully
      --  analyzed).
   --  Start of processing for Semantics
   begin
      Inside_Preanalysis_Without_Freezing := 0;
      if Debug_Unit_Walk then
         if Already_Analyzed then
            Write_Str ("(done)");
         end if;
         Write_Unit_Info
           (Get_Cunit_Unit_Number (Comp_Unit),
            Unit (Comp_Unit),
            Prefix => "--> ");
         Indent;
      end if;
      Compiler_State   := Analyzing;
      Current_Sem_Unit := Curunit;
      --  Compile predefined units with GNAT_Mode set to True, to properly
      --  process the categorization stuff. However, do not set GNAT_Mode
      --  to True for the renamings units (Text_IO, IO_Exceptions, Direct_IO,
      --  Sequential_IO) as this would prevent pragma Extend_System from being
      --  taken into account, for example when Text_IO is renaming DEC.Text_IO.
      if Is_Predefined_Unit (Current_Sem_Unit)
        and then not Is_Predefined_Renaming (Current_Sem_Unit)
      then
         GNAT_Mode := True;
      end if;
      --  For generic main, never do expansion
      if Generic_Main then
         Expander_Mode_Save_And_Set (False);
      --  Non generic case
      else
         Expander_Mode_Save_And_Set
           --  Turn on expansion if generating code
           (Operating_Mode = Generate_Code
             --  Or if special debug flag -gnatdx is set
             or else Debug_Flag_X
             --  Or if in configuration run-time mode. We do this so we get
             --  error messages about missing entities in the run-time even
             --  if we are compiling in -gnatc (no code generation) mode.
             --  Similar processing applies to No_Run_Time_Mode. However,
             --  don't do this if debug flag -gnatd.Z is set or when we are
             --  compiling a separate unit (this is to handle a situation
             --  where this new processing causes trouble).
             or else
               ((Configurable_Run_Time_Mode or No_Run_Time_Mode)
                  and then not Debug_Flag_Dot_ZZ
                  and then Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit));
      end if;
      Full_Analysis      := True;
      Inside_A_Generic   := False;
      In_Assertion_Expr  := 0;
      In_Declare_Expr    := 0;
      In_Default_Expr    := False;
      In_Spec_Expression := False;
      Set_Comes_From_Source_Default (False);
      --  Save current config switches and reset then appropriately
      Save_Config_Attrs := Save_Config_Switches;
      Set_Config_Switches
        (Is_Internal_Unit (Current_Sem_Unit),
         Is_Main_Unit_Or_Main_Unit_Spec);
      --  Save current non-partition-wide restrictions
      Save_Cunit_Restrictions := Cunit_Boolean_Restrictions_Save;
      --  For unit in main extended unit, we reset the configuration values
      --  for the non-partition-wide restrictions. For other units reset them.
      if Ext_Main_Source_Unit then
         Restore_Config_Cunit_Boolean_Restrictions;
      else
         Reset_Cunit_Boolean_Restrictions;
      end if;
      --  Turn off style checks for unit that is not in the extended main
      --  source unit. This improves processing efficiency for such units
      --  (for which we don't want style checks anyway, and where they will
      --  get suppressed), and is definitely needed to stop some style checks
      --  from invading the run-time units (e.g. overriding checks).
      if not Ext_Main_Source_Unit then
         Style_Check := False;
      --  If this is part of the extended main source unit, set style check
      --  mode to match the style check mode of the main source unit itself.
      else
         Style_Check := Style_Check_Main;
      end if;
      --  Only do analysis of unit that has not already been analyzed
      if not Analyzed (Comp_Unit) then
         Initialize_Version (Current_Sem_Unit);
         --  Do analysis, and then append the compilation unit onto the
         --  Comp_Unit_List, if appropriate. This is done after analysis,
         --  so if this unit depends on some others, they have already been
         --  appended. We ignore bodies, except for the main unit itself, and
         --  for subprogram bodies that act as specs. We have also to guard
         --  against ill-formed subunits that have an improper context.
         Do_Analyze;
         if Present (Comp_Unit)
           and then Nkind (Unit (Comp_Unit)) in N_Proper_Body
           and then (Nkind (Unit (Comp_Unit)) /= N_Subprogram_Body
                       or else not Acts_As_Spec (Comp_Unit))
           and then not Ext_Main_Source_Unit
         then
            null;
         else
            Append_New_Elmt (Comp_Unit, To => Comp_Unit_List);
            if Debug_Unit_Walk then
               Write_Str ("Appending ");
               Write_Unit_Info
                 (Get_Cunit_Unit_Number (Comp_Unit), Unit (Comp_Unit));
            end if;
         end if;
      end if;
      --  Save indication of dynamic elaboration checks for ALI file
      Set_Dynamic_Elab (Current_Sem_Unit, Dynamic_Elaboration_Checks);
      --  Restore settings of saved switches to entry values
      Current_Sem_Unit     := S_Current_Sem_Unit;
      Full_Analysis        := S_Full_Analysis;
      Global_Discard_Names := S_Global_Dis_Names;
      GNAT_Mode            := S_GNAT_Mode;
      In_Assertion_Expr    := S_In_Assertion_Expr;
      In_Declare_Expr      := S_In_Declare_Expr;
      In_Default_Expr      := S_In_Default_Expr;
      In_Spec_Expression   := S_In_Spec_Expr;
      Inside_A_Generic     := S_Inside_A_Generic;
      Outer_Generic_Scope  := S_Outer_Gen_Scope;
      Style_Check          := S_Style_Check;
      Restore_Config_Switches (Save_Config_Attrs);
      --  Deal with restore of restrictions
      Cunit_Boolean_Restrictions_Restore (Save_Cunit_Restrictions);
      Expander_Mode_Restore;
      if Debug_Unit_Walk then
         Outdent;
         if Already_Analyzed then
            Write_Str ("(done)");
         end if;
         Write_Unit_Info
           (Get_Cunit_Unit_Number (Comp_Unit),
            Unit (Comp_Unit),
            Prefix => "<-- ");
      end if;
      Inside_Preanalysis_Without_Freezing := Save_Preanalysis_Counter;
   end Semantics;
   --------
   -- ss --
   --------
   function ss (Index : Int) return Scope_Stack_Entry is
   begin
      return Scope_Stack.Table (Index);
   end ss;
   ---------
   -- sst --
   ---------
   function sst return Scope_Stack_Entry is
   begin
      return ss (Scope_Stack.Last);
   end sst;
   ------------
   -- Unlock --
   ------------
   procedure Unlock is
   begin
      Scope_Stack.Locked := False;
   end Unlock;
   ------------------------
   -- Walk_Library_Items --
   ------------------------
   procedure Walk_Library_Items is
      type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
      pragma Pack (Unit_Number_Set);
      Main_CU : constant Node_Id := Cunit (Main_Unit);
      Spec_CU : Node_Id := Empty;
      Seen, Done : Unit_Number_Set := (others => False);
      --  Seen (X) is True after we have seen unit X in the walk. This is used
      --  to prevent processing the same unit more than once. Done (X) is True
      --  after we have fully processed X, and is used only for debugging
      --  printouts and assertions.
      Do_Main : Boolean := False;
      --  Flag to delay processing the main body until after all other units.
      --  This is needed because the spec of the main unit may appear in the
      --  context of some other unit. We do not want this to force processing
      --  of the main body before all other units have been processed.
      --
      --  Another circularity pattern occurs when the main unit is a child unit
      --  and the body of an ancestor has a with-clause of the main unit or on
      --  one of its children. In both cases the body in question has a with-
      --  clause on the main unit, and must be excluded from the traversal. In
      --  some convoluted cases this may lead to a CodePeer error because the
      --  spec of a subprogram declared in an instance within the parent will
      --  not be seen in the main unit.
      function Depends_On_Main (CU : Node_Id) return Boolean;
      --  The body of a unit that is withed by the spec of the main unit may in
      --  turn have a with_clause on that spec. In that case do not traverse
      --  the body, to prevent loops. It can also happen that the main body has
      --  a with_clause on a child, which of course has an implicit with on its
      --  parent. It's OK to traverse the child body if the main spec has been
      --  processed, otherwise we also have a circularity to avoid.
      procedure Do_Action (CU : Node_Id; Item : Node_Id);
      --  Calls Action, with some validity checks
      procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id);
      --  Calls Do_Action, first on the units with'ed by this one, then on
      --  this unit. If it's an instance body, do the spec first. If it is
      --  an instance spec, do the body last.
      procedure Do_Withed_Unit (Withed_Unit : Node_Id);
      --  Apply Do_Unit_And_Dependents to a unit in a context clause
      procedure Process_Bodies_In_Context (Comp : Node_Id);
      --  The main unit and its spec may depend on bodies that contain generics
      --  that are instantiated in them. Iterate through the corresponding
      --  contexts before processing main (spec/body) itself, to process bodies
      --  that may be present, together with their context. The spec of main
      --  is processed wherever it appears in the list of units, while the body
      --  is processed as the last unit in the list.
      ---------------------
      -- Depends_On_Main --
      ---------------------
      function Depends_On_Main (CU : Node_Id) return Boolean is
         CL  : Node_Id;
         MCU : constant Node_Id := Unit (Main_CU);
      begin
         --  Problem does not arise with main subprograms
         if Nkind (MCU) not in N_Package_Body | N_Package_Declaration then
            return False;
         end if;
         CL := First (Context_Items (CU));
         while Present (CL) loop
            if Nkind (CL) = N_With_Clause
              and then Library_Unit (CL) = Main_CU
              and then not Done (Get_Cunit_Unit_Number (Library_Unit (CL)))
            then
               return True;
            end if;
            Next (CL);
         end loop;
         return False;
      end Depends_On_Main;
      ---------------
      -- Do_Action --
      ---------------
      procedure Do_Action (CU : Node_Id; Item : Node_Id) is
      begin
         --  This calls Action at the end. All the preceding code is just
         --  assertions and debugging output.
         pragma Assert (No (CU) or else Nkind (CU) = N_Compilation_Unit);
         case Nkind (Item) is
            when N_Generic_Function_Renaming_Declaration
               | N_Generic_Package_Declaration
               | N_Generic_Package_Renaming_Declaration
               | N_Generic_Procedure_Renaming_Declaration
               | N_Generic_Subprogram_Declaration
               | N_Package_Declaration
               | N_Package_Renaming_Declaration
               | N_Subprogram_Declaration
               | N_Subprogram_Renaming_Declaration
            =>
               --  Specs are OK
               null;
            when N_Package_Body  =>
               --  Package bodies are processed separately if the main unit
               --  depends on them.
               null;
            when N_Subprogram_Body =>
               --  A subprogram body must be the main unit
               pragma Assert (Acts_As_Spec (CU) or else CU = Main_CU);
               null;
            when N_Function_Instantiation
               | N_Package_Instantiation
               | N_Procedure_Instantiation
            =>
               --  Can only happen if some generic body (needed for gnat2scil
               --  traversal, but not by GNAT) is not available, ignore.
               null;
            --  All other cases cannot happen
            when N_Subunit =>
               pragma Assert (False, "subunit");
               null;
            when N_Null_Statement =>
               --  Do not call Action for an ignored ghost unit
               pragma Assert (Is_Ignored_Ghost_Node (Original_Node (Item)));
               return;
            when others =>
               pragma Assert (False);
               null;
         end case;
         if Present (CU) then
            pragma Assert (Item /= Stand.Standard_Package_Node);
            pragma Assert (Item = Unit (CU));
            declare
               Unit_Num : constant Unit_Number_Type :=
                            Get_Cunit_Unit_Number (CU);
               procedure Assert_Done (Withed_Unit : Node_Id);
               --  Assert Withed_Unit is already Done, unless it's a body. It
               --  might seem strange for a with_clause to refer to a body, but
               --  this happens in the case of a generic instantiation, which
               --  gets transformed into the instance body (and the instance
               --  spec is also created). With clauses pointing to the
               --  instantiation end up pointing to the instance body.
               -----------------
               -- Assert_Done --
               -----------------
               procedure Assert_Done (Withed_Unit : Node_Id) is
               begin
                  if Withed_Unit /= Main_CU
                    and then not Done (Get_Cunit_Unit_Number (Withed_Unit))
                  then
                     --  N_Null_Statement will happen in case of a ghost unit
                     --  which gets rewritten.
                     if Nkind (Unit (Withed_Unit)) not in
                          N_Generic_Package_Declaration  |
                          N_Package_Body                 |
                          N_Package_Renaming_Declaration |
                          N_Subprogram_Body              |
                          N_Null_Statement
                     then
                        Write_Unit_Name
                          (Unit_Name (Get_Cunit_Unit_Number (Withed_Unit)));
                        Write_Str (" not yet walked!");
                        if Get_Cunit_Unit_Number (Withed_Unit) = Unit_Num then
                           Write_Str (" (self-ref)");
                        end if;
                        Write_Eol;
                        pragma Assert (False);
                     end if;
                  end if;
               end Assert_Done;
               procedure Assert_Withed_Units_Done is
                 new Walk_Withs (Assert_Done);
            begin
               if Debug_Unit_Walk then
                  Write_Unit_Info (Unit_Num, Item, Withs => True);
               end if;
               --  Main unit should come last, except in the case where we
               --  skipped System_Aux_Id, in which case we missed the things it
               --  depends on, and in the case of parent bodies if present.
               pragma Assert
                 (not Done (Main_Unit)
                  or else Present (System_Aux_Id)
                  or else Nkind (Item) = N_Package_Body);
               --  We shouldn't do the same thing twice
               pragma Assert (not Done (Unit_Num));
               --  Everything we depend upon should already be done
               pragma Debug
                 (Assert_Withed_Units_Done (CU, Include_Limited => False));
            end;
         else
            --  Must be Standard, which has no entry in the units table
            pragma Assert (Item = Stand.Standard_Package_Node);
            if Debug_Unit_Walk then
               Write_Line ("Standard");
            end if;
         end if;
         Action (Item);
      end Do_Action;
      --------------------
      -- Do_Withed_Unit --
      --------------------
      procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
      begin
         Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
         --  If the unit in the with_clause is a generic instance, the clause
         --  now denotes the instance body. Traverse the corresponding spec
         --  because there may be no other dependence that will force the
         --  traversal of its own context.
         if Nkind (Unit (Withed_Unit)) = N_Package_Body
           and then Is_Generic_Instance
                      (Defining_Entity (Unit (Library_Unit (Withed_Unit))))
         then
            Do_Withed_Unit (Library_Unit (Withed_Unit));
         end if;
      end Do_Withed_Unit;
      ----------------------------
      -- Do_Unit_And_Dependents --
      ----------------------------
      procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
         Unit_Num  : constant Unit_Number_Type := Get_Cunit_Unit_Number (CU);
         Child     : Node_Id;
         Body_U    : Unit_Number_Type;
         Parent_CU : Node_Id;
         procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
      begin
         if not Seen (Unit_Num) then
            --  Process the with clauses
            Do_Withed_Units (CU, Include_Limited => False);
            --  Process the unit if it is a spec or the main unit, if it
            --  has no previous spec or we have done all other units.
            if Nkind (Item) not in N_Package_Body | N_Subprogram_Body
              or else Acts_As_Spec (CU)
            then
               if CU = Main_CU and then not Do_Main then
                  Seen (Unit_Num) := False;
               else
                  Seen (Unit_Num) := True;
                  if CU = Library_Unit (Main_CU) then
                     Process_Bodies_In_Context (CU);
                     --  If main is a child unit, examine parent unit contexts
                     --  to see if they include instantiated units. Also, if
                     --  the parent itself is an instance, process its body
                     --  because it may contain subprograms that are called
                     --  in the main unit.
                     if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
                        Child := Cunit_Entity (Main_Unit);
                        while Is_Child_Unit (Child) loop
                           Parent_CU :=
                             Cunit
                               (Get_Cunit_Entity_Unit_Number (Scope (Child)));
                           Process_Bodies_In_Context (Parent_CU);
                           if Nkind (Unit (Parent_CU)) = N_Package_Body
                             and then
                               Nkind (Original_Node (Unit (Parent_CU)))
                                 = N_Package_Instantiation
                             and then
                               not Seen (Get_Cunit_Unit_Number (Parent_CU))
                           then
                              Body_U := Get_Cunit_Unit_Number (Parent_CU);
                              Seen (Body_U) := True;
                              Do_Action (Parent_CU, Unit (Parent_CU));
                              Done (Body_U) := True;
                           end if;
                           Child := Scope (Child);
                        end loop;
                     end if;
                  end if;
                  Do_Action (CU, Item);
                  Done (Unit_Num) := True;
               end if;
            end if;
         end if;
      end Do_Unit_And_Dependents;
      -------------------------------
      -- Process_Bodies_In_Context --
      -------------------------------
      procedure Process_Bodies_In_Context (Comp : Node_Id) is
         Body_CU : Node_Id;
         Body_U  : Unit_Number_Type;
         Clause  : Node_Id;
         Spec    : Node_Id;
         procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
      --  Start of processing for Process_Bodies_In_Context
      begin
         Clause := First (Context_Items (Comp));
         while Present (Clause) loop
            if Nkind (Clause) = N_With_Clause then
               Spec := Library_Unit (Clause);
               Body_CU := Library_Unit (Spec);
               --  If we are processing the spec of the main unit, load bodies
               --  only if the with_clause indicates that it forced the loading
               --  of the body for a generic instantiation. Note that bodies of
               --  parents that are instances have been loaded already.
               if Present (Body_CU)
                 and then Body_CU /= Main_CU
                 and then Nkind (Unit (Body_CU)) /= N_Subprogram_Body
                 and then Nkind (Unit (Comp)) /= N_Package_Declaration
               then
                  Body_U := Get_Cunit_Unit_Number (Body_CU);
                  if not Seen (Body_U)
                    and then not Depends_On_Main (Body_CU)
                  then
                     Seen (Body_U) := True;
                     Do_Withed_Units (Body_CU, Include_Limited => False);
                     Do_Action (Body_CU, Unit (Body_CU));
                     Done (Body_U) := True;
                  end if;
               end if;
            end if;
            Next (Clause);
         end loop;
      end Process_Bodies_In_Context;
      --  Local Declarations
      Cur : Elmt_Id;
   --  Start of processing for Walk_Library_Items
   begin
      if Debug_Unit_Walk then
         Write_Line ("Walk_Library_Items:");
         Indent;
      end if;
      --  Do Standard first, then walk the Comp_Unit_List
      Do_Action (Empty, Standard_Package_Node);
      --  First place the context of all instance bodies on the corresponding
      --  spec, because it may be needed to analyze the code at the place of
      --  the instantiation.
      Cur := First_Elmt (Comp_Unit_List);
      while Present (Cur) loop
         declare
            CU : constant Node_Id := Node (Cur);
            N  : constant Node_Id := Unit (CU);
         begin
            if Nkind (N) = N_Package_Body
              and then Is_Generic_Instance (Defining_Entity (N))
            then
               Append_List
                 (Context_Items (CU), Context_Items (Library_Unit (CU)));
            end if;
            Next_Elmt (Cur);
         end;
      end loop;
      --  Now traverse compilation units (specs) in order
      Cur := First_Elmt (Comp_Unit_List);
      while Present (Cur) loop
         declare
            CU  : constant Node_Id := Node (Cur);
            N   : constant Node_Id := Unit (CU);
            Par : Entity_Id;
         begin
            pragma Assert (Nkind (CU) = N_Compilation_Unit);
            case Nkind (N) is
               --  If it is a subprogram body, process it if it has no
               --  separate spec.
               --  If it's a package body, ignore it, unless it is a body
               --  created for an instance that is the main unit. In the case
               --  of subprograms, the body is the wrapper package. In case of
               --  a package, the original file carries the body, and the spec
               --  appears as a later entry in the units list.
               --  Otherwise bodies appear in the list only because of inlining
               --  or instantiations, and they are processed only if relevant.
               --  The flag Withed_Body on a context clause indicates that a
               --  unit contains an instantiation that may be needed later,
               --  and therefore the body that contains the generic body (and
               --  its context) must be traversed immediately after the
               --  corresponding spec (see Do_Unit_And_Dependents).
               --  The main unit itself is processed separately after all other
               --  specs, and relevant bodies are examined in Process_Main.
               when N_Subprogram_Body =>
                  if Acts_As_Spec (N) then
                     Do_Unit_And_Dependents (CU, N);
                  end if;
               when N_Package_Body =>
                  if CU = Main_CU
                    and then Nkind (Original_Node (Unit (Main_CU))) in
                                                  N_Generic_Instantiation
                    and then Present (Library_Unit (Main_CU))
                  then
                     Do_Unit_And_Dependents
                       (Library_Unit (Main_CU),
                        Unit (Library_Unit (Main_CU)));
                  end if;
               --  It is a spec, process it, and the units it depends on,
               --  unless it is a descendant of the main unit. This can happen
               --  when the body of a parent depends on some other descendant.
               when N_Null_Statement =>
                  --  Ignore an ignored ghost unit
                  pragma Assert (Is_Ignored_Ghost_Node (Original_Node (N)));
                  null;
               when others =>
                  --  Skip spec of main unit for now, we want to process it
                  --  after all other specs.
                  if Nkind (Unit (CU)) = N_Package_Declaration
                    and then Library_Unit (CU) = Main_CU
                    and then CU /= Main_CU
                  then
                     Spec_CU := CU;
                  else
                     Par := Scope (Defining_Entity (Unit (CU)));
                     if Is_Child_Unit (Defining_Entity (Unit (CU))) then
                        while Present (Par)
                          and then Par /= Standard_Standard
                          and then Par /= Cunit_Entity (Main_Unit)
                        loop
                           Par := Scope (Par);
                        end loop;
                     end if;
                     if Par /= Cunit_Entity (Main_Unit) then
                        Do_Unit_And_Dependents (CU, N);
                     end if;
                  end if;
            end case;
         end;
         Next_Elmt (Cur);
      end loop;
      --  Now process main package spec if skipped
      if Present (Spec_CU) then
         Do_Unit_And_Dependents (Spec_CU, Unit (Spec_CU));
      end if;
      --  Now process package bodies on which main depends, followed by bodies
      --  of parents, if present, and finally main itself.
      if not Done (Main_Unit) then
         Do_Main := True;
         Process_Main : declare
            Parent_CU : Node_Id;
            Body_CU   : Node_Id;
            Body_U    : Unit_Number_Type;
            Child     : Entity_Id;
            function Is_Subunit_Of_Main (U : Node_Id) return Boolean;
            --  If the main unit has subunits, their context may include
            --  bodies that are needed in the body of main. We must examine
            --  the context of the subunits, which are otherwise not made
            --  explicit in the main unit.
            ------------------------
            -- Is_Subunit_Of_Main --
            ------------------------
            function Is_Subunit_Of_Main (U : Node_Id) return Boolean is
               Lib : Node_Id;
            begin
               if Present (U) and then Nkind (Unit (U)) = N_Subunit then
                  Lib := Library_Unit (U);
                  return Lib = Main_CU or else Is_Subunit_Of_Main (Lib);
               else
                  return False;
               end if;
            end Is_Subunit_Of_Main;
         --  Start of processing for Process_Main
         begin
            Process_Bodies_In_Context (Main_CU);
            for Unit_Num in Done'Range loop
               if Is_Subunit_Of_Main (Cunit (Unit_Num)) then
                  Process_Bodies_In_Context (Cunit (Unit_Num));
               end if;
            end loop;
            --  If the main unit is a child unit, parent bodies may be present
            --  because they export instances or inlined subprograms. Check for
            --  presence of these, which are not present in context clauses.
            --  Note that if the parents are instances, their bodies have been
            --  processed before the main spec, because they may be needed
            --  therein, so the following loop only affects non-instances.
            if Is_Child_Unit (Cunit_Entity (Main_Unit)) then
               Child := Cunit_Entity (Main_Unit);
               while Is_Child_Unit (Child) loop
                  Parent_CU :=
                    Cunit (Get_Cunit_Entity_Unit_Number (Scope (Child)));
                  Body_CU := Library_Unit (Parent_CU);
                  if Present (Body_CU)
                    and then not Seen (Get_Cunit_Unit_Number (Body_CU))
                    and then not Depends_On_Main (Body_CU)
                  then
                     Body_U := Get_Cunit_Unit_Number (Body_CU);
                     Seen (Body_U) := True;
                     Do_Action (Body_CU, Unit (Body_CU));
                     Done (Body_U) := True;
                  end if;
                  Child := Scope (Child);
               end loop;
            end if;
            Do_Action (Main_CU, Unit (Main_CU));
            Done (Main_Unit) := True;
         end Process_Main;
      end if;
      if Debug_Unit_Walk then
         if Done /= (Done'Range => True) then
            Write_Eol;
            Write_Line ("Ignored units:");
            Indent;
            for Unit_Num in Done'Range loop
               if not Done (Unit_Num) then
                  --  Units with configuration pragmas (.ads files) have empty
                  --  compilation-unit nodes; skip printing info about them.
                  if Present (Cunit (Unit_Num)) then
                     Write_Unit_Info
                       (Unit_Num, Unit (Cunit (Unit_Num)), Withs => True);
                  end if;
               end if;
            end loop;
            Outdent;
         end if;
      end if;
      pragma Assert (Done (Main_Unit));
      if Debug_Unit_Walk then
         Outdent;
         Write_Line ("end Walk_Library_Items.");
      end if;
   end Walk_Library_Items;
   ----------------
   -- Walk_Withs --
   ----------------
   procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean) is
      pragma Assert (Nkind (CU) = N_Compilation_Unit);
      pragma Assert (Nkind (Unit (CU)) /= N_Subunit);
      procedure Walk_Immediate is new Walk_Withs_Immediate (Action);
   begin
      --  First walk the withs immediately on the library item
      Walk_Immediate (CU, Include_Limited);
      --  For a body, we must also check for any subunits which belong to it
      --  and which have context clauses of their own, since these with'ed
      --  units are part of its own dependencies.
      if Nkind (Unit (CU)) in N_Unit_Body then
         for S in Main_Unit .. Last_Unit loop
            --  We are only interested in subunits. For preproc. data and def.
            --  files, Cunit is Empty, so we need to test that first.
            if Cunit (S) /= Empty
              and then Nkind (Unit (Cunit (S))) = N_Subunit
            then
               declare
                  Pnode : Node_Id;
               begin
                  Pnode := Library_Unit (Cunit (S));
                  --  In -gnatc mode, the errors in the subunits will not have
                  --  been recorded, but the analysis of the subunit may have
                  --  failed, so just quit.
                  if No (Pnode) then
                     exit;
                  end if;
                  --  Find ultimate parent of the subunit
                  while Nkind (Unit (Pnode)) = N_Subunit loop
                     Pnode := Library_Unit (Pnode);
                  end loop;
                  --  See if it belongs to current unit, and if so, include its
                  --  with_clauses. Do not process main unit prematurely.
                  if Pnode = CU and then CU /= Cunit (Main_Unit) then
                     Walk_Immediate (Cunit (S), Include_Limited);
                  end if;
               end;
            end if;
         end loop;
      end if;
   end Walk_Withs;
   --------------------------
   -- Walk_Withs_Immediate --
   --------------------------
   procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean) is
      pragma Assert (Nkind (CU) = N_Compilation_Unit);
      Context_Item : Node_Id;
      Lib_Unit     : Node_Id;
   begin
      Context_Item := First (Context_Items (CU));
      while Present (Context_Item) loop
         if Nkind (Context_Item) = N_With_Clause
           and then (Include_Limited
                     or else not Limited_Present (Context_Item))
         then
            Lib_Unit := Library_Unit (Context_Item);
            Action (Lib_Unit);
         end if;
         Next (Context_Item);
      end loop;
   end Walk_Withs_Immediate;
end Sem;
 
     |