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