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