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 genComplexType(mlir::MLIRContext *context, int KIND) {
79   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
80           Fortran::common::TypeCategory::Complex, KIND))
81     return fir::ComplexType::get(context, KIND);
82   return {};
83 }
84 
85 static mlir::Type genFIRType(mlir::MLIRContext *context,
86                              Fortran::common::TypeCategory tc, int kind) {
87   switch (tc) {
88   case Fortran::common::TypeCategory::Real:
89     return genRealType(context, kind);
90   case Fortran::common::TypeCategory::Integer:
91     return genIntegerType(context, kind);
92   case Fortran::common::TypeCategory::Complex:
93     return genComplexType(context, kind);
94   case Fortran::common::TypeCategory::Logical:
95     return genLogicalType(context, kind);
96   case Fortran::common::TypeCategory::Character:
97     TODO_NOLOC("genFIRType Character");
98   default:
99     break;
100   }
101   llvm_unreachable("unhandled type category");
102 }
103 
104 //===--------------------------------------------------------------------===//
105 // Symbol and expression type translation
106 //===--------------------------------------------------------------------===//
107 
108 /// TypeBuilder translates expression and symbol type taking into account
109 /// their shape and length parameters. For symbols, attributes such as
110 /// ALLOCATABLE or POINTER are reflected in the fir type.
111 /// It uses evaluate::DynamicType and evaluate::Shape when possible to
112 /// avoid re-implementing type/shape analysis here.
113 /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
114 /// since it is not guaranteed to exist yet when we lower types.
115 namespace {
116 class TypeBuilder {
117 public:
118   TypeBuilder(Fortran::lower::AbstractConverter &converter)
119       : converter{converter}, context{&converter.getMLIRContext()} {}
120 
121   mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
122     std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
123     if (!dynamicType)
124       return genTypelessExprType(expr);
125     Fortran::common::TypeCategory category = dynamicType->category();
126 
127     mlir::Type baseType;
128     if (category == Fortran::common::TypeCategory::Derived) {
129       TODO(converter.getCurrentLocation(), "genExprType derived");
130     } else {
131       // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
132       baseType = genFIRType(context, category, dynamicType->kind());
133     }
134     std::optional<Fortran::evaluate::Shape> shapeExpr =
135         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
136     fir::SequenceType::Shape shape;
137     if (shapeExpr) {
138       translateShape(shape, std::move(*shapeExpr));
139     } else {
140       // Shape static analysis cannot return something useful for the shape.
141       // Use unknown extents.
142       int rank = expr.Rank();
143       if (rank < 0)
144         TODO(converter.getCurrentLocation(),
145              "Assumed rank expression type lowering");
146       for (int dim = 0; dim < rank; ++dim)
147         shape.emplace_back(fir::SequenceType::getUnknownExtent());
148     }
149     if (!shape.empty())
150       return fir::SequenceType::get(shape, baseType);
151     return baseType;
152   }
153 
154   template <typename A>
155   void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
156     for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
157       fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
158       if (std::optional<std::int64_t> constantExtent =
159               toInt64(std::move(extentExpr)))
160         extent = *constantExtent;
161       shape.push_back(extent);
162     }
163   }
164 
165   template <typename A>
166   std::optional<std::int64_t> toInt64(A &&expr) {
167     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
168         converter.getFoldingContext(), std::move(expr)));
169   }
170 
171   mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
172     return std::visit(
173         Fortran::common::visitors{
174             [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
175               return mlir::NoneType::get(context);
176             },
177             [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
178               return fir::ReferenceType::get(mlir::NoneType::get(context));
179             },
180             [&](const Fortran::evaluate::ProcedureDesignator &proc)
181                 -> mlir::Type {
182               TODO(converter.getCurrentLocation(),
183                    "genTypelessExprType ProcedureDesignator");
184             },
185             [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
186               return mlir::NoneType::get(context);
187             },
188             [](const auto &x) -> mlir::Type {
189               using T = std::decay_t<decltype(x)>;
190               static_assert(!Fortran::common::HasMember<
191                                 T, Fortran::evaluate::TypelessExpression>,
192                             "missing typeless expr handling in type lowering");
193               llvm::report_fatal_error("not a typeless expression");
194             },
195         },
196         expr.u);
197   }
198 
199   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
200                            bool isAlloc = false, bool isPtr = false) {
201     mlir::Location loc = converter.genLocation(symbol.name());
202     mlir::Type ty;
203     // If the symbol is not the same as the ultimate one (i.e, it is host or use
204     // associated), all the symbol properties are the ones of the ultimate
205     // symbol but the volatile and asynchronous attributes that may differ. To
206     // avoid issues with helper functions that would not follow association
207     // links, the fir type is built based on the ultimate symbol. This relies
208     // on the fact volatile and asynchronous are not reflected in fir types.
209     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
210     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
211       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
212               type->AsIntrinsic()) {
213         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
214         ty = genFIRType(context, tySpec->category(), kind);
215       } else if (type->IsPolymorphic()) {
216         TODO(loc, "genSymbolType polymorphic types");
217       } else if (type->AsDerived()) {
218         TODO(loc, "genSymbolType derived type");
219       } else {
220         fir::emitFatalError(loc, "symbol's type must have a type spec");
221       }
222     } else {
223       fir::emitFatalError(loc, "symbol must have a type");
224     }
225     if (ultimate.IsObjectArray()) {
226       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
227           converter.getFoldingContext()}(ultimate);
228       if (!shapeExpr)
229         TODO(loc, "assumed rank symbol type lowering");
230       fir::SequenceType::Shape shape;
231       translateShape(shape, std::move(*shapeExpr));
232       ty = fir::SequenceType::get(shape, ty);
233     }
234 
235     if (Fortran::semantics::IsPointer(symbol))
236       return fir::BoxType::get(fir::PointerType::get(ty));
237     if (Fortran::semantics::IsAllocatable(symbol))
238       return fir::BoxType::get(fir::HeapType::get(ty));
239     // isPtr and isAlloc are variable that were promoted to be on the
240     // heap or to be pointers, but they do not have Fortran allocatable
241     // or pointer semantics, so do not use box for them.
242     if (isPtr)
243       return fir::PointerType::get(ty);
244     if (isAlloc)
245       return fir::HeapType::get(ty);
246     return ty;
247   }
248 
249   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
250     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
251   }
252 
253 private:
254   Fortran::lower::AbstractConverter &converter;
255   mlir::MLIRContext *context;
256 };
257 
258 } // namespace
259 
260 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
261                                       Fortran::common::TypeCategory tc,
262                                       int kind) {
263   return genFIRType(context, tc, kind);
264 }
265 
266 mlir::Type Fortran::lower::translateSomeExprToFIRType(
267     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
268   return TypeBuilder{converter}.genExprType(expr);
269 }
270 
271 mlir::Type Fortran::lower::translateSymbolToFIRType(
272     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
273   return TypeBuilder{converter}.genSymbolType(symbol);
274 }
275 
276 mlir::Type Fortran::lower::translateVariableToFIRType(
277     Fortran::lower::AbstractConverter &converter,
278     const Fortran::lower::pft::Variable &var) {
279   return TypeBuilder{converter}.genVariableType(var);
280 }
281 
282 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
283   return genRealType(context, kind);
284 }
285