1 //===-- lib/Semantics/type.cpp --------------------------------------------===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #include "flang/Semantics/type.h" 10 #include "flang/Evaluate/fold.h" 11 #include "flang/Parser/characters.h" 12 #include "flang/Semantics/scope.h" 13 #include "flang/Semantics/symbol.h" 14 #include "flang/Semantics/tools.h" 15 #include "llvm/Support/raw_ostream.h" 16 17 namespace Fortran::semantics { 18 19 DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol) 20 : name_{name}, typeSymbol_{typeSymbol} { 21 CHECK(typeSymbol.has<DerivedTypeDetails>()); 22 } 23 DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default; 24 DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default; 25 26 void DerivedTypeSpec::set_scope(const Scope &scope) { 27 CHECK(!scope_); 28 ReplaceScope(scope); 29 } 30 void DerivedTypeSpec::ReplaceScope(const Scope &scope) { 31 CHECK(scope.IsDerivedType()); 32 scope_ = &scope; 33 } 34 35 void DerivedTypeSpec::AddRawParamValue( 36 const std::optional<parser::Keyword> &keyword, ParamValue &&value) { 37 CHECK(parameters_.empty()); 38 rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value)); 39 } 40 41 void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) { 42 if (cooked_) { 43 return; 44 } 45 cooked_ = true; 46 auto &messages{foldingContext.messages()}; 47 if (IsForwardReferenced()) { 48 messages.Say(typeSymbol_.name(), 49 "Derived type '%s' was used but never defined"_err_en_US, 50 typeSymbol_.name()); 51 return; 52 } 53 54 // Parameters of the most deeply nested "base class" come first when the 55 // derived type is an extension. 56 auto parameterNames{OrderParameterNames(typeSymbol_)}; 57 auto parameterDecls{OrderParameterDeclarations(typeSymbol_)}; 58 auto nextNameIter{parameterNames.begin()}; 59 RawParameters raw{std::move(rawParameters_)}; 60 for (auto &[maybeKeyword, value] : raw) { 61 SourceName name; 62 common::TypeParamAttr attr{common::TypeParamAttr::Kind}; 63 if (maybeKeyword) { 64 name = maybeKeyword->v.source; 65 auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(), 66 [&](const Symbol &symbol) { return symbol.name() == name; })}; 67 if (it == parameterDecls.end()) { 68 messages.Say(name, 69 "'%s' is not the name of a parameter for derived type '%s'"_err_en_US, 70 name, typeSymbol_.name()); 71 } else { 72 // Resolve the keyword's symbol 73 maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get()); 74 attr = it->get().get<TypeParamDetails>().attr(); 75 } 76 } else if (nextNameIter != parameterNames.end()) { 77 name = *nextNameIter++; 78 auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(), 79 [&](const Symbol &symbol) { return symbol.name() == name; })}; 80 if (it == parameterDecls.end()) { 81 break; 82 } 83 attr = it->get().get<TypeParamDetails>().attr(); 84 } else { 85 messages.Say(name_, 86 "Too many type parameters given for derived type '%s'"_err_en_US, 87 typeSymbol_.name()); 88 break; 89 } 90 if (FindParameter(name)) { 91 messages.Say(name_, 92 "Multiple values given for type parameter '%s'"_err_en_US, name); 93 } else { 94 value.set_attr(attr); 95 AddParamValue(name, std::move(value)); 96 } 97 } 98 } 99 100 void DerivedTypeSpec::EvaluateParameters( 101 evaluate::FoldingContext &foldingContext) { 102 CookParameters(foldingContext); 103 if (evaluated_) { 104 return; 105 } 106 evaluated_ = true; 107 auto &messages{foldingContext.messages()}; 108 109 // Fold the explicit type parameter value expressions first. Do not 110 // fold them within the scope of the derived type being instantiated; 111 // these expressions cannot use its type parameters. Convert the values 112 // of the expressions to the declared types of the type parameters. 113 auto parameterDecls{OrderParameterDeclarations(typeSymbol_)}; 114 for (const Symbol &symbol : parameterDecls) { 115 const SourceName &name{symbol.name()}; 116 if (ParamValue * paramValue{FindParameter(name)}) { 117 if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) { 118 if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) { 119 SomeExpr folded{ 120 evaluate::Fold(foldingContext, std::move(*converted))}; 121 if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) { 122 paramValue->SetExplicit(std::move(*intExpr)); 123 continue; 124 } 125 } 126 if (!symbol.test(Symbol::Flag::Error)) { 127 evaluate::SayWithDeclaration(messages, symbol, 128 "Value of type parameter '%s' (%s) is not convertible to its" 129 " type"_err_en_US, 130 name, expr->AsFortran()); 131 } 132 } 133 } 134 } 135 136 // Default initialization expressions for the derived type's parameters 137 // may reference other parameters so long as the declaration precedes the 138 // use in the expression (10.1.12). This is not necessarily the same 139 // order as "type parameter order" (7.5.3.2). 140 // Type parameter default value expressions are folded in declaration order 141 // within the scope of the derived type so that the values of earlier type 142 // parameters are available for use in the default initialization 143 // expressions of later parameters. 144 auto restorer{foldingContext.WithPDTInstance(*this)}; 145 for (const Symbol &symbol : parameterDecls) { 146 const SourceName &name{symbol.name()}; 147 if (!FindParameter(name)) { 148 const TypeParamDetails &details{symbol.get<TypeParamDetails>()}; 149 if (details.init()) { 150 auto expr{ 151 evaluate::Fold(foldingContext, common::Clone(details.init()))}; 152 AddParamValue(name, ParamValue{std::move(*expr), details.attr()}); 153 } else if (!symbol.test(Symbol::Flag::Error)) { 154 messages.Say(name_, 155 "Type parameter '%s' lacks a value and has no default"_err_en_US, 156 name); 157 } 158 } 159 } 160 } 161 162 void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) { 163 CHECK(cooked_); 164 auto pair{parameters_.insert(std::make_pair(name, std::move(value)))}; 165 CHECK(pair.second); // name was not already present 166 } 167 168 int DerivedTypeSpec::NumLengthParameters() const { 169 int result{0}; 170 for (const auto &pair : parameters_) { 171 if (pair.second.isLen()) { 172 ++result; 173 } 174 } 175 return result; 176 } 177 178 bool DerivedTypeSpec::MightBeParameterized() const { 179 return !cooked_ || !parameters_.empty(); 180 } 181 182 bool DerivedTypeSpec::IsForwardReferenced() const { 183 return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced(); 184 } 185 186 bool DerivedTypeSpec::HasDefaultInitialization() const { 187 for (const Scope *scope{scope_}; scope; 188 scope = scope->GetDerivedTypeParent()) { 189 for (const auto &pair : *scope) { 190 const Symbol &symbol{*pair.second}; 191 if (IsAllocatable(symbol) || IsInitialized(symbol)) { 192 return true; 193 } 194 } 195 } 196 return false; 197 } 198 199 ParamValue *DerivedTypeSpec::FindParameter(SourceName target) { 200 return const_cast<ParamValue *>( 201 const_cast<const DerivedTypeSpec *>(this)->FindParameter(target)); 202 } 203 204 class InstantiateHelper { 205 public: 206 InstantiateHelper(SemanticsContext &context, Scope &scope) 207 : context_{context}, scope_{scope} {} 208 // Instantiate components from fromScope into scope_ 209 void InstantiateComponents(const Scope &); 210 211 private: 212 evaluate::FoldingContext &foldingContext() { 213 return context_.foldingContext(); 214 } 215 template <typename T> T Fold(T &&expr) { 216 return evaluate::Fold(foldingContext(), std::move(expr)); 217 } 218 void InstantiateComponent(const Symbol &); 219 const DeclTypeSpec *InstantiateType(const Symbol &); 220 const DeclTypeSpec &InstantiateIntrinsicType(const DeclTypeSpec &); 221 DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool); 222 223 SemanticsContext &context_; 224 Scope &scope_; 225 }; 226 227 void DerivedTypeSpec::Instantiate( 228 Scope &containingScope, SemanticsContext &context) { 229 if (instantiated_) { 230 return; 231 } 232 instantiated_ = true; 233 auto &foldingContext{context.foldingContext()}; 234 if (IsForwardReferenced()) { 235 foldingContext.messages().Say(typeSymbol_.name(), 236 "The derived type '%s' was forward-referenced but not defined"_err_en_US, 237 typeSymbol_.name()); 238 return; 239 } 240 CookParameters(foldingContext); 241 EvaluateParameters(foldingContext); 242 const Scope &typeScope{DEREF(typeSymbol_.scope())}; 243 if (!MightBeParameterized()) { 244 scope_ = &typeScope; 245 for (auto &pair : typeScope) { 246 Symbol &symbol{*pair.second}; 247 if (DeclTypeSpec * type{symbol.GetType()}) { 248 if (DerivedTypeSpec * derived{type->AsDerived()}) { 249 if (!(derived->IsForwardReferenced() && 250 IsAllocatableOrPointer(symbol))) { 251 derived->Instantiate(containingScope, context); 252 } 253 } 254 } 255 } 256 return; 257 } 258 Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; 259 newScope.set_derivedTypeSpec(*this); 260 ReplaceScope(newScope); 261 for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) { 262 const SourceName &name{symbol.name()}; 263 if (typeScope.find(symbol.name()) != typeScope.end()) { 264 // This type parameter belongs to the derived type itself, not to 265 // one of its ancestors. Put the type parameter expression value 266 // into the new scope as the initialization value for the parameter. 267 if (ParamValue * paramValue{FindParameter(name)}) { 268 const TypeParamDetails &details{symbol.get<TypeParamDetails>()}; 269 paramValue->set_attr(details.attr()); 270 if (MaybeIntExpr expr{paramValue->GetExplicit()}) { 271 // Ensure that any kind type parameters with values are 272 // constant by now. 273 if (details.attr() == common::TypeParamAttr::Kind) { 274 // Any errors in rank and type will have already elicited 275 // messages, so don't pile on by complaining further here. 276 if (auto maybeDynamicType{expr->GetType()}) { 277 if (expr->Rank() == 0 && 278 maybeDynamicType->category() == TypeCategory::Integer) { 279 if (!evaluate::ToInt64(*expr)) { 280 if (auto *msg{foldingContext.messages().Say( 281 "Value of kind type parameter '%s' (%s) is not " 282 "a scalar INTEGER constant"_err_en_US, 283 name, expr->AsFortran())}) { 284 msg->Attach(name, "declared here"_en_US); 285 } 286 } 287 } 288 } 289 } 290 TypeParamDetails instanceDetails{details.attr()}; 291 if (const DeclTypeSpec * type{details.type()}) { 292 instanceDetails.set_type(*type); 293 } 294 instanceDetails.set_init(std::move(*expr)); 295 newScope.try_emplace(name, std::move(instanceDetails)); 296 } 297 } 298 } 299 } 300 // Instantiate every non-parameter symbol from the original derived 301 // type's scope into the new instance. 302 auto restorer{foldingContext.WithPDTInstance(*this)}; 303 newScope.AddSourceRange(typeScope.sourceRange()); 304 InstantiateHelper{context, newScope}.InstantiateComponents(typeScope); 305 } 306 307 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) { 308 for (const auto &pair : fromScope) { 309 InstantiateComponent(*pair.second); 310 } 311 } 312 313 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) { 314 auto pair{scope_.try_emplace( 315 oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))}; 316 Symbol &newSymbol{*pair.first->second}; 317 if (!pair.second) { 318 // Symbol was already present in the scope, which can only happen 319 // in the case of type parameters. 320 CHECK(oldSymbol.has<TypeParamDetails>()); 321 return; 322 } 323 newSymbol.flags() = oldSymbol.flags(); 324 if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) { 325 if (const DeclTypeSpec * newType{InstantiateType(newSymbol)}) { 326 details->ReplaceType(*newType); 327 } 328 details->set_init(Fold(std::move(details->init()))); 329 for (ShapeSpec &dim : details->shape()) { 330 if (dim.lbound().isExplicit()) { 331 dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit()))); 332 } 333 if (dim.ubound().isExplicit()) { 334 dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit()))); 335 } 336 } 337 for (ShapeSpec &dim : details->coshape()) { 338 if (dim.lbound().isExplicit()) { 339 dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit()))); 340 } 341 if (dim.ubound().isExplicit()) { 342 dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit()))); 343 } 344 } 345 } 346 } 347 348 const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) { 349 const DeclTypeSpec *type{symbol.GetType()}; 350 if (!type) { 351 return nullptr; // error has occurred 352 } else if (const DerivedTypeSpec * spec{type->AsDerived()}) { 353 return &FindOrInstantiateDerivedType(scope_, 354 CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)), 355 context_, type->category()); 356 } else if (type->AsIntrinsic()) { 357 return &InstantiateIntrinsicType(*type); 358 } else if (type->category() == DeclTypeSpec::ClassStar) { 359 return type; 360 } else { 361 common::die("InstantiateType: %s", type->AsFortran().c_str()); 362 } 363 } 364 365 // Apply type parameter values to an intrinsic type spec. 366 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( 367 const DeclTypeSpec &spec) { 368 const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())}; 369 if (evaluate::ToInt64(intrinsic.kind())) { 370 return spec; // KIND is already a known constant 371 } 372 // The expression was not originally constant, but now it must be so 373 // in the context of a parameterized derived type instantiation. 374 KindExpr copy{Fold(common::Clone(intrinsic.kind()))}; 375 int kind{context_.GetDefaultKind(intrinsic.category())}; 376 if (auto value{evaluate::ToInt64(copy)}) { 377 if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) { 378 kind = *value; 379 } else { 380 foldingContext().messages().Say( 381 "KIND parameter value (%jd) of intrinsic type %s " 382 "did not resolve to a supported value"_err_en_US, 383 *value, 384 parser::ToUpperCaseLetters(EnumToString(intrinsic.category()))); 385 } 386 } 387 switch (spec.category()) { 388 case DeclTypeSpec::Numeric: 389 return scope_.MakeNumericType(intrinsic.category(), KindExpr{kind}); 390 case DeclTypeSpec::Logical: 391 return scope_.MakeLogicalType(KindExpr{kind}); 392 case DeclTypeSpec::Character: 393 return scope_.MakeCharacterType( 394 ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind}); 395 default: 396 CRASH_NO_CASE; 397 } 398 } 399 400 DerivedTypeSpec InstantiateHelper::CreateDerivedTypeSpec( 401 const DerivedTypeSpec &spec, bool isParentComp) { 402 DerivedTypeSpec result{spec}; 403 result.CookParameters(foldingContext()); // enables AddParamValue() 404 if (isParentComp) { 405 // Forward any explicit type parameter values from the 406 // derived type spec under instantiation that define type parameters 407 // of the parent component to the derived type spec of the 408 // parent component. 409 const DerivedTypeSpec &instanceSpec{DEREF(foldingContext().pdtInstance())}; 410 for (const auto &[name, value] : instanceSpec.parameters()) { 411 if (scope_.find(name) == scope_.end()) { 412 result.AddParamValue(name, ParamValue{value}); 413 } 414 } 415 } 416 return result; 417 } 418 419 std::string DerivedTypeSpec::AsFortran() const { 420 std::string buf; 421 llvm::raw_string_ostream ss{buf}; 422 ss << name_; 423 if (!rawParameters_.empty()) { 424 CHECK(parameters_.empty()); 425 ss << '('; 426 bool first = true; 427 for (const auto &[maybeKeyword, value] : rawParameters_) { 428 if (first) { 429 first = false; 430 } else { 431 ss << ','; 432 } 433 if (maybeKeyword) { 434 ss << maybeKeyword->v.source.ToString() << '='; 435 } 436 ss << value.AsFortran(); 437 } 438 ss << ')'; 439 } else if (!parameters_.empty()) { 440 ss << '('; 441 bool first = true; 442 for (const auto &[name, value] : parameters_) { 443 if (first) { 444 first = false; 445 } else { 446 ss << ','; 447 } 448 ss << name.ToString() << '=' << value.AsFortran(); 449 } 450 ss << ')'; 451 } 452 return ss.str(); 453 } 454 455 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DerivedTypeSpec &x) { 456 return o << x.AsFortran(); 457 } 458 459 Bound::Bound(int bound) : expr_{bound} {} 460 461 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const Bound &x) { 462 if (x.isAssumed()) { 463 o << '*'; 464 } else if (x.isDeferred()) { 465 o << ':'; 466 } else if (x.expr_) { 467 x.expr_->AsFortran(o); 468 } else { 469 o << "<no-expr>"; 470 } 471 return o; 472 } 473 474 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ShapeSpec &x) { 475 if (x.lb_.isAssumed()) { 476 CHECK(x.ub_.isAssumed()); 477 o << ".."; 478 } else { 479 if (!x.lb_.isDeferred()) { 480 o << x.lb_; 481 } 482 o << ':'; 483 if (!x.ub_.isDeferred()) { 484 o << x.ub_; 485 } 486 } 487 return o; 488 } 489 490 bool ArraySpec::IsExplicitShape() const { 491 return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); }); 492 } 493 bool ArraySpec::IsAssumedShape() const { 494 return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); }); 495 } 496 bool ArraySpec::IsDeferredShape() const { 497 return CheckAll([](const ShapeSpec &x) { 498 return x.lbound().isDeferred() && x.ubound().isDeferred(); 499 }); 500 } 501 bool ArraySpec::IsImpliedShape() const { 502 return !IsAssumedRank() && 503 CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); 504 } 505 bool ArraySpec::IsAssumedSize() const { 506 return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && 507 std::all_of(begin(), end() - 1, 508 [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); 509 } 510 bool ArraySpec::IsAssumedRank() const { 511 return Rank() == 1 && front().lbound().isAssumed(); 512 } 513 bool ArraySpec::IsConstantShape() const { 514 return CheckAll([](const ShapeSpec &x) { 515 const auto &lb{x.lbound().GetExplicit()}; 516 const auto &ub{x.ubound().GetExplicit()}; 517 return lb && ub && IsConstantExpr(*lb) && IsConstantExpr(*ub); 518 }); 519 } 520 521 llvm::raw_ostream &operator<<( 522 llvm::raw_ostream &os, const ArraySpec &arraySpec) { 523 char sep{'('}; 524 for (auto &shape : arraySpec) { 525 os << sep << shape; 526 sep = ','; 527 } 528 if (sep == ',') { 529 os << ')'; 530 } 531 return os; 532 } 533 534 ParamValue::ParamValue(MaybeIntExpr &&expr, common::TypeParamAttr attr) 535 : attr_{attr}, expr_{std::move(expr)} {} 536 ParamValue::ParamValue(SomeIntExpr &&expr, common::TypeParamAttr attr) 537 : attr_{attr}, expr_{std::move(expr)} {} 538 ParamValue::ParamValue( 539 common::ConstantSubscript value, common::TypeParamAttr attr) 540 : ParamValue(SomeIntExpr{evaluate::Expr<evaluate::SubscriptInteger>{value}}, 541 attr) {} 542 543 void ParamValue::SetExplicit(SomeIntExpr &&x) { 544 category_ = Category::Explicit; 545 expr_ = std::move(x); 546 } 547 548 std::string ParamValue::AsFortran() const { 549 switch (category_) { 550 SWITCH_COVERS_ALL_CASES 551 case Category::Assumed: 552 return "*"; 553 case Category::Deferred: 554 return ":"; 555 case Category::Explicit: 556 if (expr_) { 557 std::string buf; 558 llvm::raw_string_ostream ss{buf}; 559 expr_->AsFortran(ss); 560 return ss.str(); 561 } else { 562 return ""; 563 } 564 } 565 } 566 567 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const ParamValue &x) { 568 return o << x.AsFortran(); 569 } 570 571 IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, KindExpr &&kind) 572 : category_{category}, kind_{std::move(kind)} { 573 CHECK(category != TypeCategory::Derived); 574 } 575 576 static std::string KindAsFortran(const KindExpr &kind) { 577 std::string buf; 578 llvm::raw_string_ostream ss{buf}; 579 if (auto k{evaluate::ToInt64(kind)}) { 580 ss << *k; // emit unsuffixed kind code 581 } else { 582 kind.AsFortran(ss); 583 } 584 return ss.str(); 585 } 586 587 std::string IntrinsicTypeSpec::AsFortran() const { 588 return parser::ToUpperCaseLetters(common::EnumToString(category_)) + '(' + 589 KindAsFortran(kind_) + ')'; 590 } 591 592 llvm::raw_ostream &operator<<( 593 llvm::raw_ostream &os, const IntrinsicTypeSpec &x) { 594 return os << x.AsFortran(); 595 } 596 597 std::string CharacterTypeSpec::AsFortran() const { 598 return "CHARACTER(" + length_.AsFortran() + ',' + KindAsFortran(kind()) + ')'; 599 } 600 601 llvm::raw_ostream &operator<<( 602 llvm::raw_ostream &os, const CharacterTypeSpec &x) { 603 return os << x.AsFortran(); 604 } 605 606 DeclTypeSpec::DeclTypeSpec(NumericTypeSpec &&typeSpec) 607 : category_{Numeric}, typeSpec_{std::move(typeSpec)} {} 608 DeclTypeSpec::DeclTypeSpec(LogicalTypeSpec &&typeSpec) 609 : category_{Logical}, typeSpec_{std::move(typeSpec)} {} 610 DeclTypeSpec::DeclTypeSpec(const CharacterTypeSpec &typeSpec) 611 : category_{Character}, typeSpec_{typeSpec} {} 612 DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &&typeSpec) 613 : category_{Character}, typeSpec_{std::move(typeSpec)} {} 614 DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec) 615 : category_{category}, typeSpec_{typeSpec} { 616 CHECK(category == TypeDerived || category == ClassDerived); 617 } 618 DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &&typeSpec) 619 : category_{category}, typeSpec_{std::move(typeSpec)} { 620 CHECK(category == TypeDerived || category == ClassDerived); 621 } 622 DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} { 623 CHECK(category == TypeStar || category == ClassStar); 624 } 625 bool DeclTypeSpec::IsNumeric(TypeCategory tc) const { 626 return category_ == Numeric && numericTypeSpec().category() == tc; 627 } 628 bool DeclTypeSpec::IsSequenceType() const { 629 if (const DerivedTypeSpec * derivedType{AsDerived()}) { 630 const auto *typeDetails{ 631 derivedType->typeSymbol().detailsIf<DerivedTypeDetails>()}; 632 return typeDetails && typeDetails->sequence(); 633 } 634 return false; 635 } 636 637 IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() { 638 switch (category_) { 639 case Numeric: 640 return &std::get<NumericTypeSpec>(typeSpec_); 641 case Logical: 642 return &std::get<LogicalTypeSpec>(typeSpec_); 643 case Character: 644 return &std::get<CharacterTypeSpec>(typeSpec_); 645 default: 646 return nullptr; 647 } 648 } 649 const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const { 650 return const_cast<DeclTypeSpec *>(this)->AsIntrinsic(); 651 } 652 653 DerivedTypeSpec *DeclTypeSpec::AsDerived() { 654 switch (category_) { 655 case TypeDerived: 656 case ClassDerived: 657 return &std::get<DerivedTypeSpec>(typeSpec_); 658 default: 659 return nullptr; 660 } 661 } 662 const DerivedTypeSpec *DeclTypeSpec::AsDerived() const { 663 return const_cast<DeclTypeSpec *>(this)->AsDerived(); 664 } 665 666 const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const { 667 CHECK(category_ == Numeric); 668 return std::get<NumericTypeSpec>(typeSpec_); 669 } 670 const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const { 671 CHECK(category_ == Logical); 672 return std::get<LogicalTypeSpec>(typeSpec_); 673 } 674 bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const { 675 return category_ == that.category_ && typeSpec_ == that.typeSpec_; 676 } 677 678 std::string DeclTypeSpec::AsFortran() const { 679 switch (category_) { 680 SWITCH_COVERS_ALL_CASES 681 case Numeric: 682 return numericTypeSpec().AsFortran(); 683 case Logical: 684 return logicalTypeSpec().AsFortran(); 685 case Character: 686 return characterTypeSpec().AsFortran(); 687 case TypeDerived: 688 return "TYPE(" + derivedTypeSpec().AsFortran() + ')'; 689 case ClassDerived: 690 return "CLASS(" + derivedTypeSpec().AsFortran() + ')'; 691 case TypeStar: 692 return "TYPE(*)"; 693 case ClassStar: 694 return "CLASS(*)"; 695 } 696 } 697 698 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) { 699 return o << x.AsFortran(); 700 } 701 702 void ProcInterface::set_symbol(const Symbol &symbol) { 703 CHECK(!type_); 704 symbol_ = &symbol; 705 } 706 void ProcInterface::set_type(const DeclTypeSpec &type) { 707 CHECK(!symbol_); 708 type_ = &type; 709 } 710 } // namespace Fortran::semantics 711