1 //===-- ConvertExpr.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 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10 //
11 //===----------------------------------------------------------------------===//
12 
13 #include "flang/Lower/ConvertExpr.h"
14 #include "flang/Evaluate/fold.h"
15 #include "flang/Evaluate/real.h"
16 #include "flang/Evaluate/traverse.h"
17 #include "flang/Lower/AbstractConverter.h"
18 #include "flang/Lower/SymbolMap.h"
19 #include "flang/Lower/Todo.h"
20 #include "flang/Semantics/expression.h"
21 #include "flang/Semantics/symbol.h"
22 #include "flang/Semantics/tools.h"
23 #include "flang/Semantics/type.h"
24 #include "mlir/Dialect/StandardOps/IR/Ops.h"
25 #include "llvm/Support/Debug.h"
26 
27 #define DEBUG_TYPE "flang-lower-expr"
28 
29 //===----------------------------------------------------------------------===//
30 // The composition and structure of Fortran::evaluate::Expr is defined in
31 // the various header files in include/flang/Evaluate. You are referred
32 // there for more information on these data structures. Generally speaking,
33 // these data structures are a strongly typed family of abstract data types
34 // that, composed as trees, describe the syntax of Fortran expressions.
35 //
36 // This part of the bridge can traverse these tree structures and lower them
37 // to the correct FIR representation in SSA form.
38 //===----------------------------------------------------------------------===//
39 
40 /// Generate a load of a value from an address. Beware that this will lose
41 /// any dynamic type information for polymorphic entities (note that unlimited
42 /// polymorphic cannot be loaded and must not be provided here).
43 static fir::ExtendedValue genLoad(fir::FirOpBuilder &builder,
44                                   mlir::Location loc,
45                                   const fir::ExtendedValue &addr) {
46   return addr.match(
47       [](const fir::CharBoxValue &box) -> fir::ExtendedValue { return box; },
48       [&](const fir::UnboxedValue &v) -> fir::ExtendedValue {
49         if (fir::unwrapRefType(fir::getBase(v).getType())
50                 .isa<fir::RecordType>())
51           return v;
52         return builder.create<fir::LoadOp>(loc, fir::getBase(v));
53       },
54       [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
55         TODO(loc, "genLoad for MutableBoxValue");
56       },
57       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
58         TODO(loc, "genLoad for BoxValue");
59       },
60       [&](const auto &) -> fir::ExtendedValue {
61         fir::emitFatalError(
62             loc, "attempting to load whole array or procedure address");
63       });
64 }
65 
66 namespace {
67 
68 /// Lowering of Fortran::evaluate::Expr<T> expressions
69 class ScalarExprLowering {
70 public:
71   using ExtValue = fir::ExtendedValue;
72 
73   explicit ScalarExprLowering(mlir::Location loc,
74                               Fortran::lower::AbstractConverter &converter,
75                               Fortran::lower::SymMap &symMap)
76       : location{loc}, converter{converter},
77         builder{converter.getFirOpBuilder()}, symMap{symMap} {}
78 
79   mlir::Location getLoc() { return location; }
80 
81   /// Generate an integral constant of `value`
82   template <int KIND>
83   mlir::Value genIntegerConstant(mlir::MLIRContext *context,
84                                  std::int64_t value) {
85     mlir::Type type =
86         converter.genType(Fortran::common::TypeCategory::Integer, KIND);
87     return builder.createIntegerConstant(getLoc(), type, value);
88   }
89 
90   /// Generate a logical/boolean constant of `value`
91   mlir::Value genBoolConstant(bool value) {
92     return builder.createBool(getLoc(), value);
93   }
94 
95   /// Returns a reference to a symbol or its box/boxChar descriptor if it has
96   /// one.
97   ExtValue gen(Fortran::semantics::SymbolRef sym) {
98     if (Fortran::lower::SymbolBox val = symMap.lookupSymbol(sym))
99       return val.match([&val](auto &) { return val.toExtendedValue(); });
100     LLVM_DEBUG(llvm::dbgs()
101                << "unknown symbol: " << sym << "\nmap: " << symMap << '\n');
102     fir::emitFatalError(getLoc(), "symbol is not mapped to any IR value");
103   }
104 
105   ExtValue genLoad(const ExtValue &exv) {
106     return ::genLoad(builder, getLoc(), exv);
107   }
108 
109   ExtValue genval(Fortran::semantics::SymbolRef sym) {
110     ExtValue var = gen(sym);
111     if (const fir::UnboxedValue *s = var.getUnboxed())
112       if (fir::isReferenceLike(s->getType()))
113         return genLoad(*s);
114     return var;
115   }
116 
117   ExtValue genval(const Fortran::evaluate::BOZLiteralConstant &) {
118     TODO(getLoc(), "genval BOZ");
119   }
120 
121   /// Return indirection to function designated in ProcedureDesignator.
122   /// The type of the function indirection is not guaranteed to match the one
123   /// of the ProcedureDesignator due to Fortran implicit typing rules.
124   ExtValue genval(const Fortran::evaluate::ProcedureDesignator &proc) {
125     TODO(getLoc(), "genval ProcedureDesignator");
126   }
127 
128   ExtValue genval(const Fortran::evaluate::NullPointer &) {
129     TODO(getLoc(), "genval NullPointer");
130   }
131 
132   ExtValue genval(const Fortran::evaluate::StructureConstructor &ctor) {
133     TODO(getLoc(), "genval StructureConstructor");
134   }
135 
136   /// Lowering of an <i>ac-do-variable</i>, which is not a Symbol.
137   ExtValue genval(const Fortran::evaluate::ImpliedDoIndex &var) {
138     TODO(getLoc(), "genval ImpliedDoIndex");
139   }
140 
141   ExtValue genval(const Fortran::evaluate::DescriptorInquiry &desc) {
142     TODO(getLoc(), "genval DescriptorInquiry");
143   }
144 
145   ExtValue genval(const Fortran::evaluate::TypeParamInquiry &) {
146     TODO(getLoc(), "genval TypeParamInquiry");
147   }
148 
149   template <int KIND>
150   ExtValue genval(const Fortran::evaluate::ComplexComponent<KIND> &part) {
151     TODO(getLoc(), "genval ComplexComponent");
152   }
153 
154   template <int KIND>
155   ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
156                       Fortran::common::TypeCategory::Integer, KIND>> &op) {
157     TODO(getLoc(), "genval Negate integer");
158   }
159 
160   template <int KIND>
161   ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
162                       Fortran::common::TypeCategory::Real, KIND>> &op) {
163     TODO(getLoc(), "genval Negate real");
164   }
165   template <int KIND>
166   ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
167                       Fortran::common::TypeCategory::Complex, KIND>> &op) {
168     TODO(getLoc(), "genval Negate complex");
169   }
170 
171 #undef GENBIN
172 #define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
173   template <int KIND>                                                          \
174   ExtValue genval(const Fortran::evaluate::GenBinEvOp<Fortran::evaluate::Type< \
175                       Fortran::common::TypeCategory::GenBinTyCat, KIND>> &x) { \
176     TODO(getLoc(), "genval GenBinEvOp");                                       \
177   }
178 
179   GENBIN(Add, Integer, mlir::arith::AddIOp)
180   GENBIN(Add, Real, mlir::arith::AddFOp)
181   GENBIN(Add, Complex, fir::AddcOp)
182   GENBIN(Subtract, Integer, mlir::arith::SubIOp)
183   GENBIN(Subtract, Real, mlir::arith::SubFOp)
184   GENBIN(Subtract, Complex, fir::SubcOp)
185   GENBIN(Multiply, Integer, mlir::arith::MulIOp)
186   GENBIN(Multiply, Real, mlir::arith::MulFOp)
187   GENBIN(Multiply, Complex, fir::MulcOp)
188   GENBIN(Divide, Integer, mlir::arith::DivSIOp)
189   GENBIN(Divide, Real, mlir::arith::DivFOp)
190   GENBIN(Divide, Complex, fir::DivcOp)
191 
192   template <Fortran::common::TypeCategory TC, int KIND>
193   ExtValue genval(
194       const Fortran::evaluate::Power<Fortran::evaluate::Type<TC, KIND>> &op) {
195     TODO(getLoc(), "genval Power");
196   }
197 
198   template <Fortran::common::TypeCategory TC, int KIND>
199   ExtValue genval(
200       const Fortran::evaluate::RealToIntPower<Fortran::evaluate::Type<TC, KIND>>
201           &op) {
202     TODO(getLoc(), "genval RealToInt");
203   }
204 
205   template <int KIND>
206   ExtValue genval(const Fortran::evaluate::ComplexConstructor<KIND> &op) {
207     TODO(getLoc(), "genval ComplexConstructor");
208   }
209 
210   template <int KIND>
211   ExtValue genval(const Fortran::evaluate::Concat<KIND> &op) {
212     TODO(getLoc(), "genval Concat<KIND>");
213   }
214 
215   /// MIN and MAX operations
216   template <Fortran::common::TypeCategory TC, int KIND>
217   ExtValue
218   genval(const Fortran::evaluate::Extremum<Fortran::evaluate::Type<TC, KIND>>
219              &op) {
220     TODO(getLoc(), "genval Extremum<TC, KIND>");
221   }
222 
223   template <int KIND>
224   ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
225     TODO(getLoc(), "genval SetLength<KIND>");
226   }
227 
228   template <int KIND>
229   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
230                       Fortran::common::TypeCategory::Integer, KIND>> &op) {
231     TODO(getLoc(), "genval integer comparison");
232   }
233   template <int KIND>
234   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
235                       Fortran::common::TypeCategory::Real, KIND>> &op) {
236     TODO(getLoc(), "genval real comparison");
237   }
238   template <int KIND>
239   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
240                       Fortran::common::TypeCategory::Complex, KIND>> &op) {
241     TODO(getLoc(), "genval complex comparison");
242   }
243   template <int KIND>
244   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
245                       Fortran::common::TypeCategory::Character, KIND>> &op) {
246     TODO(getLoc(), "genval char comparison");
247   }
248 
249   ExtValue
250   genval(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
251     TODO(getLoc(), "genval comparison");
252   }
253 
254   template <Fortran::common::TypeCategory TC1, int KIND,
255             Fortran::common::TypeCategory TC2>
256   ExtValue
257   genval(const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>,
258                                           TC2> &convert) {
259     TODO(getLoc(), "genval convert<TC1, KIND, TC2>");
260   }
261 
262   template <typename A>
263   ExtValue genval(const Fortran::evaluate::Parentheses<A> &op) {
264     TODO(getLoc(), "genval parentheses<A>");
265   }
266 
267   template <int KIND>
268   ExtValue genval(const Fortran::evaluate::Not<KIND> &op) {
269     TODO(getLoc(), "genval Not<KIND>");
270   }
271 
272   template <int KIND>
273   ExtValue genval(const Fortran::evaluate::LogicalOperation<KIND> &op) {
274     TODO(getLoc(), "genval LogicalOperation<KIND>");
275   }
276 
277   /// Convert a scalar literal constant to IR.
278   template <Fortran::common::TypeCategory TC, int KIND>
279   ExtValue genScalarLit(
280       const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>>
281           &value) {
282     if constexpr (TC == Fortran::common::TypeCategory::Integer) {
283       return genIntegerConstant<KIND>(builder.getContext(), value.ToInt64());
284     } else if constexpr (TC == Fortran::common::TypeCategory::Logical) {
285       return genBoolConstant(value.IsTrue());
286     } else if constexpr (TC == Fortran::common::TypeCategory::Real) {
287       TODO(getLoc(), "genval real constant");
288     } else if constexpr (TC == Fortran::common::TypeCategory::Complex) {
289       TODO(getLoc(), "genval complex constant");
290     } else /*constexpr*/ {
291       llvm_unreachable("unhandled constant");
292     }
293   }
294 
295   /// Convert a ascii scalar literal CHARACTER to IR. (specialization)
296   ExtValue
297   genAsciiScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
298                         Fortran::common::TypeCategory::Character, 1>> &value,
299                     int64_t len) {
300     assert(value.size() == static_cast<std::uint64_t>(len) &&
301            "value.size() doesn't match with len");
302     return fir::factory::createStringLiteral(builder, getLoc(), value);
303   }
304 
305   template <Fortran::common::TypeCategory TC, int KIND>
306   ExtValue
307   genval(const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
308              &con) {
309     if (con.Rank() > 0)
310       TODO(getLoc(), "genval array constant");
311     std::optional<Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>>>
312         opt = con.GetScalarValue();
313     assert(opt.has_value() && "constant has no value");
314     if constexpr (TC == Fortran::common::TypeCategory::Character) {
315       if constexpr (KIND == 1)
316         return genAsciiScalarLit(opt.value(), con.LEN());
317       TODO(getLoc(), "genval for Character with KIND != 1");
318     } else {
319       return genScalarLit<TC, KIND>(opt.value());
320     }
321   }
322 
323   fir::ExtendedValue genval(
324       const Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived> &con) {
325     TODO(getLoc(), "genval constant derived");
326   }
327 
328   template <typename A>
329   ExtValue genval(const Fortran::evaluate::ArrayConstructor<A> &) {
330     TODO(getLoc(), "genval ArrayConstructor<A>");
331   }
332 
333   ExtValue genval(const Fortran::evaluate::ComplexPart &x) {
334     TODO(getLoc(), "genval ComplexPart");
335   }
336 
337   ExtValue genval(const Fortran::evaluate::Substring &ss) {
338     TODO(getLoc(), "genval Substring");
339   }
340 
341   ExtValue genval(const Fortran::evaluate::Subscript &subs) {
342     TODO(getLoc(), "genval Subscript");
343   }
344 
345   ExtValue genval(const Fortran::evaluate::DataRef &dref) {
346     TODO(getLoc(), "genval DataRef");
347   }
348 
349   ExtValue genval(const Fortran::evaluate::Component &cmpt) {
350     TODO(getLoc(), "genval Component");
351   }
352 
353   ExtValue genval(const Fortran::semantics::Bound &bound) {
354     TODO(getLoc(), "genval Bound");
355   }
356 
357   ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
358     TODO(getLoc(), "genval ArrayRef");
359   }
360 
361   ExtValue genval(const Fortran::evaluate::CoarrayRef &coref) {
362     TODO(getLoc(), "genval CoarrayRef");
363   }
364 
365   template <typename A>
366   ExtValue genval(const Fortran::evaluate::Designator<A> &des) {
367     return std::visit([&](const auto &x) { return genval(x); }, des.u);
368   }
369 
370   template <typename A>
371   ExtValue genval(const Fortran::evaluate::FunctionRef<A> &funcRef) {
372     TODO(getLoc(), "genval FunctionRef<A>");
373   }
374 
375   ExtValue genval(const Fortran::evaluate::ProcedureRef &procRef) {
376     TODO(getLoc(), "genval ProcedureRef");
377   }
378 
379   template <typename A>
380   bool isScalar(const A &x) {
381     return x.Rank() == 0;
382   }
383 
384   template <typename A>
385   ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
386     if (isScalar(x))
387       return std::visit([&](const auto &e) { return genval(e); }, x.u);
388     TODO(getLoc(), "genval Expr<A> arrays");
389   }
390 
391   template <int KIND>
392   ExtValue genval(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
393                       Fortran::common::TypeCategory::Logical, KIND>> &exp) {
394     return std::visit([&](const auto &e) { return genval(e); }, exp.u);
395   }
396 
397 private:
398   mlir::Location location;
399   Fortran::lower::AbstractConverter &converter;
400   fir::FirOpBuilder &builder;
401   Fortran::lower::SymMap &symMap;
402 };
403 } // namespace
404 
405 fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
406     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
407     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
408   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
409   return ScalarExprLowering{loc, converter, symMap}.genval(expr);
410 }
411