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 | |
29 | using Fortran::common::VectorElementCategory; |
30 | |
31 | //===--------------------------------------------------------------------===// |
32 | // Intrinsic type translation helpers |
33 | //===--------------------------------------------------------------------===// |
34 | |
35 | static 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 | |
56 | template <int KIND> |
57 | int getIntegerBits() { |
58 | return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, |
59 | KIND>::Scalar::bits; |
60 | } |
61 | static 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 | |
85 | static 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 | |
92 | static 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 | |
101 | static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) { |
102 | return mlir::ComplexType::get(genRealType(context, KIND)); |
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, 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. |
141 | namespace { |
142 | struct 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 ¶m : |
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> ¶ms, |
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 | |
613 | mlir::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 | |
620 | mlir::Type Fortran::lower::translateDerivedTypeToFIRType( |
621 | Fortran::lower::AbstractConverter &converter, |
622 | const Fortran::semantics::DerivedTypeSpec &tySpec) { |
623 | return TypeBuilderImpl{converter}.genDerivedType(tySpec); |
624 | } |
625 | |
626 | mlir::Type Fortran::lower::translateSomeExprToFIRType( |
627 | Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) { |
628 | return TypeBuilderImpl{converter}.genExprType(expr); |
629 | } |
630 | |
631 | mlir::Type Fortran::lower::translateSymbolToFIRType( |
632 | Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) { |
633 | return TypeBuilderImpl{converter}.genSymbolType(symbol); |
634 | } |
635 | |
636 | mlir::Type Fortran::lower::translateVariableToFIRType( |
637 | Fortran::lower::AbstractConverter &converter, |
638 | const Fortran::lower::pft::Variable &var) { |
639 | return TypeBuilderImpl{converter}.genVariableType(var); |
640 | } |
641 | |
642 | mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) { |
643 | return genRealType(context, kind); |
644 | } |
645 | |
646 | bool 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 | |
655 | template <typename T> |
656 | mlir::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 | |
662 | const Fortran::semantics::DerivedTypeSpec & |
663 | Fortran::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 | |
672 | void Fortran::lower::ComponentReverseIterator::setCurrentType( |
673 | const Fortran::semantics::DerivedTypeSpec &derived) { |
674 | currentParentType = &derived; |
675 | currentTypeDetails = ¤tParentType->typeSymbol() |
676 | .get<Fortran::semantics::DerivedTypeDetails>(); |
677 | componentIt = currentTypeDetails->componentNames().crbegin(); |
678 | componentItEnd = currentTypeDetails->componentNames().crend(); |
679 | } |
680 | |
681 | using namespace Fortran::evaluate; |
682 | using namespace Fortran::common; |
683 | FOR_EACH_SPECIFIC_TYPE(template class Fortran::lower::TypeBuilder, ) |
684 | |