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/Todo.h"
13 #include "flang/Lower/Utils.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 template <typename A>
105 bool isConstant(const Fortran::evaluate::Expr<A> &e) {
106   return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e});
107 }
108 
109 template <typename A>
110 int64_t toConstant(const Fortran::evaluate::Expr<A> &e) {
111   auto opt = Fortran::evaluate::ToInt64(e);
112   assert(opt.has_value() && "expression didn't resolve to a constant");
113   return opt.value();
114 }
115 
116 // one argument template, must be specialized
117 template <Fortran::common::TypeCategory TC>
118 mlir::Type genFIRType(mlir::MLIRContext *, int) {
119   return {};
120 }
121 
122 // two argument template
123 template <Fortran::common::TypeCategory TC, int KIND>
124 mlir::Type genFIRType(mlir::MLIRContext *context) {
125   if constexpr (TC == Fortran::common::TypeCategory::Integer) {
126     auto bits{Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
127                                       KIND>::Scalar::bits};
128     return mlir::IntegerType::get(context, bits);
129   } else if constexpr (TC == Fortran::common::TypeCategory::Logical ||
130                        TC == Fortran::common::TypeCategory::Character ||
131                        TC == Fortran::common::TypeCategory::Complex) {
132     return genFIRType<TC>(context, KIND);
133   } else {
134     return {};
135   }
136 }
137 
138 template <>
139 mlir::Type
140 genFIRType<Fortran::common::TypeCategory::Character>(mlir::MLIRContext *context,
141                                                      int KIND) {
142   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
143           Fortran::common::TypeCategory::Character, KIND))
144     return fir::CharacterType::get(context, KIND, 1);
145   return {};
146 }
147 
148 namespace {
149 
150 /// Discover the type of an Fortran::evaluate::Expr<T> and convert it to an
151 /// mlir::Type. The type returned may be an MLIR standard or FIR type.
152 class TypeBuilder {
153 public:
154   TypeBuilder(Fortran::lower::AbstractConverter &converter)
155       : converter{converter}, context{&converter.getMLIRContext()} {}
156 
157   template <typename A>
158   std::optional<std::int64_t> toInt64(A &&expr) {
159     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
160         converter.getFoldingContext(), std::move(expr)));
161   }
162 
163   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
164                            bool isAlloc = false, bool isPtr = false) {
165     mlir::Location loc = converter.genLocation(symbol.name());
166     mlir::Type ty;
167     // If the symbol is not the same as the ultimate one (i.e, it is host or use
168     // associated), all the symbol properties are the ones of the ultimate
169     // symbol but the volatile and asynchronous attributes that may differ. To
170     // avoid issues with helper functions that would not follow association
171     // links, the fir type is built based on the ultimate symbol. This relies
172     // on the fact volatile and asynchronous are not reflected in fir types.
173     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
174     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
175       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
176               type->AsIntrinsic()) {
177         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
178         ty = genFIRType(context, tySpec->category(), kind);
179       } else if (type->IsPolymorphic()) {
180         TODO(loc, "genSymbolType polymorphic types");
181       } else if (type->AsDerived()) {
182         TODO(loc, "genSymbolType derived type");
183       } else {
184         fir::emitFatalError(loc, "symbol's type must have a type spec");
185       }
186     } else {
187       fir::emitFatalError(loc, "symbol must have a type");
188     }
189 
190     if (Fortran::semantics::IsPointer(symbol))
191       return fir::BoxType::get(fir::PointerType::get(ty));
192     if (Fortran::semantics::IsAllocatable(symbol))
193       return fir::BoxType::get(fir::HeapType::get(ty));
194     // isPtr and isAlloc are variable that were promoted to be on the
195     // heap or to be pointers, but they do not have Fortran allocatable
196     // or pointer semantics, so do not use box for them.
197     if (isPtr)
198       return fir::PointerType::get(ty);
199     if (isAlloc)
200       return fir::HeapType::get(ty);
201     return ty;
202   }
203 
204   //===--------------------------------------------------------------------===//
205   // Generate type entry points
206   //===--------------------------------------------------------------------===//
207 
208   template <template <typename> typename A, Fortran::common::TypeCategory TC>
209   mlir::Type gen(const A<Fortran::evaluate::SomeKind<TC>> &) {
210     return genFIRType<TC>(context, defaultKind<TC>());
211   }
212 
213   template <template <typename> typename A, Fortran::common::TypeCategory TC,
214             int KIND>
215   mlir::Type gen(const A<Fortran::evaluate::Type<TC, KIND>> &) {
216     return genFIRType<TC, KIND>(context);
217   }
218 
219   // breaks the conflict between A<Type<TC,KIND>> and Expr<B> deduction
220   template <Fortran::common::TypeCategory TC, int KIND>
221   mlir::Type
222   gen(const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> &) {
223     return genFIRType<TC, KIND>(context);
224   }
225 
226   // breaks the conflict between A<SomeKind<TC>> and Expr<B> deduction
227   template <Fortran::common::TypeCategory TC>
228   mlir::Type
229   gen(const Fortran::evaluate::Expr<Fortran::evaluate::SomeKind<TC>> &expr) {
230     return {};
231   }
232 
233   template <typename A>
234   mlir::Type gen(const Fortran::evaluate::Expr<A> &expr) {
235     return {};
236   }
237 
238   mlir::Type gen(const Fortran::evaluate::DataRef &dref) { return {}; }
239 
240   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
241     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
242   }
243 
244   // non-template, category is runtime values, kind is defaulted
245   mlir::Type genFIRTy(Fortran::common::TypeCategory tc) {
246     return genFIRTy(tc, defaultKind(tc));
247   }
248 
249   // non-template, arguments are runtime values
250   mlir::Type genFIRTy(Fortran::common::TypeCategory tc, int kind) {
251     switch (tc) {
252     case Fortran::common::TypeCategory::Real:
253       return genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
254     case Fortran::common::TypeCategory::Integer:
255       return genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
256     case Fortran::common::TypeCategory::Complex:
257       return genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
258     case Fortran::common::TypeCategory::Logical:
259       return genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
260     case Fortran::common::TypeCategory::Character:
261       return genFIRType<Fortran::common::TypeCategory::Character>(context,
262                                                                   kind);
263     default:
264       break;
265     }
266     llvm_unreachable("unhandled type category");
267   }
268 
269 private:
270   //===--------------------------------------------------------------------===//
271   // Generate type helpers
272   //===--------------------------------------------------------------------===//
273 
274   mlir::Type gen(const Fortran::evaluate::ImpliedDoIndex &) {
275     return genFIRType<Fortran::evaluate::ImpliedDoIndex::Result::category>(
276         context, Fortran::evaluate::ImpliedDoIndex::Result::kind);
277   }
278 
279   mlir::Type gen(const Fortran::evaluate::TypeParamInquiry &) {
280     return genFIRType<Fortran::evaluate::TypeParamInquiry::Result::category>(
281         context, Fortran::evaluate::TypeParamInquiry::Result::kind);
282   }
283 
284   template <typename A>
285   mlir::Type gen(const Fortran::evaluate::Relational<A> &) {
286     return genFIRType<Fortran::common::TypeCategory::Logical, 1>(context);
287   }
288 
289   // some sequence of `n` bytes
290   mlir::Type gen(const Fortran::evaluate::StaticDataObject::Pointer &ptr) {
291     mlir::Type byteTy{mlir::IntegerType::get(context, 8)};
292     return fir::SequenceType::get(trivialShape(ptr->itemBytes()), byteTy);
293   }
294 
295   mlir::Type gen(const Fortran::evaluate::Substring &ss) { return {}; }
296 
297   mlir::Type gen(const Fortran::evaluate::NullPointer &) {
298     return genTypelessPtr();
299   }
300   mlir::Type gen(const Fortran::evaluate::ProcedureRef &) {
301     return genTypelessPtr();
302   }
303   mlir::Type gen(const Fortran::evaluate::ProcedureDesignator &) {
304     return genTypelessPtr();
305   }
306   mlir::Type gen(const Fortran::evaluate::BOZLiteralConstant &) {
307     return genTypelessPtr();
308   }
309   mlir::Type gen(const Fortran::evaluate::ArrayRef &) {
310     TODO_NOLOC("array ref");
311   }
312   mlir::Type gen(const Fortran::evaluate::CoarrayRef &) {
313     TODO_NOLOC("coarray ref");
314   }
315   mlir::Type gen(const Fortran::evaluate::Component &) {
316     TODO_NOLOC("component");
317   }
318   mlir::Type gen(const Fortran::evaluate::ComplexPart &) {
319     TODO_NOLOC("complex part");
320   }
321   mlir::Type gen(const Fortran::evaluate::DescriptorInquiry &) {
322     TODO_NOLOC("descriptor inquiry");
323   }
324   mlir::Type gen(const Fortran::evaluate::StructureConstructor &) {
325     TODO_NOLOC("structure constructor");
326   }
327 
328   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol) {
329     assert(symbol->IsObjectArray() && "unexpected symbol type");
330     fir::SequenceType::Shape bounds;
331     return seqShapeHelper(symbol, bounds);
332   }
333 
334   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol,
335                                        fir::SequenceType::Extent charLen) {
336     assert(symbol->IsObjectArray() && "unexpected symbol type");
337     fir::SequenceType::Shape bounds;
338     bounds.push_back(charLen);
339     return seqShapeHelper(symbol, bounds);
340   }
341 
342   //===--------------------------------------------------------------------===//
343   // Other helper functions
344   //===--------------------------------------------------------------------===//
345 
346   fir::SequenceType::Shape trivialShape(int size) {
347     fir::SequenceType::Shape bounds;
348     bounds.emplace_back(size);
349     return bounds;
350   }
351 
352   mlir::Type mkVoid() { return mlir::TupleType::get(context); }
353   mlir::Type genTypelessPtr() { return fir::ReferenceType::get(mkVoid()); }
354 
355   template <Fortran::common::TypeCategory TC>
356   int defaultKind() {
357     return defaultKind(TC);
358   }
359   int defaultKind(Fortran::common::TypeCategory TC) { return 0; }
360 
361   fir::SequenceType::Shape seqShapeHelper(Fortran::semantics::SymbolRef symbol,
362                                           fir::SequenceType::Shape &bounds) {
363     auto &details = symbol->get<Fortran::semantics::ObjectEntityDetails>();
364     const auto size = details.shape().size();
365     for (auto &ss : details.shape()) {
366       auto lb = ss.lbound();
367       auto ub = ss.ubound();
368       if (lb.isStar() && ub.isStar() && size == 1)
369         return {}; // assumed rank
370       if (lb.isExplicit() && ub.isExplicit()) {
371         auto &lbv = lb.GetExplicit();
372         auto &ubv = ub.GetExplicit();
373         if (lbv.has_value() && ubv.has_value() && isConstant(lbv.value()) &&
374             isConstant(ubv.value())) {
375           bounds.emplace_back(toConstant(ubv.value()) -
376                               toConstant(lbv.value()) + 1);
377         } else {
378           bounds.emplace_back(fir::SequenceType::getUnknownExtent());
379         }
380       } else {
381         bounds.emplace_back(fir::SequenceType::getUnknownExtent());
382       }
383     }
384     return bounds;
385   }
386 
387   //===--------------------------------------------------------------------===//
388   // Emit errors and warnings.
389   //===--------------------------------------------------------------------===//
390 
391   mlir::InFlightDiagnostic emitError(const llvm::Twine &message) {
392     return mlir::emitError(mlir::UnknownLoc::get(context), message);
393   }
394 
395   mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) {
396     return mlir::emitWarning(mlir::UnknownLoc::get(context), message);
397   }
398 
399   //===--------------------------------------------------------------------===//
400 
401   Fortran::lower::AbstractConverter &converter;
402   mlir::MLIRContext *context;
403 };
404 
405 } // namespace
406 
407 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
408                                       Fortran::common::TypeCategory tc,
409                                       int kind) {
410   return genFIRType(context, tc, kind);
411 }
412 
413 mlir::Type
414 Fortran::lower::getFIRType(Fortran::lower::AbstractConverter &converter,
415                            Fortran::common::TypeCategory tc) {
416   return TypeBuilder{converter}.genFIRTy(tc);
417 }
418 
419 mlir::Type Fortran::lower::translateDataRefToFIRType(
420     Fortran::lower::AbstractConverter &converter,
421     const Fortran::evaluate::DataRef &dataRef) {
422   return TypeBuilder{converter}.gen(dataRef);
423 }
424 
425 mlir::Type Fortran::lower::translateSomeExprToFIRType(
426     Fortran::lower::AbstractConverter &converter, const SomeExpr *expr) {
427   return TypeBuilder{converter}.gen(*expr);
428 }
429 
430 mlir::Type Fortran::lower::translateSymbolToFIRType(
431     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
432   return TypeBuilder{converter}.genSymbolType(symbol);
433 }
434 
435 mlir::Type Fortran::lower::translateVariableToFIRType(
436     Fortran::lower::AbstractConverter &converter,
437     const Fortran::lower::pft::Variable &var) {
438   return TypeBuilder{converter}.genVariableType(var);
439 }
440 
441 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
442   return genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
443 }
444 
445 mlir::Type Fortran::lower::getSequenceRefType(mlir::Type refType) {
446   auto type{refType.dyn_cast<fir::ReferenceType>()};
447   assert(type && "expected a reference type");
448   auto elementType{type.getEleTy()};
449   fir::SequenceType::Shape shape{fir::SequenceType::getUnknownExtent()};
450   return fir::ReferenceType::get(fir::SequenceType::get(shape, elementType));
451 }
452