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/PFTBuilder.h"
12 #include "flang/Lower/Support/Utils.h"
13 #include "flang/Lower/Todo.h"
14 #include "flang/Optimizer/Dialect/FIRType.h"
15 #include "flang/Semantics/tools.h"
16 #include "flang/Semantics/type.h"
17 #include "mlir/IR/Builders.h"
18 #include "mlir/IR/BuiltinTypes.h"
19 
20 #define DEBUG_TYPE "flang-lower-type"
21 
22 //===--------------------------------------------------------------------===//
23 // Intrinsic type translation helpers
24 //===--------------------------------------------------------------------===//
25 
26 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
27   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
28           Fortran::common::TypeCategory::Real, kind)) {
29     switch (kind) {
30     case 2:
31       return mlir::FloatType::getF16(context);
32     case 3:
33       return mlir::FloatType::getBF16(context);
34     case 4:
35       return mlir::FloatType::getF32(context);
36     case 8:
37       return mlir::FloatType::getF64(context);
38     case 10:
39       return mlir::FloatType::getF80(context);
40     case 16:
41       return mlir::FloatType::getF128(context);
42     }
43   }
44   llvm_unreachable("REAL type translation not implemented");
45 }
46 
47 template <int KIND>
48 int getIntegerBits() {
49   return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
50                                  KIND>::Scalar::bits;
51 }
52 static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) {
53   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
54           Fortran::common::TypeCategory::Integer, kind)) {
55     switch (kind) {
56     case 1:
57       return mlir::IntegerType::get(context, getIntegerBits<1>());
58     case 2:
59       return mlir::IntegerType::get(context, getIntegerBits<2>());
60     case 4:
61       return mlir::IntegerType::get(context, getIntegerBits<4>());
62     case 8:
63       return mlir::IntegerType::get(context, getIntegerBits<8>());
64     case 16:
65       return mlir::IntegerType::get(context, getIntegerBits<16>());
66     }
67   }
68   llvm_unreachable("INTEGER kind not translated");
69 }
70 
71 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
72   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
73           Fortran::common::TypeCategory::Logical, KIND))
74     return fir::LogicalType::get(context, KIND);
75   return {};
76 }
77 
78 static mlir::Type genCharacterType(
79     mlir::MLIRContext *context, int KIND,
80     Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) {
81   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
82           Fortran::common::TypeCategory::Character, KIND))
83     return fir::CharacterType::get(context, KIND, len);
84   return {};
85 }
86 
87 static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) {
88   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
89           Fortran::common::TypeCategory::Complex, KIND))
90     return fir::ComplexType::get(context, KIND);
91   return {};
92 }
93 
94 static mlir::Type
95 genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
96            int kind,
97            llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) {
98   switch (tc) {
99   case Fortran::common::TypeCategory::Real:
100     return genRealType(context, kind);
101   case Fortran::common::TypeCategory::Integer:
102     return genIntegerType(context, kind);
103   case Fortran::common::TypeCategory::Complex:
104     return genComplexType(context, kind);
105   case Fortran::common::TypeCategory::Logical:
106     return genLogicalType(context, kind);
107   case Fortran::common::TypeCategory::Character:
108     if (!lenParameters.empty())
109       return genCharacterType(context, kind, lenParameters[0]);
110     return genCharacterType(context, kind);
111   default:
112     break;
113   }
114   llvm_unreachable("unhandled type category");
115 }
116 
117 //===--------------------------------------------------------------------===//
118 // Symbol and expression type translation
119 //===--------------------------------------------------------------------===//
120 
121 /// TypeBuilder translates expression and symbol type taking into account
122 /// their shape and length parameters. For symbols, attributes such as
123 /// ALLOCATABLE or POINTER are reflected in the fir type.
124 /// It uses evaluate::DynamicType and evaluate::Shape when possible to
125 /// avoid re-implementing type/shape analysis here.
126 /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
127 /// since it is not guaranteed to exist yet when we lower types.
128 namespace {
129 class TypeBuilder {
130 public:
131   TypeBuilder(Fortran::lower::AbstractConverter &converter)
132       : converter{converter}, context{&converter.getMLIRContext()} {}
133 
134   mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
135     std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
136     if (!dynamicType)
137       return genTypelessExprType(expr);
138     Fortran::common::TypeCategory category = dynamicType->category();
139 
140     mlir::Type baseType;
141     if (category == Fortran::common::TypeCategory::Derived) {
142       TODO(converter.getCurrentLocation(), "genExprType derived");
143     } else {
144       // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
145       llvm::SmallVector<Fortran::lower::LenParameterTy> params;
146       translateLenParameters(params, category, expr);
147       baseType = genFIRType(context, category, dynamicType->kind(), params);
148     }
149     std::optional<Fortran::evaluate::Shape> shapeExpr =
150         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
151     fir::SequenceType::Shape shape;
152     if (shapeExpr) {
153       translateShape(shape, std::move(*shapeExpr));
154     } else {
155       // Shape static analysis cannot return something useful for the shape.
156       // Use unknown extents.
157       int rank = expr.Rank();
158       if (rank < 0)
159         TODO(converter.getCurrentLocation(),
160              "Assumed rank expression type lowering");
161       for (int dim = 0; dim < rank; ++dim)
162         shape.emplace_back(fir::SequenceType::getUnknownExtent());
163     }
164     if (!shape.empty())
165       return fir::SequenceType::get(shape, baseType);
166     return baseType;
167   }
168 
169   template <typename A>
170   void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
171     for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
172       fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
173       if (std::optional<std::int64_t> constantExtent =
174               toInt64(std::move(extentExpr)))
175         extent = *constantExtent;
176       shape.push_back(extent);
177     }
178   }
179 
180   template <typename A>
181   std::optional<std::int64_t> toInt64(A &&expr) {
182     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
183         converter.getFoldingContext(), std::move(expr)));
184   }
185 
186   mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
187     return std::visit(
188         Fortran::common::visitors{
189             [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
190               return mlir::NoneType::get(context);
191             },
192             [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
193               return fir::ReferenceType::get(mlir::NoneType::get(context));
194             },
195             [&](const Fortran::evaluate::ProcedureDesignator &proc)
196                 -> mlir::Type {
197               TODO(converter.getCurrentLocation(),
198                    "genTypelessExprType ProcedureDesignator");
199             },
200             [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
201               return mlir::NoneType::get(context);
202             },
203             [](const auto &x) -> mlir::Type {
204               using T = std::decay_t<decltype(x)>;
205               static_assert(!Fortran::common::HasMember<
206                                 T, Fortran::evaluate::TypelessExpression>,
207                             "missing typeless expr handling in type lowering");
208               llvm::report_fatal_error("not a typeless expression");
209             },
210         },
211         expr.u);
212   }
213 
214   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
215                            bool isAlloc = false, bool isPtr = false) {
216     mlir::Location loc = converter.genLocation(symbol.name());
217     mlir::Type ty;
218     // If the symbol is not the same as the ultimate one (i.e, it is host or use
219     // associated), all the symbol properties are the ones of the ultimate
220     // symbol but the volatile and asynchronous attributes that may differ. To
221     // avoid issues with helper functions that would not follow association
222     // links, the fir type is built based on the ultimate symbol. This relies
223     // on the fact volatile and asynchronous are not reflected in fir types.
224     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
225     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
226       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
227               type->AsIntrinsic()) {
228         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
229         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
230         translateLenParameters(params, tySpec->category(), ultimate);
231         ty = genFIRType(context, tySpec->category(), kind, params);
232       } else if (type->IsPolymorphic()) {
233         TODO(loc, "genSymbolType polymorphic types");
234       } else if (type->AsDerived()) {
235         TODO(loc, "genSymbolType derived type");
236       } else {
237         fir::emitFatalError(loc, "symbol's type must have a type spec");
238       }
239     } else {
240       fir::emitFatalError(loc, "symbol must have a type");
241     }
242     if (ultimate.IsObjectArray()) {
243       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
244           converter.getFoldingContext()}(ultimate);
245       if (!shapeExpr)
246         TODO(loc, "assumed rank symbol type lowering");
247       fir::SequenceType::Shape shape;
248       translateShape(shape, std::move(*shapeExpr));
249       ty = fir::SequenceType::get(shape, ty);
250     }
251 
252     if (Fortran::semantics::IsPointer(symbol))
253       return fir::BoxType::get(fir::PointerType::get(ty));
254     if (Fortran::semantics::IsAllocatable(symbol))
255       return fir::BoxType::get(fir::HeapType::get(ty));
256     // isPtr and isAlloc are variable that were promoted to be on the
257     // heap or to be pointers, but they do not have Fortran allocatable
258     // or pointer semantics, so do not use box for them.
259     if (isPtr)
260       return fir::PointerType::get(ty);
261     if (isAlloc)
262       return fir::HeapType::get(ty);
263     return ty;
264   }
265 
266   // To get the character length from a symbol, make an fold a designator for
267   // the symbol to cover the case where the symbol is an assumed length named
268   // constant and its length comes from its init expression length.
269   template <int Kind>
270   fir::SequenceType::Extent
271   getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
272     using TC =
273         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
274     auto designator = Fortran::evaluate::Fold(
275         converter.getFoldingContext(),
276         Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
277     if (auto len = toInt64(std::move(designator.LEN())))
278       return *len;
279     return fir::SequenceType::getUnknownExtent();
280   }
281 
282   template <typename T>
283   void translateLenParameters(
284       llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
285       Fortran::common::TypeCategory category, const T &exprOrSym) {
286     if (category == Fortran::common::TypeCategory::Character)
287       params.push_back(getCharacterLength(exprOrSym));
288     else if (category == Fortran::common::TypeCategory::Derived)
289       TODO(converter.getCurrentLocation(),
290            "lowering derived type length parameters");
291     return;
292   }
293   Fortran::lower::LenParameterTy
294   getCharacterLength(const Fortran::semantics::Symbol &symbol) {
295     const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
296     if (!type ||
297         type->category() != Fortran::semantics::DeclTypeSpec::Character ||
298         !type->AsIntrinsic())
299       llvm::report_fatal_error("not a character symbol");
300     int kind =
301         toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
302     switch (kind) {
303     case 1:
304       return getCharacterLengthHelper<1>(symbol);
305     case 2:
306       return getCharacterLengthHelper<2>(symbol);
307     case 4:
308       return getCharacterLengthHelper<4>(symbol);
309     }
310     llvm_unreachable("unknown character kind");
311   }
312   Fortran::lower::LenParameterTy
313   getCharacterLength(const Fortran::lower::SomeExpr &expr) {
314     // Do not use dynamic type length here. We would miss constant
315     // lengths opportunities because dynamic type only has the length
316     // if it comes from a declaration.
317     auto charExpr =
318         std::get<Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
319             expr.u);
320     if (auto constantLen = toInt64(charExpr.LEN()))
321       return *constantLen;
322     return fir::SequenceType::getUnknownExtent();
323   }
324 
325   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
326     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
327   }
328 
329 private:
330   Fortran::lower::AbstractConverter &converter;
331   mlir::MLIRContext *context;
332 };
333 
334 } // namespace
335 
336 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
337                                       Fortran::common::TypeCategory tc,
338                                       int kind,
339                                       llvm::ArrayRef<LenParameterTy> params) {
340   return genFIRType(context, tc, kind, params);
341 }
342 
343 mlir::Type Fortran::lower::translateSomeExprToFIRType(
344     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
345   return TypeBuilder{converter}.genExprType(expr);
346 }
347 
348 mlir::Type Fortran::lower::translateSymbolToFIRType(
349     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
350   return TypeBuilder{converter}.genSymbolType(symbol);
351 }
352 
353 mlir::Type Fortran::lower::translateVariableToFIRType(
354     Fortran::lower::AbstractConverter &converter,
355     const Fortran::lower::pft::Variable &var) {
356   return TypeBuilder{converter}.genVariableType(var);
357 }
358 
359 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
360   return genRealType(context, kind);
361 }
362