xref: /llvm-project/flang/lib/Evaluate/expression.cpp (revision 5c5bde1bb6e451e0014067802bc6a9d7b1314636)
1 //===-- lib/Evaluate/expression.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/Evaluate/expression.h"
10 #include "int-power.h"
11 #include "flang/Common/idioms.h"
12 #include "flang/Evaluate/common.h"
13 #include "flang/Evaluate/tools.h"
14 #include "flang/Evaluate/variable.h"
15 #include "flang/Parser/char-block.h"
16 #include "flang/Parser/message.h"
17 #include "flang/Semantics/scope.h"
18 #include "flang/Semantics/symbol.h"
19 #include "flang/Semantics/tools.h"
20 #include "flang/Semantics/type.h"
21 #include "llvm/Support/raw_ostream.h"
22 #include <string>
23 #include <type_traits>
24 
25 using namespace Fortran::parser::literals;
26 
27 namespace Fortran::evaluate {
28 
29 template <int KIND>
30 std::optional<Expr<SubscriptInteger>>
31 Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
32   using T = std::optional<Expr<SubscriptInteger>>;
33   return std::visit(
34       common::visitors{
35           [](const Constant<Result> &c) -> T {
36             return AsExpr(Constant<SubscriptInteger>{c.LEN()});
37           },
38           [](const ArrayConstructor<Result> &a) -> T { return a.LEN(); },
39           [](const Parentheses<Result> &x) { return x.left().LEN(); },
40           [](const Convert<Result> &x) {
41             return std::visit(
42                 [&](const auto &kx) { return kx.LEN(); }, x.left().u);
43           },
44           [](const Concat<KIND> &c) -> T {
45             if (auto llen{c.left().LEN()}) {
46               if (auto rlen{c.right().LEN()}) {
47                 return *std::move(llen) + *std::move(rlen);
48               }
49             }
50             return std::nullopt;
51           },
52           [](const Extremum<Result> &c) -> T {
53             if (auto llen{c.left().LEN()}) {
54               if (auto rlen{c.right().LEN()}) {
55                 return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{
56                     Ordering::Greater, *std::move(llen), *std::move(rlen)}};
57               }
58             }
59             return std::nullopt;
60           },
61           [](const Designator<Result> &dr) { return dr.LEN(); },
62           [](const FunctionRef<Result> &fr) { return fr.LEN(); },
63           [](const SetLength<KIND> &x) -> T { return x.right(); },
64       },
65       u);
66 }
67 
68 Expr<SomeType>::~Expr() = default;
69 
70 #if defined(__APPLE__) && defined(__GNUC__)
71 template <typename A>
72 typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() {
73   return *static_cast<Derived *>(this);
74 }
75 
76 template <typename A>
77 const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const {
78   return *static_cast<const Derived *>(this);
79 }
80 #endif
81 
82 template <typename A>
83 std::optional<DynamicType> ExpressionBase<A>::GetType() const {
84   if constexpr (IsLengthlessIntrinsicType<Result>) {
85     return Result::GetType();
86   } else {
87     return std::visit(
88         [&](const auto &x) -> std::optional<DynamicType> {
89           if constexpr (!common::HasMember<decltype(x), TypelessExpression>) {
90             return x.GetType();
91           }
92           return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning
93         },
94         derived().u);
95   }
96 }
97 
98 template <typename A> int ExpressionBase<A>::Rank() const {
99   return std::visit(
100       [](const auto &x) {
101         if constexpr (common::HasMember<decltype(x), TypelessExpression>) {
102           return 0;
103         } else {
104           return x.Rank();
105         }
106       },
107       derived().u);
108 }
109 
110 DynamicType Parentheses<SomeDerived>::GetType() const {
111   return left().GetType().value();
112 }
113 
114 #if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
115 template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const {
116   llvm::errs() << "Expr is <{" << AsFortran() << "}>\n";
117 }
118 #endif
119 
120 // Equality testing
121 
122 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {
123   return name == that.name;
124 }
125 
126 template <typename T>
127 bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const {
128   return name_ == that.name_ && lower_ == that.lower_ &&
129       upper_ == that.upper_ && stride_ == that.stride_ &&
130       values_ == that.values_;
131 }
132 
133 template <typename T>
134 bool ArrayConstructorValue<T>::operator==(
135     const ArrayConstructorValue<T> &that) const {
136   return u == that.u;
137 }
138 
139 template <typename R>
140 bool ArrayConstructorValues<R>::operator==(
141     const ArrayConstructorValues<R> &that) const {
142   return values_ == that.values_;
143 }
144 
145 template <int KIND>
146 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
147     const ArrayConstructor &that) const {
148   return length_ == that.length_ &&
149       static_cast<const Base &>(*this) == static_cast<const Base &>(that);
150 }
151 
152 bool ArrayConstructor<SomeDerived>::operator==(
153     const ArrayConstructor &that) const {
154   return result_ == that.result_ &&
155       static_cast<const Base &>(*this) == static_cast<const Base &>(that);
156   ;
157 }
158 
159 StructureConstructor::StructureConstructor(
160     const semantics::DerivedTypeSpec &spec,
161     const StructureConstructorValues &values)
162     : result_{spec}, values_{values} {}
163 StructureConstructor::StructureConstructor(
164     const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values)
165     : result_{spec}, values_{std::move(values)} {}
166 
167 bool StructureConstructor::operator==(const StructureConstructor &that) const {
168   return result_ == that.result_ && values_ == that.values_;
169 }
170 
171 bool Relational<SomeType>::operator==(const Relational<SomeType> &that) const {
172   return u == that.u;
173 }
174 
175 template <int KIND>
176 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(
177     const Expr<Type<TypeCategory::Integer, KIND>> &that) const {
178   return u == that.u;
179 }
180 
181 template <int KIND>
182 bool Expr<Type<TypeCategory::Real, KIND>>::operator==(
183     const Expr<Type<TypeCategory::Real, KIND>> &that) const {
184   return u == that.u;
185 }
186 
187 template <int KIND>
188 bool Expr<Type<TypeCategory::Complex, KIND>>::operator==(
189     const Expr<Type<TypeCategory::Complex, KIND>> &that) const {
190   return u == that.u;
191 }
192 
193 template <int KIND>
194 bool Expr<Type<TypeCategory::Logical, KIND>>::operator==(
195     const Expr<Type<TypeCategory::Logical, KIND>> &that) const {
196   return u == that.u;
197 }
198 
199 template <int KIND>
200 bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
201     const Expr<Type<TypeCategory::Character, KIND>> &that) const {
202   return u == that.u;
203 }
204 
205 template <TypeCategory CAT>
206 bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
207   return u == that.u;
208 }
209 
210 bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const {
211   return u == that.u;
212 }
213 
214 bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const {
215   return u == that.u;
216 }
217 
218 bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const {
219   return u == that.u;
220 }
221 
222 DynamicType StructureConstructor::GetType() const { return result_.GetType(); }
223 
224 std::optional<Expr<SomeType>> StructureConstructor::CreateParentComponent(
225     const Symbol &component) const {
226   if (const semantics::DerivedTypeSpec *
227       parentSpec{GetParentTypeSpec(derivedTypeSpec())}) {
228     StructureConstructor structureConstructor{*parentSpec};
229     if (const auto *parentDetails{
230             component.detailsIf<semantics::DerivedTypeDetails>()}) {
231       auto parentIter{parentDetails->componentNames().begin()};
232       for (const auto &childIter : values_) {
233         if (parentIter == parentDetails->componentNames().end()) {
234           break; // There are more components in the child
235         }
236         SymbolRef componentSymbol{childIter.first};
237         structureConstructor.Add(
238             *componentSymbol, common::Clone(childIter.second.value()));
239         ++parentIter;
240       }
241       Constant<SomeDerived> constResult{std::move(structureConstructor)};
242       Expr<SomeDerived> result{std::move(constResult)};
243       return std::optional<Expr<SomeType>>{result};
244     }
245   }
246   return std::nullopt;
247 }
248 
249 static const Symbol *GetParentComponentSymbol(const Symbol &symbol) {
250   if (symbol.test(Symbol::Flag::ParentComp)) {
251     // we have a created parent component
252     const auto &compObject{symbol.get<semantics::ObjectEntityDetails>()};
253     if (const semantics::DeclTypeSpec * compType{compObject.type()}) {
254       const semantics::DerivedTypeSpec &dtSpec{compType->derivedTypeSpec()};
255       const semantics::Symbol &compTypeSymbol{dtSpec.typeSymbol()};
256       return &compTypeSymbol;
257     }
258   }
259   if (symbol.detailsIf<semantics::DerivedTypeDetails>()) {
260     // we have an implicit parent type component
261     return &symbol;
262   }
263   return nullptr;
264 }
265 
266 std::optional<Expr<SomeType>> StructureConstructor::Find(
267     const Symbol &component) const {
268   if (auto iter{values_.find(component)}; iter != values_.end()) {
269     return iter->second.value();
270   }
271   // The component wasn't there directly, see if we're looking for the parent
272   // component of an extended type
273   if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) {
274     return CreateParentComponent(*typeSymbol);
275   }
276   // Look for the component in the parent type component.  The parent type
277   // component is always the first one
278   if (!values_.empty()) {
279     const Expr<SomeType> *parentExpr{&values_.begin()->second.value()};
280     if (const Expr<SomeDerived> *derivedExpr{
281             std::get_if<Expr<SomeDerived>>(&parentExpr->u)}) {
282       if (const Constant<SomeDerived> *constExpr{
283               std::get_if<Constant<SomeDerived>>(&derivedExpr->u)}) {
284         if (std::optional<StructureConstructor> parentComponentValue{
285                 constExpr->GetScalarValue()}) {
286           // Try to find the component in the parent structure constructor
287           return parentComponentValue->Find(component);
288         }
289       }
290     }
291   }
292   return std::nullopt;
293 }
294 
295 StructureConstructor &StructureConstructor::Add(
296     const Symbol &symbol, Expr<SomeType> &&expr) {
297   values_.emplace(symbol, std::move(expr));
298   return *this;
299 }
300 
301 GenericExprWrapper::~GenericExprWrapper() {}
302 
303 void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; }
304 
305 GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
306 
307 void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) {
308   delete p;
309 }
310 
311 template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
312   return std::visit(
313       [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
314       u);
315 }
316 
317 int Expr<SomeCharacter>::GetKind() const {
318   return std::visit(
319       [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
320       u);
321 }
322 
323 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
324   return std::visit([](const auto &kx) { return kx.LEN(); }, u);
325 }
326 
327 #ifdef _MSC_VER // disable bogus warning about missing definitions
328 #pragma warning(disable : 4661)
329 #endif
330 INSTANTIATE_EXPRESSION_TEMPLATES
331 } // namespace Fortran::evaluate
332