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