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