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