1-- Semantic analysis. 2-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16with Logging; use Logging; 17with Tables; 18with Flags; use Flags; 19with Name_Table; -- use Name_Table; 20with Files_Map; use Files_Map; 21with Errorout; use Errorout; 22with Vhdl.Errors; use Vhdl.Errors; 23with Vhdl.Utils; use Vhdl.Utils; 24 25package body Vhdl.Sem_Scopes is 26 -- An interpretation cell is the element of the simply linked list 27 -- of interpretation for an identifier. 28 -- Interpretation cells are stored in table Interpretations. 29 type Interpretation_Cell is record 30 -- The declaration for this interpretation. 31 Decl: Iir; 32 33 -- If True, the declaration is potentially visible (ie visible via a 34 -- use clause). 35 Is_Potential : Boolean; 36 37 -- If True, previous declarations in PREV chain are hidden and shouldn't 38 -- be considered. 39 Prev_Hidden : Boolean; 40 41 -- Previous interpretation for this identifier. 42 -- If No_Name_Interpretation, this (not PREV) interpretation is the last 43 -- one. If Prev_Hidden is True, PREV must be ignored. If Prev_Hidden is 44 -- false, the identifier is overloaded. 45 Prev: Name_Interpretation_Type; 46 47 -- Previous added identifier in the declarative region. This forms a 48 -- linked list used to remove interpretations when a declarative 49 -- region is closed. 50 Prev_In_Region : Name_Id; 51 end record; 52 pragma Pack (Interpretation_Cell); 53 54 package Interpretations is new Tables 55 (Table_Component_Type => Interpretation_Cell, 56 Table_Index_Type => Name_Interpretation_Type, 57 Table_Low_Bound => First_Valid_Interpretation, 58 Table_Initial => 1024); 59 60 -- Cached value of Prev_In_Region of current region. 61 Last_In_Region : Name_Id := Null_Identifier; 62 63 -- First interpretation in the current declarative region. 64 Current_Region_Start : Name_Interpretation_Type := 65 First_Valid_Interpretation; 66 67 -- First valid interpretation. All interpretations smaller than this 68 -- value are part of a previous (and nested) analysis and must not be 69 -- considered. 70 First_Interpretation : Name_Interpretation_Type := 71 First_Valid_Interpretation; 72 73 -- List of non-local hidden declarations. 74 type Hide_Index is new Nat32; 75 No_Hide_Index : constant Hide_Index := 0; 76 77 package Hidden_Decls is new Tables 78 (Table_Component_Type => Name_Interpretation_Type, 79 Table_Index_Type => Hide_Index, 80 Table_Low_Bound => No_Hide_Index + 1, 81 Table_Initial => 32); 82 83 -- First non-local hidden declarations. In VHDL, it is possible to hide 84 -- an overloaded declaration (by declaring a subprogram with the same 85 -- profile). If the overloaded declaration is local, the interpretation 86 -- can simply be modified. But if it is not local, the interpretation is 87 -- removed from the chain and saved in the Hidden_Decls table. 88 First_Hide_Index : Hide_Index := No_Hide_Index; 89 90 -- To manage the list of interpretation and to add informations to this 91 -- list, a stack is used. 92 -- Elements of stack can be of kind: 93 -- Save_Cell: 94 -- the element contains the interpretation INTER for the indentifier ID 95 -- for the outer declarative region. 96 -- A save cell is always created each time a declaration is added to save 97 -- the previous interpretation. 98 -- Region_Start: 99 -- A new declarative region start at interpretation INTER. Here, INTER 100 -- is used as an index in the interpretations stack (table). 101 -- ID is used as an index into the unidim_array stack. 102 -- Barrier_start, Barrier_end: 103 -- All currents interpretations are saved between both INTER, and 104 -- are cleared. This is used to call semantic during another semantic. 105 106 type Scope_Cell_Kind_Type is (Scope_Start, Scope_Region); 107 108 type Scope_Cell is record 109 Kind: Scope_Cell_Kind_Type; 110 111 -- Values for the previous scope. 112 Saved_Last_In_Region : Name_Id; 113 Saved_Region_Start : Name_Interpretation_Type; 114 Saved_First_Hide_Index : Hide_Index; 115 Saved_First_Interpretation : Name_Interpretation_Type; 116 end record; 117 118 package Scopes is new Tables 119 (Table_Component_Type => Scope_Cell, 120 Table_Index_Type => Natural, 121 Table_Low_Bound => 1, 122 Table_Initial => 64); 123 124 function Valid_Interpretation (Inter : Name_Interpretation_Type) 125 return Boolean is 126 begin 127 return Inter >= First_Interpretation; 128 end Valid_Interpretation; 129 130 -- Return True iff NI means there is a conflict for the identifier: no 131 -- valid interpretation due to potentially visible homoraph. 132 function Is_Conflict_Declaration (Ni : Name_Interpretation_Type) 133 return Boolean is 134 begin 135 pragma Assert (Valid_Interpretation (Ni)); 136 return Interpretations.Table (Ni).Decl = Null_Iir; 137 end Is_Conflict_Declaration; 138 139 -- Get the current interpretation for ID. The result is raw: it may not 140 -- be valid. 141 function Get_Interpretation_Raw (Id : Name_Id) 142 return Name_Interpretation_Type is 143 begin 144 return Name_Interpretation_Type (Name_Table.Get_Name_Info (Id)); 145 end Get_Interpretation_Raw; 146 147 procedure Set_Interpretation 148 (Id : Name_Id; Inter : Name_Interpretation_Type) is 149 begin 150 Name_Table.Set_Name_Info (Id, Int32 (Inter)); 151 end Set_Interpretation; 152 153 function Get_Interpretation_From_Raw (Inter : Name_Interpretation_Type) 154 return Name_Interpretation_Type is 155 begin 156 if Valid_Interpretation (Inter) 157 and then not Is_Conflict_Declaration (Inter) 158 then 159 -- In the current scopes set and not a conflict. 160 return Inter; 161 else 162 return No_Name_Interpretation; 163 end if; 164 end Get_Interpretation_From_Raw; 165 166 function Get_Interpretation (Id : Name_Id) 167 return Name_Interpretation_Type is 168 begin 169 return Get_Interpretation_From_Raw (Get_Interpretation_Raw (Id)); 170 end Get_Interpretation; 171 172 procedure Check_Interpretations; 173 pragma Unreferenced (Check_Interpretations); 174 175 procedure Check_Interpretations 176 is 177 Inter: Name_Interpretation_Type; 178 Last : constant Name_Interpretation_Type := Interpretations.Last; 179 Err : Boolean; 180 begin 181 Err := False; 182 for I in 0 .. Name_Table.Last_Name_Id loop 183 Inter := Get_Interpretation (I); 184 if Inter > Last then 185 Log_Line ("bad interpretation for " & Name_Table.Image (I)); 186 Err := True; 187 end if; 188 end loop; 189 if Err then 190 raise Internal_Error; 191 end if; 192 end Check_Interpretations; 193 194 procedure Push_Interpretations is 195 begin 196 Scopes.Append ((Kind => Scope_Start, 197 Saved_Last_In_Region => Last_In_Region, 198 Saved_Region_Start => Current_Region_Start, 199 Saved_First_Hide_Index => First_Hide_Index, 200 Saved_First_Interpretation => First_Interpretation)); 201 Last_In_Region := Null_Identifier; 202 Current_Region_Start := Interpretations.Last + 1; 203 First_Hide_Index := Hidden_Decls.Last + 1; 204 First_Interpretation := Interpretations.Last + 1; 205 end Push_Interpretations; 206 207 procedure Pop_Interpretations 208 is 209 Cell : Scope_Cell renames Scopes.Table (Scopes.Last); 210 begin 211 pragma Assert (Scopes.Table (Scopes.Last).Kind = Scope_Start); 212 213 -- All the declarative regions must have been removed. 214 pragma Assert (Last_In_Region = Null_Identifier); 215 pragma Assert (Current_Region_Start = Interpretations.Last + 1); 216 pragma Assert (First_Hide_Index = Hidden_Decls.Last + 1); 217 pragma Assert (First_Interpretation = Interpretations.Last + 1); 218 219 Last_In_Region := Cell.Saved_Last_In_Region; 220 Current_Region_Start := Cell.Saved_Region_Start; 221 First_Hide_Index := Cell.Saved_First_Hide_Index; 222 First_Interpretation := Cell.Saved_First_Interpretation; 223 224 Scopes.Decrement_Last; 225 end Pop_Interpretations; 226 227 -- Create a new declarative region. 228 -- Simply push a region_start cell and update current_scope_start. 229 procedure Open_Declarative_Region is 230 begin 231 Scopes.Append ((Kind => Scope_Region, 232 Saved_Last_In_Region => Last_In_Region, 233 Saved_Region_Start => Current_Region_Start, 234 Saved_First_Hide_Index => First_Hide_Index, 235 Saved_First_Interpretation => No_Name_Interpretation)); 236 Last_In_Region := Null_Identifier; 237 Current_Region_Start := Interpretations.Last + 1; 238 First_Hide_Index := Hidden_Decls.Last + 1; 239 end Open_Declarative_Region; 240 241 -- Close a declarative region. 242 -- Update interpretation of identifiers. 243 procedure Close_Declarative_Region 244 is 245 Cell : Scope_Cell renames Scopes.Table (Scopes.Last); 246 Id : Name_Id; 247 begin 248 pragma Assert (Cell.Kind = Scope_Region); 249 250 -- Restore hidden declarations. 251 for I in reverse First_Hide_Index .. Hidden_Decls.Last loop 252 declare 253 Inter : constant Name_Interpretation_Type := 254 Hidden_Decls.Table (I); 255 Prev_Inter, Next_Inter : Name_Interpretation_Type; 256 begin 257 Prev_Inter := Interpretations.Table (Inter).Prev; 258 Next_Inter := Interpretations.Table (Prev_Inter).Prev; 259 Interpretations.Table (Inter).Prev := Next_Inter; 260 Interpretations.Table (Prev_Inter).Prev := Inter; 261 end; 262 end loop; 263 Hidden_Decls.Set_Last (First_Hide_Index - 1); 264 265 -- Remove interpretations of that region. 266 Id := Last_In_Region; 267 if Id /= Null_Identifier then 268 declare 269 Inter : Name_Interpretation_Type; 270 begin 271 loop 272 Inter := Get_Interpretation_Raw (Id); 273 pragma Assert (Inter >= Current_Region_Start); 274 Set_Interpretation (Id, Interpretations.Table (Inter).Prev); 275 Id := Interpretations.Table (Inter).Prev_In_Region; 276 exit when Id = Null_Identifier; 277 end loop; 278 pragma Assert (Inter = Current_Region_Start); 279 end; 280 Interpretations.Set_Last (Current_Region_Start - 1); 281 end if; 282 283 Last_In_Region := Cell.Saved_Last_In_Region; 284 Current_Region_Start := Cell.Saved_Region_Start; 285 First_Hide_Index := Cell.Saved_First_Hide_Index; 286 287 Scopes.Decrement_Last; 288 end Close_Declarative_Region; 289 290 procedure Open_Scope_Extension renames Open_Declarative_Region; 291 procedure Close_Scope_Extension renames Close_Declarative_Region; 292 293 function Get_Next_Interpretation (Ni : Name_Interpretation_Type) 294 return Name_Interpretation_Type 295 is 296 pragma Assert (Valid_Interpretation (Ni)); 297 Cell : Interpretation_Cell renames Interpretations.Table (Ni); 298 begin 299 if Cell.Prev_Hidden 300 or else not Valid_Interpretation (Cell.Prev) 301 then 302 return No_Name_Interpretation; 303 else 304 return Cell.Prev; 305 end if; 306 end Get_Next_Interpretation; 307 308 function Get_Declaration (Ni : Name_Interpretation_Type) return Iir is 309 begin 310 pragma Assert (Valid_Interpretation (Ni)); 311 return Interpretations.Table (Ni).Decl; 312 end Get_Declaration; 313 314 function Get_Under_Interpretation (Id : Name_Id) 315 return Name_Interpretation_Type 316 is 317 Inter : constant Name_Interpretation_Type := Get_Interpretation (Id); 318 begin 319 -- ID has no interpretation. 320 -- So, there is no 'under' interpretation (FIXME: prove it). 321 pragma Assert (Valid_Interpretation (Inter)); 322 323 declare 324 Cell : Interpretation_Cell renames Interpretations.Table (Inter); 325 Prev : constant Name_Interpretation_Type := Cell.Prev; 326 begin 327 -- Get_Under_Interpretation can be used only to get a hidden 328 -- interpretation. 329 pragma Assert (Cell.Prev_Hidden); 330 331 if Valid_Interpretation (Prev) 332 -- Not a conflict one (use clauses). 333 and then Get_Declaration (Prev) /= Null_Iir 334 then 335 return Prev; 336 else 337 return No_Name_Interpretation; 338 end if; 339 end; 340 end Get_Under_Interpretation; 341 342 function Strip_Non_Object_Alias (Decl : Iir) return Iir 343 is 344 Res : Iir; 345 begin 346 Res := Decl; 347 if Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then 348 Res := Get_Named_Entity (Get_Name (Res)); 349 end if; 350 return Res; 351 end Strip_Non_Object_Alias; 352 353 function Get_Non_Alias_Declaration (Ni : Name_Interpretation_Type) 354 return Iir is 355 begin 356 return Strip_Non_Object_Alias (Get_Declaration (Ni)); 357 end Get_Non_Alias_Declaration; 358 359 -- Return TRUE if INTER was made directly visible via a use clause. 360 function Is_Potentially_Visible (Inter : Name_Interpretation_Type) 361 return Boolean is 362 begin 363 return Interpretations.Table (Inter).Is_Potential; 364 end Is_Potentially_Visible; 365 366 -- Return TRUE iif DECL can be overloaded. 367 function Is_Overloadable (Decl : Iir) return Boolean is 368 begin 369 -- LRM93 10.3: 370 -- The overloaded declarations considered in this chapter are those for 371 -- subprograms and enumeration literals. 372 case Get_Kind (Decl) is 373 when Iir_Kind_Enumeration_Literal 374 | Iir_Kind_Function_Declaration 375 | Iir_Kind_Procedure_Declaration 376 | Iir_Kind_Interface_Function_Declaration 377 | Iir_Kind_Interface_Procedure_Declaration => 378 return True; 379 when Iir_Kind_Non_Object_Alias_Declaration => 380 case Get_Kind (Get_Named_Entity (Get_Name (Decl))) is 381 when Iir_Kind_Enumeration_Literal 382 | Iir_Kind_Function_Declaration 383 | Iir_Kind_Procedure_Declaration 384 | Iir_Kind_Interface_Function_Declaration 385 | Iir_Kind_Interface_Procedure_Declaration => 386 return True; 387 when Iir_Kind_Non_Object_Alias_Declaration => 388 raise Internal_Error; 389 when others => 390 return False; 391 end case; 392 when others => 393 return False; 394 end case; 395 end Is_Overloadable; 396 397 -- Return TRUE if INTER was made direclty visible in the current 398 -- declarative region. 399 function Is_In_Current_Declarative_Region (Inter : Name_Interpretation_Type) 400 return Boolean is 401 begin 402 return Inter >= Current_Region_Start; 403 end Is_In_Current_Declarative_Region; 404 405 -- Emit a warning when DECL hides PREV_DECL. 406 procedure Warning_Hide (Decl : Iir; Prev_Decl : Iir) 407 is 408 begin 409 if Get_Kind (Decl) in Iir_Kinds_Interface_Declaration 410 and then Get_Kind (Get_Parent (Decl)) = Iir_Kind_Component_Declaration 411 then 412 -- Do not warn when an interface in a component hides a declaration. 413 -- This is a common case (eg: in testbenches), and there is no real 414 -- hiding. 415 return; 416 end if; 417 418 if Get_Kind (Decl) = Iir_Kind_Element_Declaration then 419 -- Do not warn for record elements. They are used by selection. 420 return; 421 end if; 422 423 if Decl = Prev_Decl then 424 -- Can happen in configuration. No real hidding. 425 return; 426 end if; 427 428 if Name_Table.Get_Name_Ptr (Get_Identifier (Decl))(1) = 'P' then 429 -- Do not warn for labels starting with 'P'. These are canonicalized 430 -- process labels which are scoped. 431 -- This can happen as an architecture is canonicalized during 432 -- analysis and then its declarations are 'imported' by a 433 -- configuration. 434 return; 435 end if; 436 437 Warning_Msg_Sem (Warnid_Hide, +Decl, 438 "declaration of %i hides %n", (+Decl, +Prev_Decl)); 439 end Warning_Hide; 440 441 -- Add interpretation DECL to the identifier of DECL. 442 -- POTENTIALLY is true if the identifier comes from a use clause. 443 procedure Add_Name (Decl : Iir; Ident : Name_Id; Potentially : Boolean) 444 is 445 -- Current interpretation of ID. This is the one before DECL is 446 -- added (if so). 447 Raw_Inter : constant Name_Interpretation_Type := 448 Get_Interpretation_Raw (Ident); 449 Current_Inter : constant Name_Interpretation_Type := 450 Get_Interpretation_From_Raw (Raw_Inter); 451 Current_Decl : Iir; 452 453 -- Add DECL in the chain of interpretation for the identifier. 454 procedure Add_New_Interpretation (Hid_Prev : Boolean; D : Iir := Decl) is 455 begin 456 Interpretations.Append ((Decl => D, 457 Prev => Raw_Inter, 458 Is_Potential => Potentially, 459 Prev_Hidden => Hid_Prev, 460 Prev_In_Region => Last_In_Region)); 461 Set_Interpretation (Ident, Interpretations.Last); 462 Last_In_Region := Ident; 463 end Add_New_Interpretation; 464 begin 465 if Ident = Null_Identifier then 466 -- Missing identifier can happen only in case of parse error. 467 pragma Assert (Flags.Flag_Force_Analysis); 468 return; 469 end if; 470 471 if not Valid_Interpretation (Raw_Inter) then 472 -- Very simple: no hidding, no overloading. 473 Add_New_Interpretation (True); 474 return; 475 end if; 476 477 if Is_Conflict_Declaration (Raw_Inter) then 478 -- The current declaration for RAW_INTER is a conflict: there are 479 -- multiple *potentially* visible declarations for the identifier. 480 if Potentially then 481 -- Yet another conflicting interpretation. 482 return; 483 else 484 -- Very simple: no hidding, no overloading. 485 -- (current interpretation is Conflict_Interpretation if there is 486 -- only potentially visible declarations that are not made 487 -- directly visible). 488 -- Note: in case of conflict interpretation, it may be unnecessary 489 -- to keep the current interpretation (but it is simpler as is). 490 Add_New_Interpretation (True); 491 return; 492 end if; 493 end if; 494 495 if Potentially then 496 -- Do not re-add a potential decl. This handles cases like: 497 -- 'use p.all; use p.all;'. 498 -- FIXME: add a flag (or reuse Visible_Flag) to avoid walking all 499 -- the interpretations. 500 declare 501 Inter : Name_Interpretation_Type := Current_Inter; 502 begin 503 while Valid_Interpretation (Inter) loop 504 if Get_Declaration (Inter) = Decl then 505 return; 506 end if; 507 Inter := Get_Next_Interpretation (Inter); 508 end loop; 509 end; 510 end if; 511 512 -- LRM 10.3 Visibility 513 -- Each of two declarations is said to be a homograph of the other if 514 -- both declarations have the same identifier, operator symbol, or 515 -- character literal, and overloading is allowed for at most one 516 -- of the two. 517 -- 518 -- GHDL: the condition 'overloading is allowed for at most one of the 519 -- two' is false iff overloading is allowed for both; this is a nand. 520 521 -- Note: at this stage, current_inter is valid. 522 Current_Decl := Get_Declaration (Current_Inter); 523 524 if Is_Overloadable (Current_Decl) and then Is_Overloadable (Decl) then 525 -- Current_Inter and Decl overloads (well, they have the same 526 -- designator). 527 528 -- LRM 10.3 Visibility 529 -- If overloading is allowed for both declarations, then each of the 530 -- two is a homograph of the other if they have the same identifier, 531 -- operator symbol or character literal, as well as the same 532 -- parameter and result profile. 533 534 declare 535 Homograph : Name_Interpretation_Type; 536 Prev_Homograph : Name_Interpretation_Type; 537 538 -- Hide HOMOGRAPH (ie unlink it from the chain of interpretation). 539 procedure Hide_Homograph 540 is 541 S : Name_Interpretation_Type; 542 begin 543 if Prev_Homograph = No_Name_Interpretation then 544 Prev_Homograph := Interpretations.Last; 545 end if; 546 547 -- PREV_HOMOGRAPH must be the interpretation just before 548 -- HOMOGRAPH. 549 pragma Assert 550 (Interpretations.Table (Prev_Homograph).Prev = Homograph); 551 552 -- Hide previous interpretation. 553 Hidden_Decls.Append (Homograph); 554 555 S := Interpretations.Table (Homograph).Prev; 556 Interpretations.Table (Homograph).Prev := Prev_Homograph; 557 Interpretations.Table (Prev_Homograph).Prev := S; 558 end Hide_Homograph; 559 560 function Get_Hash_Non_Alias (D : Iir) return Iir_Int32 is 561 begin 562 return Get_Subprogram_Hash (Strip_Non_Object_Alias (D)); 563 end Get_Hash_Non_Alias; 564 565 -- Return True iff D is an implicit declaration (either a 566 -- subprogram or an implicit alias). 567 function Is_Implicit_Declaration (D : Iir) return Boolean is 568 begin 569 case Get_Kind (D) is 570 when Iir_Kind_Non_Object_Alias_Declaration => 571 return Get_Implicit_Alias_Flag (D); 572 when Iir_Kind_Enumeration_Literal => 573 return False; 574 when Iir_Kind_Procedure_Declaration 575 | Iir_Kind_Function_Declaration => 576 return Is_Implicit_Subprogram (D); 577 when others => 578 Error_Kind ("is_implicit_declaration", D); 579 end case; 580 end Is_Implicit_Declaration; 581 582 -- Return TRUE iff D is an implicit alias of an implicit 583 -- subprogram. 584 function Is_Implicit_Alias (D : Iir) return Boolean is 585 begin 586 -- FIXME: Is it possible to have an implicit alias of an 587 -- explicit subprogram ? Yes for enumeration literal and 588 -- physical units. 589 return Get_Kind (D) = Iir_Kind_Non_Object_Alias_Declaration 590 and then Get_Implicit_Alias_Flag (D) 591 and then Is_Implicit_Subprogram (Get_Named_Entity 592 (Get_Name (D))); 593 end Is_Implicit_Alias; 594 595 -- Replace the homograph of DECL by DECL. 596 procedure Replace_Homograph is 597 begin 598 Interpretations.Table (Homograph).Decl := Decl; 599 end Replace_Homograph; 600 601 Decl_Hash : Iir_Int32; 602 Hash : Iir_Int32; 603 begin 604 Decl_Hash := Get_Hash_Non_Alias (Decl); 605 -- The hash must have been computed. 606 pragma Assert (Decl_Hash /= 0); 607 608 -- LRM02 10.3 Visibility 609 -- Each of two declarations is said to be a /homograph/ of the 610 -- other if both declarations have the same identifier, operator 611 -- symbol, or character literal, and if overloading is allowed for 612 -- at most one of the two. 613 -- 614 -- LRM08 12.3 Visibility 615 -- Each of two declarations is said to be a /homograph/ of the 616 -- other if and only if both declarations have the same 617 -- designator, and they denote different named entities, and 618 -- either overloading is allows for at most one of the two, or 619 -- overloading is allowed for both declarations and they have the 620 -- same parameter and result type profile. 621 622 -- GHDL: here we are in the case when both declarations are 623 -- overloadable. Also, always follow the LRM08 rules as they fix 624 -- issues. 625 -- GHDL: Special case for a second declaration with the same 626 -- designator and that denotes the same named entity than a 627 -- previous one (that would be an alias): according to the LRM, 628 -- they are both visible and there are no ambiguity as they 629 -- denotes the same named entity. In GHDL, the new one hides the 630 -- previous one. The behaviour should be the same. 631 632 -- Find an homograph of this declaration (and also keep the 633 -- interpretation just before it in the chain). 634 Homograph := Current_Inter; 635 Prev_Homograph := No_Name_Interpretation; 636 while Homograph /= No_Name_Interpretation loop 637 Current_Decl := Get_Declaration (Homograph); 638 Hash := Get_Hash_Non_Alias (Current_Decl); 639 exit when Decl_Hash = Hash 640 and then Is_Same_Profile (Decl, Current_Decl); 641 Prev_Homograph := Homograph; 642 Homograph := Get_Next_Interpretation (Homograph); 643 end loop; 644 645 if Homograph = No_Name_Interpretation then 646 -- Simple case: no homograph. 647 Add_New_Interpretation (False); 648 return; 649 end if; 650 651 -- There is an homograph (or the named entity is the same). 652 if Potentially then 653 -- Added DECL would be made potentially visible. 654 655 -- LRM93 10.4 1) / LRM08 12.4 a) Use Clauses 656 -- 1. A potentially visible declaration is not made 657 -- directly visible if the place considered is within the 658 -- immediate scope of a homograph of the declaration. 659 if not Is_Potentially_Visible (Homograph) then 660 return; 661 end if; 662 663 -- LRM08 12.4 Use Clauses 664 -- b) If two potentially visible declarations are homograph 665 -- and one is explicitly declared and the other is 666 -- implicitly declared, then the implicit declaration is 667 -- not made directly visible. 668 if (Flags.Flag_Explicit or else Flags.Vhdl_Std >= Vhdl_08) 669 and then Is_Potentially_Visible (Homograph) 670 then 671 declare 672 Implicit_Current_Decl : constant Boolean := 673 Is_Implicit_Declaration (Current_Decl); 674 Implicit_Decl : constant Boolean := 675 Is_Implicit_Declaration (Decl); 676 begin 677 if Implicit_Current_Decl and then not Implicit_Decl then 678 if Is_In_Current_Declarative_Region (Homograph) then 679 Replace_Homograph; 680 else 681 -- Insert DECL and hide homograph. 682 Add_New_Interpretation (False); 683 Hide_Homograph; 684 end if; 685 return; 686 elsif not Implicit_Current_Decl and then Implicit_Decl 687 then 688 -- Discard decl. 689 return; 690 elsif Strip_Non_Object_Alias (Decl) 691 = Strip_Non_Object_Alias (Current_Decl) 692 then 693 -- This rule is not written clearly in the LRM, but 694 -- if two designators denote the same named entity, 695 -- no need to make both visible. 696 return; 697 end if; 698 end; 699 end if; 700 701 -- GHDL: if the homograph is in the same declarative 702 -- region than DECL, it must be an implicit declaration 703 -- to be hidden. 704 -- FIXME: this rule is not in the LRM93, but it is necessary 705 -- so that explicit declaration hides the implicit one. 706 if Flags.Vhdl_Std < Vhdl_08 707 and then not Flags.Flag_Explicit 708 and then Get_Parent (Decl) = Get_Parent (Current_Decl) 709 then 710 declare 711 Implicit_Current_Decl : constant Boolean := 712 Is_Implicit_Subprogram (Current_Decl); 713 Implicit_Decl : constant Boolean := 714 Is_Implicit_Subprogram (Decl); 715 begin 716 if Implicit_Current_Decl and not Implicit_Decl then 717 -- Note: no need to save previous interpretation, as 718 -- it is in the same declarative region. 719 -- Replace the previous homograph with DECL. 720 Replace_Homograph; 721 return; 722 elsif not Implicit_Current_Decl and Implicit_Decl then 723 -- As we have replaced the homograph, it is possible 724 -- than the implicit declaration is re-added (by 725 -- a new use clause). Discard it. 726 return; 727 end if; 728 end; 729 end if; 730 731 -- The homograph was made visible in an outer declarative 732 -- region. Therefore, it must not be hidden. 733 Add_New_Interpretation (False); 734 735 return; 736 else 737 -- Added DECL would be made directly visible. 738 739 if not Is_Potentially_Visible (Homograph) then 740 -- The homograph was also declared in that declarative 741 -- region or in an inner one. 742 if Is_In_Current_Declarative_Region (Homograph) then 743 -- ... and was declared in the same region 744 745 -- To sum up: at this point both DECL and CURRENT_DECL 746 -- are overloadable, have the same profile (but may be 747 -- aliases) and are declared in the same declarative 748 -- region. 749 750 -- LRM08 12.3 Visibility 751 -- LRM93 10.3 Visibility 752 -- Two declarations that occur immediately within 753 -- the same declarative regions [...] shall not be 754 -- homograph, unless exactely one of them is the 755 -- implicit declaration of a predefined operation, 756 757 -- LRM08 12.3 Visibility 758 -- or is an implicit alias of such implicit declaration. 759 -- 760 -- GHDL: FIXME: 'implicit alias' 761 762 -- LRM08 12.3 Visibility 763 -- LRM93 10.3 Visibility 764 -- Each of two declarations is said to be a 765 -- homograph of the other if and only if both 766 -- declarations have the same designator, [...] 767 -- 768 -- LRM08 12.3 Visibility 769 -- [...] and they denote different named entities, 770 -- and [...] 771 declare 772 Is_Decl_Implicit : Boolean; 773 Is_Current_Decl_Implicit : Boolean; 774 begin 775 if Flags.Vhdl_Std >= Vhdl_08 then 776 Is_Current_Decl_Implicit := 777 Is_Implicit_Subprogram (Current_Decl) 778 or else Is_Implicit_Alias (Current_Decl); 779 Is_Decl_Implicit := Is_Implicit_Subprogram (Decl) 780 or else Is_Implicit_Alias (Decl); 781 782 -- If they denote the same entity, they aren't 783 -- homograph. 784 if Strip_Non_Object_Alias (Decl) 785 = Strip_Non_Object_Alias (Current_Decl) 786 then 787 if Is_Current_Decl_Implicit 788 and then not Is_Decl_Implicit 789 then 790 -- They aren't homograph but DECL is stronger 791 -- (at it is not an implicit declaration) 792 -- than CURRENT_DECL 793 Replace_Homograph; 794 end if; 795 796 return; 797 end if; 798 799 if Is_Decl_Implicit 800 and then not Is_Current_Decl_Implicit 801 then 802 -- Re-declaration of an implicit subprogram via 803 -- an implicit alias is simply discarded. 804 return; 805 end if; 806 else 807 -- Can an implicit subprogram declaration appears 808 -- after an explicit one in vhdl 93? I don't 809 -- think so. 810 Is_Decl_Implicit := Is_Implicit_Subprogram (Decl); 811 Is_Current_Decl_Implicit := 812 Is_Implicit_Subprogram (Current_Decl); 813 end if; 814 815 if not (Is_Decl_Implicit xor Is_Current_Decl_Implicit) 816 then 817 Error_Msg_Sem 818 (+Decl, "redeclaration of %n defined at %l", 819 (+Current_Decl, +Current_Decl)); 820 return; 821 end if; 822 823 if not Is_Decl_Implicit and Is_Current_Decl_Implicit 824 then 825 -- DECL 'overrides' the predefined current 826 -- declaration. 827 828 -- LRM93 10.3 Visibility 829 -- In such cases, a predefined operation is always 830 -- hidden by the other homograph. Where hidden in 831 -- this manner, an implicit declaration is hidden 832 -- within the entire scope of the other declaration 833 -- (regardless of which declaration occurs first); 834 -- the implicit declaration is visible neither by 835 -- selection nor directly. 836 Set_Visible_Flag (Current_Decl, False); 837 if Get_Kind (Decl) 838 in Iir_Kinds_Subprogram_Declaration 839 then 840 Set_Hide_Implicit_Flag (Decl, True); 841 end if; 842 end if; 843 end; 844 else 845 -- GHDL: hide directly visible declaration declared in 846 -- an outer region. 847 null; 848 end if; 849 else 850 -- LRM 10.4 Use Clauses 851 -- 1. A potentially visible declaration is not made 852 -- directly visible if the place considered is within the 853 -- immediate scope of a homograph of the declaration. 854 855 -- GHDL: hide the potentially visible declaration. 856 null; 857 end if; 858 Add_New_Interpretation (False); 859 860 Hide_Homograph; 861 return; 862 end if; 863 end; 864 end if; 865 866 -- The current interpretation and the new one aren't overloadable, ie 867 -- they are homograph (well almost). 868 869 if Is_Potentially_Visible (Current_Inter) then 870 if Potentially then 871 -- LRM93 10.4 2) / LRM08 12.4 c) Use clauses 872 -- Potentially visible declarations that have the same 873 -- designator are not made directly visible unless each of 874 -- them is either an enumeration literal specification or 875 -- the declaration of a subprogram. 876 if Decl = Get_Declaration (Current_Inter) then 877 -- The rule applies only for distinct declaration. 878 -- This handles 'use p.all; use P.all;'. 879 -- FIXME: this should have been handled at the start of 880 -- this subprogram. 881 raise Internal_Error; 882 return; 883 end if; 884 885 -- LRM08 12.3 Visibility 886 -- Each of two declarations is said to be a homograph of the 887 -- other if and only if both declarations have the same 888 -- designator; and they denote different named entities, [...] 889 if Flags.Vhdl_Std >= Vhdl_08 then 890 if Strip_Non_Object_Alias (Decl) 891 = Strip_Non_Object_Alias (Current_Decl) 892 then 893 return; 894 end if; 895 end if; 896 897 -- Conflict. 898 Add_New_Interpretation (True, Null_Iir); 899 return; 900 else 901 -- LRM93 10.4 item #1 902 -- A potentially visible declaration is not made directly 903 -- visible if the place considered is within the immediate 904 -- scope of a homograph of the declaration. 905 -- GHDL: Could directly replace the previous interpretation 906 -- (added in same scope), but don't do that for entity 907 -- declarations, since it is used to find default binding. 908 Add_New_Interpretation (True); 909 return; 910 end if; 911 else 912 -- There is already a declaration in the current scope. 913 if Potentially then 914 -- LRM93 10.4 item #1 915 -- Discard the new and potentially visible declaration. 916 -- However, add the type. 917 -- FIXME: Add_In_Visible_List (Ident, Decl); 918 return; 919 else 920 if Is_In_Current_Declarative_Region (Current_Inter) then 921 -- They are perhaps visible in the same declarative region. 922 923 if Get_Kind (Current_Decl) = Iir_Kind_Library_Declaration then 924 -- LRM93 11.2 925 -- If two or more logical names having the same 926 -- identifier appear in library clauses in the same 927 -- context, the second and subsequent occurences of the 928 -- logical name have no effect. The same is true of 929 -- logical names appearing both in the context clause 930 -- of a primary unit and in the context clause of a 931 -- corresponding secondary unit. 932 -- GHDL: we apply this rule with VHDL-87, because of 933 -- implicit library clauses STD and WORK. 934 if Get_Kind (Decl) = Iir_Kind_Library_Declaration then 935 return; 936 end if; 937 938 if Flag_Relaxed_Rules 939 and then Get_Kind (Decl) in Iir_Kinds_Library_Unit 940 then 941 Warning_Msg_Sem 942 (Warnid_Hide, +Decl, 943 "unit %i hides library %i", (+Decl, +Decl)); 944 Interpretations.Table (Current_Inter).Decl := Decl; 945 return; 946 end if; 947 end if; 948 949 -- None of the two declarations are potentially visible, ie 950 -- both are visible. 951 -- LRM 10.3: 952 -- Two declarations that occur immediately within the same 953 -- declarative region must not be homographs, 954 -- FIXME: unless one of them is the implicit declaration of a 955 -- predefined operation. 956 Report_Start_Group; 957 Error_Msg_Sem 958 (+Decl, "identifier %i already used for a declaration", 959 +Ident); 960 Error_Msg_Sem 961 (+Current_Decl, "previous declaration: %n", +Current_Decl); 962 Report_End_Group; 963 return; 964 else 965 -- Homograph, not in the same scope. 966 -- LRM93 10.3: 967 -- A declaration is said to be hidden within (part of) an inner 968 -- declarative region if the inner region contains an homograph 969 -- of this declaration; the outer declaration is the hidden 970 -- within the immediate scope of the inner homograph. 971 if Is_Warning_Enabled (Warnid_Hide) 972 and then not Is_Potentially_Visible (Current_Inter) 973 then 974 Warning_Hide (Decl, Current_Decl); 975 end if; 976 977 Add_New_Interpretation (True); 978 return; 979 end if; 980 end if; 981 end if; 982 end Add_Name; 983 984 procedure Add_Name (Decl: Iir) is 985 begin 986 Add_Name (Decl, Get_Identifier (Decl), False); 987 end Add_Name; 988 989 procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir) 990 is 991 Inter : Name_Interpretation_Type; 992 begin 993 Inter := Get_Interpretation (Id); 994 loop 995 exit when Get_Declaration (Inter) = Old; 996 Inter := Get_Next_Interpretation (Inter); 997 pragma Assert (Valid_Interpretation (Inter)); 998 end loop; 999 Interpretations.Table (Inter).Decl := Decl; 1000 pragma Assert (Get_Next_Interpretation (Inter) = No_Name_Interpretation); 1001 end Replace_Name; 1002 1003 procedure Name_Visible (Decl : Iir) is 1004 begin 1005 -- A name can be made visible only once. 1006 pragma Assert (not Get_Visible_Flag (Decl)); 1007 Set_Visible_Flag (Decl, True); 1008 end Name_Visible; 1009 1010 procedure Iterator_Decl (Decl : Iir; Arg : Arg_Type) 1011 is 1012 begin 1013 case Get_Kind (Decl) is 1014 when Iir_Kind_Subtype_Declaration 1015 | Iir_Kind_Enumeration_Literal -- By use clause 1016 | Iir_Kind_Constant_Declaration 1017 | Iir_Kind_Signal_Declaration 1018 | Iir_Kind_Variable_Declaration 1019 | Iir_Kind_File_Declaration 1020 | Iir_Kind_Object_Alias_Declaration 1021 | Iir_Kind_Non_Object_Alias_Declaration 1022 | Iir_Kinds_Interface_Object_Declaration 1023 | Iir_Kind_Interface_Package_Declaration 1024 | Iir_Kinds_Interface_Subprogram_Declaration 1025 | Iir_Kind_Component_Declaration 1026 | Iir_Kind_Attribute_Declaration 1027 | Iir_Kind_Group_Template_Declaration 1028 | Iir_Kind_Group_Declaration 1029 | Iir_Kind_Nature_Declaration 1030 | Iir_Kind_Subnature_Declaration 1031 | Iir_Kinds_Quantity_Declaration 1032 | Iir_Kind_Terminal_Declaration 1033 | Iir_Kind_Entity_Declaration 1034 | Iir_Kind_Package_Declaration 1035 | Iir_Kind_Package_Instantiation_Declaration 1036 | Iir_Kind_Configuration_Declaration 1037 | Iir_Kind_Context_Declaration 1038 | Iir_Kinds_Concurrent_Statement 1039 | Iir_Kinds_Sequential_Statement => 1040 Handle_Decl (Decl, Arg); 1041 when Iir_Kind_Procedure_Declaration 1042 | Iir_Kind_Function_Declaration => 1043 if not Is_Second_Subprogram_Specification (Decl) then 1044 Handle_Decl (Decl, Arg); 1045 end if; 1046 when Iir_Kind_Type_Declaration => 1047 declare 1048 Def : constant Iir := Get_Type_Definition (Decl); 1049 List : Iir_Flist; 1050 El : Iir; 1051 begin 1052 -- Handle incomplete type declaration. 1053 if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then 1054 return; 1055 end if; 1056 1057 Handle_Decl (Decl, Arg); 1058 1059 if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then 1060 List := Get_Enumeration_Literal_List (Def); 1061 for I in Flist_First .. Flist_Last (List) loop 1062 El := Get_Nth_Element (List, I); 1063 Handle_Decl (El, Arg); 1064 end loop; 1065 end if; 1066 end; 1067 when Iir_Kind_Anonymous_Type_Declaration => 1068 Handle_Decl (Decl, Arg); 1069 1070 declare 1071 Def : constant Iir := Get_Type_Definition (Decl); 1072 El : Iir; 1073 begin 1074 if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then 1075 El := Get_Unit_Chain (Def); 1076 while El /= Null_Iir loop 1077 Handle_Decl (El, Arg); 1078 El := Get_Chain (El); 1079 end loop; 1080 end if; 1081 end; 1082 when Iir_Kind_Interface_Type_Declaration => 1083 Handle_Decl (Decl, Arg); 1084 declare 1085 El : Iir; 1086 begin 1087 El := Get_Interface_Type_Subprograms (Decl); 1088 while El /= Null_Iir loop 1089 Handle_Decl (El, Arg); 1090 El := Get_Chain (El); 1091 end loop; 1092 end; 1093 when Iir_Kind_Use_Clause 1094 | Iir_Kind_Context_Reference => 1095 Handle_Decl (Decl, Arg); 1096 when Iir_Kind_Library_Clause => 1097 Handle_Decl (Decl, Arg); 1098-- El := Get_Library_Declaration (Decl); 1099-- if El /= Null_Iir then 1100-- -- May be empty. 1101-- Handle_Decl (El, Arg); 1102-- end if; 1103 1104 when Iir_Kind_Procedure_Body 1105 | Iir_Kind_Function_Body => 1106 null; 1107 1108 when Iir_Kind_Package_Body => 1109 null; 1110 1111 when Iir_Kind_Attribute_Specification 1112 | Iir_Kind_Configuration_Specification 1113 | Iir_Kind_Disconnection_Specification => 1114 null; 1115 when Iir_Kinds_Signal_Attribute 1116 | Iir_Kind_Signal_Attribute_Declaration 1117 | Iir_Kind_Anonymous_Signal_Declaration => 1118 null; 1119 1120 when Iir_Kind_Protected_Type_Body => 1121 -- FIXME: allowed only in debugger (if the current scope is 1122 -- within a package body) ? 1123 null; 1124 1125 when others => 1126 Error_Kind ("iterator_decl", Decl); 1127 end case; 1128 end Iterator_Decl; 1129 1130 -- Handle context_clause of context reference CTXT. 1131 procedure Add_One_Context_Reference (Ctxt : Iir) 1132 is 1133 Name : constant Iir := Get_Selected_Name (Ctxt); 1134 Ent : constant Iir := Get_Named_Entity (Name); 1135 Item : Iir; 1136 begin 1137 if Ent = Null_Iir or else Is_Error (Ent) then 1138 -- Stop now in case of error. 1139 return; 1140 end if; 1141 pragma Assert (Get_Kind (Ent) = Iir_Kind_Context_Declaration); 1142 1143 Item := Get_Context_Items (Ent); 1144 while Item /= Null_Iir loop 1145 case Get_Kind (Item) is 1146 when Iir_Kind_Use_Clause => 1147 Add_Use_Clause (Item); 1148 when Iir_Kind_Library_Clause => 1149 Add_Name (Get_Library_Declaration (Item), 1150 Get_Identifier (Item), False); 1151 when Iir_Kind_Context_Reference => 1152 Add_Context_Reference (Item); 1153 when others => 1154 Error_Kind ("add_context_reference", Item); 1155 end case; 1156 Item := Get_Chain (Item); 1157 end loop; 1158 end Add_One_Context_Reference; 1159 1160 procedure Add_Context_Reference (Ref : Iir) 1161 is 1162 Ctxt : Iir; 1163 begin 1164 Ctxt := Ref; 1165 loop 1166 Add_One_Context_Reference (Ctxt); 1167 Ctxt := Get_Context_Reference_Chain (Ctxt); 1168 exit when Ctxt = Null_Iir; 1169 end loop; 1170 end Add_Context_Reference; 1171 1172 -- Make POTENTIALLY (or not) visible DECL. 1173 procedure Add_Name_Decl (Decl : Iir; Potentially : Boolean) is 1174 begin 1175 case Get_Kind (Decl) is 1176 when Iir_Kind_Use_Clause => 1177 if not Potentially then 1178 Add_Use_Clause (Decl); 1179 end if; 1180 when Iir_Kind_Context_Reference => 1181 pragma Assert (not Potentially); 1182 Add_Context_Reference (Decl); 1183 when Iir_Kind_Library_Clause => 1184 Add_Name (Get_Library_Declaration (Decl), 1185 Get_Identifier (Decl), Potentially); 1186 when Iir_Kind_Anonymous_Type_Declaration => 1187 null; 1188 when others => 1189 Add_Name (Decl, Get_Identifier (Decl), Potentially); 1190 end case; 1191 end Add_Name_Decl; 1192 1193 procedure Add_Declaration is 1194 new Iterator_Decl (Arg_Type => Boolean, Handle_Decl => Add_Name_Decl); 1195 1196 procedure Iterator_Decl_List (Decl_List : Iir_List; Arg : Arg_Type) 1197 is 1198 Decl : Iir; 1199 It : List_Iterator; 1200 begin 1201 if Decl_List = Null_Iir_List then 1202 return; 1203 end if; 1204 It := List_Iterate (Decl_List); 1205 while Is_Valid (It) loop 1206 Decl := Get_Element (It); 1207 Handle_Decl (Decl, Arg); 1208 Next (It); 1209 end loop; 1210 end Iterator_Decl_List; 1211 1212 procedure Iterator_Decl_Chain (Chain_First : Iir; Arg : Arg_Type) 1213 is 1214 Decl: Iir; 1215 begin 1216 Decl := Chain_First; 1217 while Decl /= Null_Iir loop 1218 Handle_Decl (Decl, Arg); 1219 Decl := Get_Chain (Decl); 1220 end loop; 1221 end Iterator_Decl_Chain; 1222 1223 procedure Add_Declarations_1 is new Iterator_Decl_Chain 1224 (Arg_Type => Boolean, Handle_Decl => Add_Declaration); 1225 1226 procedure Add_Declarations (Chain : Iir; Potentially : Boolean := False) 1227 renames Add_Declarations_1; 1228 1229 procedure Add_Declarations_List is new Iterator_Decl_List 1230 (Arg_Type => Boolean, Handle_Decl => Add_Declaration); 1231 1232 procedure Add_Declarations_From_Interface_Chain (Chain : Iir) 1233 is 1234 El : Iir; 1235 Id : Name_Id; 1236 begin 1237 El := Chain; 1238 while El /= Null_Iir loop 1239 Id := Get_Identifier (El); 1240 1241 -- The chain may be from an implicitely declared subprograms, with 1242 -- anonymous identifiers. In that case, all interfaces are 1243 -- anonymous and there is no need to iterate. 1244 exit when Id = Null_Identifier; 1245 1246 Add_Name (El, Id, False); 1247 El := Get_Chain (El); 1248 end loop; 1249 end Add_Declarations_From_Interface_Chain; 1250 1251 procedure Add_Declarations_Of_Concurrent_Statement (Parent : Iir) 1252 is 1253 El: Iir; 1254 Label: Name_Id; 1255 begin 1256 El := Get_Concurrent_Statement_Chain (Parent); 1257 while El /= Null_Iir loop 1258 Label := Get_Label (El); 1259 if Label /= Null_Identifier then 1260 Add_Name (El, Get_Identifier (El), False); 1261 end if; 1262 El := Get_Chain (El); 1263 end loop; 1264 end Add_Declarations_Of_Concurrent_Statement; 1265 1266 procedure Add_Context_Clauses (Unit : Iir_Design_Unit) is 1267 begin 1268 Add_Declarations (Get_Context_Items (Unit), False); 1269 end Add_Context_Clauses; 1270 1271 -- Add declarations from an entity into the current declarative region. 1272 -- This is needed when an architecture is analysed. 1273 procedure Add_Entity_Declarations (Entity : Iir_Entity_Declaration) 1274 is 1275 Prev_Hide : constant Boolean := Is_Warning_Enabled (Warnid_Hide); 1276 begin 1277 -- Temporarly disable hide warning to avoid spurious messages. 1278 Enable_Warning (Warnid_Hide, False); 1279 1280 Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Entity)); 1281 Add_Declarations_From_Interface_Chain (Get_Port_Chain (Entity)); 1282 Add_Declarations (Get_Declaration_Chain (Entity), False); 1283 Add_Declarations_Of_Concurrent_Statement (Entity); 1284 1285 -- Restore 1286 Enable_Warning (Warnid_Hide, Prev_Hide); 1287 end Add_Entity_Declarations; 1288 1289 -- Add declarations from a package into the current declarative region. 1290 -- (for a use clause or when a package body is analyzed) 1291 procedure Add_Package_Declarations 1292 (Decl: Iir_Package_Declaration; Potentially : Boolean) 1293 is 1294 Header : constant Iir := Get_Package_Header (Decl); 1295 begin 1296 -- LRM08 12.1 Declarative region 1297 -- d) A package declaration together with the corresponding body 1298 -- 1299 -- GHDL: the formal generic declarations are considered to be in the 1300 -- same declarative region as the package declarations (and therefore 1301 -- in the same scope), even if they don't occur immediately within a 1302 -- package declaration. 1303 if Header /= Null_Iir then 1304 Add_Declarations (Get_Generic_Chain (Header), Potentially); 1305 end if; 1306 1307 Add_Declarations (Get_Declaration_Chain (Decl), Potentially); 1308 end Add_Package_Declarations; 1309 1310 procedure Add_Package_Instantiation_Declarations 1311 (Decl: Iir; Potentially : Boolean) is 1312 begin 1313 -- LRM08 4.9 Package instantiation declarations 1314 -- The package instantiation declaration is equivalent to declaration of 1315 -- a generic-mapped package, consisting of a package declaration [...] 1316 Add_Declarations (Get_Generic_Chain (Decl), Potentially); 1317 Add_Declarations (Get_Declaration_Chain (Decl), Potentially); 1318 end Add_Package_Instantiation_Declarations; 1319 1320 -- Add declarations from a package into the current declarative region. 1321 -- This is needed when a package body is analysed. 1322 procedure Add_Package_Declarations (Decl: Iir_Package_Declaration) is 1323 begin 1324 Add_Package_Declarations (Decl, False); 1325 end Add_Package_Declarations; 1326 1327 procedure Add_Component_Declarations (Component: Iir_Component_Declaration) 1328 is 1329 begin 1330 Add_Declarations_From_Interface_Chain (Get_Generic_Chain (Component)); 1331 Add_Declarations_From_Interface_Chain (Get_Port_Chain (Component)); 1332 end Add_Component_Declarations; 1333 1334 procedure Add_Protected_Type_Declarations 1335 (Decl : Iir_Protected_Type_Declaration) is 1336 begin 1337 Add_Declarations (Get_Declaration_Chain (Decl), False); 1338 end Add_Protected_Type_Declarations; 1339 1340 procedure Extend_Scope_Of_Block_Declarations (Decl : Iir) is 1341 begin 1342 case Get_Kind (Decl) is 1343 when Iir_Kind_Architecture_Body => 1344 Add_Context_Clauses (Get_Design_Unit (Decl)); 1345 when Iir_Kind_Block_Statement 1346 | Iir_Kind_Generate_Statement_Body => 1347 -- FIXME: formal, iterator ? 1348 null; 1349 when others => 1350 Error_Kind ("extend_scope_of_block_declarations", Decl); 1351 end case; 1352 Add_Declarations (Get_Declaration_Chain (Decl), False); 1353 Add_Declarations_Of_Concurrent_Statement (Decl); 1354 end Extend_Scope_Of_Block_Declarations; 1355 1356 procedure Use_Library_All (Library : Iir_Library_Declaration) 1357 is 1358 Design_File : Iir_Design_File; 1359 Design_Unit : Iir_Design_Unit; 1360 Library_Unit : Iir; 1361 begin 1362 Design_File := Get_Design_File_Chain (Library); 1363 while Design_File /= Null_Iir loop 1364 Design_Unit := Get_First_Design_Unit (Design_File); 1365 while Design_Unit /= Null_Iir loop 1366 Library_Unit := Get_Library_Unit (Design_Unit); 1367 if Get_Kind (Library_Unit) /= Iir_Kind_Package_Body then 1368 Add_Name (Design_Unit, Get_Identifier (Design_Unit), True); 1369 end if; 1370 Design_Unit := Get_Chain (Design_Unit); 1371 end loop; 1372 Design_File := Get_Chain (Design_File); 1373 end loop; 1374 end Use_Library_All; 1375 1376 procedure Potentially_Add_Name (Name : Iir) is 1377 begin 1378 Add_Name (Name, Get_Identifier (Name), True); 1379 end Potentially_Add_Name; 1380 1381 -- LRM08 12.4 Use clauses 1382 -- Moreover, the following declarations, if any, that occurs immediately 1383 -- within the package denoted by the prefix of the selected name, are also 1384 -- identifier: 1385 procedure Use_Selected_Type_Name (Name : Iir) 1386 is 1387 Type_Def : constant Iir := Get_Type (Name); 1388 Base_Type : constant Iir := Get_Base_Type (Type_Def); 1389 begin 1390 case Get_Kind (Base_Type) is 1391 when Iir_Kind_Enumeration_Type_Definition => 1392 -- LRM08 12.4 Use clauses 1393 -- - If the type mark denotes an enumeration type of a subtype of 1394 -- an enumeration type, the enumeration literals of the base 1395 -- type 1396 declare 1397 List : constant Iir_Flist := 1398 Get_Enumeration_Literal_List (Base_Type); 1399 El : Iir; 1400 begin 1401 for I in Flist_First .. Flist_Last (List) loop 1402 El := Get_Nth_Element (List, I); 1403 Potentially_Add_Name (El); 1404 end loop; 1405 end; 1406 when Iir_Kind_Physical_Type_Definition => 1407 -- LRM08 12.4 Use clauses 1408 -- - If the type mark denotes a subtype of a physical type, the 1409 -- units of the base type 1410 declare 1411 El : Iir; 1412 begin 1413 El := Get_Unit_Chain (Base_Type); 1414 while El /= Null_Iir loop 1415 Potentially_Add_Name (El); 1416 El := Get_Chain (El); 1417 end loop; 1418 end; 1419 when others => 1420 null; 1421 end case; 1422 1423 -- LRM08 12.4 Use clauses 1424 -- - The implicit declarations of predefined operations for the type 1425 -- that are not hidden by homographs explicitely declared immediately 1426 -- within the package denoted by the prefix of the selected name 1427 -- - The declarations of homographs, explicitely declared immediately 1428 -- within the package denotes by the prefix of the selected name, 1429 -- that hide implicit declarations of predefined operations for the 1430 -- type 1431 declare 1432 Type_Decl : constant Iir := Get_Type_Declarator (Base_Type); 1433 El : Iir; 1434 Has_Override : Boolean; 1435 begin 1436 Has_Override := False; 1437 El := Get_Chain (Type_Decl); 1438 while El /= Null_Iir loop 1439 if Is_Implicit_Subprogram (El) 1440 and then Is_Operation_For_Type (El, Base_Type) 1441 then 1442 if Get_Visible_Flag (El) then 1443 -- Implicit declaration EL was overriden by a user 1444 -- declaration. Don't make it visible. 1445 Potentially_Add_Name (El); 1446 else 1447 Has_Override := True; 1448 end if; 1449 El := Get_Chain (El); 1450 else 1451 exit; 1452 end if; 1453 end loop; 1454 1455 -- Explicitely declared homograph. 1456 if Has_Override then 1457 while El /= Null_Iir loop 1458 if Get_Kind (El) in Iir_Kinds_Subprogram_Declaration 1459 and then Get_Hide_Implicit_Flag (El) 1460 and then Is_Operation_For_Type (El, Base_Type) 1461 then 1462 Potentially_Add_Name (El); 1463 end if; 1464 El := Get_Chain (El); 1465 end loop; 1466 end if; 1467 end; 1468 end Use_Selected_Type_Name; 1469 1470 -- LRM02 10.4 Use clauses 1471 -- Each selected name in a use clause identifiers one or more declarations 1472 -- that will potentially become directly visible. If the suffix of the 1473 -- selected name is a simple name, a character literal, or operator 1474 -- symbol, then the selected name identifiers only the declarations(s) of 1475 -- that simple name, character literal, or operator symbol contained 1476 -- within the package or library denoted by the prefix of the selected 1477 -- name. 1478 procedure Use_Selected_Name (Name : Iir) 1479 is 1480 Nname : Iir; 1481 begin 1482 if Name = Null_Iir then 1483 return; 1484 end if; 1485 1486 case Get_Kind (Name) is 1487 when Iir_Kind_Overload_List => 1488 Add_Declarations_List (Get_Overload_List (Name), True); 1489 when Iir_Kind_Error => 1490 null; 1491 when others => 1492 Potentially_Add_Name (Name); 1493 1494 -- LRM08 12.4 Use clauses 1495 -- If the suffix of the selected name is a type mark, then the 1496 -- declaration of the type or subtype denoted by the type mark 1497 -- is identified. Moreover [...] 1498 if (Vhdl_Std >= Vhdl_08 or else Flag_Relaxed_Rules) then 1499 Nname := Strip_Non_Object_Alias (Name); 1500 if Get_Kind (Nname) in Iir_Kinds_Type_Declaration then 1501 Use_Selected_Type_Name (Nname); 1502 end if; 1503 end if; 1504 end case; 1505 end Use_Selected_Name; 1506 1507 -- LRM93 10.4 Use clauses 1508 -- If the suffix is the reserved word ALL, then all the selected name 1509 -- identifies all declaration that are contained within the package or 1510 -- library denotes by te prefix of the selected name. 1511 procedure Use_All_Names (Name: Iir) is 1512 begin 1513 case Get_Kind (Name) is 1514 when Iir_Kind_Library_Declaration => 1515 Use_Library_All (Name); 1516 when Iir_Kind_Package_Declaration => 1517 Add_Package_Declarations (Name, True); 1518 when Iir_Kind_Package_Instantiation_Declaration => 1519 Add_Package_Instantiation_Declarations (Name, True); 1520 when Iir_Kind_Interface_Package_Declaration => 1521 -- LRM08 6.5.5 Interface package declarations 1522 -- Within an entity declaration, an architecture body, a 1523 -- component declaration, or an uninstantiated subprogram or 1524 -- package declaration that declares a given interface package, 1525 -- the name of the given interface package denotes an undefined 1526 -- instance of the uninstantiated package. 1527 Add_Package_Instantiation_Declarations (Name, True); 1528 when Iir_Kind_Error => 1529 null; 1530 when others => 1531 raise Internal_Error; 1532 end case; 1533 end Use_All_Names; 1534 1535 procedure Add_Use_Clause (Clause : Iir_Use_Clause) 1536 is 1537 Name : Iir; 1538 Cl : Iir_Use_Clause; 1539 begin 1540 Cl := Clause; 1541 loop 1542 Name := Get_Selected_Name (Cl); 1543 if Name = Null_Iir then 1544 pragma Assert (Flags.Flag_Force_Analysis); 1545 null; 1546 else 1547 if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then 1548 Name := Get_Prefix (Name); 1549 if not Is_Error (Name) then 1550 Use_All_Names (Get_Named_Entity (Name)); 1551 end if; 1552 else 1553 if not Is_Error (Name) then 1554 Use_Selected_Name (Get_Named_Entity (Name)); 1555 end if; 1556 end if; 1557 end if; 1558 Cl := Get_Use_Clause_Chain (Cl); 1559 exit when Cl = Null_Iir; 1560 end loop; 1561 end Add_Use_Clause; 1562 1563 -- Debugging subprograms. 1564 procedure Disp_All_Names; 1565 pragma Unreferenced (Disp_All_Names); 1566 1567 procedure Disp_Scopes; 1568 pragma Unreferenced (Disp_Scopes); 1569 1570 procedure Disp_Detailed_Interpretations (Ident : Name_Id); 1571 pragma Unreferenced (Disp_Detailed_Interpretations); 1572 1573 procedure Dump_Current_Scope; 1574 pragma Unreferenced (Dump_Current_Scope); 1575 1576 procedure Disp_Detailed_Interpretations (Ident : Name_Id) 1577 is 1578 Inter: Name_Interpretation_Type; 1579 Decl : Iir; 1580 begin 1581 Log (Name_Table.Image (Ident)); 1582 Log_Line (":"); 1583 1584 Inter := Get_Interpretation (Ident); 1585 while Valid_Interpretation (Inter) loop 1586 Log (Name_Interpretation_Type'Image (Inter)); 1587 if Is_Potentially_Visible (Inter) then 1588 Log (" (use)"); 1589 end if; 1590 Log (":"); 1591 Decl := Get_Declaration (Inter); 1592 Log (Iir'Image (Decl)); 1593 Log (":"); 1594 Log (Iir_Kind'Image (Get_Kind (Decl))); 1595 Log_Line (", loc: " & Image (Get_Location (Decl))); 1596 if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then 1597 Log_Line (" " & Disp_Subprg (Decl)); 1598 end if; 1599 Inter := Get_Next_Interpretation (Inter); 1600 end loop; 1601 end Disp_Detailed_Interpretations; 1602 1603 procedure Disp_All_Interpretations 1604 (Interpretation : Name_Interpretation_Type) 1605 is 1606 Inter: Name_Interpretation_Type; 1607 begin 1608 Inter := Interpretation; 1609 while Valid_Interpretation (Inter) loop 1610 Log (Name_Interpretation_Type'Image (Inter)); 1611 Log ("."); 1612 Log (Iir_Kind'Image (Get_Kind (Get_Declaration (Inter)))); 1613 Inter := Get_Next_Interpretation (Inter); 1614 end loop; 1615 Log_Line; 1616 end Disp_All_Interpretations; 1617 1618 procedure Disp_All_Names 1619 is 1620 Inter: Name_Interpretation_Type; 1621 begin 1622 for I in 0 .. Name_Table.Last_Name_Id loop 1623 Inter := Get_Interpretation (I); 1624 if Valid_Interpretation (Inter) then 1625 Log (Name_Table.Image (I)); 1626 Log (Name_Id'Image (I)); 1627 Log (":"); 1628 Disp_All_Interpretations (Inter); 1629 end if; 1630 end loop; 1631 Log_Line ("interprations.last = " 1632 & Name_Interpretation_Type'Image (Interpretations.Last)); 1633 Log_Line ("current_region_start =" 1634 & Name_Interpretation_Type'Image (Current_Region_Start)); 1635 end Disp_All_Names; 1636 1637 procedure Dump_Interpretation (Inter : Name_Interpretation_Type) 1638 is 1639 Decl : Iir; 1640 begin 1641 Log (Name_Interpretation_Type'Image (Inter)); 1642 if Is_Potentially_Visible (Inter) then 1643 Log (" (use)"); 1644 end if; 1645 Log (": "); 1646 Decl := Get_Declaration (Inter); 1647 if Decl = Null_Iir then 1648 Log_Line ("null: conflict"); 1649 else 1650 Log (Iir_Kind'Image (Get_Kind (Decl))); 1651 Log_Line (", loc: " & Image (Get_Location (Decl))); 1652 if Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration then 1653 Log_Line (" " & Disp_Subprg (Decl)); 1654 end if; 1655 end if; 1656 end Dump_Interpretation; 1657 1658 procedure Dump_A_Scope (First, Last : Name_Interpretation_Type) is 1659 begin 1660 if First > Last then 1661 Log_Line ("scope is empty"); 1662 return; 1663 end if; 1664 1665 for Inter in reverse First .. Last loop 1666 declare 1667 Cell : Interpretation_Cell renames Interpretations.Table (Inter); 1668 begin 1669 Dump_Interpretation (Inter); 1670 if Cell.Prev_Hidden then 1671 Log (" [prev:"); 1672 Log (Name_Interpretation_Type'Image (Cell.Prev)); 1673 if Cell.Prev_Hidden then 1674 Log (" hidden"); 1675 end if; 1676 Log_Line ("]"); 1677 else 1678 if Cell.Prev < First then 1679 Log_Line (" [last in scope]"); 1680 end if; 1681 end if; 1682 end; 1683 end loop; 1684 end Dump_A_Scope; 1685 1686 procedure Dump_Current_Scope is 1687 begin 1688 Dump_A_Scope (Current_Region_Start, Interpretations.Last); 1689 end Dump_Current_Scope; 1690 1691 procedure Disp_Scopes is 1692 begin 1693 for I in reverse Scopes.First .. Scopes.Last loop 1694 declare 1695 S : Scope_Cell renames Scopes.Table (I); 1696 begin 1697 case S.Kind is 1698 when Scope_Start => 1699 Log ("scope_start at"); 1700 when Scope_Region => 1701 Log ("scope_region at"); 1702 end case; 1703 Log_Line (Name_Interpretation_Type'Image (S.Saved_Region_Start)); 1704 end; 1705 end loop; 1706 end Disp_Scopes; 1707end Vhdl.Sem_Scopes; 1708