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