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/PFTBuilder.h"
11 #include "flang/Lower/Utils.h"
12 #include "flang/Optimizer/Dialect/FIRType.h"
13 #include "flang/Semantics/tools.h"
14 #include "flang/Semantics/type.h"
15 #include "mlir/IR/Builders.h"
16 #include "mlir/IR/StandardTypes.h"
17 
18 #undef QUOTE
19 #undef TODO
20 #define QUOTE(X) #X
21 #define TODO(S)                                                                \
22   {                                                                            \
23     emitError(__FILE__ ":" QUOTE(__LINE__) ": type lowering of " S             \
24                                            " not implemented");                \
25     exit(1);                                                                   \
26   }
27 
28 template <typename A>
29 bool isConstant(const Fortran::evaluate::Expr<A> &e) {
30   return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e});
31 }
32 
33 template <typename A>
34 int64_t toConstant(const Fortran::evaluate::Expr<A> &e) {
35   auto opt = Fortran::evaluate::ToInt64(e);
36   assert(opt.has_value() && "expression didn't resolve to a constant");
37   return opt.value();
38 }
39 
40 // one argument template, must be specialized
41 template <Fortran::common::TypeCategory TC>
42 mlir::Type genFIRType(mlir::MLIRContext *, int) {
43   return {};
44 }
45 
46 // two argument template
47 template <Fortran::common::TypeCategory TC, int KIND>
48 mlir::Type genFIRType(mlir::MLIRContext *context) {
49   if constexpr (TC == Fortran::common::TypeCategory::Integer) {
50     auto bits{Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
51                                       KIND>::Scalar::bits};
52     return mlir::IntegerType::get(bits, context);
53   } else if constexpr (TC == Fortran::common::TypeCategory::Logical ||
54                        TC == Fortran::common::TypeCategory::Character ||
55                        TC == Fortran::common::TypeCategory::Complex) {
56     return genFIRType<TC>(context, KIND);
57   } else {
58     return {};
59   }
60 }
61 
62 template <>
63 mlir::Type
64 genFIRType<Fortran::common::TypeCategory::Real, 2>(mlir::MLIRContext *context) {
65   return mlir::FloatType::getF16(context);
66 }
67 
68 template <>
69 mlir::Type
70 genFIRType<Fortran::common::TypeCategory::Real, 3>(mlir::MLIRContext *context) {
71   return mlir::FloatType::getBF16(context);
72 }
73 
74 template <>
75 mlir::Type
76 genFIRType<Fortran::common::TypeCategory::Real, 4>(mlir::MLIRContext *context) {
77   return mlir::FloatType::getF32(context);
78 }
79 
80 template <>
81 mlir::Type
82 genFIRType<Fortran::common::TypeCategory::Real, 8>(mlir::MLIRContext *context) {
83   return mlir::FloatType::getF64(context);
84 }
85 
86 template <>
87 mlir::Type genFIRType<Fortran::common::TypeCategory::Real, 10>(
88     mlir::MLIRContext *context) {
89   return fir::RealType::get(context, 10);
90 }
91 
92 template <>
93 mlir::Type genFIRType<Fortran::common::TypeCategory::Real, 16>(
94     mlir::MLIRContext *context) {
95   return fir::RealType::get(context, 16);
96 }
97 
98 template <>
99 mlir::Type
100 genFIRType<Fortran::common::TypeCategory::Real>(mlir::MLIRContext *context,
101                                                 int kind) {
102   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
103           Fortran::common::TypeCategory::Real, kind)) {
104     switch (kind) {
105     case 2:
106       return genFIRType<Fortran::common::TypeCategory::Real, 2>(context);
107     case 3:
108       return genFIRType<Fortran::common::TypeCategory::Real, 3>(context);
109     case 4:
110       return genFIRType<Fortran::common::TypeCategory::Real, 4>(context);
111     case 8:
112       return genFIRType<Fortran::common::TypeCategory::Real, 8>(context);
113     case 10:
114       return genFIRType<Fortran::common::TypeCategory::Real, 10>(context);
115     case 16:
116       return genFIRType<Fortran::common::TypeCategory::Real, 16>(context);
117     }
118   }
119   llvm_unreachable("REAL type translation not implemented");
120 }
121 
122 template <>
123 mlir::Type
124 genFIRType<Fortran::common::TypeCategory::Integer>(mlir::MLIRContext *context,
125                                                    int kind) {
126   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
127           Fortran::common::TypeCategory::Integer, kind)) {
128     switch (kind) {
129     case 1:
130       return genFIRType<Fortran::common::TypeCategory::Integer, 1>(context);
131     case 2:
132       return genFIRType<Fortran::common::TypeCategory::Integer, 2>(context);
133     case 4:
134       return genFIRType<Fortran::common::TypeCategory::Integer, 4>(context);
135     case 8:
136       return genFIRType<Fortran::common::TypeCategory::Integer, 8>(context);
137     case 16:
138       return genFIRType<Fortran::common::TypeCategory::Integer, 16>(context);
139     }
140   }
141   llvm_unreachable("INTEGER type translation not implemented");
142 }
143 
144 template <>
145 mlir::Type
146 genFIRType<Fortran::common::TypeCategory::Logical>(mlir::MLIRContext *context,
147                                                    int KIND) {
148   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
149           Fortran::common::TypeCategory::Logical, KIND))
150     return fir::LogicalType::get(context, KIND);
151   return {};
152 }
153 
154 template <>
155 mlir::Type
156 genFIRType<Fortran::common::TypeCategory::Character>(mlir::MLIRContext *context,
157                                                      int KIND) {
158   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
159           Fortran::common::TypeCategory::Character, KIND))
160     return fir::CharacterType::get(context, KIND);
161   return {};
162 }
163 
164 template <>
165 mlir::Type
166 genFIRType<Fortran::common::TypeCategory::Complex>(mlir::MLIRContext *context,
167                                                    int KIND) {
168   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
169           Fortran::common::TypeCategory::Complex, KIND))
170     return fir::CplxType::get(context, KIND);
171   return {};
172 }
173 
174 namespace {
175 
176 /// Discover the type of an Fortran::evaluate::Expr<T> and convert it to an
177 /// mlir::Type. The type returned may be an MLIR standard or FIR type.
178 class TypeBuilder {
179 public:
180   /// Constructor.
181   explicit TypeBuilder(
182       mlir::MLIRContext *context,
183       const Fortran::common::IntrinsicTypeDefaultKinds &defaults)
184       : context{context}, defaults{defaults} {}
185 
186   //===--------------------------------------------------------------------===//
187   // Generate type entry points
188   //===--------------------------------------------------------------------===//
189 
190   template <template <typename> typename A, Fortran::common::TypeCategory TC>
191   mlir::Type gen(const A<Fortran::evaluate::SomeKind<TC>> &) {
192     return genFIRType<TC>(context, defaultKind<TC>());
193   }
194 
195   template <template <typename> typename A, Fortran::common::TypeCategory TC,
196             int KIND>
197   mlir::Type gen(const A<Fortran::evaluate::Type<TC, KIND>> &) {
198     return genFIRType<TC, KIND>(context);
199   }
200 
201   // breaks the conflict between A<Type<TC,KIND>> and Expr<B> deduction
202   template <Fortran::common::TypeCategory TC, int KIND>
203   mlir::Type
204   gen(const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> &) {
205     return genFIRType<TC, KIND>(context);
206   }
207 
208   // breaks the conflict between A<SomeKind<TC>> and Expr<B> deduction
209   template <Fortran::common::TypeCategory TC>
210   mlir::Type
211   gen(const Fortran::evaluate::Expr<Fortran::evaluate::SomeKind<TC>> &expr) {
212     return genVariant(expr);
213   }
214 
215   template <typename A>
216   mlir::Type gen(const Fortran::evaluate::Expr<A> &expr) {
217     return genVariant(expr);
218   }
219 
220   mlir::Type gen(const Fortran::evaluate::DataRef &dref) {
221     return genVariant(dref);
222   }
223 
224   mlir::Type gen(const Fortran::lower::pft::Variable &var) {
225     return genSymbolHelper(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
226   }
227 
228   /// Type consing from a symbol. A symbol's type must be created from the type
229   /// discovered by the front-end at runtime.
230   mlir::Type gen(Fortran::semantics::SymbolRef symbol) {
231     return genSymbolHelper(symbol);
232   }
233 
234   // non-template, category is runtime values, kind is defaulted
235   mlir::Type genFIRTy(Fortran::common::TypeCategory tc) {
236     return genFIRTy(tc, defaultKind(tc));
237   }
238 
239   // non-template, arguments are runtime values
240   mlir::Type genFIRTy(Fortran::common::TypeCategory tc, int kind) {
241     switch (tc) {
242     case Fortran::common::TypeCategory::Real:
243       return genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
244     case Fortran::common::TypeCategory::Integer:
245       return genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
246     case Fortran::common::TypeCategory::Complex:
247       return genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
248     case Fortran::common::TypeCategory::Logical:
249       return genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
250     case Fortran::common::TypeCategory::Character:
251       return genFIRType<Fortran::common::TypeCategory::Character>(context,
252                                                                   kind);
253     default:
254       break;
255     }
256     llvm_unreachable("unhandled type category");
257   }
258 
259 private:
260   //===--------------------------------------------------------------------===//
261   // Generate type helpers
262   //===--------------------------------------------------------------------===//
263 
264   mlir::Type gen(const Fortran::evaluate::ImpliedDoIndex &) {
265     return genFIRType<Fortran::evaluate::ImpliedDoIndex::Result::category>(
266         context, Fortran::evaluate::ImpliedDoIndex::Result::kind);
267   }
268 
269   mlir::Type gen(const Fortran::evaluate::TypeParamInquiry &) {
270     return genFIRType<Fortran::evaluate::TypeParamInquiry::Result::category>(
271         context, Fortran::evaluate::TypeParamInquiry::Result::kind);
272   }
273 
274   template <typename A>
275   mlir::Type gen(const Fortran::evaluate::Relational<A> &) {
276     return genFIRType<Fortran::common::TypeCategory::Logical, 1>(context);
277   }
278 
279   // some sequence of `n` bytes
280   mlir::Type gen(const Fortran::evaluate::StaticDataObject::Pointer &ptr) {
281     mlir::Type byteTy{mlir::IntegerType::get(8, context)};
282     return fir::SequenceType::get(trivialShape(ptr->itemBytes()), byteTy);
283   }
284 
285   mlir::Type gen(const Fortran::evaluate::Substring &ss) {
286     return genVariant(ss.GetBaseObject());
287   }
288 
289   mlir::Type gen(const Fortran::evaluate::NullPointer &) {
290     return genTypelessPtr();
291   }
292   mlir::Type gen(const Fortran::evaluate::ProcedureRef &) {
293     return genTypelessPtr();
294   }
295   mlir::Type gen(const Fortran::evaluate::ProcedureDesignator &) {
296     return genTypelessPtr();
297   }
298   mlir::Type gen(const Fortran::evaluate::BOZLiteralConstant &) {
299     return genTypelessPtr();
300   }
301   mlir::Type gen(const Fortran::evaluate::ArrayRef &) { TODO("array ref"); }
302   mlir::Type gen(const Fortran::evaluate::CoarrayRef &) { TODO("coarray ref"); }
303   mlir::Type gen(const Fortran::evaluate::Component &) { TODO("component"); }
304   mlir::Type gen(const Fortran::evaluate::ComplexPart &) {
305     TODO("complex part");
306   }
307   mlir::Type gen(const Fortran::evaluate::DescriptorInquiry &) {
308     TODO("descriptor inquiry");
309   }
310   mlir::Type gen(const Fortran::evaluate::StructureConstructor &) {
311     TODO("structure constructor");
312   }
313 
314   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol) {
315     assert(symbol->IsObjectArray() && "unexpected symbol type");
316     fir::SequenceType::Shape bounds;
317     return seqShapeHelper(symbol, bounds);
318   }
319 
320   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol,
321                                        fir::SequenceType::Extent charLen) {
322     assert(symbol->IsObjectArray() && "unexpected symbol type");
323     fir::SequenceType::Shape bounds;
324     bounds.push_back(charLen);
325     return seqShapeHelper(symbol, bounds);
326   }
327 
328   mlir::Type genSymbolHelper(const Fortran::semantics::Symbol &symbol,
329                              bool isAlloc = false, bool isPtr = false) {
330     mlir::Type ty;
331     if (auto *type{symbol.GetType()}) {
332       if (auto *tySpec{type->AsIntrinsic()}) {
333         int kind = toConstant(tySpec->kind());
334         switch (tySpec->category()) {
335         case Fortran::common::TypeCategory::Integer:
336           ty =
337               genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
338           break;
339         case Fortran::common::TypeCategory::Real:
340           ty = genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
341           break;
342         case Fortran::common::TypeCategory::Complex:
343           ty =
344               genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
345           break;
346         case Fortran::common::TypeCategory::Character:
347           ty = genFIRType<Fortran::common::TypeCategory::Character>(context,
348                                                                     kind);
349           break;
350         case Fortran::common::TypeCategory::Logical:
351           ty =
352               genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
353           break;
354         default:
355           emitError("symbol has unknown intrinsic type");
356           return {};
357         }
358       } else if (auto *tySpec = type->AsDerived()) {
359         std::vector<std::pair<std::string, mlir::Type>> ps;
360         std::vector<std::pair<std::string, mlir::Type>> cs;
361         auto &symbol = tySpec->typeSymbol();
362         // FIXME: don't want to recurse forever here, but this won't happen
363         // since we don't know the components at this time
364         auto rec = fir::RecordType::get(context, toStringRef(symbol.name()));
365         auto &details = symbol.get<Fortran::semantics::DerivedTypeDetails>();
366         for (auto &param : details.paramDecls()) {
367           auto &p{*param};
368           ps.push_back(std::pair{p.name().ToString(), gen(p)});
369         }
370         emitError("the front-end returns symbols of derived type that have "
371                   "components that are simple names and not symbols, so cannot "
372                   "construct the type '" +
373                   toStringRef(symbol.name()) + "'");
374         rec.finalize(ps, cs);
375         ty = rec;
376       } else {
377         emitError("symbol's type must have a type spec");
378         return {};
379       }
380     } else {
381       emitError("symbol must have a type");
382       return {};
383     }
384     if (symbol.IsObjectArray()) {
385       if (symbol.GetType()->category() ==
386           Fortran::semantics::DeclTypeSpec::Character) {
387         auto charLen = fir::SequenceType::getUnknownExtent();
388         const auto &lenParam = symbol.GetType()->characterTypeSpec().length();
389         if (auto expr = lenParam.GetExplicit()) {
390           auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr));
391           auto asInt = Fortran::evaluate::ToInt64(len);
392           if (asInt)
393             charLen = *asInt;
394         }
395         return fir::SequenceType::get(genSeqShape(symbol, charLen), ty);
396       }
397       return fir::SequenceType::get(genSeqShape(symbol), ty);
398     }
399     if (isPtr || Fortran::semantics::IsPointer(symbol))
400       ty = fir::PointerType::get(ty);
401     else if (isAlloc || Fortran::semantics::IsAllocatable(symbol))
402       ty = fir::HeapType::get(ty);
403     return ty;
404   }
405 
406   //===--------------------------------------------------------------------===//
407   // Other helper functions
408   //===--------------------------------------------------------------------===//
409 
410   fir::SequenceType::Shape trivialShape(int size) {
411     fir::SequenceType::Shape bounds;
412     bounds.emplace_back(size);
413     return bounds;
414   }
415 
416   mlir::Type mkVoid() { return mlir::TupleType::get(context); }
417   mlir::Type genTypelessPtr() { return fir::ReferenceType::get(mkVoid()); }
418 
419   template <typename A>
420   mlir::Type genVariant(const A &variant) {
421     return std::visit([&](const auto &x) { return gen(x); }, variant.u);
422   }
423 
424   template <Fortran::common::TypeCategory TC>
425   int defaultKind() {
426     return defaultKind(TC);
427   }
428   int defaultKind(Fortran::common::TypeCategory TC) {
429     return defaults.GetDefaultKind(TC);
430   }
431 
432   fir::SequenceType::Shape seqShapeHelper(Fortran::semantics::SymbolRef symbol,
433                                           fir::SequenceType::Shape &bounds) {
434     auto &details = symbol->get<Fortran::semantics::ObjectEntityDetails>();
435     const auto size = details.shape().size();
436     for (auto &ss : details.shape()) {
437       auto lb = ss.lbound();
438       auto ub = ss.ubound();
439       if (lb.isAssumed() && ub.isAssumed() && size == 1)
440         return {};
441       if (lb.isExplicit() && ub.isExplicit()) {
442         auto &lbv = lb.GetExplicit();
443         auto &ubv = ub.GetExplicit();
444         if (lbv.has_value() && ubv.has_value() && isConstant(lbv.value()) &&
445             isConstant(ubv.value())) {
446           bounds.emplace_back(toConstant(ubv.value()) -
447                               toConstant(lbv.value()) + 1);
448         } else {
449           bounds.emplace_back(fir::SequenceType::getUnknownExtent());
450         }
451       } else {
452         bounds.emplace_back(fir::SequenceType::getUnknownExtent());
453       }
454     }
455     return bounds;
456   }
457 
458   //===--------------------------------------------------------------------===//
459   // Emit errors and warnings.
460   //===--------------------------------------------------------------------===//
461 
462   mlir::InFlightDiagnostic emitError(const llvm::Twine &message) {
463     return mlir::emitError(mlir::UnknownLoc::get(context), message);
464   }
465 
466   mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) {
467     return mlir::emitWarning(mlir::UnknownLoc::get(context), message);
468   }
469 
470   //===--------------------------------------------------------------------===//
471 
472   mlir::MLIRContext *context;
473   const Fortran::common::IntrinsicTypeDefaultKinds &defaults;
474 };
475 
476 } // namespace
477 
478 mlir::Type Fortran::lower::getFIRType(
479     mlir::MLIRContext *context,
480     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
481     Fortran::common::TypeCategory tc, int kind) {
482   return TypeBuilder{context, defaults}.genFIRTy(tc, kind);
483 }
484 
485 mlir::Type Fortran::lower::getFIRType(
486     mlir::MLIRContext *context,
487     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
488     Fortran::common::TypeCategory tc) {
489   return TypeBuilder{context, defaults}.genFIRTy(tc);
490 }
491 
492 mlir::Type Fortran::lower::translateDataRefToFIRType(
493     mlir::MLIRContext *context,
494     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
495     const Fortran::evaluate::DataRef &dataRef) {
496   return TypeBuilder{context, defaults}.gen(dataRef);
497 }
498 
499 mlir::Type Fortran::lower::translateSomeExprToFIRType(
500     mlir::MLIRContext *context,
501     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
502     const SomeExpr *expr) {
503   return TypeBuilder{context, defaults}.gen(*expr);
504 }
505 
506 mlir::Type Fortran::lower::translateSymbolToFIRType(
507     mlir::MLIRContext *context,
508     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
509     const SymbolRef symbol) {
510   return TypeBuilder{context, defaults}.gen(symbol);
511 }
512 
513 mlir::Type Fortran::lower::translateVariableToFIRType(
514     mlir::MLIRContext *context,
515     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
516     const Fortran::lower::pft::Variable &var) {
517   return TypeBuilder{context, defaults}.gen(var);
518 }
519 
520 mlir::Type Fortran::lower::convertReal(mlir::MLIRContext *context, int kind) {
521   return genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
522 }
523 
524 mlir::Type Fortran::lower::getSequenceRefType(mlir::Type refType) {
525   auto type{refType.dyn_cast<fir::ReferenceType>()};
526   assert(type && "expected a reference type");
527   auto elementType{type.getEleTy()};
528   fir::SequenceType::Shape shape{fir::SequenceType::getUnknownExtent()};
529   return fir::ReferenceType::get(fir::SequenceType::get(shape, elementType));
530 }
531