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