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

source code of flang/lib/Evaluate/expression.cpp