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