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