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/Lower/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 //===--------------------------------------------------------------------===//
27 // Intrinsic type translation helpers
28 //===--------------------------------------------------------------------===//
29 
30 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
31   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
32           Fortran::common::TypeCategory::Real, kind)) {
33     switch (kind) {
34     case 2:
35       return mlir::FloatType::getF16(context);
36     case 3:
37       return mlir::FloatType::getBF16(context);
38     case 4:
39       return mlir::FloatType::getF32(context);
40     case 8:
41       return mlir::FloatType::getF64(context);
42     case 10:
43       return mlir::FloatType::getF80(context);
44     case 16:
45       return mlir::FloatType::getF128(context);
46     }
47   }
48   llvm_unreachable("REAL type translation not implemented");
49 }
50 
51 template <int KIND>
52 int getIntegerBits() {
53   return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
54                                  KIND>::Scalar::bits;
55 }
56 static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) {
57   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
58           Fortran::common::TypeCategory::Integer, kind)) {
59     switch (kind) {
60     case 1:
61       return mlir::IntegerType::get(context, getIntegerBits<1>());
62     case 2:
63       return mlir::IntegerType::get(context, getIntegerBits<2>());
64     case 4:
65       return mlir::IntegerType::get(context, getIntegerBits<4>());
66     case 8:
67       return mlir::IntegerType::get(context, getIntegerBits<8>());
68     case 16:
69       return mlir::IntegerType::get(context, getIntegerBits<16>());
70     }
71   }
72   llvm_unreachable("INTEGER kind not translated");
73 }
74 
75 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
76   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
77           Fortran::common::TypeCategory::Logical, KIND))
78     return fir::LogicalType::get(context, KIND);
79   return {};
80 }
81 
82 static mlir::Type genCharacterType(
83     mlir::MLIRContext *context, int KIND,
84     Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) {
85   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
86           Fortran::common::TypeCategory::Character, KIND))
87     return fir::CharacterType::get(context, KIND, len);
88   return {};
89 }
90 
91 static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) {
92   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
93           Fortran::common::TypeCategory::Complex, KIND))
94     return fir::ComplexType::get(context, KIND);
95   return {};
96 }
97 
98 static mlir::Type
99 genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
100            int kind,
101            llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) {
102   switch (tc) {
103   case Fortran::common::TypeCategory::Real:
104     return genRealType(context, kind);
105   case Fortran::common::TypeCategory::Integer:
106     return genIntegerType(context, kind);
107   case Fortran::common::TypeCategory::Complex:
108     return genComplexType(context, kind);
109   case Fortran::common::TypeCategory::Logical:
110     return genLogicalType(context, kind);
111   case Fortran::common::TypeCategory::Character:
112     if (!lenParameters.empty())
113       return genCharacterType(context, kind, lenParameters[0]);
114     return genCharacterType(context, kind);
115   default:
116     break;
117   }
118   llvm_unreachable("unhandled type category");
119 }
120 
121 //===--------------------------------------------------------------------===//
122 // Symbol and expression type translation
123 //===--------------------------------------------------------------------===//
124 
125 /// TypeBuilder translates expression and symbol type taking into account
126 /// their shape and length parameters. For symbols, attributes such as
127 /// ALLOCATABLE or POINTER are reflected in the fir type.
128 /// It uses evaluate::DynamicType and evaluate::Shape when possible to
129 /// avoid re-implementing type/shape analysis here.
130 /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
131 /// since it is not guaranteed to exist yet when we lower types.
132 namespace {
133 struct TypeBuilder {
134 
135   TypeBuilder(Fortran::lower::AbstractConverter &converter)
136       : converter{converter}, context{&converter.getMLIRContext()} {}
137 
138   mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
139     std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
140     if (!dynamicType)
141       return genTypelessExprType(expr);
142     Fortran::common::TypeCategory category = dynamicType->category();
143 
144     mlir::Type baseType;
145     if (category == Fortran::common::TypeCategory::Derived) {
146       baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
147     } else {
148       // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
149       llvm::SmallVector<Fortran::lower::LenParameterTy> params;
150       translateLenParameters(params, category, expr);
151       baseType = genFIRType(context, category, dynamicType->kind(), params);
152     }
153     std::optional<Fortran::evaluate::Shape> shapeExpr =
154         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
155     fir::SequenceType::Shape shape;
156     if (shapeExpr) {
157       translateShape(shape, std::move(*shapeExpr));
158     } else {
159       // Shape static analysis cannot return something useful for the shape.
160       // Use unknown extents.
161       int rank = expr.Rank();
162       if (rank < 0)
163         TODO(converter.getCurrentLocation(),
164              "Assumed rank expression type lowering");
165       for (int dim = 0; dim < rank; ++dim)
166         shape.emplace_back(fir::SequenceType::getUnknownExtent());
167     }
168     if (!shape.empty())
169       return fir::SequenceType::get(shape, baseType);
170     return baseType;
171   }
172 
173   template <typename A>
174   void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
175     for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
176       fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
177       if (std::optional<std::int64_t> constantExtent =
178               toInt64(std::move(extentExpr)))
179         extent = *constantExtent;
180       shape.push_back(extent);
181     }
182   }
183 
184   template <typename A>
185   std::optional<std::int64_t> toInt64(A &&expr) {
186     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
187         converter.getFoldingContext(), std::move(expr)));
188   }
189 
190   mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
191     return std::visit(
192         Fortran::common::visitors{
193             [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
194               return mlir::NoneType::get(context);
195             },
196             [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
197               return fir::ReferenceType::get(mlir::NoneType::get(context));
198             },
199             [&](const Fortran::evaluate::ProcedureDesignator &proc)
200                 -> mlir::Type {
201               return Fortran::lower::translateSignature(proc, converter);
202             },
203             [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
204               return mlir::NoneType::get(context);
205             },
206             [](const auto &x) -> mlir::Type {
207               using T = std::decay_t<decltype(x)>;
208               static_assert(!Fortran::common::HasMember<
209                                 T, Fortran::evaluate::TypelessExpression>,
210                             "missing typeless expr handling in type lowering");
211               llvm::report_fatal_error("not a typeless expression");
212             },
213         },
214         expr.u);
215   }
216 
217   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
218                            bool isAlloc = false, bool isPtr = false) {
219     mlir::Location loc = converter.genLocation(symbol.name());
220     mlir::Type ty;
221     // If the symbol is not the same as the ultimate one (i.e, it is host or use
222     // associated), all the symbol properties are the ones of the ultimate
223     // symbol but the volatile and asynchronous attributes that may differ. To
224     // avoid issues with helper functions that would not follow association
225     // links, the fir type is built based on the ultimate symbol. This relies
226     // on the fact volatile and asynchronous are not reflected in fir types.
227     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
228     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
229       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
230               type->AsIntrinsic()) {
231         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
232         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
233         translateLenParameters(params, tySpec->category(), ultimate);
234         ty = genFIRType(context, tySpec->category(), kind, params);
235       } else if (type->IsPolymorphic()) {
236         TODO(loc, "[genSymbolType] polymorphic types");
237       } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
238                      type->AsDerived()) {
239         ty = genDerivedType(*tySpec);
240       } else {
241         fir::emitFatalError(loc, "symbol's type must have a type spec");
242       }
243     } else {
244       fir::emitFatalError(loc, "symbol must have a type");
245     }
246     if (ultimate.IsObjectArray()) {
247       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
248           converter.getFoldingContext()}(ultimate);
249       if (!shapeExpr)
250         TODO(loc, "assumed rank symbol type lowering");
251       fir::SequenceType::Shape shape;
252       translateShape(shape, std::move(*shapeExpr));
253       ty = fir::SequenceType::get(shape, ty);
254     }
255 
256     if (Fortran::semantics::IsPointer(symbol))
257       return fir::BoxType::get(fir::PointerType::get(ty));
258     if (Fortran::semantics::IsAllocatable(symbol))
259       return fir::BoxType::get(fir::HeapType::get(ty));
260     // isPtr and isAlloc are variable that were promoted to be on the
261     // heap or to be pointers, but they do not have Fortran allocatable
262     // or pointer semantics, so do not use box for them.
263     if (isPtr)
264       return fir::PointerType::get(ty);
265     if (isAlloc)
266       return fir::HeapType::get(ty);
267     return ty;
268   }
269 
270   /// Does \p component has non deferred lower bounds that are not compile time
271   /// constant 1.
272   static bool componentHasNonDefaultLowerBounds(
273       const Fortran::semantics::Symbol &component) {
274     if (const auto *objDetails =
275             component.detailsIf<Fortran::semantics::ObjectEntityDetails>())
276       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
277         if (auto lb = bounds.lbound().GetExplicit())
278           if (auto constant = Fortran::evaluate::ToInt64(*lb))
279             if (!constant || *constant != 1)
280               return true;
281     return false;
282   }
283 
284   mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
285     std::vector<std::pair<std::string, mlir::Type>> ps;
286     std::vector<std::pair<std::string, mlir::Type>> cs;
287     const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
288     if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
289       return ty;
290     auto rec = fir::RecordType::get(context,
291                                     Fortran::lower::mangle::mangleName(tySpec));
292     // Maintain the stack of types for recursive references.
293     derivedTypeInConstruction.emplace_back(typeSymbol, rec);
294 
295     // Gather the record type fields.
296     // (1) The data components.
297     for (const auto &field :
298          Fortran::semantics::OrderedComponentIterator(tySpec)) {
299       // Lowering is assuming non deferred component lower bounds are always 1.
300       // Catch any situations where this is not true for now.
301       if (componentHasNonDefaultLowerBounds(field))
302         TODO(converter.genLocation(field.name()),
303              "lowering derived type components with non default lower bounds");
304       if (IsProcName(field))
305         TODO(converter.genLocation(field.name()), "procedure components");
306       mlir::Type ty = genSymbolType(field);
307       // Do not add the parent component (component of the parents are
308       // added and should be sufficient, the parent component would
309       // duplicate the fields).
310       if (field.test(Fortran::semantics::Symbol::Flag::ParentComp))
311         continue;
312       cs.emplace_back(field.name().ToString(), ty);
313     }
314 
315     // (2) The LEN type parameters.
316     for (const auto &param :
317          Fortran::semantics::OrderParameterDeclarations(typeSymbol))
318       if (param->get<Fortran::semantics::TypeParamDetails>().attr() ==
319           Fortran::common::TypeParamAttr::Len)
320         ps.emplace_back(param->name().ToString(), genSymbolType(*param));
321 
322     rec.finalize(ps, cs);
323     popDerivedTypeInConstruction();
324 
325     mlir::Location loc = converter.genLocation(typeSymbol.name());
326     if (!ps.empty()) {
327       // This type is a PDT (parametric derived type). Create the functions to
328       // use for allocation, dereferencing, and address arithmetic here.
329       TODO(loc, "parametrized derived types lowering");
330     }
331     LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
332 
333     // Generate the type descriptor object if any
334     if (const Fortran::semantics::Scope *derivedScope =
335             tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope())
336       if (const Fortran::semantics::Symbol *typeInfoSym =
337               derivedScope->runtimeDerivedTypeDescription())
338         converter.registerRuntimeTypeInfo(loc, *typeInfoSym);
339     return rec;
340   }
341 
342   // To get the character length from a symbol, make an fold a designator for
343   // the symbol to cover the case where the symbol is an assumed length named
344   // constant and its length comes from its init expression length.
345   template <int Kind>
346   fir::SequenceType::Extent
347   getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
348     using TC =
349         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
350     auto designator = Fortran::evaluate::Fold(
351         converter.getFoldingContext(),
352         Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
353     if (auto len = toInt64(std::move(designator.LEN())))
354       return *len;
355     return fir::SequenceType::getUnknownExtent();
356   }
357 
358   template <typename T>
359   void translateLenParameters(
360       llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
361       Fortran::common::TypeCategory category, const T &exprOrSym) {
362     if (category == Fortran::common::TypeCategory::Character)
363       params.push_back(getCharacterLength(exprOrSym));
364     else if (category == Fortran::common::TypeCategory::Derived)
365       TODO(converter.getCurrentLocation(),
366            "lowering derived type length parameters");
367     return;
368   }
369   Fortran::lower::LenParameterTy
370   getCharacterLength(const Fortran::semantics::Symbol &symbol) {
371     const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
372     if (!type ||
373         type->category() != Fortran::semantics::DeclTypeSpec::Character ||
374         !type->AsIntrinsic())
375       llvm::report_fatal_error("not a character symbol");
376     int kind =
377         toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
378     switch (kind) {
379     case 1:
380       return getCharacterLengthHelper<1>(symbol);
381     case 2:
382       return getCharacterLengthHelper<2>(symbol);
383     case 4:
384       return getCharacterLengthHelper<4>(symbol);
385     }
386     llvm_unreachable("unknown character kind");
387   }
388   Fortran::lower::LenParameterTy
389   getCharacterLength(const Fortran::lower::SomeExpr &expr) {
390     // Do not use dynamic type length here. We would miss constant
391     // lengths opportunities because dynamic type only has the length
392     // if it comes from a declaration.
393     auto charExpr =
394         std::get<Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
395             expr.u);
396     if (auto constantLen = toInt64(charExpr.LEN()))
397       return *constantLen;
398     return fir::SequenceType::getUnknownExtent();
399   }
400 
401   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
402     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
403   }
404 
405   /// Derived type can be recursive. That is, pointer components of a derived
406   /// type `t` have type `t`. This helper returns `t` if it is already being
407   /// lowered to avoid infinite loops.
408   mlir::Type getTypeIfDerivedAlreadyInConstruction(
409       const Fortran::lower::SymbolRef derivedSym) const {
410     for (const auto &[sym, type] : derivedTypeInConstruction)
411       if (sym == derivedSym)
412         return type;
413     return {};
414   }
415 
416   void popDerivedTypeInConstruction() {
417     assert(!derivedTypeInConstruction.empty());
418     derivedTypeInConstruction.pop_back();
419   }
420 
421   /// Stack derived type being processed to avoid infinite loops in case of
422   /// recursive derived types. The depth of derived types is expected to be
423   /// shallow (<10), so a SmallVector is sufficient.
424   llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>>
425       derivedTypeInConstruction;
426   Fortran::lower::AbstractConverter &converter;
427   mlir::MLIRContext *context;
428 };
429 } // namespace
430 
431 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
432                                       Fortran::common::TypeCategory tc,
433                                       int kind,
434                                       llvm::ArrayRef<LenParameterTy> params) {
435   return genFIRType(context, tc, kind, params);
436 }
437 
438 mlir::Type Fortran::lower::translateDerivedTypeToFIRType(
439     Fortran::lower::AbstractConverter &converter,
440     const Fortran::semantics::DerivedTypeSpec &tySpec) {
441   return TypeBuilder{converter}.genDerivedType(tySpec);
442 }
443 
444 mlir::Type Fortran::lower::translateSomeExprToFIRType(
445     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
446   return TypeBuilder{converter}.genExprType(expr);
447 }
448 
449 mlir::Type Fortran::lower::translateSymbolToFIRType(
450     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
451   return TypeBuilder{converter}.genSymbolType(symbol);
452 }
453 
454 mlir::Type Fortran::lower::translateVariableToFIRType(
455     Fortran::lower::AbstractConverter &converter,
456     const Fortran::lower::pft::Variable &var) {
457   return TypeBuilder{converter}.genVariableType(var);
458 }
459 
460 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
461   return genRealType(context, kind);
462 }
463