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 (Fortran::semantics::IsProcedurePointer(ultimate))
229       TODO(loc, "procedure pointers");
230     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
231       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
232               type->AsIntrinsic()) {
233         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
234         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
235         translateLenParameters(params, tySpec->category(), ultimate);
236         ty = genFIRType(context, tySpec->category(), kind, params);
237       } else if (type->IsPolymorphic()) {
238         TODO(loc, "[genSymbolType] polymorphic types");
239       } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
240                      type->AsDerived()) {
241         ty = genDerivedType(*tySpec);
242       } else {
243         fir::emitFatalError(loc, "symbol's type must have a type spec");
244       }
245     } else {
246       fir::emitFatalError(loc, "symbol must have a type");
247     }
248     if (ultimate.IsObjectArray()) {
249       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
250           converter.getFoldingContext()}(ultimate);
251       if (!shapeExpr)
252         TODO(loc, "assumed rank symbol type lowering");
253       fir::SequenceType::Shape shape;
254       translateShape(shape, std::move(*shapeExpr));
255       ty = fir::SequenceType::get(shape, ty);
256     }
257 
258     if (Fortran::semantics::IsPointer(symbol))
259       return fir::BoxType::get(fir::PointerType::get(ty));
260     if (Fortran::semantics::IsAllocatable(symbol))
261       return fir::BoxType::get(fir::HeapType::get(ty));
262     // isPtr and isAlloc are variable that were promoted to be on the
263     // heap or to be pointers, but they do not have Fortran allocatable
264     // or pointer semantics, so do not use box for them.
265     if (isPtr)
266       return fir::PointerType::get(ty);
267     if (isAlloc)
268       return fir::HeapType::get(ty);
269     return ty;
270   }
271 
272   /// Does \p component has non deferred lower bounds that are not compile time
273   /// constant 1.
274   static bool componentHasNonDefaultLowerBounds(
275       const Fortran::semantics::Symbol &component) {
276     if (const auto *objDetails =
277             component.detailsIf<Fortran::semantics::ObjectEntityDetails>())
278       for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
279         if (auto lb = bounds.lbound().GetExplicit())
280           if (auto constant = Fortran::evaluate::ToInt64(*lb))
281             if (!constant || *constant != 1)
282               return true;
283     return false;
284   }
285 
286   mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
287     std::vector<std::pair<std::string, mlir::Type>> ps;
288     std::vector<std::pair<std::string, mlir::Type>> cs;
289     const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
290     if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
291       return ty;
292     auto rec = fir::RecordType::get(context,
293                                     Fortran::lower::mangle::mangleName(tySpec));
294     // Maintain the stack of types for recursive references.
295     derivedTypeInConstruction.emplace_back(typeSymbol, rec);
296 
297     // Gather the record type fields.
298     // (1) The data components.
299     for (const auto &field :
300          Fortran::semantics::OrderedComponentIterator(tySpec)) {
301       // Lowering is assuming non deferred component lower bounds are always 1.
302       // Catch any situations where this is not true for now.
303       if (componentHasNonDefaultLowerBounds(field))
304         TODO(converter.genLocation(field.name()),
305              "lowering derived type components with non default lower bounds");
306       if (IsProcedure(field))
307         TODO(converter.genLocation(field.name()), "procedure components");
308       mlir::Type ty = genSymbolType(field);
309       // Do not add the parent component (component of the parents are
310       // added and should be sufficient, the parent component would
311       // duplicate the fields).
312       if (field.test(Fortran::semantics::Symbol::Flag::ParentComp))
313         continue;
314       cs.emplace_back(field.name().ToString(), ty);
315     }
316 
317     // (2) The LEN type parameters.
318     for (const auto &param :
319          Fortran::semantics::OrderParameterDeclarations(typeSymbol))
320       if (param->get<Fortran::semantics::TypeParamDetails>().attr() ==
321           Fortran::common::TypeParamAttr::Len)
322         ps.emplace_back(param->name().ToString(), genSymbolType(*param));
323 
324     rec.finalize(ps, cs);
325     popDerivedTypeInConstruction();
326 
327     mlir::Location loc = converter.genLocation(typeSymbol.name());
328     if (!ps.empty()) {
329       // This type is a PDT (parametric derived type). Create the functions to
330       // use for allocation, dereferencing, and address arithmetic here.
331       TODO(loc, "parametrized derived types lowering");
332     }
333     LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
334 
335     // Generate the type descriptor object if any
336     if (const Fortran::semantics::Scope *derivedScope =
337             tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope())
338       if (const Fortran::semantics::Symbol *typeInfoSym =
339               derivedScope->runtimeDerivedTypeDescription())
340         converter.registerRuntimeTypeInfo(loc, *typeInfoSym);
341     return rec;
342   }
343 
344   // To get the character length from a symbol, make an fold a designator for
345   // the symbol to cover the case where the symbol is an assumed length named
346   // constant and its length comes from its init expression length.
347   template <int Kind>
348   fir::SequenceType::Extent
349   getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
350     using TC =
351         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
352     auto designator = Fortran::evaluate::Fold(
353         converter.getFoldingContext(),
354         Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
355     if (auto len = toInt64(std::move(designator.LEN())))
356       return *len;
357     return fir::SequenceType::getUnknownExtent();
358   }
359 
360   template <typename T>
361   void translateLenParameters(
362       llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
363       Fortran::common::TypeCategory category, const T &exprOrSym) {
364     if (category == Fortran::common::TypeCategory::Character)
365       params.push_back(getCharacterLength(exprOrSym));
366     else if (category == Fortran::common::TypeCategory::Derived)
367       TODO(converter.getCurrentLocation(),
368            "lowering derived type length parameters");
369     return;
370   }
371   Fortran::lower::LenParameterTy
372   getCharacterLength(const Fortran::semantics::Symbol &symbol) {
373     const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
374     if (!type ||
375         type->category() != Fortran::semantics::DeclTypeSpec::Character ||
376         !type->AsIntrinsic())
377       llvm::report_fatal_error("not a character symbol");
378     int kind =
379         toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
380     switch (kind) {
381     case 1:
382       return getCharacterLengthHelper<1>(symbol);
383     case 2:
384       return getCharacterLengthHelper<2>(symbol);
385     case 4:
386       return getCharacterLengthHelper<4>(symbol);
387     }
388     llvm_unreachable("unknown character kind");
389   }
390   Fortran::lower::LenParameterTy
391   getCharacterLength(const Fortran::lower::SomeExpr &expr) {
392     // Do not use dynamic type length here. We would miss constant
393     // lengths opportunities because dynamic type only has the length
394     // if it comes from a declaration.
395     auto charExpr =
396         std::get<Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
397             expr.u);
398     if (auto constantLen = toInt64(charExpr.LEN()))
399       return *constantLen;
400     return fir::SequenceType::getUnknownExtent();
401   }
402 
403   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
404     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
405   }
406 
407   /// Derived type can be recursive. That is, pointer components of a derived
408   /// type `t` have type `t`. This helper returns `t` if it is already being
409   /// lowered to avoid infinite loops.
410   mlir::Type getTypeIfDerivedAlreadyInConstruction(
411       const Fortran::lower::SymbolRef derivedSym) const {
412     for (const auto &[sym, type] : derivedTypeInConstruction)
413       if (sym == derivedSym)
414         return type;
415     return {};
416   }
417 
418   void popDerivedTypeInConstruction() {
419     assert(!derivedTypeInConstruction.empty());
420     derivedTypeInConstruction.pop_back();
421   }
422 
423   /// Stack derived type being processed to avoid infinite loops in case of
424   /// recursive derived types. The depth of derived types is expected to be
425   /// shallow (<10), so a SmallVector is sufficient.
426   llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>>
427       derivedTypeInConstruction;
428   Fortran::lower::AbstractConverter &converter;
429   mlir::MLIRContext *context;
430 };
431 } // namespace
432 
433 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
434                                       Fortran::common::TypeCategory tc,
435                                       int kind,
436                                       llvm::ArrayRef<LenParameterTy> params) {
437   return genFIRType(context, tc, kind, params);
438 }
439 
440 mlir::Type Fortran::lower::translateDerivedTypeToFIRType(
441     Fortran::lower::AbstractConverter &converter,
442     const Fortran::semantics::DerivedTypeSpec &tySpec) {
443   return TypeBuilder{converter}.genDerivedType(tySpec);
444 }
445 
446 mlir::Type Fortran::lower::translateSomeExprToFIRType(
447     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
448   return TypeBuilder{converter}.genExprType(expr);
449 }
450 
451 mlir::Type Fortran::lower::translateSymbolToFIRType(
452     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
453   return TypeBuilder{converter}.genSymbolType(symbol);
454 }
455 
456 mlir::Type Fortran::lower::translateVariableToFIRType(
457     Fortran::lower::AbstractConverter &converter,
458     const Fortran::lower::pft::Variable &var) {
459   return TypeBuilder{converter}.genVariableType(var);
460 }
461 
462 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
463   return genRealType(context, kind);
464 }
465