1 //===-- lib/Evaluate/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/Evaluate/type.h" 10 #include "flang/Common/idioms.h" 11 #include "flang/Evaluate/expression.h" 12 #include "flang/Evaluate/fold.h" 13 #include "flang/Evaluate/target.h" 14 #include "flang/Parser/characters.h" 15 #include "flang/Semantics/scope.h" 16 #include "flang/Semantics/symbol.h" 17 #include "flang/Semantics/tools.h" 18 #include "flang/Semantics/type.h" 19 #include <algorithm> 20 #include <optional> 21 #include <string> 22 23 // IsDescriptor() predicate: true when a symbol is implemented 24 // at runtime with a descriptor. 25 namespace Fortran::semantics { 26 27 static bool IsDescriptor(const DeclTypeSpec *type) { 28 if (type) { 29 if (auto dynamicType{evaluate::DynamicType::From(*type)}) { 30 return dynamicType->RequiresDescriptor(); 31 } 32 } 33 return false; 34 } 35 36 static bool IsDescriptor(const ObjectEntityDetails &details) { 37 if (IsDescriptor(details.type())) { 38 return true; 39 } 40 for (const ShapeSpec &shapeSpec : details.shape()) { 41 const auto &lb{shapeSpec.lbound().GetExplicit()}; 42 const auto &ub{shapeSpec.ubound().GetExplicit()}; 43 if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) { 44 return true; 45 } 46 } 47 return false; 48 } 49 50 static bool IsDescriptor(const ProcEntityDetails &details) { 51 // A procedure pointer or dummy procedure must be & is a descriptor if 52 // and only if it requires a static link. 53 // TODO: refine this placeholder 54 return details.HasExplicitInterface(); 55 } 56 57 bool IsDescriptor(const Symbol &symbol) { 58 return common::visit( 59 common::visitors{ 60 [&](const ObjectEntityDetails &d) { 61 return IsAllocatableOrPointer(symbol) || IsDescriptor(d); 62 }, 63 [&](const ProcEntityDetails &d) { 64 return (symbol.attrs().test(Attr::POINTER) || 65 symbol.attrs().test(Attr::EXTERNAL)) && 66 IsDescriptor(d); 67 }, 68 [&](const EntityDetails &d) { return IsDescriptor(d.type()); }, 69 [](const AssocEntityDetails &d) { 70 if (const auto &expr{d.expr()}) { 71 if (expr->Rank() > 0) { 72 return true; 73 } 74 if (const auto dynamicType{expr->GetType()}) { 75 if (dynamicType->RequiresDescriptor()) { 76 return true; 77 } 78 } 79 } 80 return false; 81 }, 82 [](const SubprogramDetails &d) { 83 return d.isFunction() && IsDescriptor(d.result()); 84 }, 85 [](const UseDetails &d) { return IsDescriptor(d.symbol()); }, 86 [](const HostAssocDetails &d) { return IsDescriptor(d.symbol()); }, 87 [](const auto &) { return false; }, 88 }, 89 symbol.details()); 90 } 91 } // namespace Fortran::semantics 92 93 namespace Fortran::evaluate { 94 95 DynamicType::DynamicType(int k, const semantics::ParamValue &pv) 96 : category_{TypeCategory::Character}, kind_{k} { 97 CHECK(IsValidKindOfIntrinsicType(category_, kind_)); 98 if (auto n{ToInt64(pv.GetExplicit())}) { 99 knownLength_ = *n > 0 ? *n : 0; 100 } else { 101 charLengthParamValue_ = &pv; 102 } 103 } 104 105 template <typename A> inline bool PointeeComparison(const A *x, const A *y) { 106 return x == y || (x && y && *x == *y); 107 } 108 109 bool DynamicType::operator==(const DynamicType &that) const { 110 return category_ == that.category_ && kind_ == that.kind_ && 111 PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) && 112 knownLength().has_value() == that.knownLength().has_value() && 113 (!knownLength() || *knownLength() == *that.knownLength()) && 114 PointeeComparison(derived_, that.derived_); 115 } 116 117 std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const { 118 if (category_ == TypeCategory::Character) { 119 if (knownLength()) { 120 return AsExpr(Constant<SubscriptInteger>(*knownLength())); 121 } else if (charLengthParamValue_) { 122 if (auto length{charLengthParamValue_->GetExplicit()}) { 123 return ConvertToType<SubscriptInteger>(std::move(*length)); 124 } 125 } 126 } 127 return std::nullopt; 128 } 129 130 std::size_t DynamicType::GetAlignment( 131 const TargetCharacteristics &targetCharacteristics) const { 132 if (category_ == TypeCategory::Derived) { 133 if (derived_ && derived_->scope()) { 134 return derived_->scope()->alignment().value_or(1); 135 } 136 } else { 137 return targetCharacteristics.GetAlignment(category_, kind_); 138 } 139 return 1; // needs to be after switch to dodge a bogus gcc warning 140 } 141 142 std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes( 143 FoldingContext &context, bool aligned, 144 std::optional<std::int64_t> charLength) const { 145 switch (category_) { 146 case TypeCategory::Integer: 147 case TypeCategory::Real: 148 case TypeCategory::Complex: 149 case TypeCategory::Logical: 150 return Expr<SubscriptInteger>{ 151 context.targetCharacteristics().GetByteSize(category_, kind_)}; 152 case TypeCategory::Character: 153 if (auto len{charLength ? Expr<SubscriptInteger>{Constant<SubscriptInteger>{ 154 *charLength}} 155 : GetCharLength()}) { 156 return Fold(context, 157 Expr<SubscriptInteger>{ 158 context.targetCharacteristics().GetByteSize(category_, kind_)} * 159 std::move(*len)); 160 } 161 break; 162 case TypeCategory::Derived: 163 if (!IsPolymorphic() && derived_ && derived_->scope()) { 164 auto size{derived_->scope()->size()}; 165 auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0}; 166 auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size}; 167 return Expr<SubscriptInteger>{ 168 static_cast<ConstantSubscript>(alignedSize)}; 169 } 170 break; 171 } 172 return std::nullopt; 173 } 174 175 bool DynamicType::IsAssumedLengthCharacter() const { 176 return category_ == TypeCategory::Character && charLengthParamValue_ && 177 charLengthParamValue_->isAssumed(); 178 } 179 180 bool DynamicType::IsNonConstantLengthCharacter() const { 181 if (category_ != TypeCategory::Character) { 182 return false; 183 } else if (knownLength()) { 184 return false; 185 } else if (!charLengthParamValue_) { 186 return true; 187 } else if (const auto &expr{charLengthParamValue_->GetExplicit()}) { 188 return !IsConstantExpr(*expr); 189 } else { 190 return true; 191 } 192 } 193 194 bool DynamicType::IsTypelessIntrinsicArgument() const { 195 return category_ == TypeCategory::Integer && kind_ == TypelessKind; 196 } 197 198 const semantics::DerivedTypeSpec *GetDerivedTypeSpec( 199 const std::optional<DynamicType> &type) { 200 return type ? GetDerivedTypeSpec(*type) : nullptr; 201 } 202 203 const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &type) { 204 if (type.category() == TypeCategory::Derived && 205 !type.IsUnlimitedPolymorphic()) { 206 return &type.GetDerivedTypeSpec(); 207 } else { 208 return nullptr; 209 } 210 } 211 212 static const semantics::Symbol *FindParentComponent( 213 const semantics::DerivedTypeSpec &derived) { 214 const semantics::Symbol &typeSymbol{derived.typeSymbol()}; 215 const semantics::Scope *scope{derived.scope()}; 216 if (!scope) { 217 scope = typeSymbol.scope(); 218 } 219 if (scope) { 220 const auto &dtDetails{typeSymbol.get<semantics::DerivedTypeDetails>()}; 221 // TODO: Combine with semantics::DerivedTypeDetails::GetParentComponent 222 if (auto extends{dtDetails.GetParentComponentName()}) { 223 if (auto iter{scope->find(*extends)}; iter != scope->cend()) { 224 if (const semantics::Symbol & symbol{*iter->second}; 225 symbol.test(semantics::Symbol::Flag::ParentComp)) { 226 return &symbol; 227 } 228 } 229 } 230 } 231 return nullptr; 232 } 233 234 const semantics::DerivedTypeSpec *GetParentTypeSpec( 235 const semantics::DerivedTypeSpec &derived) { 236 if (const semantics::Symbol * parent{FindParentComponent(derived)}) { 237 return &parent->get<semantics::ObjectEntityDetails>() 238 .type() 239 ->derivedTypeSpec(); 240 } else { 241 return nullptr; 242 } 243 } 244 245 // Compares two derived type representations to see whether they both 246 // represent the "same type" in the sense of section 7.5.2.4. 247 using SetOfDerivedTypePairs = 248 std::set<std::pair<const semantics::DerivedTypeSpec *, 249 const semantics::DerivedTypeSpec *>>; 250 251 static bool AreSameComponent(const semantics::Symbol &x, 252 const semantics::Symbol &y, 253 SetOfDerivedTypePairs & /* inProgress - not yet used */) { 254 if (x.attrs() != y.attrs()) { 255 return false; 256 } 257 if (x.attrs().test(semantics::Attr::PRIVATE)) { 258 return false; 259 } 260 // TODO: compare types, parameters, bounds, &c. 261 return x.has<semantics::ObjectEntityDetails>() == 262 y.has<semantics::ObjectEntityDetails>(); 263 } 264 265 // TODO: These utilities were cloned out of Semantics to avoid a cyclic 266 // dependency and should be repackaged into then "namespace semantics" 267 // part of Evaluate/tools.cpp. 268 269 static const semantics::Symbol *GetParentComponent( 270 const semantics::DerivedTypeDetails &details, 271 const semantics::Scope &scope) { 272 if (auto extends{details.GetParentComponentName()}) { 273 if (auto iter{scope.find(*extends)}; iter != scope.cend()) { 274 if (const Symbol & symbol{*iter->second}; 275 symbol.test(semantics::Symbol::Flag::ParentComp)) { 276 return &symbol; 277 } 278 } 279 } 280 return nullptr; 281 } 282 283 static const semantics::Symbol *GetParentComponent( 284 const semantics::Symbol *symbol, const semantics::Scope &scope) { 285 if (symbol) { 286 if (const auto *dtDetails{ 287 symbol->detailsIf<semantics::DerivedTypeDetails>()}) { 288 return GetParentComponent(*dtDetails, scope); 289 } 290 } 291 return nullptr; 292 } 293 294 static const semantics::DerivedTypeSpec *GetParentTypeSpec( 295 const semantics::Symbol *symbol, const semantics::Scope &scope) { 296 if (const Symbol * parentComponent{GetParentComponent(symbol, scope)}) { 297 return &parentComponent->get<semantics::ObjectEntityDetails>() 298 .type() 299 ->derivedTypeSpec(); 300 } else { 301 return nullptr; 302 } 303 } 304 305 static const semantics::Scope *GetDerivedTypeParent( 306 const semantics::Scope *scope) { 307 if (scope) { 308 CHECK(scope->IsDerivedType()); 309 if (const auto *parent{GetParentTypeSpec(scope->GetSymbol(), *scope)}) { 310 return parent->scope(); 311 } 312 } 313 return nullptr; 314 } 315 316 static const semantics::Symbol *FindComponent( 317 const semantics::Scope *scope, parser::CharBlock name) { 318 if (!scope) { 319 return nullptr; 320 } 321 CHECK(scope->IsDerivedType()); 322 auto found{scope->find(name)}; 323 if (found != scope->end()) { 324 return &*found->second; 325 } else { 326 return FindComponent(GetDerivedTypeParent(scope), name); 327 } 328 } 329 330 static bool AreTypeParamCompatible(const semantics::DerivedTypeSpec &x, 331 const semantics::DerivedTypeSpec &y, bool ignoreLenParameters) { 332 const auto *xScope{x.typeSymbol().scope()}; 333 const auto *yScope{y.typeSymbol().scope()}; 334 for (const auto &[paramName, value] : x.parameters()) { 335 const auto *yValue{y.FindParameter(paramName)}; 336 if (!yValue) { 337 return false; 338 } 339 const auto *xParm{FindComponent(xScope, paramName)}; 340 const auto *yParm{FindComponent(yScope, paramName)}; 341 if (xParm && yParm) { 342 const auto *xTPD{xParm->detailsIf<semantics::TypeParamDetails>()}; 343 const auto *yTPD{yParm->detailsIf<semantics::TypeParamDetails>()}; 344 if (xTPD && yTPD) { 345 if (xTPD->attr() != yTPD->attr()) { 346 return false; 347 } 348 if (!ignoreLenParameters || 349 xTPD->attr() != common::TypeParamAttr::Len) { 350 auto xExpr{value.GetExplicit()}; 351 auto yExpr{yValue->GetExplicit()}; 352 if (xExpr && yExpr) { 353 auto xVal{ToInt64(*xExpr)}; 354 auto yVal{ToInt64(*yExpr)}; 355 if (xVal && yVal && *xVal != *yVal) { 356 return false; 357 } 358 } 359 } 360 } 361 } 362 } 363 for (const auto &[paramName, _] : y.parameters()) { 364 if (!x.FindParameter(paramName)) { 365 return false; // y has more parameters than x 366 } 367 } 368 return true; 369 } 370 371 static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x, 372 const semantics::DerivedTypeSpec &y, bool ignoreTypeParameterValues, 373 bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress) { 374 if (&x == &y) { 375 return true; 376 } 377 if (!ignoreTypeParameterValues && 378 !AreTypeParamCompatible(x, y, ignoreLenParameters)) { 379 return false; 380 } 381 const auto &xSymbol{x.typeSymbol()}; 382 const auto &ySymbol{y.typeSymbol()}; 383 if (xSymbol == ySymbol) { 384 return true; 385 } 386 if (xSymbol.name() != ySymbol.name()) { 387 return false; 388 } 389 auto thisQuery{std::make_pair(&x, &y)}; 390 if (inProgress.find(thisQuery) != inProgress.end()) { 391 return true; // recursive use of types in components 392 } 393 inProgress.insert(thisQuery); 394 const auto &xDetails{xSymbol.get<semantics::DerivedTypeDetails>()}; 395 const auto &yDetails{ySymbol.get<semantics::DerivedTypeDetails>()}; 396 if (!(xDetails.sequence() && yDetails.sequence()) && 397 !(xSymbol.attrs().test(semantics::Attr::BIND_C) && 398 ySymbol.attrs().test(semantics::Attr::BIND_C))) { 399 // PGI does not enforce this requirement; all other Fortran 400 // processors do with a hard error when violations are caught. 401 return false; 402 } 403 // Compare the component lists in their orders of declaration. 404 auto xEnd{xDetails.componentNames().cend()}; 405 auto yComponentName{yDetails.componentNames().cbegin()}; 406 auto yEnd{yDetails.componentNames().cend()}; 407 for (auto xComponentName{xDetails.componentNames().cbegin()}; 408 xComponentName != xEnd; ++xComponentName, ++yComponentName) { 409 if (yComponentName == yEnd || *xComponentName != *yComponentName || 410 !xSymbol.scope() || !ySymbol.scope()) { 411 return false; 412 } 413 const auto xLookup{xSymbol.scope()->find(*xComponentName)}; 414 const auto yLookup{ySymbol.scope()->find(*yComponentName)}; 415 if (xLookup == xSymbol.scope()->end() || 416 yLookup == ySymbol.scope()->end() || 417 !AreSameComponent(*xLookup->second, *yLookup->second, inProgress)) { 418 return false; 419 } 420 } 421 return yComponentName == yEnd; 422 } 423 424 bool AreSameDerivedType( 425 const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) { 426 SetOfDerivedTypePairs inProgress; 427 return AreSameDerivedType(x, y, false, false, inProgress); 428 } 429 430 static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x, 431 const semantics::DerivedTypeSpec *y, bool isPolymorphic, 432 bool ignoreTypeParameterValues, bool ignoreLenTypeParameters) { 433 if (!x || !y) { 434 return false; 435 } else { 436 SetOfDerivedTypePairs inProgress; 437 if (AreSameDerivedType(*x, *y, ignoreTypeParameterValues, 438 ignoreLenTypeParameters, inProgress)) { 439 return true; 440 } else { 441 return isPolymorphic && 442 AreCompatibleDerivedTypes(x, GetParentTypeSpec(*y), true, 443 ignoreTypeParameterValues, ignoreLenTypeParameters); 444 } 445 } 446 } 447 448 static bool AreCompatibleTypes(const DynamicType &x, const DynamicType &y, 449 bool ignoreTypeParameterValues, bool ignoreLengths) { 450 if (x.IsUnlimitedPolymorphic()) { 451 return true; 452 } else if (y.IsUnlimitedPolymorphic()) { 453 return false; 454 } else if (x.category() != y.category()) { 455 return false; 456 } else if (x.category() == TypeCategory::Character) { 457 const auto xLen{x.knownLength()}; 458 const auto yLen{y.knownLength()}; 459 return x.kind() == y.kind() && 460 (ignoreLengths || !xLen || !yLen || *xLen == *yLen); 461 } else if (x.category() != TypeCategory::Derived) { 462 return x.kind() == y.kind(); 463 } else { 464 const auto *xdt{GetDerivedTypeSpec(x)}; 465 const auto *ydt{GetDerivedTypeSpec(y)}; 466 return AreCompatibleDerivedTypes( 467 xdt, ydt, x.IsPolymorphic(), ignoreTypeParameterValues, false); 468 } 469 } 470 471 // See 7.3.2.3 (5) & 15.5.2.4 472 bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const { 473 return AreCompatibleTypes(*this, that, false, true); 474 } 475 476 bool DynamicType::IsTkLenCompatibleWith(const DynamicType &that) const { 477 return AreCompatibleTypes(*this, that, false, false); 478 } 479 480 // 16.9.165 481 std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const { 482 bool x{AreCompatibleTypes(*this, that, true, true)}; 483 bool y{AreCompatibleTypes(that, *this, true, true)}; 484 if (!x && !y) { 485 return false; 486 } else if (x && y && !IsPolymorphic() && !that.IsPolymorphic()) { 487 return true; 488 } else { 489 return std::nullopt; 490 } 491 } 492 493 // 16.9.76 494 std::optional<bool> DynamicType::ExtendsTypeOf(const DynamicType &that) const { 495 if (IsUnlimitedPolymorphic() || that.IsUnlimitedPolymorphic()) { 496 return std::nullopt; // unknown 497 } 498 const auto *thisDts{evaluate::GetDerivedTypeSpec(*this)}; 499 const auto *thatDts{evaluate::GetDerivedTypeSpec(that)}; 500 if (!thisDts || !thatDts) { 501 return std::nullopt; 502 } else if (!AreCompatibleDerivedTypes(thatDts, thisDts, true, true, true)) { 503 // Note that I check *thisDts, not its parent, so that EXTENDS_TYPE_OF() 504 // is .true. when they are the same type. This is technically 505 // an implementation-defined case in the standard, but every other 506 // compiler works this way. 507 if (IsPolymorphic() && 508 AreCompatibleDerivedTypes(thisDts, thatDts, true, true, true)) { 509 // 'that' is *this or an extension of *this, and so runtime *this 510 // could be an extension of 'that' 511 return std::nullopt; 512 } else { 513 return false; 514 } 515 } else if (that.IsPolymorphic()) { 516 return std::nullopt; // unknown 517 } else { 518 return true; 519 } 520 } 521 522 std::optional<DynamicType> DynamicType::From( 523 const semantics::DeclTypeSpec &type) { 524 if (const auto *intrinsic{type.AsIntrinsic()}) { 525 if (auto kind{ToInt64(intrinsic->kind())}) { 526 TypeCategory category{intrinsic->category()}; 527 if (IsValidKindOfIntrinsicType(category, *kind)) { 528 if (category == TypeCategory::Character) { 529 const auto &charType{type.characterTypeSpec()}; 530 return DynamicType{static_cast<int>(*kind), charType.length()}; 531 } else { 532 return DynamicType{category, static_cast<int>(*kind)}; 533 } 534 } 535 } 536 } else if (const auto *derived{type.AsDerived()}) { 537 return DynamicType{ 538 *derived, type.category() == semantics::DeclTypeSpec::ClassDerived}; 539 } else if (type.category() == semantics::DeclTypeSpec::ClassStar) { 540 return DynamicType::UnlimitedPolymorphic(); 541 } else if (type.category() == semantics::DeclTypeSpec::TypeStar) { 542 return DynamicType::AssumedType(); 543 } else { 544 common::die("DynamicType::From(DeclTypeSpec): failed"); 545 } 546 return std::nullopt; 547 } 548 549 std::optional<DynamicType> DynamicType::From(const semantics::Symbol &symbol) { 550 return From(symbol.GetType()); // Symbol -> DeclTypeSpec -> DynamicType 551 } 552 553 DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const { 554 switch (category_) { 555 case TypeCategory::Integer: 556 switch (that.category_) { 557 case TypeCategory::Integer: 558 return DynamicType{TypeCategory::Integer, std::max(kind_, that.kind_)}; 559 case TypeCategory::Real: 560 case TypeCategory::Complex: 561 return that; 562 default: 563 CRASH_NO_CASE; 564 } 565 break; 566 case TypeCategory::Real: 567 switch (that.category_) { 568 case TypeCategory::Integer: 569 return *this; 570 case TypeCategory::Real: 571 return DynamicType{TypeCategory::Real, std::max(kind_, that.kind_)}; 572 case TypeCategory::Complex: 573 return DynamicType{TypeCategory::Complex, std::max(kind_, that.kind_)}; 574 default: 575 CRASH_NO_CASE; 576 } 577 break; 578 case TypeCategory::Complex: 579 switch (that.category_) { 580 case TypeCategory::Integer: 581 return *this; 582 case TypeCategory::Real: 583 case TypeCategory::Complex: 584 return DynamicType{TypeCategory::Complex, std::max(kind_, that.kind_)}; 585 default: 586 CRASH_NO_CASE; 587 } 588 break; 589 case TypeCategory::Logical: 590 switch (that.category_) { 591 case TypeCategory::Logical: 592 return DynamicType{TypeCategory::Logical, std::max(kind_, that.kind_)}; 593 default: 594 CRASH_NO_CASE; 595 } 596 break; 597 default: 598 CRASH_NO_CASE; 599 } 600 return *this; 601 } 602 603 bool DynamicType::RequiresDescriptor() const { 604 return IsPolymorphic() || IsNonConstantLengthCharacter() || 605 (derived_ && CountNonConstantLenParameters(*derived_) > 0); 606 } 607 608 bool DynamicType::HasDeferredTypeParameter() const { 609 if (derived_) { 610 for (const auto &pair : derived_->parameters()) { 611 if (pair.second.isDeferred()) { 612 return true; 613 } 614 } 615 } 616 return charLengthParamValue_ && charLengthParamValue_->isDeferred(); 617 } 618 619 bool SomeKind<TypeCategory::Derived>::operator==( 620 const SomeKind<TypeCategory::Derived> &that) const { 621 return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_); 622 } 623 624 int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168 625 auto lower{parser::ToLowerCaseLetters(s)}; 626 auto n{lower.size()}; 627 while (n > 0 && lower[0] == ' ') { 628 lower.erase(0, 1); 629 --n; 630 } 631 while (n > 0 && lower[n - 1] == ' ') { 632 lower.erase(--n, 1); 633 } 634 if (lower == "ascii") { 635 return 1; 636 } else if (lower == "ucs-2") { 637 return 2; 638 } else if (lower == "iso_10646" || lower == "ucs-4") { 639 return 4; 640 } else if (lower == "default") { 641 return defaultKind; 642 } else { 643 return -1; 644 } 645 } 646 647 std::optional<DynamicType> ComparisonType( 648 const DynamicType &t1, const DynamicType &t2) { 649 switch (t1.category()) { 650 case TypeCategory::Integer: 651 switch (t2.category()) { 652 case TypeCategory::Integer: 653 return DynamicType{TypeCategory::Integer, std::max(t1.kind(), t2.kind())}; 654 case TypeCategory::Real: 655 case TypeCategory::Complex: 656 return t2; 657 default: 658 return std::nullopt; 659 } 660 case TypeCategory::Real: 661 switch (t2.category()) { 662 case TypeCategory::Integer: 663 return t1; 664 case TypeCategory::Real: 665 case TypeCategory::Complex: 666 return DynamicType{t2.category(), std::max(t1.kind(), t2.kind())}; 667 default: 668 return std::nullopt; 669 } 670 case TypeCategory::Complex: 671 switch (t2.category()) { 672 case TypeCategory::Integer: 673 return t1; 674 case TypeCategory::Real: 675 case TypeCategory::Complex: 676 return DynamicType{TypeCategory::Complex, std::max(t1.kind(), t2.kind())}; 677 default: 678 return std::nullopt; 679 } 680 case TypeCategory::Character: 681 switch (t2.category()) { 682 case TypeCategory::Character: 683 return DynamicType{ 684 TypeCategory::Character, std::max(t1.kind(), t2.kind())}; 685 default: 686 return std::nullopt; 687 } 688 case TypeCategory::Logical: 689 switch (t2.category()) { 690 case TypeCategory::Logical: 691 return DynamicType{TypeCategory::Logical, LogicalResult::kind}; 692 default: 693 return std::nullopt; 694 } 695 default: 696 return std::nullopt; 697 } 698 } 699 700 bool IsInteroperableIntrinsicType(const DynamicType &type) { 701 switch (type.category()) { 702 case TypeCategory::Integer: 703 return true; 704 case TypeCategory::Real: 705 case TypeCategory::Complex: 706 return type.kind() >= 4; // no short or half floats 707 case TypeCategory::Logical: 708 return type.kind() == 1; // C_BOOL 709 case TypeCategory::Character: 710 return type.kind() == 1 /* C_CHAR */ && type.knownLength().value_or(0) == 1; 711 default: 712 // Derived types are tested in Semantics/check-declarations.cpp 713 return false; 714 } 715 } 716 717 } // namespace Fortran::evaluate 718