1//===-- ConvertType.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/Lower/ConvertType.h"
10#include "flang/Common/type-kinds.h"
11#include "flang/Lower/AbstractConverter.h"
12#include "flang/Lower/CallInterface.h"
13#include "flang/Lower/ConvertVariable.h"
14#include "flang/Lower/Mangler.h"
15#include "flang/Lower/PFTBuilder.h"
16#include "flang/Lower/Support/Utils.h"
17#include "flang/Optimizer/Builder/Todo.h"
18#include "flang/Optimizer/Dialect/FIRType.h"
19#include "flang/Semantics/tools.h"
20#include "flang/Semantics/type.h"
21#include "mlir/IR/Builders.h"
22#include "mlir/IR/BuiltinTypes.h"
23#include "llvm/Support/Debug.h"
24#include "llvm/TargetParser/Host.h"
25#include "llvm/TargetParser/Triple.h"
26
27#define DEBUG_TYPE "flang-lower-type"
28
29using Fortran::common::VectorElementCategory;
30
31//===--------------------------------------------------------------------===//
32// Intrinsic type translation helpers
33//===--------------------------------------------------------------------===//
34
35static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
36 if (Fortran::common::IsValidKindOfIntrinsicType(
37 Fortran::common::TypeCategory::Real, kind)) {
38 switch (kind) {
39 case 2:
40 return mlir::Float16Type::get(context);
41 case 3:
42 return mlir::BFloat16Type::get(context);
43 case 4:
44 return mlir::Float32Type::get(context);
45 case 8:
46 return mlir::Float64Type::get(context);
47 case 10:
48 return mlir::Float80Type::get(context);
49 case 16:
50 return mlir::Float128Type::get(context);
51 }
52 }
53 llvm_unreachable("REAL type translation not implemented");
54}
55
56template <int KIND>
57int getIntegerBits() {
58 return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
59 KIND>::Scalar::bits;
60}
61static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
62 bool isUnsigned = false) {
63 if (Fortran::common::IsValidKindOfIntrinsicType(
64 Fortran::common::TypeCategory::Integer, kind)) {
65 mlir::IntegerType::SignednessSemantics signedness =
66 (isUnsigned ? mlir::IntegerType::SignednessSemantics::Unsigned
67 : mlir::IntegerType::SignednessSemantics::Signless);
68
69 switch (kind) {
70 case 1:
71 return mlir::IntegerType::get(context, getIntegerBits<1>(), signedness);
72 case 2:
73 return mlir::IntegerType::get(context, getIntegerBits<2>(), signedness);
74 case 4:
75 return mlir::IntegerType::get(context, getIntegerBits<4>(), signedness);
76 case 8:
77 return mlir::IntegerType::get(context, getIntegerBits<8>(), signedness);
78 case 16:
79 return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
80 }
81 }
82 llvm_unreachable("INTEGER or UNSIGNED kind not translated");
83}
84
85static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
86 if (Fortran::common::IsValidKindOfIntrinsicType(
87 Fortran::common::TypeCategory::Logical, KIND))
88 return fir::LogicalType::get(context, KIND);
89 return {};
90}
91
92static mlir::Type genCharacterType(
93 mlir::MLIRContext *context, int KIND,
94 Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) {
95 if (Fortran::common::IsValidKindOfIntrinsicType(
96 Fortran::common::TypeCategory::Character, KIND))
97 return fir::CharacterType::get(context, KIND, len);
98 return {};
99}
100
101static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) {
102 return mlir::ComplexType::get(genRealType(context, KIND));
103}
104
105static mlir::Type
106genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
107 int kind,
108 llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) {
109 switch (tc) {
110 case Fortran::common::TypeCategory::Real:
111 return genRealType(context, kind);
112 case Fortran::common::TypeCategory::Integer:
113 return genIntegerType(context, kind, false);
114 case Fortran::common::TypeCategory::Unsigned:
115 return genIntegerType(context, kind, true);
116 case Fortran::common::TypeCategory::Complex:
117 return genComplexType(context, kind);
118 case Fortran::common::TypeCategory::Logical:
119 return genLogicalType(context, kind);
120 case Fortran::common::TypeCategory::Character:
121 if (!lenParameters.empty())
122 return genCharacterType(context, kind, lenParameters[0]);
123 return genCharacterType(context, kind);
124 default:
125 break;
126 }
127 llvm_unreachable("unhandled type category");
128}
129
130//===--------------------------------------------------------------------===//
131// Symbol and expression type translation
132//===--------------------------------------------------------------------===//
133
134/// TypeBuilderImpl translates expression and symbol type taking into account
135/// their shape and length parameters. For symbols, attributes such as
136/// ALLOCATABLE or POINTER are reflected in the fir type.
137/// It uses evaluate::DynamicType and evaluate::Shape when possible to
138/// avoid re-implementing type/shape analysis here.
139/// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
140/// since it is not guaranteed to exist yet when we lower types.
141namespace {
142struct TypeBuilderImpl {
143
144 TypeBuilderImpl(Fortran::lower::AbstractConverter &converter)
145 : derivedTypeInConstruction{converter.getTypeConstructionStack()},
146 converter{converter}, context{&converter.getMLIRContext()} {}
147
148 template <typename A>
149 mlir::Type genExprType(const A &expr) {
150 std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
151 if (!dynamicType)
152 return genTypelessExprType(expr);
153 Fortran::common::TypeCategory category = dynamicType->category();
154
155 mlir::Type baseType;
156 bool isPolymorphic = (dynamicType->IsPolymorphic() ||
157 dynamicType->IsUnlimitedPolymorphic()) &&
158 !dynamicType->IsAssumedType();
159 if (dynamicType->IsUnlimitedPolymorphic()) {
160 baseType = mlir::NoneType::get(context);
161 } else if (category == Fortran::common::TypeCategory::Derived) {
162 baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
163 } else {
164 // INTEGER, UNSIGNED, REAL, COMPLEX, CHARACTER, LOGICAL
165 llvm::SmallVector<Fortran::lower::LenParameterTy> params;
166 translateLenParameters(params, category, expr);
167 baseType = genFIRType(context, category, dynamicType->kind(), params);
168 }
169 std::optional<Fortran::evaluate::Shape> shapeExpr =
170 Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
171 fir::SequenceType::Shape shape;
172 if (shapeExpr) {
173 translateShape(shape, std::move(*shapeExpr));
174 } else {
175 // Shape static analysis cannot return something useful for the shape.
176 // Use unknown extents.
177 int rank = expr.Rank();
178 if (rank < 0)
179 TODO(converter.getCurrentLocation(), "assumed rank expression types");
180 for (int dim = 0; dim < rank; ++dim)
181 shape.emplace_back(fir::SequenceType::getUnknownExtent());
182 }
183
184 if (!shape.empty()) {
185 if (isPolymorphic)
186 return fir::ClassType::get(fir::SequenceType::get(shape, baseType));
187 return fir::SequenceType::get(shape, baseType);
188 }
189 if (isPolymorphic)
190 return fir::ClassType::get(baseType);
191 return baseType;
192 }
193
194 template <typename A>
195 void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
196 for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
197 fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
198 if (std::optional<std::int64_t> constantExtent =
199 toInt64(std::move(extentExpr)))
200 extent = *constantExtent;
201 shape.push_back(extent);
202 }
203 }
204
205 template <typename A>
206 std::optional<std::int64_t> toInt64(A &&expr) {
207 return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
208 converter.getFoldingContext(), std::move(expr)));
209 }
210
211 template <typename A>
212 mlir::Type genTypelessExprType(const A &expr) {
213 fir::emitFatalError(converter.getCurrentLocation(), "not a typeless expr");
214 }
215
216 mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
217 return Fortran::common::visit(
218 Fortran::common::visitors{
219 [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
220 return mlir::NoneType::get(context);
221 },
222 [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
223 return fir::ReferenceType::get(mlir::NoneType::get(context));
224 },
225 [&](const Fortran::evaluate::ProcedureDesignator &proc)
226 -> mlir::Type {
227 return Fortran::lower::translateSignature(proc, converter);
228 },
229 [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
230 return mlir::NoneType::get(context);
231 },
232 [](const auto &x) -> mlir::Type {
233 using T = std::decay_t<decltype(x)>;
234 static_assert(!Fortran::common::HasMember<
235 T, Fortran::evaluate::TypelessExpression>,
236 "missing typeless expr handling");
237 llvm::report_fatal_error("not a typeless expression");
238 },
239 },
240 expr.u);
241 }
242
243 mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
244 bool isAlloc = false, bool isPtr = false) {
245 mlir::Location loc = converter.genLocation(symbol.name());
246 mlir::Type ty;
247 // If the symbol is not the same as the ultimate one (i.e, it is host or use
248 // associated), all the symbol properties are the ones of the ultimate
249 // symbol but the volatile and asynchronous attributes that may differ. To
250 // avoid issues with helper functions that would not follow association
251 // links, the fir type is built based on the ultimate symbol. This relies
252 // on the fact volatile and asynchronous are not reflected in fir types.
253 const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
254
255 if (Fortran::semantics::IsProcedurePointer(ultimate)) {
256 Fortran::evaluate::ProcedureDesignator proc(ultimate);
257 auto procTy{Fortran::lower::translateSignature(proc, converter)};
258 return fir::BoxProcType::get(context, procTy);
259 }
260
261 if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
262 if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
263 type->AsIntrinsic()) {
264 int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
265 llvm::SmallVector<Fortran::lower::LenParameterTy> params;
266 translateLenParameters(params, tySpec->category(), ultimate);
267 ty = genFIRType(context, tySpec->category(), kind, params);
268 } else if (type->IsUnlimitedPolymorphic()) {
269 ty = mlir::NoneType::get(context);
270 } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
271 type->AsDerived()) {
272 ty = genDerivedType(*tySpec);
273 } else {
274 fir::emitFatalError(loc, "symbol's type must have a type spec");
275 }
276 } else {
277 fir::emitFatalError(loc, "symbol must have a type");
278 }
279
280 auto shapeExpr =
281 Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
282
283 if (shapeExpr && !shapeExpr->empty()) {
284 // Statically ranked array.
285 fir::SequenceType::Shape shape;
286 translateShape(shape, std::move(*shapeExpr));
287 ty = fir::SequenceType::get(shape, ty);
288 } else if (!shapeExpr) {
289 // Assumed-rank.
290 ty = fir::SequenceType::get(fir::SequenceType::Shape{}, ty);
291 }
292
293 bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) ||
294 Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
295 !Fortran::semantics::IsAssumedType(symbol);
296 if (Fortran::semantics::IsPointer(symbol))
297 return fir::wrapInClassOrBoxType(fir::PointerType::get(ty),
298 isPolymorphic);
299 if (Fortran::semantics::IsAllocatable(symbol))
300 return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic);
301 // isPtr and isAlloc are variable that were promoted to be on the
302 // heap or to be pointers, but they do not have Fortran allocatable
303 // or pointer semantics, so do not use box for them.
304 if (isPtr)
305 return fir::PointerType::get(ty);
306 if (isAlloc)
307 return fir::HeapType::get(ty);
308 if (isPolymorphic)
309 return fir::ClassType::get(ty);
310 return ty;
311 }
312
313 /// Does \p component has non deferred lower bounds that are not compile time
314 /// constant 1.
315 static bool componentHasNonDefaultLowerBounds(
316 const Fortran::semantics::Symbol &component) {
317 if (const auto *objDetails =
318 component.detailsIf<Fortran::semantics::ObjectEntityDetails>())
319 for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
320 if (auto lb = bounds.lbound().GetExplicit())
321 if (auto constant = Fortran::evaluate::ToInt64(*lb))
322 if (!constant || *constant != 1)
323 return true;
324 return false;
325 }
326
327 mlir::Type genVectorType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
328 assert(tySpec.scope() && "Missing scope for Vector type");
329 auto vectorSize{tySpec.scope()->size()};
330 switch (tySpec.category()) {
331 SWITCH_COVERS_ALL_CASES
332 case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): {
333 int64_t vecElemKind;
334 int64_t vecElemCategory;
335
336 for (const auto &pair : tySpec.parameters()) {
337 if (pair.first == "element_category") {
338 vecElemCategory =
339 Fortran::evaluate::ToInt64(pair.second.GetExplicit())
340 .value_or(-1);
341 } else if (pair.first == "element_kind") {
342 vecElemKind =
343 Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0);
344 }
345 }
346
347 assert((vecElemCategory >= 0 &&
348 static_cast<size_t>(vecElemCategory) <
349 Fortran::common::VectorElementCategory_enumSize) &&
350 "Vector element type is not specified");
351 assert(vecElemKind && "Vector element kind is not specified");
352
353 int64_t numOfElements = vectorSize / vecElemKind;
354 switch (static_cast<VectorElementCategory>(vecElemCategory)) {
355 SWITCH_COVERS_ALL_CASES
356 case VectorElementCategory::Integer:
357 return fir::VectorType::get(numOfElements,
358 genIntegerType(context, vecElemKind));
359 case VectorElementCategory::Unsigned:
360 return fir::VectorType::get(numOfElements,
361 genIntegerType(context, vecElemKind, true));
362 case VectorElementCategory::Real:
363 return fir::VectorType::get(numOfElements,
364 genRealType(context, vecElemKind));
365 }
366 break;
367 }
368 case (Fortran::semantics::DerivedTypeSpec::Category::PairVector):
369 case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector):
370 return fir::VectorType::get(vectorSize * 8,
371 mlir::IntegerType::get(context, 1));
372 case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType):
373 Fortran::common::die("Vector element type not implemented");
374 }
375 }
376
377 mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
378 std::vector<std::pair<std::string, mlir::Type>> ps;
379 std::vector<std::pair<std::string, mlir::Type>> cs;
380 if (tySpec.IsVectorType()) {
381 return genVectorType(tySpec);
382 }
383
384 const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
385 const Fortran::semantics::Scope &derivedScope = DEREF(tySpec.GetScope());
386 if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(derivedScope))
387 return ty;
388
389 auto rec = fir::RecordType::get(context, converter.mangleName(tySpec));
390 // Maintain the stack of types for recursive references and to speed-up
391 // the derived type constructions that can be expensive for derived type
392 // with dozens of components/parents (modern Fortran).
393 derivedTypeInConstruction.try_emplace(&derivedScope, rec);
394
395 auto targetTriple{llvm::Triple(
396 llvm::Triple::normalize(Str: llvm::sys::getDefaultTargetTriple()))};
397 // Always generate packed FIR struct type for bind(c) derived type for AIX
398 if (targetTriple.getOS() == llvm::Triple::OSType::AIX &&
399 tySpec.typeSymbol().attrs().test(Fortran::semantics::Attr::BIND_C) &&
400 !IsIsoCType(&tySpec) && !fir::isa_builtin_cdevptr_type(rec)) {
401 rec.pack(true);
402 }
403
404 // Gather the record type fields.
405 // (1) The data components.
406 if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
407 size_t prev_offset{0};
408 unsigned padCounter{0};
409 // In HLFIR the parent component is the first fir.type component.
410 for (const auto &componentName :
411 typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
412 .componentNames()) {
413 auto scopeIter = derivedScope.find(componentName);
414 assert(scopeIter != derivedScope.cend() &&
415 "failed to find derived type component symbol");
416 const Fortran::semantics::Symbol &component = scopeIter->second.get();
417 mlir::Type ty = genSymbolType(component);
418 if (rec.isPacked()) {
419 auto compSize{component.size()};
420 auto compOffset{component.offset()};
421
422 if (prev_offset < compOffset) {
423 size_t pad{compOffset - prev_offset};
424 mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
425 fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
426 mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
427 prev_offset += pad;
428 cs.emplace_back("__padding" + std::to_string(padCounter++), padTy);
429 }
430 prev_offset += compSize;
431 }
432 cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
433 if (rec.isPacked()) {
434 // For the last component, determine if any padding is needed.
435 if (componentName ==
436 typeSymbol.get<Fortran::semantics::DerivedTypeDetails>()
437 .componentNames()
438 .back()) {
439 auto compEnd{component.offset() + component.size()};
440 if (compEnd < derivedScope.size()) {
441 size_t pad{derivedScope.size() - compEnd};
442 mlir::Type i8Ty{mlir::IntegerType::get(context, 8)};
443 fir::SequenceType::Shape shape{static_cast<int64_t>(pad)};
444 mlir::Type padTy{fir::SequenceType::get(shape, i8Ty)};
445 cs.emplace_back("__padding" + std::to_string(padCounter++),
446 padTy);
447 }
448 }
449 }
450 }
451 } else {
452 for (const auto &component :
453 Fortran::semantics::OrderedComponentIterator(tySpec)) {
454 // In the lowering to FIR the parent component does not appear in the
455 // fir.type and its components are inlined at the beginning of the
456 // fir.type<>.
457 // FIXME: this strategy leads to bugs because padding should be inserted
458 // after the component of the parents so that the next components do not
459 // end-up in the parent storage if the sum of the parent's component
460 // storage size is not a multiple of the parent type storage alignment.
461
462 // Lowering is assuming non deferred component lower bounds are
463 // always 1. Catch any situations where this is not true for now.
464 if (componentHasNonDefaultLowerBounds(component))
465 TODO(converter.genLocation(component.name()),
466 "derived type components with non default lower bounds");
467 if (IsProcedure(component))
468 TODO(converter.genLocation(component.name()), "procedure components");
469 mlir::Type ty = genSymbolType(component);
470 // Do not add the parent component (component of the parents are
471 // added and should be sufficient, the parent component would
472 // duplicate the fields). Note that genSymbolType must be called above
473 // on it so that the dispatch table for the parent type still gets
474 // emitted as needed.
475 if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
476 continue;
477 cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
478 }
479 }
480
481 mlir::Location loc = converter.genLocation(typeSymbol.name());
482 // (2) The LEN type parameters.
483 for (const auto &param :
484 Fortran::semantics::OrderParameterDeclarations(typeSymbol))
485 if (param->get<Fortran::semantics::TypeParamDetails>().attr() ==
486 Fortran::common::TypeParamAttr::Len) {
487 TODO(loc, "parameterized derived types");
488 // TODO: emplace in ps. Beware that param is the symbol in the type
489 // declaration, not instantiation: its kind may not be a constant.
490 // The instantiated symbol in tySpec.scope should be used instead.
491 ps.emplace_back(param->name().ToString(), genSymbolType(*param));
492 }
493
494 rec.finalize(ps, cs);
495
496 if (!ps.empty()) {
497 // TODO: this type is a PDT (parametric derived type) with length
498 // parameter. Create the functions to use for allocation, dereferencing,
499 // and address arithmetic here.
500 }
501 LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
502
503 // Generate the type descriptor object if any
504 if (const Fortran::semantics::Symbol *typeInfoSym =
505 derivedScope.runtimeDerivedTypeDescription())
506 converter.registerTypeInfo(loc, *typeInfoSym, tySpec, rec);
507 return rec;
508 }
509
510 // To get the character length from a symbol, make an fold a designator for
511 // the symbol to cover the case where the symbol is an assumed length named
512 // constant and its length comes from its init expression length.
513 template <int Kind>
514 fir::SequenceType::Extent
515 getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
516 using TC =
517 Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
518 auto designator = Fortran::evaluate::Fold(
519 converter.getFoldingContext(),
520 Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
521 if (auto len = toInt64(std::move(designator.LEN())))
522 return *len;
523 return fir::SequenceType::getUnknownExtent();
524 }
525
526 template <typename T>
527 void translateLenParameters(
528 llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
529 Fortran::common::TypeCategory category, const T &exprOrSym) {
530 if (category == Fortran::common::TypeCategory::Character)
531 params.push_back(getCharacterLength(exprOrSym));
532 else if (category == Fortran::common::TypeCategory::Derived)
533 TODO(converter.getCurrentLocation(), "derived type length parameters");
534 }
535 Fortran::lower::LenParameterTy
536 getCharacterLength(const Fortran::semantics::Symbol &symbol) {
537 const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
538 if (!type ||
539 type->category() != Fortran::semantics::DeclTypeSpec::Character ||
540 !type->AsIntrinsic())
541 llvm::report_fatal_error(reason: "not a character symbol");
542 int kind =
543 toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
544 switch (kind) {
545 case 1:
546 return getCharacterLengthHelper<1>(symbol);
547 case 2:
548 return getCharacterLengthHelper<2>(symbol);
549 case 4:
550 return getCharacterLengthHelper<4>(symbol);
551 }
552 llvm_unreachable("unknown character kind");
553 }
554
555 template <typename A>
556 Fortran::lower::LenParameterTy getCharacterLength(const A &expr) {
557 return fir::SequenceType::getUnknownExtent();
558 }
559
560 template <typename T>
561 Fortran::lower::LenParameterTy
562 getCharacterLength(const Fortran::evaluate::FunctionRef<T> &funcRef) {
563 if (auto constantLen = toInt64(funcRef.LEN()))
564 return *constantLen;
565 return fir::SequenceType::getUnknownExtent();
566 }
567
568 Fortran::lower::LenParameterTy
569 getCharacterLength(const Fortran::lower::SomeExpr &expr) {
570 // Do not use dynamic type length here. We would miss constant
571 // lengths opportunities because dynamic type only has the length
572 // if it comes from a declaration.
573 if (const auto *charExpr = std::get_if<
574 Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
575 &expr.u)) {
576 if (auto constantLen = toInt64(charExpr->LEN()))
577 return *constantLen;
578 } else if (auto dynamicType = expr.GetType()) {
579 // When generating derived type type descriptor as structure constructor,
580 // semantics wraps designators to data component initialization into
581 // CLASS(*), regardless of their actual type.
582 // GetType() will recover the actual symbol type as the dynamic type, so
583 // getCharacterLength may be reached even if expr is packaged as an
584 // Expr<SomeDerived> instead of an Expr<SomeChar>.
585 // Just use the dynamic type here again to retrieve the length.
586 if (auto constantLen = toInt64(dynamicType->GetCharLength()))
587 return *constantLen;
588 }
589 return fir::SequenceType::getUnknownExtent();
590 }
591
592 mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
593 return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
594 }
595
596 /// Derived type can be recursive. That is, pointer components of a derived
597 /// type `t` have type `t`. This helper returns `t` if it is already being
598 /// lowered to avoid infinite loops.
599 mlir::Type getTypeIfDerivedAlreadyInConstruction(
600 const Fortran::semantics::Scope &derivedScope) const {
601 return derivedTypeInConstruction.lookup(&derivedScope);
602 }
603
604 /// Stack derived type being processed to avoid infinite loops in case of
605 /// recursive derived types. The depth of derived types is expected to be
606 /// shallow (<10), so a SmallVector is sufficient.
607 Fortran::lower::TypeConstructionStack &derivedTypeInConstruction;
608 Fortran::lower::AbstractConverter &converter;
609 mlir::MLIRContext *context;
610};
611} // namespace
612
613mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
614 Fortran::common::TypeCategory tc,
615 int kind,
616 llvm::ArrayRef<LenParameterTy> params) {
617 return genFIRType(context, tc, kind, params);
618}
619
620mlir::Type Fortran::lower::translateDerivedTypeToFIRType(
621 Fortran::lower::AbstractConverter &converter,
622 const Fortran::semantics::DerivedTypeSpec &tySpec) {
623 return TypeBuilderImpl{converter}.genDerivedType(tySpec);
624}
625
626mlir::Type Fortran::lower::translateSomeExprToFIRType(
627 Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
628 return TypeBuilderImpl{converter}.genExprType(expr);
629}
630
631mlir::Type Fortran::lower::translateSymbolToFIRType(
632 Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
633 return TypeBuilderImpl{converter}.genSymbolType(symbol);
634}
635
636mlir::Type Fortran::lower::translateVariableToFIRType(
637 Fortran::lower::AbstractConverter &converter,
638 const Fortran::lower::pft::Variable &var) {
639 return TypeBuilderImpl{converter}.genVariableType(var);
640}
641
642mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
643 return genRealType(context, kind);
644}
645
646bool Fortran::lower::isDerivedTypeWithLenParameters(
647 const Fortran::semantics::Symbol &sym) {
648 if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
649 if (const Fortran::semantics::DerivedTypeSpec *derived =
650 declTy->AsDerived())
651 return Fortran::semantics::CountLenParameters(*derived) > 0;
652 return false;
653}
654
655template <typename T>
656mlir::Type Fortran::lower::TypeBuilder<T>::genType(
657 Fortran::lower::AbstractConverter &converter,
658 const Fortran::evaluate::FunctionRef<T> &funcRef) {
659 return TypeBuilderImpl{converter}.genExprType(funcRef);
660}
661
662const Fortran::semantics::DerivedTypeSpec &
663Fortran::lower::ComponentReverseIterator::advanceToParentType() {
664 const Fortran::semantics::Scope *scope = currentParentType->GetScope();
665 auto parentComp =
666 DEREF(scope).find(currentTypeDetails->GetParentComponentName().value());
667 assert(parentComp != scope->cend() && "failed to get parent component");
668 setCurrentType(parentComp->second->GetType()->derivedTypeSpec());
669 return *currentParentType;
670}
671
672void Fortran::lower::ComponentReverseIterator::setCurrentType(
673 const Fortran::semantics::DerivedTypeSpec &derived) {
674 currentParentType = &derived;
675 currentTypeDetails = &currentParentType->typeSymbol()
676 .get<Fortran::semantics::DerivedTypeDetails>();
677 componentIt = currentTypeDetails->componentNames().crbegin();
678 componentItEnd = currentTypeDetails->componentNames().crend();
679}
680
681using namespace Fortran::evaluate;
682using namespace Fortran::common;
683FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::TypeBuilder, )
684

source code of flang/lib/Lower/ConvertType.cpp