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