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 
181   /// Constructor.
182   explicit TypeBuilder(
183       mlir::MLIRContext *context,
184       const Fortran::common::IntrinsicTypeDefaultKinds &defaults)
185       : context{context}, defaults{defaults} {}
186 
187 
188   //===--------------------------------------------------------------------===//
189   // Generate type entry points
190   //===--------------------------------------------------------------------===//
191 
192   template <template <typename> typename A, Fortran::common::TypeCategory TC>
193   mlir::Type gen(const A<Fortran::evaluate::SomeKind<TC>> &) {
194     return genFIRType<TC>(context, defaultKind<TC>());
195   }
196 
197   template <template <typename> typename A, Fortran::common::TypeCategory TC,
198             int KIND>
199   mlir::Type gen(const A<Fortran::evaluate::Type<TC, KIND>> &) {
200     return genFIRType<TC, KIND>(context);
201   }
202 
203   // breaks the conflict between A<Type<TC,KIND>> and Expr<B> deduction
204   template <Fortran::common::TypeCategory TC, int KIND>
205   mlir::Type
206   gen(const Fortran::evaluate::Expr<Fortran::evaluate::Type<TC, KIND>> &) {
207     return genFIRType<TC, KIND>(context);
208   }
209 
210   // breaks the conflict between A<SomeKind<TC>> and Expr<B> deduction
211   template <Fortran::common::TypeCategory TC>
212   mlir::Type
213   gen(const Fortran::evaluate::Expr<Fortran::evaluate::SomeKind<TC>> &expr) {
214     return genVariant(expr);
215   }
216 
217   template <typename A>
218   mlir::Type gen(const Fortran::evaluate::Expr<A> &expr) {
219     return genVariant(expr);
220   }
221 
222   mlir::Type gen(const Fortran::evaluate::DataRef &dref) {
223     return genVariant(dref);
224   }
225 
226   mlir::Type gen(const Fortran::lower::pft::Variable &var) {
227     return genSymbolHelper(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
228   }
229 
230   /// Type consing from a symbol. A symbol's type must be created from the type
231   /// discovered by the front-end at runtime.
232   mlir::Type gen(Fortran::semantics::SymbolRef symbol) {
233     return genSymbolHelper(symbol);
234   }
235 
236   // non-template, category is runtime values, kind is defaulted
237   mlir::Type genFIRTy(Fortran::common::TypeCategory tc) {
238     return genFIRTy(tc, defaultKind(tc));
239   }
240 
241   // non-template, arguments are runtime values
242   mlir::Type genFIRTy(Fortran::common::TypeCategory tc, int kind) {
243     switch (tc) {
244     case Fortran::common::TypeCategory::Real:
245       return genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
246     case Fortran::common::TypeCategory::Integer:
247       return genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
248     case Fortran::common::TypeCategory::Complex:
249       return genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
250     case Fortran::common::TypeCategory::Logical:
251       return genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
252     case Fortran::common::TypeCategory::Character:
253       return genFIRType<Fortran::common::TypeCategory::Character>(context,
254                                                                   kind);
255     default:
256       break;
257     }
258     llvm_unreachable("unhandled type category");
259   }
260 
261 private:
262   //===--------------------------------------------------------------------===//
263   // Generate type helpers
264   //===--------------------------------------------------------------------===//
265 
266   mlir::Type gen(const Fortran::evaluate::ImpliedDoIndex &) {
267     return genFIRType<Fortran::common::TypeCategory::Integer>(
268         context, defaultKind<Fortran::common::TypeCategory::Integer>());
269   }
270 
271   template <int KIND>
272   mlir::Type gen(const Fortran::evaluate::TypeParamInquiry<KIND> &) {
273     return genFIRType<Fortran::common::TypeCategory::Integer, KIND>(context);
274   }
275 
276   template <typename A>
277   mlir::Type gen(const Fortran::evaluate::Relational<A> &) {
278     return genFIRType<Fortran::common::TypeCategory::Logical, 1>(context);
279   }
280 
281   // some sequence of `n` bytes
282   mlir::Type gen(const Fortran::evaluate::StaticDataObject::Pointer &ptr) {
283     mlir::Type byteTy{mlir::IntegerType::get(8, context)};
284     return fir::SequenceType::get(trivialShape(ptr->itemBytes()), byteTy);
285   }
286 
287   mlir::Type gen(const Fortran::evaluate::Substring &ss) {
288     return genVariant(ss.GetBaseObject());
289   }
290 
291   mlir::Type gen(const Fortran::evaluate::NullPointer &) {
292     return genTypelessPtr();
293   }
294   mlir::Type gen(const Fortran::evaluate::ProcedureRef &) {
295     return genTypelessPtr();
296   }
297   mlir::Type gen(const Fortran::evaluate::ProcedureDesignator &) {
298     return genTypelessPtr();
299   }
300   mlir::Type gen(const Fortran::evaluate::BOZLiteralConstant &) {
301     return genTypelessPtr();
302   }
303   mlir::Type gen(const Fortran::evaluate::ArrayRef &) { TODO("array ref"); }
304   mlir::Type gen(const Fortran::evaluate::CoarrayRef &) { TODO("coarray ref"); }
305   mlir::Type gen(const Fortran::evaluate::Component &) { TODO("component"); }
306   mlir::Type gen(const Fortran::evaluate::ComplexPart &) {
307     TODO("complex part");
308   }
309   mlir::Type gen(const Fortran::evaluate::DescriptorInquiry &) {
310     TODO("descriptor inquiry");
311   }
312   mlir::Type gen(const Fortran::evaluate::StructureConstructor &) {
313     TODO("structure constructor");
314   }
315 
316   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol) {
317     assert(symbol->IsObjectArray() && "unexpected symbol type");
318     fir::SequenceType::Shape bounds;
319     return seqShapeHelper(symbol, bounds);
320   }
321 
322   fir::SequenceType::Shape genSeqShape(Fortran::semantics::SymbolRef symbol,
323                                        fir::SequenceType::Extent charLen) {
324     assert(symbol->IsObjectArray() && "unexpected symbol type");
325     fir::SequenceType::Shape bounds;
326     bounds.push_back(charLen);
327     return seqShapeHelper(symbol, bounds);
328   }
329 
330   mlir::Type genSymbolHelper(const Fortran::semantics::Symbol &symbol,
331                              bool isAlloc = false, bool isPtr = false) {
332     mlir::Type ty;
333     if (auto *type{symbol.GetType()}) {
334       if (auto *tySpec{type->AsIntrinsic()}) {
335         int kind = toConstant(tySpec->kind());
336         switch (tySpec->category()) {
337         case Fortran::common::TypeCategory::Integer:
338           ty =
339               genFIRType<Fortran::common::TypeCategory::Integer>(context, kind);
340           break;
341         case Fortran::common::TypeCategory::Real:
342           ty = genFIRType<Fortran::common::TypeCategory::Real>(context, kind);
343           break;
344         case Fortran::common::TypeCategory::Complex:
345           ty =
346               genFIRType<Fortran::common::TypeCategory::Complex>(context, kind);
347           break;
348         case Fortran::common::TypeCategory::Character:
349           ty = genFIRType<Fortran::common::TypeCategory::Character>(context,
350                                                                     kind);
351           break;
352         case Fortran::common::TypeCategory::Logical:
353           ty =
354               genFIRType<Fortran::common::TypeCategory::Logical>(context, kind);
355           break;
356         default:
357           emitError("symbol has unknown intrinsic type");
358           return {};
359         }
360       } else if (auto *tySpec = type->AsDerived()) {
361         std::vector<std::pair<std::string, mlir::Type>> ps;
362         std::vector<std::pair<std::string, mlir::Type>> cs;
363         auto &symbol = tySpec->typeSymbol();
364         // FIXME: don't want to recurse forever here, but this won't happen
365         // since we don't know the components at this time
366         auto rec = fir::RecordType::get(context, toStringRef(symbol.name()));
367         auto &details = symbol.get<Fortran::semantics::DerivedTypeDetails>();
368         for (auto &param : details.paramDecls()) {
369           auto &p{*param};
370           ps.push_back(std::pair{p.name().ToString(), gen(p)});
371         }
372         emitError("the front-end returns symbols of derived type that have "
373                   "components that are simple names and not symbols, so cannot "
374                   "construct the type '" +
375                   toStringRef(symbol.name()) + "'");
376         rec.finalize(ps, cs);
377         ty = rec;
378       } else {
379         emitError("symbol's type must have a type spec");
380         return {};
381       }
382     } else {
383       emitError("symbol must have a type");
384       return {};
385     }
386     if (symbol.IsObjectArray()) {
387       if (symbol.GetType()->category() ==
388           Fortran::semantics::DeclTypeSpec::Character) {
389         auto charLen = fir::SequenceType::getUnknownExtent();
390         const auto &lenParam = symbol.GetType()->characterTypeSpec().length();
391         if (auto expr = lenParam.GetExplicit()) {
392           auto len = Fortran::evaluate::AsGenericExpr(std::move(*expr));
393           auto asInt = Fortran::evaluate::ToInt64(len);
394           if (asInt)
395             charLen = *asInt;
396         }
397         return fir::SequenceType::get(genSeqShape(symbol, charLen), ty);
398       }
399       return fir::SequenceType::get(genSeqShape(symbol), ty);
400     }
401     if (isPtr || Fortran::semantics::IsPointer(symbol))
402       ty = fir::PointerType::get(ty);
403     else if (isAlloc || Fortran::semantics::IsAllocatable(symbol))
404       ty = fir::HeapType::get(ty);
405     return ty;
406   }
407 
408   //===--------------------------------------------------------------------===//
409   // Other helper functions
410   //===--------------------------------------------------------------------===//
411 
412   fir::SequenceType::Shape trivialShape(int size) {
413     fir::SequenceType::Shape bounds;
414     bounds.emplace_back(size);
415     return bounds;
416   }
417 
418   mlir::Type mkVoid() { return mlir::TupleType::get(context); }
419   mlir::Type genTypelessPtr() { return fir::ReferenceType::get(mkVoid()); }
420 
421   template <typename A>
422   mlir::Type genVariant(const A &variant) {
423     return std::visit([&](const auto &x) { return gen(x); }, variant.u);
424   }
425 
426   template <Fortran::common::TypeCategory TC>
427   int defaultKind() {
428     return defaultKind(TC);
429   }
430   int defaultKind(Fortran::common::TypeCategory TC) {
431     return defaults.GetDefaultKind(TC);
432   }
433 
434   fir::SequenceType::Shape seqShapeHelper(Fortran::semantics::SymbolRef symbol,
435                                           fir::SequenceType::Shape &bounds) {
436     auto &details = symbol->get<Fortran::semantics::ObjectEntityDetails>();
437     const auto size = details.shape().size();
438     for (auto &ss : details.shape()) {
439       auto lb = ss.lbound();
440       auto ub = ss.ubound();
441       if (lb.isAssumed() && ub.isAssumed() && size == 1)
442         return {};
443       if (lb.isExplicit() && ub.isExplicit()) {
444         auto &lbv = lb.GetExplicit();
445         auto &ubv = ub.GetExplicit();
446         if (lbv.has_value() && ubv.has_value() && isConstant(lbv.value()) &&
447             isConstant(ubv.value())) {
448           bounds.emplace_back(toConstant(ubv.value()) -
449                               toConstant(lbv.value()) + 1);
450         } else {
451           bounds.emplace_back(fir::SequenceType::getUnknownExtent());
452         }
453       } else {
454         bounds.emplace_back(fir::SequenceType::getUnknownExtent());
455       }
456     }
457     return bounds;
458   }
459 
460   //===--------------------------------------------------------------------===//
461   // Emit errors and warnings.
462   //===--------------------------------------------------------------------===//
463 
464   mlir::InFlightDiagnostic emitError(const llvm::Twine &message) {
465     return mlir::emitError(mlir::UnknownLoc::get(context), message);
466   }
467 
468   mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) {
469     return mlir::emitWarning(mlir::UnknownLoc::get(context), message);
470   }
471 
472   //===--------------------------------------------------------------------===//
473 
474   mlir::MLIRContext *context;
475   const Fortran::common::IntrinsicTypeDefaultKinds &defaults;
476 };
477 
478 } // namespace
479 
480 mlir::Type Fortran::lower::getFIRType(
481     mlir::MLIRContext *context,
482     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
483     Fortran::common::TypeCategory tc, int kind) {
484   return TypeBuilder{context, defaults}.genFIRTy(tc, kind);
485 }
486 
487 mlir::Type Fortran::lower::getFIRType(
488     mlir::MLIRContext *context,
489     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
490     Fortran::common::TypeCategory tc) {
491   return TypeBuilder{context, defaults}.genFIRTy(tc);
492 }
493 
494 mlir::Type Fortran::lower::translateDataRefToFIRType(
495     mlir::MLIRContext *context,
496     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
497     const Fortran::evaluate::DataRef &dataRef) {
498   return TypeBuilder{context, defaults}.gen(dataRef);
499 }
500 
501 mlir::Type Fortran::lower::translateSomeExprToFIRType(
502     mlir::MLIRContext *context,
503     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
504     const SomeExpr *expr) {
505   return TypeBuilder{context, defaults}.gen(*expr);
506 }
507 
508 mlir::Type Fortran::lower::translateSymbolToFIRType(
509     mlir::MLIRContext *context,
510     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
511     const SymbolRef symbol) {
512   return TypeBuilder{context, defaults}.gen(symbol);
513 }
514 
515 mlir::Type Fortran::lower::translateVariableToFIRType(
516     mlir::MLIRContext *context,
517     const Fortran::common::IntrinsicTypeDefaultKinds &defaults,
518     const Fortran::lower::pft::Variable &var) {
519   return TypeBuilder{context, defaults}.gen(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