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