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