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 Libraries; 17with Flags; use Flags; 18with Types; use Types; 19with Errorout; use Errorout; 20with Vhdl.Errors; use Vhdl.Errors; 21with Vhdl.Evaluation; use Vhdl.Evaluation; 22with Vhdl.Sem_Utils; 23with Vhdl.Sem_Expr; use Vhdl.Sem_Expr; 24with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes; 25with Vhdl.Sem_Names; use Vhdl.Sem_Names; 26with Vhdl.Sem_Decls; 27with Vhdl.Sem_Inst; 28with Name_Table; 29with Std_Names; 30with Vhdl.Utils; use Vhdl.Utils; 31with Vhdl.Std_Package; use Vhdl.Std_Package; 32with Vhdl.Ieee.Std_Logic_1164; 33with Vhdl.Xrefs; use Vhdl.Xrefs; 34 35package body Vhdl.Sem_Types is 36 -- Mark the resolution function (this may be required by the back-end to 37 -- generate resolver). 38 procedure Mark_Resolution_Function (Subtyp : Iir) 39 is 40 Func : Iir_Function_Declaration; 41 begin 42 if not Get_Resolved_Flag (Subtyp) then 43 return; 44 end if; 45 46 Func := Has_Resolution_Function (Subtyp); 47 -- Maybe the type is resolved through its elements. 48 if Func /= Null_Iir then 49 Set_Resolution_Function_Flag (Func, True); 50 51 -- For internal reasons of translation, the element subtype has 52 -- to be translated for signals. 53 -- FIXME: maybe move the whole Has_Signal flag generation in 54 -- translation, as this is needed only for translation. 55 -- FIXME: how to deal with incorrect function ? Use an Error node ? 56 Set_Type_Has_Signal 57 (Get_Element_Subtype 58 (Get_Type (Get_Interface_Declaration_Chain (Func)))); 59 end if; 60 end Mark_Resolution_Function; 61 62 procedure Set_Type_Has_Signal (Atype : Iir) 63 is 64 Orig : Iir; 65 begin 66 -- Sanity check: ATYPE can be a signal type (eg: not an access type) 67 if not Get_Signal_Type_Flag (Atype) then 68 -- Do not crash since this may be called on an erroneous design. 69 return; 70 end if; 71 72 -- If the type is already marked, nothing to do. 73 if Get_Has_Signal_Flag (Atype) then 74 return; 75 end if; 76 77 -- This type is used to declare a signal. 78 Set_Has_Signal_Flag (Atype, True); 79 80 -- If this type was instantiated, also mark the origin. 81 Orig := Sem_Inst.Get_Origin (Atype); 82 if Orig /= Null_Iir then 83 Set_Type_Has_Signal (Orig); 84 end if; 85 86 -- For subtype, mark resolution function and base type. 87 case Get_Kind (Atype) is 88 when Iir_Kinds_Scalar_Subtype_Definition 89 | Iir_Kind_Array_Subtype_Definition 90 | Iir_Kind_Record_Subtype_Definition => 91 Set_Type_Has_Signal (Get_Base_Type (Atype)); 92 Mark_Resolution_Function (Atype); 93 declare 94 Tm : constant Iir := Get_Subtype_Type_Mark (Atype); 95 begin 96 if Tm /= Null_Iir then 97 Set_Type_Has_Signal (Get_Type (Get_Named_Entity (Tm))); 98 end if; 99 end; 100 when others => 101 null; 102 end case; 103 104 -- For composite types, also mark type of elements. 105 case Get_Kind (Atype) is 106 when Iir_Kind_Integer_Type_Definition 107 | Iir_Kind_Enumeration_Type_Definition 108 | Iir_Kind_Physical_Type_Definition 109 | Iir_Kind_Floating_Type_Definition => 110 null; 111 when Iir_Kinds_Scalar_Subtype_Definition => 112 null; 113 when Iir_Kind_Array_Subtype_Definition 114 | Iir_Kind_Array_Type_Definition => 115 Set_Type_Has_Signal (Get_Element_Subtype (Atype)); 116 when Iir_Kind_Record_Type_Definition 117 | Iir_Kind_Record_Subtype_Definition => 118 declare 119 El_List : constant Iir_Flist := 120 Get_Elements_Declaration_List (Atype); 121 El : Iir; 122 begin 123 for I in Flist_First .. Flist_Last (El_List) loop 124 El := Get_Nth_Element (El_List, I); 125 Set_Type_Has_Signal (Get_Type (El)); 126 end loop; 127 end; 128 when Iir_Kind_Error => 129 null; 130 when Iir_Kind_Incomplete_Type_Definition => 131 -- No need to copy the flag. 132 null; 133 when Iir_Kind_Interface_Type_Definition => 134 null; 135 when others => 136 Error_Kind ("set_type_has_signal(2)", Atype); 137 end case; 138 end Set_Type_Has_Signal; 139 140 -- Sem a range expression that appears in an integer, real or physical 141 -- type definition. 142 -- 143 -- Both left and right bounds must be of the same type class, ie 144 -- integer types, or if INT_ONLY is false, real types. 145 -- However, the two bounds need not have the same type. 146 function Sem_Type_Range_Expression (Expr : Iir; Int_Only : Boolean) 147 return Iir 148 is 149 Left, Right: Iir; 150 Bt_L_Kind, Bt_R_Kind : Iir_Kind; 151 begin 152 Left := Sem_Expression_Universal (Get_Left_Limit_Expr (Expr)); 153 Right := Sem_Expression_Universal (Get_Right_Limit_Expr (Expr)); 154 if Left = Null_Iir or Right = Null_Iir then 155 return Null_Iir; 156 end if; 157 158 -- Emit error message for overflow and replace with a value to avoid 159 -- error storm. 160 if Get_Kind (Left) = Iir_Kind_Overflow_Literal then 161 Error_Msg_Sem (+Left, "overflow in left bound"); 162 Left := Build_Extreme_Value 163 (Get_Direction (Expr) = Dir_Downto, Left); 164 end if; 165 if Get_Kind (Right) = Iir_Kind_Overflow_Literal then 166 Error_Msg_Sem (+Right, "overflow in right bound"); 167 Right := Build_Extreme_Value 168 (Get_Direction (Expr) = Dir_To, Right); 169 end if; 170 Set_Left_Limit_Expr (Expr, Left); 171 Set_Right_Limit_Expr (Expr, Right); 172 Set_Left_Limit (Expr, Left); 173 Set_Right_Limit (Expr, Right); 174 175 Set_Expr_Staticness (Expr, Min (Get_Expr_Staticness (Left), 176 Get_Expr_Staticness (Right))); 177 178 Bt_L_Kind := Get_Kind (Get_Base_Type (Get_Type (Left))); 179 Bt_R_Kind := Get_Kind (Get_Base_Type (Get_Type (Right))); 180 181 if Int_Only then 182 if Bt_L_Kind /= Iir_Kind_Integer_Type_Definition 183 and then Bt_R_Kind = Iir_Kind_Integer_Type_Definition 184 then 185 Error_Msg_Sem (+Left, "left bound must be an integer expression"); 186 return Null_Iir; 187 end if; 188 if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition 189 and then Bt_L_Kind = Iir_Kind_Integer_Type_Definition 190 then 191 Error_Msg_Sem 192 (+Right, "right bound must be an integer expression"); 193 return Null_Iir; 194 end if; 195 if Bt_R_Kind /= Iir_Kind_Integer_Type_Definition 196 and then Bt_L_Kind /= Iir_Kind_Integer_Type_Definition 197 then 198 Error_Msg_Sem (+Expr, "each bound must be an integer expression"); 199 return Null_Iir; 200 end if; 201 else 202 if Bt_L_Kind /= Bt_R_Kind then 203 Error_Msg_Sem 204 (+Expr, "left and right bounds must be of the same type class"); 205 return Null_Iir; 206 end if; 207 case Bt_L_Kind is 208 when Iir_Kind_Integer_Type_Definition 209 | Iir_Kind_Floating_Type_Definition => 210 null; 211 when others => 212 -- Enumeration range are not allowed to define a new type. 213 Error_Msg_Sem 214 (+Expr, "bad range type, only integer or float is allowed"); 215 return Null_Iir; 216 end case; 217 end if; 218 219 return Expr; 220 end Sem_Type_Range_Expression; 221 222 function Compute_Scalar_Size (Rng : Iir) return Scalar_Size 223 is 224 L, H : Iir; 225 Lv, Hv : Int64; 226 subtype Int64_32 is Int64 range -(2 ** 31) .. 2 ** 31 - 1; 227 begin 228 Get_Low_High_Limit (Rng, L, H); 229 Lv := Get_Value (L); 230 Hv := Get_Value (H); 231 if Lv in Int64_32 and then Hv in Int64_32 then 232 return Scalar_32; 233 else 234 return Scalar_64; 235 end if; 236 end Compute_Scalar_Size; 237 238 function Create_Integer_Type (Loc : Iir; Constraint : Iir; Decl : Iir) 239 return Iir 240 is 241 Ntype: Iir_Integer_Subtype_Definition; 242 Ndef: Iir_Integer_Type_Definition; 243 begin 244 Ntype := Create_Iir (Iir_Kind_Integer_Subtype_Definition); 245 Location_Copy (Ntype, Loc); 246 Ndef := Create_Iir (Iir_Kind_Integer_Type_Definition); 247 Location_Copy (Ndef, Loc); 248 Set_Type_Declarator (Ndef, Decl); 249 Set_Type_Staticness (Ndef, Locally); 250 Set_Signal_Type_Flag (Ndef, True); 251 Set_Parent_Type (Ntype, Ndef); 252 Set_Type_Declarator (Ntype, Decl); 253 Set_Range_Constraint (Ntype, Constraint); 254 Set_Type_Staticness (Ntype, Get_Expr_Staticness (Constraint)); 255 Set_Resolved_Flag (Ntype, False); 256 Set_Signal_Type_Flag (Ntype, True); 257 if Get_Type_Staticness (Ntype) /= Locally then 258 Error_Msg_Sem 259 (+Decl, "range constraint of type must be locally static"); 260 Set_Scalar_Size (Ndef, Scalar_32); 261 else 262 Set_Scalar_Size (Ndef, Compute_Scalar_Size (Constraint)); 263 end if; 264 return Ntype; 265 end Create_Integer_Type; 266 267 function Range_Expr_To_Type_Definition (Expr : Iir; Decl: Iir) 268 return Iir 269 is 270 Rng : Iir; 271 Res : Iir; 272 Base_Type : Iir; 273 begin 274 if Sem_Type_Range_Expression (Expr, False) = Null_Iir then 275 return Null_Iir; 276 end if; 277 Rng := Eval_Range_If_Static (Expr); 278 if Get_Expr_Staticness (Rng) /= Locally then 279 -- FIXME: create an artificial range to avoid error storm ? 280 null; 281 end if; 282 283 case Get_Kind (Get_Base_Type (Get_Type (Get_Left_Limit (Rng)))) is 284 when Iir_Kind_Integer_Type_Definition => 285 if Get_Expr_Staticness (Rng) = Locally 286 and then Eval_Is_Null_Discrete_Range (Rng) 287 then 288 Warning_Msg_Sem 289 (Warnid_Runtime_Error, +Expr, 290 "integer type %i has a null range", (1 => +Decl)); 291 end if; 292 Res := Create_Integer_Type (Expr, Rng, Decl); 293 when Iir_Kind_Floating_Type_Definition => 294 declare 295 Ntype: Iir_Floating_Subtype_Definition; 296 Ndef: Iir_Floating_Type_Definition; 297 begin 298 Ntype := Create_Iir (Iir_Kind_Floating_Subtype_Definition); 299 Location_Copy (Ntype, Expr); 300 Ndef := Create_Iir (Iir_Kind_Floating_Type_Definition); 301 Location_Copy (Ndef, Expr); 302 Set_Type_Declarator (Ndef, Decl); 303 Set_Type_Staticness (Ndef, Get_Expr_Staticness (Expr)); 304 Set_Scalar_Size (Ndef, Scalar_64); 305 Set_Signal_Type_Flag (Ndef, True); 306 Set_Parent_Type (Ntype, Ndef); 307 Set_Type_Declarator (Ntype, Decl); 308 Set_Range_Constraint (Ntype, Rng); 309 Set_Resolved_Flag (Ntype, False); 310 Set_Type_Staticness (Ntype, Get_Expr_Staticness (Expr)); 311 Set_Signal_Type_Flag (Ntype, True); 312 Res := Ntype; 313 end; 314 when others => 315 -- sem_range_expression should catch such errors. 316 raise Internal_Error; 317 end case; 318 319 -- A type and a subtype were declared. The type of the bounds are now 320 -- used for the implicit subtype declaration. But the type of the 321 -- bounds aren't of the type of the type declaration (this is 'obvious' 322 -- because they exist before the type declaration). Override their 323 -- type. This is doable without destroying information as they are 324 -- either literals (of type convertible_xx_type_definition) or an 325 -- evaluated literal. 326 -- 327 -- Overriding makes these implicit subtype homogenous with explicit 328 -- subtypes. 329 Base_Type := Get_Base_Type (Res); 330 Set_Type (Rng, Base_Type); 331 Set_Type (Get_Left_Limit (Rng), Base_Type); 332 Set_Type (Get_Right_Limit (Rng), Base_Type); 333 334 return Res; 335 end Range_Expr_To_Type_Definition; 336 337 function Create_Physical_Literal (Val : Int64; Unit : Iir) return Iir 338 is 339 Lit : Iir; 340 begin 341 Lit := Create_Iir (Iir_Kind_Integer_Literal); 342 Set_Value (Lit, Val); 343 Set_Expr_Staticness (Lit, Locally); 344 Set_Type (Lit, Get_Type (Unit)); 345 Location_Copy (Lit, Unit); 346 return Lit; 347 end Create_Physical_Literal; 348 349 -- Analyze a physical type definition. Create a subtype. 350 function Sem_Physical_Type_Definition (Def : Iir; Decl : Iir) 351 return Iir_Physical_Subtype_Definition 352 is 353 Unit: Iir_Unit_Declaration; 354 Sub_Type: Iir_Physical_Subtype_Definition; 355 Range_Expr : Iir; 356 Range_Expr1: Iir; 357 Val : Iir; 358 Lit : Iir_Physical_Int_Literal; 359 begin 360 Range_Expr := Get_Range_Constraint (Def); 361 362 -- LRM93 4.1 363 -- The simple name declared by a type declaration denotes the 364 -- declared type, unless the type declaration declares both a base 365 -- type and a subtype of the base type, in which case the simple name 366 -- denotes the subtype, and the base type is anonymous. 367 Set_Type_Declarator (Def, Decl); 368 Set_Resolved_Flag (Def, False); 369 Set_Type_Staticness (Def, Locally); 370 Set_Signal_Type_Flag (Def, True); 371 372 -- LRM93 3.1.3 373 -- Each bound of a range constraint that is used in a physical type 374 -- definition must be a locally static expression of some integer type 375 -- but the two bounds need not have the same integer type. 376 case Get_Kind (Range_Expr) is 377 when Iir_Kind_Range_Expression => 378 Range_Expr1 := Sem_Type_Range_Expression (Range_Expr, True); 379 when Iir_Kind_Attribute_Name => 380 Sem_Name (Range_Expr); 381 Range_Expr1 := Name_To_Range (Range_Expr); 382 when Iir_Kind_Error => 383 Range_Expr1 := Null_Iir; 384 when others => 385 Error_Kind ("sem_physical_type_definition", Range_Expr); 386 end case; 387 if Range_Expr1 = Null_Iir or else Is_Error (Range_Expr1) then 388 -- Avoid cascading errors. 389 Range_Expr1 := 390 Get_Range_Constraint (Universal_Integer_Subtype_Definition); 391 end if; 392 if Get_Expr_Staticness (Range_Expr1) /= Locally then 393 Error_Msg_Sem (+Range_Expr1, 394 "range constraint for a physical type must be static"); 395 Range_Expr1 := 396 Get_Range_Constraint (Universal_Integer_Subtype_Definition); 397 else 398 Range_Expr1 := Eval_Range_If_Static (Range_Expr1); 399 if Get_Expr_Staticness (Range_Expr1) = Locally 400 and then Eval_Is_Null_Discrete_Range (Range_Expr1) 401 then 402 Warning_Msg_Sem 403 (Warnid_Runtime_Error, +Range_Expr, 404 "physical type %i has a null range", (1 => +Decl)); 405 end if; 406 end if; 407 Set_Scalar_Size (Def, Compute_Scalar_Size (Range_Expr1)); 408 409 -- Create the subtype. 410 Sub_Type := Create_Iir (Iir_Kind_Physical_Subtype_Definition); 411 Location_Copy (Sub_Type, Range_Expr); 412 Set_Parent_Type (Sub_Type, Def); 413 Set_Signal_Type_Flag (Sub_Type, True); 414 415 -- Analyze the primary unit. 416 Unit := Get_Unit_Chain (Def); 417 418 -- Set its value to 1. 419 Set_Type (Unit, Def); 420 Set_Expr_Staticness (Unit, Locally); 421 Set_Name_Staticness (Unit, Locally); 422 Lit := Create_Physical_Literal (1, Unit); 423 Set_Physical_Literal (Unit, Lit); 424 425 Sem_Scopes.Add_Name (Unit); 426 Set_Visible_Flag (Unit, True); 427 Xref_Decl (Unit); 428 429 declare 430 Phys_Range : Iir_Range_Expression; 431 Lit : Iir; 432 begin 433 -- Create the physical range. 434 Phys_Range := Create_Iir (Iir_Kind_Range_Expression); 435 Location_Copy (Phys_Range, Range_Expr1); 436 Set_Type (Phys_Range, Def); 437 Set_Direction (Phys_Range, Get_Direction (Range_Expr1)); 438 Lit := Get_Left_Limit (Range_Expr1); 439 Set_Left_Limit_Expr (Phys_Range, Lit); 440 Set_Left_Limit (Phys_Range, Lit); 441 Lit := Get_Right_Limit (Range_Expr1); 442 Set_Right_Limit_Expr (Phys_Range, Lit); 443 Set_Right_Limit (Phys_Range, Lit); 444 Set_Expr_Staticness 445 (Phys_Range, Get_Expr_Staticness (Range_Expr1)); 446 447 Set_Range_Constraint (Sub_Type, Phys_Range); 448 Set_Range_Constraint (Def, Null_Iir); 449 -- This must be locally... 450 Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (Range_Expr1)); 451 452 -- FIXME: the original range is not used. Reuse it ? 453 Free_Iir (Range_Expr); 454 end; 455 Set_Resolved_Flag (Sub_Type, False); 456 457 -- Analyze secondary units. 458 Unit := Get_Chain (Unit); 459 while Unit /= Null_Iir loop 460 Sem_Scopes.Add_Name (Unit); 461 Val := Sem_Expression (Get_Physical_Literal (Unit), Def); 462 if Val /= Null_Iir then 463 Val := Eval_Physical_Literal (Val); 464 Set_Physical_Literal (Unit, Val); 465 466 -- LRM93 3.1 467 -- The position number of unit names need not lie within the range 468 -- specified by the range constraint. 469 -- GHDL: this was not true in VHDL87. 470 -- GHDL: This is not so simple if 1 is not included in the range. 471 if False and then Flags.Vhdl_Std = Vhdl_87 472 and then Range_Expr1 /= Null_Iir 473 then 474 if not Eval_Int_In_Range (Get_Value (Unit), Range_Expr1) then 475 Error_Msg_Sem 476 (+Unit, "physical literal does not lie within the range"); 477 end if; 478 end if; 479 else 480 -- Avoid errors storm. 481 Val := Create_Physical_Literal (1, Get_Primary_Unit (Def)); 482 Set_Literal_Origin (Val, Get_Physical_Literal (Unit)); 483 Set_Physical_Literal (Unit, Val); 484 end if; 485 486 Set_Type (Unit, Def); 487 Set_Expr_Staticness (Unit, Locally); 488 Set_Name_Staticness (Unit, Locally); 489 Sem_Scopes.Name_Visible (Unit); 490 Xref_Decl (Unit); 491 Unit := Get_Chain (Unit); 492 end loop; 493 494 return Sub_Type; 495 end Sem_Physical_Type_Definition; 496 497 -- Return true iff decl is std.textio.text 498 function Is_Text_Type_Declaration (Decl : Iir_Type_Declaration) 499 return Boolean 500 is 501 use Std_Names; 502 P : Iir; 503 begin 504 if Get_Identifier (Decl) /= Name_Text then 505 return False; 506 end if; 507 P := Get_Parent (Decl); 508 if Get_Kind (P) /= Iir_Kind_Package_Declaration 509 or else Get_Identifier (P) /= Name_Textio 510 then 511 return False; 512 end if; 513 -- design_unit, design_file, library_declaration. 514 P := Get_Library (Get_Design_File (Get_Design_Unit (P))); 515 if P /= Libraries.Std_Library then 516 return False; 517 end if; 518 return True; 519 end Is_Text_Type_Declaration; 520 521 procedure Check_No_File_Type (El_Type : Iir; Loc : Iir) is 522 begin 523 case Get_Kind (El_Type) is 524 when Iir_Kind_File_Type_Definition => 525 Error_Msg_Sem 526 (+Loc, "file type element not allowed in a composite type"); 527 when Iir_Kind_Protected_Type_Declaration => 528 Error_Msg_Sem 529 (+Loc, "protected type element not allowed in a composite type"); 530 when others => 531 null; 532 end case; 533 end Check_No_File_Type; 534 535 -- Analyze the array_element type of array type DEF. 536 -- Set resolved_flag of DEF. 537 procedure Sem_Array_Element (Def : Iir) 538 is 539 El_Type : Iir; 540 begin 541 El_Type := Get_Element_Subtype_Indication (Def); 542 El_Type := Sem_Subtype_Indication (El_Type); 543 if El_Type = Null_Iir then 544 Set_Type_Staticness (Def, None); 545 Set_Resolved_Flag (Def, False); 546 return; 547 end if; 548 Set_Element_Subtype_Indication (Def, El_Type); 549 550 El_Type := Get_Type_Of_Subtype_Indication (El_Type); 551 Set_Element_Subtype (Def, El_Type); 552 Check_No_File_Type (El_Type, Def); 553 Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (El_Type)); 554 555 -- LRM93 3.2.1.1 556 -- The same requirement exists [must define a constrained 557 -- array subtype] [...] for the element subtype indication 558 -- of an array type definition, if the type of the array 559 -- element is itself an array type. 560 if Vhdl_Std < Vhdl_08 561 and then not Is_Fully_Constrained_Type (El_Type) 562 then 563 Error_Msg_Sem 564 (+Def, 565 "array element of unconstrained %n is not allowed before vhdl08", 566 +El_Type); 567 end if; 568 Set_Resolved_Flag (Def, Get_Resolved_Flag (El_Type)); 569 end Sem_Array_Element; 570 571 procedure Sem_Protected_Type_Declaration (Type_Decl : Iir_Type_Declaration) 572 is 573 Decl : Iir_Protected_Type_Declaration; 574 El : Iir; 575 begin 576 Decl := Get_Type_Definition (Type_Decl); 577 Set_Resolved_Flag (Decl, False); 578 Set_Signal_Type_Flag (Decl, False); 579 Set_Type_Staticness (Decl, None); 580 581 -- LRM 10.3 Visibility 582 -- [...] except in the declaration of a design_unit or a protected type 583 -- declaration, in which case it starts immediatly after the reserved 584 -- word is occuring after the identifier of the design unit or 585 -- protected type declaration. 586 Set_Visible_Flag (Type_Decl, True); 587 588 -- LRM 10.1 589 -- n) A protected type declaration, together with the corresponding 590 -- body. 591 Open_Declarative_Region; 592 593 Sem_Decls.Sem_Declaration_Chain (Decl); 594 El := Get_Declaration_Chain (Decl); 595 while El /= Null_Iir loop 596 case Get_Kind (El) is 597 when Iir_Kind_Use_Clause 598 | Iir_Kind_Attribute_Specification => 599 null; 600 when Iir_Kind_Procedure_Declaration 601 | Iir_Kind_Function_Declaration => 602 declare 603 Inter : Iir; 604 Inter_Type : Iir; 605 begin 606 -- LRM08 3.5.1 Protected type declarations 607 -- Such formal parameters must not be of an access type or 608 -- a file type; moreover, they must not have a subelement 609 -- that is an access type of a file type. 610 Inter := Get_Interface_Declaration_Chain (El); 611 while Inter /= Null_Iir loop 612 Inter_Type := Get_Type (Inter); 613 if Inter_Type /= Null_Iir 614 and then Get_Signal_Type_Flag (Inter_Type) = False 615 and then Get_Kind (Inter_Type) 616 /= Iir_Kind_Protected_Type_Declaration 617 then 618 Error_Msg_Sem 619 (+Inter, "formal parameter method must not be " 620 & "access or file type"); 621 end if; 622 Inter := Get_Chain (Inter); 623 end loop; 624 625 -- LRM08 3.5.1 Protected type declarations 626 -- Additionally, in the case of a function subprogram, the 627 -- return type of the function must not be of an access type 628 -- or file type; moreover, it must not have a subelement 629 -- that is an access type of a file type. 630 if Get_Kind (El) = Iir_Kind_Function_Declaration then 631 Inter_Type := Get_Return_Type (El); 632 if Inter_Type /= Null_Iir 633 and then Get_Signal_Type_Flag (Inter_Type) = False 634 then 635 Error_Msg_Sem 636 (+El, "method cannot return an access or a file"); 637 end if; 638 end if; 639 end; 640 when Iir_Kind_Anonymous_Type_Declaration => 641 -- This is an error, but an anonynmous type declaration is 642 -- followed by a subtype declaration, which is also an error. 643 -- Avoid duplicate messages. 644 null; 645 when others => 646 Error_Msg_Sem 647 (+El, "%n is not allowed in protected type declaration", 648 +El); 649 end case; 650 El := Get_Chain (El); 651 end loop; 652 653 Close_Declarative_Region; 654 end Sem_Protected_Type_Declaration; 655 656 procedure Sem_Protected_Type_Body (Bod : Iir) 657 is 658 Inter : Name_Interpretation_Type; 659 Type_Decl : Iir; 660 Decl : Iir; 661 begin 662 -- LRM 3.5 Protected types. 663 -- Each protected type declaration appearing immediatly within a given 664 -- declaration region must have exactly one corresponding protected type 665 -- body appearing immediatly within the same declarative region and 666 -- textually subsequent to the protected type declaration. 667 -- 668 -- Similarly, each protected type body appearing immediatly within a 669 -- given declarative region must have exactly one corresponding 670 -- protected type declaration appearing immediatly within the same 671 -- declarative region and textually prior to the protected type body. 672 Inter := Get_Interpretation (Get_Identifier (Bod)); 673 if Valid_Interpretation (Inter) 674 and then Is_In_Current_Declarative_Region (Inter) 675 then 676 Type_Decl := Get_Declaration (Inter); 677 if Get_Kind (Type_Decl) = Iir_Kind_Type_Declaration then 678 Decl := Get_Type_Definition (Type_Decl); 679 else 680 Decl := Null_Iir; 681 end if; 682 else 683 Decl := Null_Iir; 684 end if; 685 686 if Decl /= Null_Iir 687 and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Declaration 688 then 689 Set_Protected_Type_Declaration (Bod, Decl); 690 if Get_Protected_Type_Body (Decl) /= Null_Iir then 691 Report_Start_Group; 692 Error_Msg_Sem 693 (+Bod, "protected type body already declared for %n", +Decl); 694 Error_Msg_Sem 695 (+Get_Protected_Type_Body (Decl), "(previous body)"); 696 Report_End_Group; 697 Decl := Null_Iir; 698 elsif not Get_Visible_Flag (Type_Decl) then 699 -- Can this happen ? 700 Report_Start_Group; 701 Error_Msg_Sem (+Bod, "protected type declaration not yet visible"); 702 Error_Msg_Sem (+Decl, "(location of protected type declaration)"); 703 Report_End_Group; 704 Decl := Null_Iir; 705 else 706 Set_Protected_Type_Body (Decl, Bod); 707 end if; 708 else 709 Error_Msg_Sem 710 (+Bod, "no protected type declaration for this body"); 711 if Decl /= Null_Iir then 712 Error_Msg_Sem (+Decl, "(found %n declared here)", +Decl); 713 Decl := Null_Iir; 714 end if; 715 end if; 716 717 -- LRM 10.1 718 -- n) A protected type declaration, together with the corresponding 719 -- body. 720 Open_Declarative_Region; 721 722 if Decl /= Null_Iir then 723 Xref_Body (Bod, Decl); 724 Add_Protected_Type_Declarations (Decl); 725 end if; 726 727 Sem_Decls.Sem_Declaration_Chain (Bod); 728 729 Sem_Decls.Check_Full_Declaration (Bod, Bod); 730 731 -- LRM 3.5.2 Protected type bodies 732 -- Each subprogram declaration appearing in a given protected type 733 -- declaration shall have a corresponding subprogram body appearing in 734 -- the corresponding protected type body. 735 if Decl /= Null_Iir then 736 Sem_Decls.Check_Full_Declaration (Decl, Bod); 737 end if; 738 739 Close_Declarative_Region; 740 end Sem_Protected_Type_Body; 741 742 -- Return the constraint state from CONST (the initial state) and EL_TYPE, 743 -- as if ATYPE was a new element of a record. 744 -- 745 -- LRM08 5 Types 746 -- A composite subtype is said to be unconstrained if: 747 -- - [...] 748 -- - It is a record subtype with at least one element of a composite 749 -- subtype and each element that is of a composite subtype is 750 -- unconstrained. 751 -- 752 -- A composite subtype is said to be fully constrained if: 753 -- - [...] 754 -- - It is a record subtype and each element subtype either is not a 755 -- composite subtype or is a fully constrained composite subtype. 756 procedure Update_Record_Constraint (Constraint : in out Iir_Constraint; 757 Composite_Found : in out Boolean; 758 El_Type : Iir) is 759 begin 760 if Get_Kind (El_Type) not in Iir_Kinds_Composite_Type_Definition then 761 pragma Assert (Composite_Found or Constraint = Fully_Constrained); 762 return; 763 end if; 764 765 if Composite_Found then 766 case Constraint is 767 when Fully_Constrained 768 | Unconstrained => 769 if Get_Constraint_State (El_Type) /= Constraint then 770 Constraint := Partially_Constrained; 771 end if; 772 when Partially_Constrained => 773 Constraint := Partially_Constrained; 774 end case; 775 else 776 Composite_Found := True; 777 Constraint := Get_Constraint_State (El_Type); 778 end if; 779 end Update_Record_Constraint; 780 781 function Get_Array_Constraint (Def : Iir) return Iir_Constraint 782 is 783 El_Type : constant Iir := Get_Element_Subtype (Def); 784 Constrained_Index : constant Boolean := Get_Index_Constraint_Flag (Def); 785 begin 786 if Get_Kind (El_Type) in Iir_Kinds_Composite_Type_Definition then 787 case Get_Constraint_State (El_Type) is 788 when Fully_Constrained => 789 if Constrained_Index then 790 return Fully_Constrained; 791 else 792 return Partially_Constrained; 793 end if; 794 when Partially_Constrained => 795 return Partially_Constrained; 796 when Unconstrained => 797 if not Constrained_Index then 798 return Unconstrained; 799 else 800 return Partially_Constrained; 801 end if; 802 end case; 803 else 804 -- Element subtype is not a composite subtype. 805 if Constrained_Index then 806 return Fully_Constrained; 807 else 808 return Unconstrained; 809 end if; 810 end if; 811 end Get_Array_Constraint; 812 813 function Sem_Enumeration_Type_Definition (Def: Iir; Decl: Iir) return Iir 814 is 815 Literal_List : constant Iir_Flist := Get_Enumeration_Literal_List (Def); 816 El: Iir; 817 Only_Characters : Boolean; 818 begin 819 Set_Type_Staticness (Def, Locally); 820 Set_Signal_Type_Flag (Def, True); 821 822 -- Makes all literal visible. 823 Only_Characters := True; 824 for I in Flist_First .. Flist_Last (Literal_List) loop 825 El := Get_Nth_Element (Literal_List, I); 826 Set_Expr_Staticness (El, Locally); 827 Set_Name_Staticness (El, Locally); 828 Set_Type (El, Def); 829 Sem_Utils.Compute_Subprogram_Hash (El); 830 Sem_Scopes.Add_Name (El); 831 Name_Visible (El); 832 Xref_Decl (El); 833 834 -- LRM93 3.1.1 Enumeration types 835 -- An enumeration type is said to be a character type if at least 836 -- one of its enumeration literals is a character literal. 837 if Name_Table.Is_Character (Get_Identifier (El)) then 838 Set_Is_Character_Type (Def, True); 839 else 840 Only_Characters := False; 841 end if; 842 end loop; 843 Set_Only_Characters_Flag (Def, Only_Characters); 844 Set_Resolved_Flag (Def, False); 845 846 Create_Range_Constraint_For_Enumeration_Type (Def); 847 848 -- Set the size. 849 if Get_Nbr_Elements (Literal_List) <= 256 then 850 Set_Scalar_Size (Def, Scalar_8); 851 else 852 Set_Scalar_Size (Def, Scalar_32); 853 end if; 854 855 -- Identifier IEEE.Std_Logic_1164.Std_Ulogic. 856 if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic 857 and then 858 Get_Parent (Decl) = Vhdl.Ieee.Std_Logic_1164.Std_Logic_1164_Pkg 859 then 860 Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type := Def; 861 end if; 862 863 return Def; 864 end Sem_Enumeration_Type_Definition; 865 866 function Sem_Record_Type_Definition (Def: Iir) return Iir 867 is 868 -- Analyzed type of previous element 869 Last_Type : Iir; 870 871 El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); 872 El : Iir; 873 El_Type : Iir; 874 Resolved_Flag : Boolean; 875 Type_Staticness : Iir_Staticness; 876 Constraint : Iir_Constraint; 877 Composite_Found : Boolean; 878 begin 879 -- LRM 10.1 880 -- 5. A record type declaration, 881 Open_Declarative_Region; 882 883 Resolved_Flag := True; 884 Last_Type := Null_Iir; 885 Type_Staticness := Locally; 886 Constraint := Fully_Constrained; 887 Composite_Found := False; 888 Set_Signal_Type_Flag (Def, True); 889 890 for I in Flist_First .. Flist_Last (El_List) loop 891 El := Get_Nth_Element (El_List, I); 892 El_Type := Get_Subtype_Indication (El); 893 if El_Type /= Null_Iir then 894 -- Be careful for a declaration list (r,g,b: integer). 895 El_Type := Sem_Subtype_Indication (El_Type); 896 Set_Subtype_Indication (El, El_Type); 897 El_Type := Get_Type_Of_Subtype_Indication (El_Type); 898 Last_Type := El_Type; 899 else 900 El_Type := Last_Type; 901 end if; 902 if El_Type /= Null_Iir then 903 Set_Type (El, El_Type); 904 Check_No_File_Type (El_Type, El); 905 if not Get_Signal_Type_Flag (El_Type) then 906 Set_Signal_Type_Flag (Def, False); 907 end if; 908 909 -- LRM93 3.2.1.1 910 -- The same requirement [must define a constrained array 911 -- subtype] exits for the subtype indication of an 912 -- element declaration, if the type of the record 913 -- element is an array type. 914 if Vhdl_Std < Vhdl_08 915 and then not Is_Fully_Constrained_Type (El_Type) 916 then 917 Error_Msg_Sem 918 (+El, 919 "element declaration of unconstrained %n is not allowed", 920 +El_Type); 921 end if; 922 Resolved_Flag := 923 Resolved_Flag and Get_Resolved_Flag (El_Type); 924 Type_Staticness := Min (Type_Staticness, 925 Get_Type_Staticness (El_Type)); 926 Update_Record_Constraint (Constraint, Composite_Found, El_Type); 927 else 928 Type_Staticness := None; 929 end if; 930 Sem_Scopes.Add_Name (El); 931 Name_Visible (El); 932 Xref_Decl (El); 933 end loop; 934 Close_Declarative_Region; 935 Set_Resolved_Flag (Def, Resolved_Flag); 936 Set_Type_Staticness (Def, Type_Staticness); 937 Set_Constraint_State (Def, Constraint); 938 return Def; 939 end Sem_Record_Type_Definition; 940 941 procedure Sem_Unbounded_Array_Indexes (Def: Iir) 942 is 943 Index_List : constant Iir_Flist := 944 Get_Index_Subtype_Definition_List (Def); 945 Index_Type : Iir; 946 begin 947 for I in Flist_First .. Flist_Last (Index_List) loop 948 Index_Type := Get_Nth_Element (Index_List, I); 949 950 Index_Type := Sem_Type_Mark (Index_Type); 951 Set_Nth_Element (Index_List, I, Index_Type); 952 953 Index_Type := Get_Type (Index_Type); 954 if Get_Kind (Index_Type) not in Iir_Kinds_Discrete_Type_Definition 955 then 956 Error_Msg_Sem 957 (+Index_Type, 958 "an index type of an array must be a discrete type"); 959 -- FIXME: disp type Index_Type ? 960 end if; 961 end loop; 962 963 Set_Index_Subtype_List (Def, Index_List); 964 end Sem_Unbounded_Array_Indexes; 965 966 function Sem_Unbounded_Array_Type_Definition (Def: Iir) return Iir is 967 begin 968 Sem_Unbounded_Array_Indexes (Def); 969 970 Sem_Array_Element (Def); 971 Set_Constraint_State (Def, Get_Array_Constraint (Def)); 972 973 -- According to LRM93 7.4.1, an unconstrained array type is not static. 974 Set_Type_Staticness (Def, None); 975 976 return Def; 977 end Sem_Unbounded_Array_Type_Definition; 978 979 -- Return the subtype declaration corresponding to the base type of ATYPE 980 -- (for integer and real types), or the type for enumerated types. To say 981 -- that differently, it returns the type or subtype which defines the 982 -- original range. 983 function Get_First_Subtype_Declaration (Atype : Iir) return Iir is 984 Base_Type : constant Iir := Get_Base_Type (Atype); 985 Base_Decl : constant Iir := Get_Type_Declarator (Base_Type); 986 begin 987 if Get_Kind (Base_Type) = Iir_Kind_Enumeration_Type_Definition then 988 pragma Assert (Get_Kind (Base_Decl) = Iir_Kind_Type_Declaration); 989 return Base_Decl; 990 else 991 return Get_Type_Declarator (Get_Subtype_Definition (Base_Decl)); 992 end if; 993 end Get_First_Subtype_Declaration; 994 995 function Sem_Constrained_Array_Type_Definition (Def: Iir; Decl: Iir) 996 return Iir 997 is 998 Index_List : constant Iir_Flist := Get_Index_Constraint_List (Def); 999 Index_Type : Iir; 1000 Index_Name : Iir; 1001 Base_Index_List : Iir_Flist; 1002 El_Type : Iir; 1003 Staticness : Iir_Staticness; 1004 1005 -- array_type_definition, which is the same as the subtype, 1006 -- but without any constraint in the indexes. 1007 Base_Type: Iir; 1008 begin 1009 -- LRM08 5.3.2.1 Array types 1010 -- A constrained array definition similarly defines both an array 1011 -- type and a subtype of this type. 1012 -- - The array type is an implicitely declared anonymous type, 1013 -- this type is defined by an (implicit) unbounded array 1014 -- definition in which the element subtype indication either 1015 -- denotes the base type of the subtype denoted by the element 1016 -- subtype indication of the constrained array definition, if 1017 -- that subtype is a composite type, or otherwise is the 1018 -- element subtype indication of the constrained array 1019 -- definition, and in which the type mark of each index subtype 1020 -- definition denotes the subtype defined by the corresponding 1021 -- discrete range. 1022 -- - The array subtype is the subtype obtained by imposition of 1023 -- the index constraint on the array type and if the element 1024 -- subtype indication of the constrained array definition 1025 -- denotes a fully or partially constrained composite subtype, 1026 -- imposition of the constraint of that subtype as an array 1027 -- element constraint on the array type. 1028 1029 -- FIXME: all indexes must be either constrained or 1030 -- unconstrained. 1031 -- If all indexes are unconstrained, this is really a type 1032 -- otherwise, this is a subtype. 1033 1034 -- Create a definition for the base type of subtype DEF. 1035 Base_Type := Create_Iir (Iir_Kind_Array_Type_Definition); 1036 Location_Copy (Base_Type, Def); 1037 Set_Type_Declarator (Base_Type, Decl); 1038 Base_Index_List := Create_Iir_Flist (Get_Nbr_Elements (Index_List)); 1039 Set_Index_Subtype_Definition_List (Base_Type, Base_Index_List); 1040 Set_Index_Subtype_List (Base_Type, Base_Index_List); 1041 1042 Staticness := Locally; 1043 for I in Flist_First .. Flist_Last (Index_List) loop 1044 Index_Type := Get_Nth_Element (Index_List, I); 1045 1046 Index_Name := Sem_Discrete_Range_Integer (Index_Type); 1047 if Index_Name /= Null_Iir then 1048 Index_Name := Range_To_Subtype_Indication (Index_Name); 1049 -- Index_Name is a subtype_indication, which can be a type_mark. 1050 else 1051 -- Avoid errors. 1052 Index_Name := Create_Iir (Iir_Kind_Integer_Subtype_Definition); 1053 Location_Copy (Index_Name, Index_Type); 1054 Set_Range_Constraint 1055 (Index_Name, 1056 Create_Error_Expr (Index_Type, Integer_Subtype_Definition)); 1057 Set_Parent_Type (Index_Name, Integer_Subtype_Definition); 1058 Set_Type_Staticness (Index_Name, Globally); 1059 end if; 1060 1061 Set_Nth_Element (Index_List, I, Index_Name); 1062 1063 Index_Type := Get_Index_Type (Index_Name); 1064 Staticness := Min (Staticness, Get_Type_Staticness (Index_Type)); 1065 1066 -- Set the index subtype definition for the array base type. 1067 if Get_Kind (Index_Name) in Iir_Kinds_Denoting_Name then 1068 Index_Type := Get_Named_Entity (Index_Name); 1069 else 1070 pragma Assert 1071 (Get_Kind (Index_Name) in Iir_Kinds_Subtype_Definition); 1072 Index_Type := Get_Subtype_Type_Mark (Index_Name); 1073 if Index_Type = Null_Iir then 1074 -- From a range expression like '1 to 4' or from an attribute 1075 -- name. 1076 Index_Type := Get_First_Subtype_Declaration (Index_Name); 1077 else 1078 Index_Type := Get_Named_Entity (Index_Type); 1079 end if; 1080 end if; 1081 1082 -- Create a new simple_name, as the type_mark is owned by the 1083 -- index constraint of the array subtype. 1084 Index_Name := Build_Simple_Name (Index_Type, Index_Name); 1085 Set_Type (Index_Name, Get_Type (Index_Type)); 1086 1087 Set_Nth_Element (Base_Index_List, I, Index_Name); 1088 end loop; 1089 Set_Index_Subtype_List (Def, Index_List); 1090 1091 -- Element type. Transfer it to the base type. 1092 Set_Element_Subtype_Indication 1093 (Base_Type, Get_Array_Element_Constraint (Def)); 1094 Sem_Array_Element (Base_Type); 1095 El_Type := Get_Element_Subtype (Base_Type); 1096 Set_Element_Subtype (Def, El_Type); 1097 Set_Array_Element_Constraint (Def, Null_Iir); 1098 1099 Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Base_Type)); 1100 1101 -- According to LRM93 7.4.1, an unconstrained array type 1102 -- is not static. 1103 Set_Type_Staticness (Base_Type, None); 1104 Set_Type_Staticness (Def, Min (Staticness, 1105 Get_Type_Staticness (El_Type))); 1106 1107 Set_Type_Declarator (Base_Type, Decl); 1108 Set_Resolved_Flag (Base_Type, Get_Resolved_Flag (Def)); 1109 Set_Index_Constraint_Flag (Def, True); 1110 Set_Constraint_State (Def, Get_Array_Constraint (Def)); 1111 Set_Constraint_State (Base_Type, Get_Array_Constraint (Base_Type)); 1112 Set_Parent_Type (Def, Base_Type); 1113 Set_Subtype_Type_Mark (Def, Null_Iir); 1114 return Def; 1115 end Sem_Constrained_Array_Type_Definition; 1116 1117 function Sem_Access_Type_Definition (Def: Iir) return Iir 1118 is 1119 D_Type : Iir; 1120 begin 1121 D_Type := Sem_Subtype_Indication 1122 (Get_Designated_Subtype_Indication (Def), True); 1123 Set_Designated_Subtype_Indication (Def, D_Type); 1124 1125 D_Type := Get_Type_Of_Subtype_Indication (D_Type); 1126 if D_Type /= Null_Iir then 1127 case Get_Kind (D_Type) is 1128 when Iir_Kind_Incomplete_Type_Definition => 1129 -- Append on the chain of incomplete type ref 1130 Set_Incomplete_Type_Ref_Chain 1131 (Def, Get_Incomplete_Type_Ref_Chain (D_Type)); 1132 Set_Incomplete_Type_Ref_Chain (D_Type, Def); 1133 when Iir_Kind_File_Type_Definition => 1134 -- LRM 3.3 1135 -- The designated type must not be a file type. 1136 Error_Msg_Sem (+Def, "designated type must not be a file type"); 1137 when Iir_Kind_Protected_Type_Declaration => 1138 -- LRM02 3.3 1139 -- [..] or a protected type. 1140 Error_Msg_Sem 1141 (+Def, "designated type must not be a protected type"); 1142 when others => 1143 null; 1144 end case; 1145 Set_Designated_Type (Def, D_Type); 1146 end if; 1147 Set_Type_Staticness (Def, None); 1148 Set_Resolved_Flag (Def, False); 1149 Set_Signal_Type_Flag (Def, False); 1150 return Def; 1151 end Sem_Access_Type_Definition; 1152 1153 function Sem_File_Type_Definition (Def: Iir; Decl: Iir) return Iir 1154 is 1155 Type_Mark : Iir; 1156 begin 1157 Type_Mark := Sem_Type_Mark (Get_File_Type_Mark (Def)); 1158 Set_File_Type_Mark (Def, Type_Mark); 1159 1160 Type_Mark := Get_Type (Type_Mark); 1161 1162 if Get_Kind (Type_Mark) = Iir_Kind_Error then 1163 null; 1164 elsif Get_Signal_Type_Flag (Type_Mark) = False then 1165 -- LRM 3.4 1166 -- The base type of this subtype must not be a file type 1167 -- or an access type. 1168 -- If the base type is a composite type, it must not 1169 -- contain a subelement of an access type. 1170 Error_Msg_Sem (+Def, "%n cannot be a file type", +Type_Mark); 1171 else 1172 -- LRM08 5.5 File type 1173 -- If the base type is an array type, it shall be a one-dimensional 1174 -- array type whose element subtype is fully constrained. If the 1175 -- base type is a record type, it shall be fully constrained. 1176 case Get_Kind (Type_Mark) is 1177 when Iir_Kinds_Array_Type_Definition => 1178 -- LRM 3.4 1179 -- If the base type is an array type, it must be a one 1180 -- dimensional array type. 1181 if not Is_One_Dimensional_Array_Type (Type_Mark) then 1182 Error_Msg_Sem 1183 (+Def, "multi-dimensional %n cannot be a file type", 1184 +Type_Mark); 1185 elsif not Is_Fully_Constrained_Type 1186 (Get_Element_Subtype (Type_Mark)) 1187 then 1188 Error_Msg_Sem 1189 (+Def, "element subtype of %n must be fully constrained", 1190 +Type_Mark); 1191 end if; 1192 when Iir_Kind_Record_Type_Definition 1193 | Iir_Kind_Record_Subtype_Definition => 1194 if Get_Constraint_State (Type_Mark) /= Fully_Constrained then 1195 Error_Msg_Sem 1196 (+Def, "%n must be fully constrained", +Type_Mark); 1197 end if; 1198 when Iir_Kind_Interface_Type_Definition => 1199 Error_Msg_Sem (+Def, "%n cannot be a file type", +Type_Mark); 1200 when others => 1201 null; 1202 end case; 1203 end if; 1204 1205 Set_Resolved_Flag (Def, False); 1206 Set_Text_File_Flag (Def, Is_Text_Type_Declaration (Decl)); 1207 Set_Signal_Type_Flag (Def, False); 1208 Set_Type_Staticness (Def, None); 1209 return Def; 1210 end Sem_File_Type_Definition; 1211 1212 function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir is 1213 begin 1214 case Get_Kind (Def) is 1215 when Iir_Kind_Enumeration_Type_Definition => 1216 return Sem_Enumeration_Type_Definition (Def, Decl); 1217 1218 when Iir_Kind_Physical_Type_Definition => 1219 return Sem_Physical_Type_Definition (Def, Decl); 1220 1221 when Iir_Kind_Range_Expression => 1222 return Range_Expr_To_Type_Definition (Def, Decl); 1223 1224 when Iir_Kind_Range_Array_Attribute 1225 | Iir_Kind_Attribute_Name 1226 | Iir_Kind_Parenthesis_Name => 1227 if Get_Type (Def) /= Null_Iir then 1228 return Sem_Physical_Type_Definition (Def, Decl); 1229 end if; 1230 -- Nb: the attribute is expected to be a 'range or 1231 -- a 'reverse_range attribute. 1232 declare 1233 Res : Iir; 1234 begin 1235 Res := Sem_Discrete_Range (Def, Null_Iir, True); 1236 if Res = Null_Iir then 1237 return Null_Iir; 1238 end if; 1239 -- This cannot be a floating range. 1240 return Create_Integer_Type (Def, Res, Decl); 1241 end; 1242 1243 when Iir_Kind_Array_Subtype_Definition => 1244 return Sem_Constrained_Array_Type_Definition (Def, Decl); 1245 1246 when Iir_Kind_Array_Type_Definition => 1247 return Sem_Unbounded_Array_Type_Definition (Def); 1248 1249 when Iir_Kind_Record_Type_Definition => 1250 return Sem_Record_Type_Definition (Def); 1251 1252 when Iir_Kind_Access_Type_Definition => 1253 return Sem_Access_Type_Definition (Def); 1254 1255 when Iir_Kind_File_Type_Definition => 1256 return Sem_File_Type_Definition (Def, Decl); 1257 1258 when Iir_Kind_Protected_Type_Declaration => 1259 Sem_Protected_Type_Declaration (Decl); 1260 return Def; 1261 1262 when others => 1263 Error_Kind ("sem_type_definition", Def); 1264 return Def; 1265 end case; 1266 end Sem_Type_Definition; 1267 1268 function Range_To_Subtype_Indication (A_Range: Iir) return Iir 1269 is 1270 Sub_Type: Iir; 1271 Range_Type : Iir; 1272 begin 1273 case Get_Kind (A_Range) is 1274 when Iir_Kind_Range_Expression 1275 | Iir_Kind_Range_Array_Attribute 1276 | Iir_Kind_Reverse_Range_Array_Attribute => 1277 -- Create a sub type. 1278 Range_Type := Get_Type (A_Range); 1279 when Iir_Kind_Simple_Name 1280 | Iir_Kind_Selected_Name => 1281 return A_Range; 1282 when Iir_Kinds_Discrete_Type_Definition => 1283 -- A_RANGE is already a subtype definition. 1284 return A_Range; 1285 when others => 1286 Error_Kind ("range_to_subtype_indication", A_Range); 1287 return Null_Iir; 1288 end case; 1289 1290 case Get_Kind (Range_Type) is 1291 when Iir_Kind_Enumeration_Type_Definition 1292 | Iir_Kind_Enumeration_Subtype_Definition => 1293 Sub_Type := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); 1294 when Iir_Kind_Integer_Type_Definition 1295 | Iir_Kind_Integer_Subtype_Definition => 1296 Sub_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); 1297 when Iir_Kind_Floating_Type_Definition 1298 | Iir_Kind_Floating_Subtype_Definition => 1299 Sub_Type := Create_Iir (Iir_Kind_Floating_Subtype_Definition); 1300 when others => 1301 raise Internal_Error; 1302 end case; 1303 Location_Copy (Sub_Type, A_Range); 1304 Set_Range_Constraint (Sub_Type, A_Range); 1305 Set_Parent_Type (Sub_Type, Get_Base_Type (Range_Type)); 1306 Set_Type_Staticness (Sub_Type, Get_Expr_Staticness (A_Range)); 1307 Set_Signal_Type_Flag (Sub_Type, True); 1308 return Sub_Type; 1309 end Range_To_Subtype_Indication; 1310 1311 -- Return TRUE iff FUNC is a resolution function for ATYPE. 1312 function Is_A_Resolution_Function (Func: Iir; Atype: Iir) return Boolean 1313 is 1314 Decl: Iir; 1315 Decl_Type : Iir; 1316 Ret_Type : Iir; 1317 begin 1318 -- LRM93 2.4 1319 -- A resolution function must be a [pure] function; 1320 if Get_Kind (Func) /= Iir_Kind_Function_Declaration then 1321 return False; 1322 end if; 1323 Decl := Get_Interface_Declaration_Chain (Func); 1324 -- LRM93 2.4 1325 -- moreover, it must have a single input parameter of class constant 1326 if Decl = Null_Iir or else Get_Chain (Decl) /= Null_Iir then 1327 return False; 1328 end if; 1329 if Get_Kind (Decl) /= Iir_Kind_Interface_Constant_Declaration then 1330 return False; 1331 end if; 1332 -- LRM93 2.4 1333 -- that is a one-dimensional, unconstrained array 1334 Decl_Type := Get_Type (Decl); 1335 if Get_Kind (Decl_Type) /= Iir_Kind_Array_Type_Definition then 1336 return False; 1337 end if; 1338 if not Is_One_Dimensional_Array_Type (Decl_Type) then 1339 return False; 1340 end if; 1341 -- LRM93 2.4 1342 -- whose element type is that of the resolved signal. 1343 -- The type of the return value of the function must also be that of 1344 -- the signal. 1345 Ret_Type := Get_Return_Type (Func); 1346 if Get_Base_Type (Get_Element_Subtype (Decl_Type)) 1347 /= Get_Base_Type (Ret_Type) 1348 then 1349 return False; 1350 end if; 1351 if Atype /= Null_Iir 1352 and then Get_Base_Type (Ret_Type) /= Get_Base_Type (Atype) 1353 then 1354 return False; 1355 end if; 1356 -- LRM93 2.4 1357 -- A resolution function must be a [pure] function; 1358 if not Flags.Flag_Relaxed_Rules and then not Get_Pure_Flag (Func) then 1359 if Atype /= Null_Iir then 1360 Error_Msg_Sem (+Atype, "resolution %n must be pure", +Func); 1361 end if; 1362 return False; 1363 end if; 1364 return True; 1365 end Is_A_Resolution_Function; 1366 1367 -- Note: this sets resolved_flag. 1368 procedure Sem_Resolution_Function (Name : Iir; Atype : Iir) 1369 is 1370 Func : Iir; 1371 Res: Iir; 1372 El : Iir; 1373 List : Iir_List; 1374 It : List_Iterator; 1375 Has_Error : Boolean; 1376 Name1 : Iir; 1377 begin 1378 Sem_Name (Name); 1379 1380 Func := Get_Named_Entity (Name); 1381 if Func = Error_Mark then 1382 return; 1383 end if; 1384 1385 Res := Null_Iir; 1386 1387 if Is_Overload_List (Func) then 1388 List := Get_Overload_List (Func); 1389 Has_Error := False; 1390 It := List_Iterate (List); 1391 while Is_Valid (It) loop 1392 El := Get_Element (It); 1393 if Is_A_Resolution_Function (El, Atype) then 1394 if Res /= Null_Iir then 1395 if not Has_Error then 1396 Has_Error := True; 1397 Report_Start_Group; 1398 Error_Msg_Sem 1399 (+Atype, 1400 "can't resolve overload for resolution function"); 1401 Error_Msg_Sem (+Atype, "candidate functions are:"); 1402 Error_Msg_Sem (+Func, " " & Disp_Subprg (Func)); 1403 Report_End_Group; 1404 end if; 1405 Error_Msg_Sem (+El, " " & Disp_Subprg (El)); 1406 else 1407 Res := El; 1408 end if; 1409 end if; 1410 Next (It); 1411 end loop; 1412 Free_Overload_List (Func); 1413 if Has_Error then 1414 return; 1415 end if; 1416 Set_Named_Entity (Name, Res); 1417 else 1418 if Is_A_Resolution_Function (Func, Atype) then 1419 Res := Func; 1420 end if; 1421 end if; 1422 1423 if Res = Null_Iir then 1424 Error_Msg_Sem 1425 (+Atype, "no matching resolution function for %n", +Name); 1426 else 1427 Name1 := Finish_Sem_Name (Name); 1428 Sem_Decls.Mark_Subprogram_Used (Res); 1429 Set_Resolved_Flag (Atype, True); 1430 Set_Resolution_Indication (Atype, Name1); 1431 end if; 1432 end Sem_Resolution_Function; 1433 1434 -- Analyze the constraint DEF + RESOLUTION for type TYPE_MARK. The 1435 -- result is always a subtype definition. 1436 function Sem_Subtype_Constraint 1437 (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir; 1438 1439 -- Create a copy of elements_declaration_list of SRC and set it to DST. 1440 procedure Copy_Record_Elements_Declaration_List (Dst : Iir; Src : Iir) 1441 is 1442 El_List : constant Iir_Flist := Get_Elements_Declaration_List (Src); 1443 New_El_List : Iir_Flist; 1444 El : Iir; 1445 begin 1446 New_El_List := Create_Iir_Flist (Get_Nbr_Elements (El_List)); 1447 Set_Elements_Declaration_List (Dst, New_El_List); 1448 for I in Flist_First .. Flist_Last (El_List) loop 1449 El := Get_Nth_Element (El_List, I); 1450 Set_Nth_Element (New_El_List, I, El); 1451 end loop; 1452 end Copy_Record_Elements_Declaration_List; 1453 1454 function Copy_Resolution_Indication (Subdef : Iir) return Iir 1455 is 1456 Ind : constant Iir := Get_Resolution_Indication (Subdef); 1457 begin 1458 if Is_Null (Ind) 1459 or else Get_Kind (Ind) = Iir_Kind_Array_Element_Resolution 1460 then 1461 -- No need to copy array_element_resolution, it is part of the 1462 -- element_subtype. 1463 return Null_Iir; 1464 else 1465 return Build_Reference_Name (Ind); 1466 end if; 1467 end Copy_Resolution_Indication; 1468 1469 function Copy_Subtype_Indication (Def : Iir) return Iir 1470 is 1471 Res : Iir; 1472 begin 1473 case Get_Kind (Def) is 1474 when Iir_Kind_Integer_Subtype_Definition 1475 | Iir_Kind_Floating_Subtype_Definition 1476 | Iir_Kind_Enumeration_Subtype_Definition 1477 | Iir_Kind_Physical_Subtype_Definition => 1478 Res := Create_Iir (Get_Kind (Def)); 1479 Set_Range_Constraint (Res, Get_Range_Constraint (Def)); 1480 Set_Is_Ref (Res, True); 1481 Set_Resolution_Indication 1482 (Res, Copy_Resolution_Indication (Def)); 1483 1484 when Iir_Kind_Enumeration_Type_Definition => 1485 Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); 1486 Set_Range_Constraint (Res, Get_Range_Constraint (Def)); 1487 Set_Is_Ref (Res, True); 1488 1489 when Iir_Kind_Access_Subtype_Definition 1490 | Iir_Kind_Access_Type_Definition => 1491 Res := Create_Iir (Iir_Kind_Access_Subtype_Definition); 1492 Set_Designated_Type (Res, Get_Designated_Type (Def)); 1493 1494 when Iir_Kind_Array_Type_Definition => 1495 Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); 1496 Set_Type_Staticness (Res, Get_Type_Staticness (Def)); 1497 Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); 1498 Set_Index_Constraint_List (Res, Null_Iir_Flist); 1499 Set_Index_Subtype_List 1500 (Res, Get_Index_Subtype_Definition_List (Def)); 1501 Set_Element_Subtype (Res, Get_Element_Subtype (Def)); 1502 Set_Index_Constraint_Flag (Res, False); 1503 Set_Constraint_State (Res, Get_Constraint_State (Def)); 1504 1505 when Iir_Kind_Array_Subtype_Definition => 1506 Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); 1507 Set_Resolution_Indication (Res, Copy_Resolution_Indication (Def)); 1508 Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); 1509 Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Def)); 1510 Set_Element_Subtype (Res, Get_Element_Subtype (Def)); 1511 Set_Index_Constraint_Flag 1512 (Res, Get_Index_Constraint_Flag (Def)); 1513 Set_Constraint_State (Res, Get_Constraint_State (Def)); 1514 1515 when Iir_Kind_Record_Type_Definition 1516 | Iir_Kind_Record_Subtype_Definition => 1517 Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); 1518 Set_Is_Ref (Res, True); 1519 Set_Type_Staticness (Res, Get_Type_Staticness (Def)); 1520 if Get_Kind (Def) = Iir_Kind_Record_Subtype_Definition then 1521 Set_Resolution_Indication 1522 (Res, Copy_Resolution_Indication (Def)); 1523 end if; 1524 Set_Resolved_Flag (Res, Get_Resolved_Flag (Def)); 1525 Set_Constraint_State (Res, Get_Constraint_State (Def)); 1526 Copy_Record_Elements_Declaration_List (Res, Def); 1527 1528 when others => 1529 -- FIXME: todo (protected type ?) 1530 Error_Kind ("copy_subtype_indication", Def); 1531 end case; 1532 Location_Copy (Res, Def); 1533 Set_Parent_Type (Res, Def); 1534 Set_Type_Staticness (Res, Get_Type_Staticness (Def)); 1535 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Def)); 1536 return Res; 1537 end Copy_Subtype_Indication; 1538 1539 function Build_Constrained_Subtype (Atype : Iir; Loc : Iir) return Iir 1540 is 1541 Res : Iir; 1542 begin 1543 if Is_Fully_Constrained_Type (Atype) then 1544 -- Already constrained, nothing to do. 1545 return Atype; 1546 end if; 1547 1548 -- The type defined by 'subtype is always constrained. Create 1549 -- a subtype if it is not. 1550 case Get_Kind (Atype) is 1551 when Iir_Kind_Array_Subtype_Definition 1552 | Iir_Kind_Array_Type_Definition => 1553 Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); 1554 -- Humm, the element is also constrained... 1555 Set_Element_Subtype (Res, Get_Element_Subtype (Atype)); 1556 Set_Index_Subtype_List (Res, Get_Index_Subtype_List (Atype)); 1557 Set_Index_Constraint_Flag (Res, True); 1558 when Iir_Kind_Record_Subtype_Definition 1559 | Iir_Kind_Record_Type_Definition => 1560 Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); 1561 -- Humm, the elements are also constrained. 1562 Set_Elements_Declaration_List 1563 (Res, Get_Elements_Declaration_List (Atype)); 1564 Set_Is_Ref (Res, True); 1565 when others => 1566 Error_Kind ("build_constrained_subtype", Atype); 1567 end case; 1568 Location_Copy (Res, Loc); 1569 -- FIXME: can be globally! 1570 Set_Type_Staticness (Res, None); 1571 Set_Parent_Type (Res, Get_Base_Type (Atype)); 1572 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Atype)); 1573 Set_Resolved_Flag (Res, Get_Resolved_Flag (Atype)); 1574 Set_Constraint_State (Res, Fully_Constrained); 1575 if Get_Kind (Atype) in Iir_Kinds_Subtype_Definition then 1576 Set_Resolution_Indication (Res, Copy_Resolution_Indication (Atype)); 1577 end if; 1578 return Res; 1579 end Build_Constrained_Subtype; 1580 1581 -- DEF is an array_subtype_definition or array_subnature_definition 1582 -- which contains indexes constraints. 1583 -- MARK_DEF is the parent type or nature, given by the type or nature mark. 1584 -- BASE_DEF is the (unbounded) base definition. 1585 -- INDEX_STATICNESS is the staticness of the indexes. 1586 procedure Sem_Array_Constraint_Indexes 1587 (Def : Iir; 1588 Mark_Def : Iir; 1589 Base_Def : Iir; 1590 Index_Staticness : out Iir_Staticness) 1591 is 1592 Type_Index, Subtype_Index: Iir; 1593 Type_Nbr_Dim : Natural; 1594 Subtype_Nbr_Dim : Natural; 1595 Type_Index_List : Iir_Flist; 1596 Subtype_Index_List : Iir_Flist; 1597 Subtype_Index_List2 : Iir_Flist; 1598 begin 1599 Index_Staticness := Locally; 1600 Type_Index_List := Get_Index_Subtype_Definition_List (Base_Def); 1601 Subtype_Index_List := Get_Index_Constraint_List (Def); 1602 1603 -- LRM08 5.3.2.2 1604 -- If an array constraint of the first form (including an index 1605 -- constraint) applies to a type or subtype, then the type or 1606 -- subtype shall be an unconstrained or partially constrained 1607 -- array type with no index constraint applying to the index 1608 -- subtypes, or an access type whose designated type is such 1609 -- a type. 1610 if Subtype_Index_List = Null_Iir_Flist then 1611 -- Array is not constrained, but the type mark may already have 1612 -- constrained on indexes. 1613 Set_Index_Constraint_Flag (Def, Get_Index_Constraint_Flag (Mark_Def)); 1614 Set_Index_Subtype_List (Def, Get_Index_Subtype_List (Mark_Def)); 1615 Index_Staticness := Get_Type_Staticness (Mark_Def); 1616 else 1617 if Get_Index_Constraint_Flag (Mark_Def) then 1618 Error_Msg_Sem (+Def, "constrained array cannot be re-constrained"); 1619 end if; 1620 Type_Nbr_Dim := Get_Nbr_Elements (Type_Index_List); 1621 Subtype_Nbr_Dim := Get_Nbr_Elements (Subtype_Index_List); 1622 1623 if Subtype_Nbr_Dim /= Type_Nbr_Dim then 1624 -- Number of dimension mismatch. Create an index with the right 1625 -- length. 1626 Subtype_Index_List2 := Create_Iir_Flist (Type_Nbr_Dim); 1627 for I in 1 .. Natural'Min (Subtype_Nbr_Dim, Type_Nbr_Dim) loop 1628 Set_Nth_Element 1629 (Subtype_Index_List2, I - 1, 1630 Get_Nth_Element (Subtype_Index_List, I - 1)); 1631 end loop; 1632 1633 if Subtype_Nbr_Dim < Type_Nbr_Dim then 1634 Error_Msg_Sem 1635 (+Def, 1636 "subtype has less indexes than %n defined at %l", 1637 (+Mark_Def, +Mark_Def)); 1638 1639 -- Clear extra indexes. 1640 for I in Subtype_Nbr_Dim + 1 .. Type_Nbr_Dim loop 1641 Set_Nth_Element (Subtype_Index_List2, I - 1, Null_Iir); 1642 end loop; 1643 else 1644 Error_Msg_Sem 1645 (+Get_Nth_Element (Subtype_Index_List, Type_Nbr_Dim), 1646 "subtype has more indexes than %n defined at %l", 1647 (+Mark_Def, +Mark_Def)); 1648 1649 -- Forget extra indexes. 1650 end if; 1651 Destroy_Iir_Flist (Subtype_Index_List); 1652 Subtype_Index_List := Subtype_Index_List2; 1653 end if; 1654 1655 for I in 1 .. Type_Nbr_Dim loop 1656 Type_Index := Get_Nth_Element (Type_Index_List, I - 1); 1657 1658 if I <= Subtype_Nbr_Dim then 1659 Subtype_Index := Get_Nth_Element (Subtype_Index_List, I - 1); 1660 Subtype_Index := Sem_Discrete_Range 1661 (Subtype_Index, Get_Index_Type (Type_Index), True); 1662 if Subtype_Index /= Null_Iir then 1663 Subtype_Index := 1664 Range_To_Subtype_Indication (Subtype_Index); 1665 Index_Staticness := Min 1666 (Index_Staticness, 1667 Get_Type_Staticness (Get_Type_Of_Subtype_Indication 1668 (Subtype_Index))); 1669 end if; 1670 else 1671 Subtype_Index := Null_Iir; 1672 end if; 1673 if Subtype_Index = Null_Iir then 1674 -- Create a fake subtype from type_index. 1675 -- FIXME: It is too fake. 1676 Subtype_Index := Type_Index; 1677 Index_Staticness := None; 1678 end if; 1679 Set_Nth_Element (Subtype_Index_List, I - 1, Subtype_Index); 1680 end loop; 1681 1682 Set_Index_Subtype_List (Def, Subtype_Index_List); 1683 Set_Index_Constraint_Flag (Def, True); 1684 end if; 1685 end Sem_Array_Constraint_Indexes; 1686 1687 -- DEF is an array_subtype_definition. 1688 procedure Sem_Array_Type_Constraint_Indexes (Def : Iir; Type_Mark : Iir) 1689 is 1690 El_Type : constant Iir := Get_Element_Subtype (Type_Mark); 1691 Base_Type : constant Iir := Get_Base_Type (Type_Mark); 1692 Index_Staticness : Iir_Staticness; 1693 begin 1694 -- Check each index constraint against array type. 1695 Set_Parent_Type (Def, Type_Mark); 1696 1697 Sem_Array_Constraint_Indexes 1698 (Def, Type_Mark, Base_Type, Index_Staticness); 1699 1700 Set_Type_Staticness 1701 (Def, Min (Get_Type_Staticness (El_Type), Index_Staticness)); 1702 Set_Signal_Type_Flag (Def, Get_Signal_Type_Flag (Type_Mark)); 1703 end Sem_Array_Type_Constraint_Indexes; 1704 1705 -- DEF is an incomplete subtype_indication or array_constraint, 1706 -- TYPE_MARK is the base type of the subtype_indication. 1707 function Sem_Array_Constraint 1708 (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir 1709 is 1710 El_Type : constant Iir := Get_Element_Subtype (Type_Mark); 1711 Res : Iir; 1712 El_Def : Iir; 1713 Resolv_Func : Iir := Null_Iir; 1714 Resolv_El : Iir := Null_Iir; 1715 Resolv_Ind : Iir; 1716 begin 1717 if Resolution /= Null_Iir then 1718 -- A resolution indication is present. 1719 case Get_Kind (Resolution) is 1720 when Iir_Kinds_Denoting_Name => 1721 Resolv_Func := Resolution; 1722 when Iir_Kind_Array_Element_Resolution => 1723 Resolv_El := Get_Resolution_Indication (Resolution); 1724 when Iir_Kind_Record_Resolution => 1725 Error_Msg_Sem 1726 (+Resolution, 1727 "record resolution not allowed for array subtype"); 1728 when others => 1729 Error_Kind ("sem_array_constraint(resolution)", Resolution); 1730 end case; 1731 end if; 1732 1733 if Def = Null_Iir then 1734 -- There is no element_constraint. 1735 pragma Assert (Resolution /= Null_Iir); 1736 Res := Copy_Subtype_Indication (Type_Mark); 1737 El_Def := Null_Iir; 1738 else 1739 case Get_Kind (Def) is 1740 when Iir_Kind_Subtype_Definition => 1741 -- This is the case of "subtype new_array is [func] old_array". 1742 -- def must be a constrained array. 1743 if Get_Range_Constraint (Def) /= Null_Iir then 1744 Error_Msg_Sem 1745 (+Def, "cannot use a range constraint for array types"); 1746 return Copy_Subtype_Indication (Type_Mark); 1747 end if; 1748 1749 Res := Copy_Subtype_Indication (Type_Mark); 1750 Location_Copy (Res, Def); 1751 Free_Name (Def); 1752 1753 -- LRM08 6.3 Subtype declarations 1754 -- 1755 -- If the subtype indication does not include a constraint, the 1756 -- subtype is the same as that denoted by the type mark. 1757 if Resolution = Null_Iir then 1758 return Res; 1759 end if; 1760 1761 -- No element constraint. 1762 El_Def := Null_Iir; 1763 1764 when Iir_Kind_Array_Subtype_Definition => 1765 -- Case of a constraint for an array. 1766 El_Def := Get_Array_Element_Constraint (Def); 1767 Sem_Array_Type_Constraint_Indexes (Def, Type_Mark); 1768 Res := Def; 1769 1770 when others => 1771 -- LRM93 3.2.1.1 / LRM08 5.3.2.2 1772 -- Index Constraints and Discrete Ranges 1773 -- 1774 -- If an index constraint appears after a type mark [...] 1775 -- The type mark must denote either an unconstrained array 1776 -- type, or an access type whose designated type is such 1777 -- an array type. 1778 Report_Start_Group; 1779 Error_Msg_Sem 1780 (+Def, 1781 "only unconstrained array type may be contrained by index"); 1782 Error_Msg_Sem 1783 (+Type_Mark, " (type mark is %n)", +Type_Mark); 1784 Report_End_Group; 1785 return Type_Mark; 1786 end case; 1787 end if; 1788 1789 -- Element subtype. 1790 if Resolv_El /= Null_Iir or else El_Def /= Null_Iir then 1791 El_Def := Sem_Subtype_Constraint (El_Def, El_Type, Resolv_El); 1792 if Resolv_El /= Null_Iir then 1793 -- Save EL_DEF so that it is owned. 1794 Set_Element_Subtype_Indication (Resolution, El_Def); 1795 Set_Resolution_Indication (Resolution, Null_Iir); 1796 end if; 1797 end if; 1798 if El_Def = Null_Iir then 1799 El_Def := Get_Element_Subtype (Type_Mark); 1800 end if; 1801 Set_Element_Subtype (Res, El_Def); 1802 1803 Set_Constraint_State (Res, Get_Array_Constraint (Res)); 1804 1805 if Resolv_Func /= Null_Iir then 1806 Sem_Resolution_Function (Resolv_Func, Res); 1807 elsif Resolv_El /= Null_Iir then 1808 Set_Resolution_Indication (Res, Resolution); 1809 -- FIXME: may a resolution indication for a record be incomplete ? 1810 Set_Resolved_Flag (Res, Get_Resolved_Flag (El_Def)); 1811 elsif Get_Kind (Type_Mark) = Iir_Kind_Array_Subtype_Definition then 1812 Resolv_Ind := Get_Resolution_Indication (Type_Mark); 1813 if Resolv_Ind /= Null_Iir then 1814 case Get_Kind (Resolv_Ind) is 1815 when Iir_Kinds_Denoting_Name => 1816 Error_Kind ("sem_array_constraint(resolution)", Resolv_Ind); 1817 when Iir_Kind_Array_Element_Resolution => 1818 -- Already applied to the element. 1819 Resolv_Ind := Null_Iir; 1820 when others => 1821 Error_Kind ("sem_array_constraint(resolution2)", Resolv_Ind); 1822 end case; 1823 Set_Resolution_Indication (Res, Resolv_Ind); 1824 end if; 1825 Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark)); 1826 else 1827 pragma Assert (Get_Kind (Type_Mark) = Iir_Kind_Array_Type_Definition); 1828 Set_Resolved_Flag (Res, Get_Resolved_Flag (Type_Mark)); 1829 end if; 1830 1831 return Res; 1832 end Sem_Array_Constraint; 1833 1834 function Reparse_As_Record_Element_Constraint (Name : Iir) return Iir 1835 is 1836 Prefix : Iir; 1837 Parent : Iir; 1838 El : Iir; 1839 begin 1840 if Get_Kind (Name) /= Iir_Kind_Parenthesis_Name then 1841 Error_Msg_Sem (+Name, "record element constraint expected"); 1842 return Null_Iir; 1843 else 1844 Prefix := Get_Prefix (Name); 1845 Parent := Name; 1846 while Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name loop 1847 Parent := Prefix; 1848 Prefix := Get_Prefix (Prefix); 1849 end loop; 1850 if Get_Kind (Prefix) /= Iir_Kind_Simple_Name then 1851 Error_Msg_Sem 1852 (+Prefix, "record element name must be a simple name"); 1853 return Null_Iir; 1854 else 1855 El := Create_Iir (Iir_Kind_Record_Element_Constraint); 1856 Location_Copy (El, Prefix); 1857 Set_Identifier (El, Get_Identifier (Prefix)); 1858 Set_Type (El, Name); 1859 Set_Prefix (Parent, Null_Iir); 1860 Free_Name (Prefix); 1861 return El; 1862 end if; 1863 end if; 1864 end Reparse_As_Record_Element_Constraint; 1865 1866 function Reparse_As_Record_Constraint (Def : Iir) return Iir 1867 is 1868 Res : Iir; 1869 Chain : Iir; 1870 El_List : Iir_List; 1871 El : Iir; 1872 begin 1873 pragma Assert (Get_Prefix (Def) = Null_Iir); 1874 Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); 1875 Set_Is_Ref (Res, True); 1876 Location_Copy (Res, Def); 1877 El_List := Create_Iir_List; 1878 Chain := Get_Association_Chain (Def); 1879 while Chain /= Null_Iir loop 1880 if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression 1881 or else Get_Formal (Chain) /= Null_Iir 1882 then 1883 Error_Msg_Sem (+Chain, "badly formed record constraint"); 1884 else 1885 El := Reparse_As_Record_Element_Constraint (Get_Actual (Chain)); 1886 if El /= Null_Iir then 1887 Append_Element (El_List, El); 1888 Set_Parent (El, Res); 1889 Append_Owned_Element_Constraint (Res, El); 1890 end if; 1891 end if; 1892 Chain := Get_Chain (Chain); 1893 end loop; 1894 Set_Elements_Declaration_List (Res, List_To_Flist (El_List)); 1895 return Res; 1896 end Reparse_As_Record_Constraint; 1897 1898 function Reparse_As_Array_Constraint (Def : Iir; Def_Type : Iir) return Iir 1899 is 1900 Parent : Iir; 1901 Name : Iir; 1902 Prefix : Iir; 1903 Res : Iir; 1904 Chain : Iir; 1905 El_List : Iir_List; 1906 Def_El_Type : Iir; 1907 begin 1908 Name := Def; 1909 Prefix := Get_Prefix (Name); 1910 Parent := Null_Iir; 1911 while Prefix /= Null_Iir 1912 and then Get_Kind (Prefix) = Iir_Kind_Parenthesis_Name 1913 loop 1914 Parent := Name; 1915 Name := Prefix; 1916 Prefix := Get_Prefix (Name); 1917 end loop; 1918 -- Detach prefix. 1919 if Parent /= Null_Iir then 1920 Set_Prefix (Parent, Null_Iir); 1921 end if; 1922 1923 Res := Create_Iir (Iir_Kind_Array_Subtype_Definition); 1924 Location_Copy (Res, Name); 1925 Set_Has_Array_Constraint_Flag (Res, True); 1926 Chain := Get_Association_Chain (Name); 1927 if Get_Kind (Chain) = Iir_Kind_Association_Element_Open then 1928 if Get_Chain (Chain) /= Null_Iir then 1929 Error_Msg_Sem (+Chain, "'open' must be alone"); 1930 end if; 1931 else 1932 El_List := Create_Iir_List; 1933 while Chain /= Null_Iir loop 1934 if Get_Kind (Chain) /= Iir_Kind_Association_Element_By_Expression 1935 or else Get_Formal (Chain) /= Null_Iir 1936 then 1937 Error_Msg_Sem (+Chain, "bad form of array constraint"); 1938 else 1939 Append_Element (El_List, Get_Actual (Chain)); 1940 end if; 1941 Chain := Get_Chain (Chain); 1942 end loop; 1943 Set_Index_Constraint_List (Res, List_To_Flist (El_List)); 1944 end if; 1945 1946 Def_El_Type := Get_Element_Subtype (Def_Type); 1947 if Parent /= Null_Iir then 1948 case Get_Kind (Def_El_Type) is 1949 when Iir_Kinds_Array_Type_Definition => 1950 Set_Array_Element_Constraint 1951 (Res, Reparse_As_Array_Constraint (Def, Def_El_Type)); 1952 Set_Has_Element_Constraint_Flag (Res, True); 1953 when others => 1954 Error_Kind ("reparse_as_array_constraint", Def_El_Type); 1955 end case; 1956 end if; 1957 return Res; 1958 end Reparse_As_Array_Constraint; 1959 1960 function Sem_Record_Constraint 1961 (Def : Iir; Type_Mark : Iir; Resolution : Iir) return Iir 1962 is 1963 Res : Iir; 1964 El_List, Tm_El_List : Iir_Flist; 1965 El : Iir; 1966 Tm_El : Iir; 1967 Tm_El_Type : Iir; 1968 El_Type : Iir; 1969 Res_List : Iir_Flist; 1970 1971 Index_List : Iir_Flist; 1972 Index_El : Iir; 1973 begin 1974 Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); 1975 Set_Is_Ref (Res, True); 1976 Location_Copy (Res, Def); 1977 Set_Parent_Type (Res, Type_Mark); 1978 if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then 1979 Set_Resolution_Indication 1980 (Res, Get_Resolution_Indication (Type_Mark)); 1981 end if; 1982 1983 case Get_Kind (Def) is 1984 when Iir_Kind_Subtype_Definition => 1985 -- Just an alias, without new constraints. 1986 Free_Name (Def); 1987 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); 1988 Set_Constraint_State (Res, Get_Constraint_State (Type_Mark)); 1989 El_List := Null_Iir_Flist; 1990 1991 when Iir_Kind_Array_Subtype_Definition => 1992 -- Record constraints were parsed as array constraints. 1993 -- Reparse. 1994 pragma Assert (Get_Kind (Def) = Iir_Kind_Array_Subtype_Definition); 1995 Index_List := Get_Index_Constraint_List (Def); 1996 El_List := Create_Iir_Flist (Get_Nbr_Elements (Index_List)); 1997 Set_Elements_Declaration_List (Res, El_List); 1998 for I in Flist_First .. Flist_Last (Index_List) loop 1999 Index_El := Get_Nth_Element (Index_List, I); 2000 El := Reparse_As_Record_Element_Constraint (Index_El); 2001 if El = Null_Iir then 2002 return Create_Error_Type (Type_Mark); 2003 end if; 2004 Set_Nth_Element (El_List, I, El); 2005 end loop; 2006 2007 when Iir_Kind_Record_Subtype_Definition => 2008 El_List := Get_Elements_Declaration_List (Def); 2009 Set_Elements_Declaration_List (Res, El_List); 2010 2011 when others => 2012 Error_Kind ("sem_record_constraint", Def); 2013 end case; 2014 2015 -- Handle resolution. 2016 Res_List := Null_Iir_Flist; 2017 if Resolution /= Null_Iir then 2018 case Get_Kind (Resolution) is 2019 when Iir_Kinds_Denoting_Name => 2020 null; 2021 when Iir_Kind_Record_Subtype_Definition => 2022 Res_List := Get_Elements_Declaration_List (Resolution); 2023 when Iir_Kind_Array_Subtype_Definition => 2024 Error_Msg_Sem 2025 (+Resolution, 2026 "resolution indication must be an array element resolution"); 2027 when others => 2028 Error_Kind ("sem_record_constraint(resolution)", Resolution); 2029 end case; 2030 end if; 2031 2032 Tm_El_List := Get_Elements_Declaration_List (Type_Mark); 2033 if El_List /= Null_Iir_Flist or Res_List /= Null_Iir_Flist then 2034 -- Constraints (either range or resolution) have been added. 2035 declare 2036 Nbr_Els : constant Natural := Get_Nbr_Elements (Tm_El_List); 2037 Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir); 2038 Res_Els : Iir_Array (0 .. Nbr_Els - 1) := (others => Null_Iir); 2039 Pos : Natural; 2040 Constraint : Iir_Constraint; 2041 Composite_Found : Boolean; 2042 Staticness : Iir_Staticness; 2043 begin 2044 -- Fill ELS with record constraints. 2045 if El_List /= Null_Iir_Flist then 2046 for I in Flist_First .. Flist_Last (El_List) loop 2047 El := Get_Nth_Element (El_List, I); 2048 Tm_El := Find_Name_In_Flist 2049 (Tm_El_List, Get_Identifier (El)); 2050 if Tm_El = Null_Iir then 2051 -- Constraint element references an element name that 2052 -- doesn't exist. 2053 Error_Msg_Sem (+El, "%n has no %n", (+Type_Mark, +El)); 2054 else 2055 Pos := Natural (Get_Element_Position (Tm_El)); 2056 if Els (Pos) /= Null_Iir then 2057 Report_Start_Group; 2058 Error_Msg_Sem 2059 (+El, "%n was already constrained", +El); 2060 Error_Msg_Sem 2061 (+Els (Pos), " (location of previous constrained)"); 2062 Report_End_Group; 2063 else 2064 Els (Pos) := El; 2065 Set_Parent (El, Res); 2066 Append_Owned_Element_Constraint (Res, El); 2067 end if; 2068 Xref_Ref (El, Tm_El); 2069 El_Type := Get_Type (El); 2070 Tm_El_Type := Get_Type (Tm_El); 2071 if Get_Kind (El_Type) = Iir_Kind_Parenthesis_Name then 2072 -- Recurse. 2073 case Get_Kind (Tm_El_Type) is 2074 when Iir_Kinds_Array_Type_Definition => 2075 El_Type := Reparse_As_Array_Constraint 2076 (El_Type, Tm_El_Type); 2077 when Iir_Kind_Record_Type_Definition 2078 | Iir_Kind_Record_Subtype_Definition => 2079 El_Type := Reparse_As_Record_Constraint 2080 (El_Type); 2081 when Iir_Kind_Error => 2082 null; 2083 when others => 2084 Error_Msg_Sem 2085 (+El_Type, 2086 "only composite types may be constrained"); 2087 end case; 2088 Set_Subtype_Indication (El, El_Type); 2089 end if; 2090 Set_Type (El, El_Type); 2091 end if; 2092 end loop; 2093 -- Record element constraints are now in Els. 2094 Destroy_Iir_Flist (El_List); 2095 end if; 2096 2097 -- Fill Res_Els (handle resolution constraints). 2098 if Res_List /= Null_Iir_Flist then 2099 for I in Flist_First .. Flist_Last (Res_List) loop 2100 El := Get_Nth_Element (Res_List, I); 2101 Tm_El := 2102 Find_Name_In_Flist (Tm_El_List, Get_Identifier (El)); 2103 if Tm_El = Null_Iir then 2104 Error_Msg_Sem (+El, "%n has no %n", (+Type_Mark, +El)); 2105 else 2106 Pos := Natural (Get_Element_Position (Tm_El)); 2107 if Res_Els (Pos) /= Null_Iir then 2108 Report_Start_Group; 2109 Error_Msg_Sem (+El, "%n was already resolved", +El); 2110 Error_Msg_Sem 2111 (+Els (Pos), " (location of previous constrained)"); 2112 Report_End_Group; 2113 else 2114 Res_Els (Pos) := Tm_El; 2115 end if; 2116 end if; 2117 --Free_Iir (El); 2118 end loop; 2119 Destroy_Iir_Flist (Res_List); 2120 end if; 2121 2122 -- Build elements list. 2123 El_List := Create_Iir_Flist (Nbr_Els); 2124 Set_Elements_Declaration_List (Res, El_List); 2125 Constraint := Fully_Constrained; 2126 Composite_Found := False; 2127 Staticness := Locally; 2128 for I in Els'Range loop 2129 Tm_El := Get_Nth_Element (Tm_El_List, I); 2130 if Els (I) = Null_Iir and Res_Els (I) = Null_Iir then 2131 -- No new record element constraints. Copy the element from 2132 -- the type mark. 2133 El := Tm_El; 2134 El_Type := Get_Type (El); 2135 else 2136 if Els (I) = Null_Iir then 2137 -- Only a resolution constraint. 2138 El := Create_Iir (Iir_Kind_Record_Element_Constraint); 2139 Location_Copy (El, Tm_El); 2140 Set_Parent (El, Res); 2141 El_Type := Null_Iir; 2142 Append_Owned_Element_Constraint (Res, El); 2143 else 2144 El := Els (I); 2145 El_Type := Get_Type (El); 2146 pragma Assert 2147 (Get_Kind (El) = Iir_Kind_Record_Element_Constraint); 2148 end if; 2149 El_Type := Sem_Subtype_Constraint (El_Type, 2150 Get_Type (Tm_El), 2151 Res_Els (I)); 2152 Set_Type (El, El_Type); 2153 Set_Subtype_Indication (El, El_Type); 2154 Set_Element_Position (El, Get_Element_Position (Tm_El)); 2155 end if; 2156 Set_Nth_Element (El_List, I, El); 2157 Update_Record_Constraint (Constraint, Composite_Found, El_Type); 2158 Staticness := Min (Staticness, Get_Type_Staticness (El_Type)); 2159 end loop; 2160 Set_Constraint_State (Res, Constraint); 2161 Set_Type_Staticness (Res, Staticness); 2162 end; 2163 else 2164 Copy_Record_Elements_Declaration_List (Res, Type_Mark); 2165 Set_Constraint_State (Res, Get_Constraint_State (Type_Mark)); 2166 Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark)); 2167 end if; 2168 2169 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); 2170 2171 if Resolution /= Null_Iir 2172 and then Get_Kind (Resolution) in Iir_Kinds_Denoting_Name 2173 then 2174 Sem_Resolution_Function (Resolution, Res); 2175 end if; 2176 2177 return Res; 2178 end Sem_Record_Constraint; 2179 2180 -- Return a scalar subtype definition (even in case of error). 2181 function Sem_Range_Constraint 2182 (Def : Iir; Type_Mark : Iir; Resolution : Iir) 2183 return Iir 2184 is 2185 Res : Iir; 2186 A_Range : Iir; 2187 Tolerance : Iir; 2188 begin 2189 if Def = Null_Iir then 2190 Res := Copy_Subtype_Indication (Type_Mark); 2191 elsif Get_Kind (Def) /= Iir_Kind_Subtype_Definition then 2192 -- FIXME: find the correct sentence from LRM 2193 -- GHDL: subtype_definition may also be used just to add 2194 -- a resolution function. 2195 Report_Start_Group; 2196 Error_Msg_Sem (+Def, "only scalar types may be constrained by range"); 2197 Error_Msg_Sem (+Type_Mark, " (type mark is %n)", +Type_Mark); 2198 Report_End_Group; 2199 Res := Copy_Subtype_Indication (Type_Mark); 2200 else 2201 Tolerance := Get_Tolerance (Def); 2202 2203 if Get_Range_Constraint (Def) = Null_Iir 2204 and then Resolution = Null_Iir 2205 and then Tolerance = Null_Iir 2206 then 2207 -- This defines an alias, and must have been handled just 2208 -- before the case statment. 2209 raise Internal_Error; 2210 end if; 2211 2212 -- There are limits. Create a new subtype. 2213 if Get_Kind (Type_Mark) = Iir_Kind_Enumeration_Type_Definition then 2214 Res := Create_Iir (Iir_Kind_Enumeration_Subtype_Definition); 2215 else 2216 Res := Create_Iir (Get_Kind (Type_Mark)); 2217 end if; 2218 Location_Copy (Res, Def); 2219 Set_Parent_Type (Res, Type_Mark); 2220 Set_Resolution_Indication (Res, Get_Resolution_Indication (Def)); 2221 A_Range := Get_Range_Constraint (Def); 2222 if A_Range = Null_Iir then 2223 A_Range := Get_Range_Constraint (Type_Mark); 2224 Set_Is_Ref (Res, True); 2225 else 2226 A_Range := Sem_Range_Expression (A_Range, Type_Mark, True); 2227 if A_Range = Null_Iir then 2228 -- Avoid error propagation. 2229 A_Range := Get_Range_Constraint (Type_Mark); 2230 Set_Is_Ref (Res, True); 2231 end if; 2232 end if; 2233 Set_Range_Constraint (Res, A_Range); 2234 Set_Type_Staticness (Res, Get_Expr_Staticness (A_Range)); 2235 Free_Name (Def); 2236 Set_Signal_Type_Flag (Res, Get_Signal_Type_Flag (Type_Mark)); 2237 if Tolerance /= Null_Iir then 2238 -- LRM93 4.2 Subtype declarations 2239 -- It is an error in this case the subtype is not a nature 2240 -- type 2241 -- 2242 -- FIXME: should be moved into sem_subtype_indication 2243 if Get_Kind (Res) /= Iir_Kind_Floating_Subtype_Definition then 2244 Error_Msg_Sem 2245 (+Tolerance, "tolerance allowed only for floating subtype"); 2246 else 2247 -- LRM93 4.2 Subtype declarations 2248 -- If the subtype indication includes a tolerance aspect, then 2249 -- the string expression must be a static expression 2250 Tolerance := Sem_Expression (Tolerance, String_Type_Definition); 2251 if Tolerance /= Null_Iir 2252 and then Get_Expr_Staticness (Tolerance) /= Locally 2253 then 2254 Error_Msg_Sem 2255 (+Tolerance, "tolerance must be a static string"); 2256 end if; 2257 Set_Tolerance (Res, Tolerance); 2258 end if; 2259 end if; 2260 end if; 2261 2262 if Resolution /= Null_Iir then 2263 -- LRM08 6.3 Subtype declarations. 2264 if Get_Kind (Resolution) not in Iir_Kinds_Denoting_Name then 2265 Error_Msg_Sem 2266 (+Resolution, "resolution indication must be a function name"); 2267 else 2268 Sem_Resolution_Function (Resolution, Res); 2269 Location_Copy (Res, Resolution); 2270 end if; 2271 end if; 2272 return Res; 2273 end Sem_Range_Constraint; 2274 2275 function Sem_Subtype_Constraint 2276 (Def : Iir; Type_Mark : Iir; Resolution : Iir) 2277 return Iir is 2278 begin 2279 case Get_Kind (Type_Mark) is 2280 when Iir_Kind_Array_Subtype_Definition 2281 | Iir_Kind_Array_Type_Definition => 2282 return Sem_Array_Constraint (Def, Type_Mark, Resolution); 2283 when Iir_Kind_Integer_Subtype_Definition 2284 | Iir_Kind_Floating_Subtype_Definition 2285 | Iir_Kind_Enumeration_Subtype_Definition 2286 | Iir_Kind_Physical_Subtype_Definition 2287 | Iir_Kind_Enumeration_Type_Definition=> 2288 return Sem_Range_Constraint (Def, Type_Mark, Resolution); 2289 when Iir_Kind_Record_Type_Definition 2290 | Iir_Kind_Record_Subtype_Definition => 2291 return Sem_Record_Constraint (Def, Type_Mark, Resolution); 2292 when Iir_Kind_Access_Type_Definition 2293 | Iir_Kind_Access_Subtype_Definition => 2294 -- LRM93 4.2 2295 -- A subtype indication denoting an access type [or a file type] 2296 -- may not contain a resolution function. 2297 if Resolution /= Null_Iir then 2298 Error_Msg_Sem 2299 (+Def, "resolution function not allowed for an access type"); 2300 end if; 2301 2302 case Get_Kind (Def) is 2303 when Iir_Kind_Subtype_Definition => 2304 Free_Name (Def); 2305 return Copy_Subtype_Indication (Type_Mark); 2306 when Iir_Kind_Array_Subtype_Definition => 2307 -- LRM93 3.3 2308 -- The only form of constraint that is allowed after a name 2309 -- of an access type in a subtype indication is an index 2310 -- constraint. 2311 declare 2312 Base_Type : constant Iir := 2313 Get_Designated_Type (Type_Mark); 2314 Sub_Type : Iir; 2315 Res : Iir; 2316 begin 2317 Sub_Type := Sem_Array_Constraint 2318 (Def, Base_Type, Null_Iir); 2319 Res := Create_Iir (Iir_Kind_Access_Subtype_Definition); 2320 Location_Copy (Res, Def); 2321 Set_Parent_Type (Res, Type_Mark); 2322 Set_Designated_Subtype_Indication (Res, Sub_Type); 2323 Set_Designated_Type (Res, Sub_Type); 2324 Set_Signal_Type_Flag (Res, False); 2325 2326 -- The type_mark is a type_mark of the access subtype, 2327 -- not of the array subtype. 2328 Set_Subtype_Type_Mark 2329 (Res, Get_Subtype_Type_Mark (Sub_Type)); 2330 Set_Subtype_Type_Mark (Sub_Type, Null_Iir); 2331 return Res; 2332 end; 2333 when others => 2334 raise Internal_Error; 2335 end case; 2336 2337 when Iir_Kind_File_Type_Definition => 2338 -- LRM08 6.3 Subtype declarations 2339 -- A subtype indication denoting a subtype of [...] a file 2340 -- type [...] shall not contain a constraint. 2341 if Get_Kind (Def) /= Iir_Kind_Subtype_Definition 2342 or else Get_Range_Constraint (Def) /= Null_Iir 2343 then 2344 Error_Msg_Sem (+Def, "file types can't be constrained"); 2345 return Type_Mark; 2346 end if; 2347 2348 -- LRM93 4.2 2349 -- A subtype indication denoting [an access type or] a file type 2350 -- may not contain a resolution function. 2351 if Resolution /= Null_Iir then 2352 Error_Msg_Sem 2353 (+Def, "resolution function not allowed for file types"); 2354 return Type_Mark; 2355 end if; 2356 Free_Name (Def); 2357 return Type_Mark; 2358 2359 when Iir_Kind_Protected_Type_Declaration => 2360 -- LRM08 6.3 Subtype declarations 2361 -- A subtype indication denoting a subtype of [...] a protected 2362 -- type [...] shall not contain a constraint. 2363 if Get_Kind (Def) /= Iir_Kind_Subtype_Definition 2364 or else Get_Range_Constraint (Def) /= Null_Iir 2365 then 2366 Error_Msg_Sem (+Def, "protected types can't be constrained"); 2367 return Type_Mark; 2368 end if; 2369 2370 -- LRM08 6.3 Subtype declarations 2371 -- A subtype indication denoting [...] a protected type shall 2372 -- not contain a resolution function. 2373 if Resolution /= Null_Iir then 2374 Error_Msg_Sem 2375 (+Def, "resolution function not allowed for file types"); 2376 return Type_Mark; 2377 end if; 2378 Free_Name (Def); 2379 return Type_Mark; 2380 2381 when Iir_Kind_Error => 2382 return Type_Mark; 2383 2384 when others => 2385 Error_Kind ("sem_subtype_constraint", Type_Mark); 2386 return Type_Mark; 2387 end case; 2388 end Sem_Subtype_Constraint; 2389 2390 function Sem_Subtype_Indication (Def: Iir; Incomplete : Boolean := False) 2391 return Iir 2392 is 2393 Type_Mark_Name : Iir; 2394 Type_Mark: Iir; 2395 Res : Iir; 2396 begin 2397 -- LRM08 6.3 Subtype declarations 2398 -- 2399 -- If the subtype indication does not include a constraint, the subtype 2400 -- is the same as that denoted by the type mark. 2401 case Get_Kind (Def) is 2402 when Iir_Kinds_Denoting_Name 2403 | Iir_Kind_Attribute_Name => 2404 Type_Mark := Sem_Type_Mark (Def, Incomplete); 2405 return Type_Mark; 2406 when Iir_Kind_Error => 2407 return Def; 2408 when others => 2409 null; 2410 end case; 2411 2412 -- Analyze the type mark. 2413 Type_Mark_Name := Get_Subtype_Type_Mark (Def); 2414 if Type_Mark_Name = Null_Iir then 2415 return Create_Error_Type (Def); 2416 end if; 2417 Type_Mark_Name := Sem_Type_Mark (Type_Mark_Name); 2418 Set_Subtype_Type_Mark (Def, Type_Mark_Name); 2419 if Is_Error (Type_Mark_Name) then 2420 return Type_Mark_Name; 2421 end if; 2422 2423 Type_Mark := Get_Type (Type_Mark_Name); 2424 -- FIXME: incomplete type ? 2425 if Is_Error (Type_Mark) then 2426 -- FIXME: handle inversion such as "subtype BASETYPE RESOLV", which 2427 -- should emit "resolution function must precede type name". 2428 2429 -- Discard the subtype definition and only keep the type mark. 2430 return Type_Mark_Name; 2431 end if; 2432 2433 Res := Sem_Subtype_Constraint 2434 (Def, Type_Mark, Get_Resolution_Indication (Def)); 2435 if not Is_Error (Res) then 2436 Set_Subtype_Type_Mark (Res, Type_Mark_Name); 2437 end if; 2438 return Res; 2439 end Sem_Subtype_Indication; 2440 2441 -- From a composite nature, two types are created: one for the across 2442 -- branch and one for the through branch. As they are very similar, these 2443 -- utilities are created. 2444 type Branch_Type is (Branch_Across, Branch_Through); 2445 2446 function Get_Branch_Type (Nat : Iir; Branch : Branch_Type) return Iir 2447 is 2448 Res : Iir; 2449 begin 2450 case Branch is 2451 when Branch_Across => 2452 Res := Get_Across_Type (Nat); 2453 when Branch_Through => 2454 Res := Get_Through_Type (Nat); 2455 end case; 2456 pragma Assert (Res /= Null_Iir); 2457 return Res; 2458 end Get_Branch_Type; 2459 2460 procedure Set_Branch_Type_Definition 2461 (Nat : Iir; Branch : Branch_Type; Def : Iir) is 2462 begin 2463 case Branch is 2464 when Branch_Across => 2465 Set_Across_Type_Definition (Nat, Def); 2466 Set_Across_Type (Nat, Def); 2467 when Branch_Through => 2468 Set_Through_Type_Definition (Nat, Def); 2469 Set_Through_Type (Nat, Def); 2470 end case; 2471 end Set_Branch_Type_Definition; 2472 2473 -- Analyze NAME as a nature name. Return NAME or an error node. 2474 function Sem_Nature_Mark (Name : Iir) return Iir 2475 is 2476 Nature_Mark : constant Iir := Sem_Denoting_Name (Name); 2477 Res : Iir; 2478 begin 2479 Res := Get_Named_Entity (Nature_Mark); 2480 if Is_Error (Res) then 2481 return Name; 2482 end if; 2483 Res := Get_Nature (Res); 2484 case Get_Kind (Res) is 2485 when Iir_Kind_Scalar_Nature_Definition 2486 | Iir_Kind_Array_Nature_Definition 2487 | Iir_Kind_Record_Nature_Definition 2488 | Iir_Kind_Array_Subnature_Definition => 2489 return Name; 2490 when others => 2491 Error_Class_Match (Nature_Mark, "nature"); 2492 raise Program_Error; -- TODO 2493 end case; 2494 end Sem_Nature_Mark; 2495 2496 function Sem_Array_Subnature_Definition (Def : Iir) return Iir 2497 is 2498 Nature_Mark : Iir; 2499 Parent_Def : Iir; 2500 Base_Nature : Iir; 2501 Index_Staticness : Iir_Staticness; 2502 begin 2503 Nature_Mark := Get_Subnature_Nature_Mark (Def); 2504 Nature_Mark := Sem_Nature_Mark (Nature_Mark); 2505 Set_Subnature_Nature_Mark (Def, Nature_Mark); 2506 2507 -- NATURE_MARK is a name of a nature or subnature declaration. 2508 -- Extract the nature definition. 2509 Parent_Def := Get_Nature_Definition (Get_Named_Entity (Nature_Mark)); 2510 Base_Nature := Get_Base_Nature (Parent_Def); 2511 Set_Base_Nature (Def, Base_Nature); 2512 2513 Sem_Array_Constraint_Indexes 2514 (Def, Parent_Def, Base_Nature, Index_Staticness); 2515 2516 -- Create subtypes. 2517 for I in Branch_Type loop 2518 declare 2519 Br_Def : constant Iir := Get_Branch_Type (Parent_Def, I); 2520 St_Def : Iir; 2521 begin 2522 St_Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); 2523 Location_Copy (St_Def, Def); 2524 Set_Index_Subtype_List (St_Def, Get_Index_Subtype_List (Def)); 2525 Set_Element_Subtype (St_Def, Get_Element_Subtype (Br_Def)); 2526 Set_Parent_Type (St_Def, Br_Def); 2527 Set_Type_Staticness (St_Def, Get_Nature_Staticness (Def)); 2528 Set_Constraint_State (St_Def, Get_Constraint_State (Def)); 2529 Set_Type_Declarator (St_Def, Get_Nature_Declarator (Def)); 2530 Set_Branch_Type_Definition (Def, I, St_Def); 2531 end; 2532 end loop; 2533 2534 return Def; 2535 end Sem_Array_Subnature_Definition; 2536 2537 function Sem_Subnature_Indication (Def: Iir) return Iir is 2538 begin 2539 -- LRM 4.8 Nature declatation 2540 -- 2541 -- If the subnature indication does not include a constraint, the 2542 -- subnature is the same as that denoted by the type mark. 2543 case Get_Kind (Def) is 2544 when Iir_Kind_Scalar_Nature_Definition => 2545 -- Used for reference declared by a nature 2546 return Def; 2547 when Iir_Kinds_Denoting_Name => 2548 return Sem_Nature_Mark (Def); 2549 when Iir_Kind_Array_Subnature_Definition => 2550 return Sem_Array_Subnature_Definition (Def); 2551 when others => 2552 Error_Kind ("sem_subnature_indication", Def); 2553 end case; 2554 end Sem_Subnature_Indication; 2555 2556 function Sem_Scalar_Nature_Definition (Def : Iir; Decl : Iir) return Iir 2557 is 2558 function Sem_Scalar_Nature_Typemark (T : Iir; Name : String) return Iir 2559 is 2560 Res : Iir; 2561 begin 2562 Res := Sem_Type_Mark (T); 2563 Res := Get_Type (Res); 2564 if Is_Error (Res) then 2565 return Real_Type_Definition; 2566 end if; 2567 -- LRM93 3.5.1 2568 -- The type marks must denote floating point types 2569 case Get_Kind (Res) is 2570 when Iir_Kind_Floating_Subtype_Definition 2571 | Iir_Kind_Floating_Type_Definition => 2572 return Res; 2573 when others => 2574 Error_Msg_Sem (+T, Name & "type must be a floating point type"); 2575 return Real_Type_Definition; 2576 end case; 2577 end Sem_Scalar_Nature_Typemark; 2578 2579 Tm : Iir; 2580 Ref : Iir; 2581 begin 2582 Tm := Get_Across_Type_Mark (Def); 2583 Tm := Sem_Scalar_Nature_Typemark (Tm, "across"); 2584 Set_Across_Type (Def, Tm); 2585 2586 Tm := Get_Through_Type_Mark (Def); 2587 Tm := Sem_Scalar_Nature_Typemark (Tm, "through"); 2588 Set_Through_Type (Def, Tm); 2589 2590 Set_Base_Nature (Def, Def); 2591 2592 -- AMS-LRM17 9.4.2 Locally static primaries 2593 -- A locally static scalar subnature is a scalar subnature. [...] 2594 -- A locally static subnature is either a locally static scalar 2595 -- subnature, [...] 2596 Set_Nature_Staticness (Def, Locally); 2597 2598 -- Declare the reference 2599 Ref := Get_Reference (Def); 2600 Set_Name_Staticness (Ref, Locally); 2601 Set_Nature (Ref, Def); 2602 Set_Chain (Ref, Get_Chain (Decl)); 2603 Set_Chain (Decl, Ref); 2604 2605 return Def; 2606 end Sem_Scalar_Nature_Definition; 2607 2608 function Sem_Unbounded_Array_Nature_Definition (Def : Iir; Decl : Iir) 2609 return Iir 2610 is 2611 El_Nat : Iir; 2612 Arr : Iir; 2613 begin 2614 El_Nat := Get_Element_Subnature_Indication (Def); 2615 El_Nat := Sem_Subnature_Indication (El_Nat); 2616 2617 if El_Nat /= Null_Iir then 2618 El_Nat := Get_Named_Entity (El_Nat); 2619 El_Nat := Get_Nature (El_Nat); 2620 Set_Element_Subnature (Def, El_Nat); 2621 2622 Set_Simple_Nature (Def, Get_Nature_Simple_Nature (El_Nat)); 2623 end if; 2624 2625 Set_Base_Nature (Def, Def); 2626 Sem_Unbounded_Array_Indexes (Def); 2627 2628 -- Create through/across type. 2629 for I in Branch_Type loop 2630 Arr := Create_Iir (Iir_Kind_Array_Type_Definition); 2631 Location_Copy (Arr, Def); 2632 Set_Index_Subtype_List (Arr, Get_Index_Subtype_List (Def)); 2633 Set_Type_Staticness (Arr, None); 2634 Set_Type_Declarator (Arr, Decl); 2635 Set_Element_Subtype (Arr, Get_Branch_Type (El_Nat, I)); 2636 Set_Branch_Type_Definition (Def, I, Arr); 2637 Set_Constraint_State (Arr, Get_Array_Constraint (Arr)); 2638 end loop; 2639 2640 return Def; 2641 end Sem_Unbounded_Array_Nature_Definition; 2642 2643 function Sem_Record_Nature_Definition (Def: Iir; Decl : Iir) return Iir 2644 is 2645 -- Analyzed nature of previous element 2646 Last_Nat : Iir; 2647 2648 El_List : constant Iir_Flist := Get_Elements_Declaration_List (Def); 2649 El : Iir; 2650 El_Nat : Iir; 2651 Nature_Staticness : Iir_Staticness; 2652 Constraint : Iir_Constraint; 2653 Composite_Found : Boolean; 2654 Simple_Nature : Iir; 2655 begin 2656 -- AMS-LRM17 12.1 Declarative region 2657 -- f) A record nature declaration 2658 Open_Declarative_Region; 2659 2660 Last_Nat := Null_Iir; 2661 Nature_Staticness := Locally; 2662 Constraint := Fully_Constrained; 2663 Composite_Found := False; 2664 Simple_Nature := Null_Iir; 2665 2666 for I in Flist_First .. Flist_Last (El_List) loop 2667 El := Get_Nth_Element (El_List, I); 2668 El_Nat := Get_Subnature_Indication (El); 2669 if El_Nat /= Null_Iir then 2670 -- Be careful for a declaration list 2671 El_Nat := Sem_Subnature_Indication (El_Nat); 2672 Set_Subnature_Indication (El, El_Nat); 2673 El_Nat := Get_Nature_Of_Subnature_Indication (El_Nat); 2674 Last_Nat := El_Nat; 2675 else 2676 El_Nat := Last_Nat; 2677 end if; 2678 if El_Nat /= Null_Iir then 2679 Set_Nature (El, El_Nat); 2680 2681 -- AMS-LRM17 5.8.3 Composite natures 2682 -- The scalar subelements of a composite nature shall all have 2683 -- the same simple nature, [...] 2684 if Simple_Nature = Null_Iir then 2685 Simple_Nature := Get_Nature_Simple_Nature (El_Nat); 2686 Set_Simple_Nature (Def, El_Nat); 2687 elsif Get_Nature_Simple_Nature (El_Nat) /= Simple_Nature then 2688 Error_Msg_Sem 2689 (+El, "elements must have the same simple nature"); 2690 end if; 2691 2692 -- LRM93 3.2.1.1 2693 -- The same requirement [must define a constrained array 2694 -- subtype] exits for the subtype indication of an 2695 -- element declaration, if the type of the record 2696 -- element is an array type. 2697 if Vhdl_Std < Vhdl_08 2698 and then not Is_Fully_Constrained_Type (El_Nat) 2699 then 2700 Error_Msg_Sem 2701 (+El, 2702 "element declaration of unconstrained %n is not allowed", 2703 +El_Nat); 2704 end if; 2705 Nature_Staticness := Min (Nature_Staticness, 2706 Get_Nature_Staticness (El_Nat)); 2707 Update_Record_Constraint (Constraint, Composite_Found, El_Nat); 2708 else 2709 Nature_Staticness := None; 2710 end if; 2711 Sem_Scopes.Add_Name (El); 2712 Name_Visible (El); 2713 Xref_Decl (El); 2714 end loop; 2715 Close_Declarative_Region; 2716 Set_Nature_Staticness (Def, Nature_Staticness); 2717 Set_Base_Nature (Def, Def); 2718 Set_Constraint_State (Def, Constraint); 2719 2720 -- AMS-LRM17 5.8.3.3 Record natures 2721 -- The across type defined by a record nature definition is equivalent 2722 -- to the type defined by a record type definition in which there is a 2723 -- matching element declaration for each nature element declaration. 2724 -- For each element declaration of the record type definition, the 2725 -- identifier list is the same as the identifier list of the matching 2726 -- nature element declaration, and the subtype indication of the 2727 -- element subtype definition is the across type defined by the nature 2728 -- of the subnature indication of the nature element declaration, 2729 -- together with the index constraint of the subnature indication of 2730 -- the nature element declaration. 2731 -- 2732 -- GHDL: likewise for through type. 2733 for I in Branch_Type loop 2734 declare 2735 St_Def : Iir; 2736 St_El : Iir; 2737 St_List : Iir_Flist; 2738 St_El_Type : Iir; 2739 Staticness : Iir_Staticness; 2740 begin 2741 St_Def := Create_Iir (Iir_Kind_Record_Type_Definition); 2742 Location_Copy (St_Def, Def); 2743 Set_Type_Declarator (St_Def, Decl); 2744 St_List := Create_Iir_Flist (Get_Nbr_Elements (El_List)); 2745 Set_Elements_Declaration_List (St_Def, St_List); 2746 Staticness := Locally; 2747 2748 for J in Flist_First .. Flist_Last (El_List) loop 2749 El := Get_Nth_Element (El_List, J); 2750 St_El := Create_Iir (Iir_Kind_Element_Declaration); 2751 Location_Copy (St_El, El); 2752 Set_Parent (St_El, St_Def); 2753 Set_Identifier (St_El, Get_Identifier (El)); 2754 -- No subtype indication, only a type. 2755 El_Nat := Get_Nature (El); 2756 St_El_Type := Get_Branch_Type (El_Nat, I); 2757 pragma Assert (St_El_Type /= Null_Iir); 2758 Set_Type (St_El, St_El_Type); 2759 Staticness := Min (Staticness, 2760 Get_Type_Staticness (St_El_Type)); 2761 Set_Element_Position (St_El, Get_Element_Position (El)); 2762 Set_Has_Identifier_List (St_El, Get_Has_Identifier_List (El)); 2763 Set_Nth_Element (St_List, J, St_El); 2764 end loop; 2765 Set_Type_Staticness (St_Def, Staticness); 2766 Set_Constraint_State (St_Def, Get_Constraint_State (Def)); 2767 Set_Branch_Type_Definition (Def, I, St_Def); 2768 end; 2769 end loop; 2770 2771 return Def; 2772 end Sem_Record_Nature_Definition; 2773 2774 function Sem_Nature_Definition (Def : Iir; Decl : Iir) return Iir is 2775 begin 2776 case Get_Kind (Def) is 2777 when Iir_Kind_Scalar_Nature_Definition => 2778 return Sem_Scalar_Nature_Definition (Def, Decl); 2779 when Iir_Kind_Array_Nature_Definition => 2780 return Sem_Unbounded_Array_Nature_Definition (Def, Decl); 2781 when Iir_Kind_Record_Nature_Definition => 2782 return Sem_Record_Nature_Definition (Def, Decl); 2783 when others => 2784 Error_Kind ("sem_nature_definition", Def); 2785 return Null_Iir; 2786 end case; 2787 end Sem_Nature_Definition; 2788 2789 function Is_Nature_Type (Dtype : Iir) return Boolean is 2790 begin 2791 case Get_Kind (Dtype) is 2792 when Iir_Kind_Error => 2793 return True; 2794 when Iir_Kind_Floating_Type_Definition 2795 | Iir_Kind_Floating_Subtype_Definition => 2796 return True; 2797 when Iir_Kind_Record_Subtype_Definition 2798 | Iir_Kind_Record_Type_Definition => 2799 declare 2800 Els : constant Iir_Flist := 2801 Get_Elements_Declaration_List (Dtype); 2802 El : Iir; 2803 begin 2804 for I in Flist_First .. Flist_Last (Els) loop 2805 El := Get_Nth_Element (Els, I); 2806 if not Is_Nature_Type (Get_Type (El)) then 2807 return False; 2808 end if; 2809 end loop; 2810 return True; 2811 end; 2812 when Iir_Kind_Array_Type_Definition 2813 | Iir_Kind_Array_Subtype_Definition => 2814 return Is_Nature_Type (Get_Element_Subtype (Dtype)); 2815 when Iir_Kind_Incomplete_Type_Definition 2816 | Iir_Kind_Interface_Type_Definition => 2817 return False; 2818 when Iir_Kind_File_Type_Definition 2819 | Iir_Kind_Protected_Type_Declaration 2820 | Iir_Kind_Access_Type_Definition 2821 | Iir_Kind_Access_Subtype_Definition 2822 | Iir_Kind_Integer_Subtype_Definition 2823 | Iir_Kind_Integer_Type_Definition 2824 | Iir_Kind_Physical_Type_Definition 2825 | Iir_Kind_Physical_Subtype_Definition 2826 | Iir_Kind_Enumeration_Subtype_Definition 2827 | Iir_Kind_Enumeration_Type_Definition => 2828 return False; 2829 when others => 2830 Error_Kind ("is_nature_type", Dtype); 2831 end case; 2832 end Is_Nature_Type; 2833 2834 function Get_Nature_Simple_Nature (Nat : Iir) return Iir is 2835 begin 2836 case Iir_Kinds_Nature_Indication (Get_Kind (Nat)) is 2837 when Iir_Kind_Scalar_Nature_Definition => 2838 return Nat; 2839 when Iir_Kind_Array_Nature_Definition 2840 | Iir_Kind_Record_Nature_Definition => 2841 return Get_Simple_Nature (Nat); 2842 when Iir_Kind_Array_Subnature_Definition => 2843 return Get_Simple_Nature (Get_Base_Nature (Nat)); 2844 end case; 2845 end Get_Nature_Simple_Nature; 2846 2847 function Is_Composite_Nature (Nat : Iir) return Boolean is 2848 begin 2849 case Iir_Kinds_Nature_Indication (Get_Kind (Nat)) is 2850 when Iir_Kind_Scalar_Nature_Definition => 2851 return False; 2852 when Iir_Kind_Array_Nature_Definition 2853 | Iir_Kind_Record_Nature_Definition 2854 | Iir_Kind_Array_Subnature_Definition => 2855 return True; 2856 end case; 2857 end Is_Composite_Nature; 2858end Vhdl.Sem_Types; 2859