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
116template <typename A> int ExpressionBase<A>::Corank() const {
117 return common::visit(
118 [](const auto &x) {
119 if constexpr (common::HasMember<decltype(x), TypelessExpression>) {
120 return 0;
121 } else {
122 return x.Corank();
123 }
124 },
125 derived().u);
126}
127
128DynamicType Parentheses<SomeDerived>::GetType() const {
129 return left().GetType().value();
130}
131
132#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
133template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const {
134 llvm::errs() << "Expr is <{" << AsFortran() << "}>\n";
135}
136#endif
137
138// Equality testing
139
140template <typename A> bool Extremum<A>::operator==(const Extremum &that) const {
141 return ordering == that.ordering && Base::operator==(that);
142}
143
144template <int KIND>
145bool LogicalOperation<KIND>::operator==(const LogicalOperation &that) const {
146 return logicalOperator == that.logicalOperator && Base::operator==(that);
147}
148
149template <typename A>
150bool Relational<A>::operator==(const Relational &that) const {
151 return opr == that.opr && Base::operator==(that);
152}
153
154bool Relational<SomeType>::operator==(const Relational &that) const {
155 return u == that.u;
156}
157
158bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {
159 return name == that.name;
160}
161
162template <typename T>
163bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const {
164 return name_ == that.name_ && lower_ == that.lower_ &&
165 upper_ == that.upper_ && stride_ == that.stride_ &&
166 values_ == that.values_;
167}
168
169template <typename T>
170bool ArrayConstructorValue<T>::operator==(
171 const ArrayConstructorValue<T> &that) const {
172 return u == that.u;
173}
174
175template <typename R>
176bool ArrayConstructorValues<R>::operator==(
177 const ArrayConstructorValues<R> &that) const {
178 return values_ == that.values_;
179}
180
181template <int KIND>
182auto ArrayConstructor<Type<TypeCategory::Character, KIND>>::set_LEN(
183 Expr<SubscriptInteger> &&len) -> ArrayConstructor & {
184 length_.emplace(std::move(len));
185 return *this;
186}
187
188template <int KIND>
189bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
190 const ArrayConstructor &that) const {
191 return length_ == that.length_ &&
192 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
193}
194
195bool ArrayConstructor<SomeDerived>::operator==(
196 const ArrayConstructor &that) const {
197 return result_ == that.result_ &&
198 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
199 ;
200}
201
202StructureConstructor::StructureConstructor(
203 const semantics::DerivedTypeSpec &spec,
204 const StructureConstructorValues &values)
205 : result_{spec}, values_{values} {}
206StructureConstructor::StructureConstructor(
207 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values)
208 : result_{spec}, values_{std::move(values)} {}
209
210bool StructureConstructor::operator==(const StructureConstructor &that) const {
211 return result_ == that.result_ && values_ == that.values_;
212}
213
214template <int KIND>
215bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(
216 const Expr<Type<TypeCategory::Integer, KIND>> &that) const {
217 return u == that.u;
218}
219
220template <int KIND>
221bool Expr<Type<TypeCategory::Real, KIND>>::operator==(
222 const Expr<Type<TypeCategory::Real, KIND>> &that) const {
223 return u == that.u;
224}
225
226template <int KIND>
227bool Expr<Type<TypeCategory::Complex, KIND>>::operator==(
228 const Expr<Type<TypeCategory::Complex, KIND>> &that) const {
229 return u == that.u;
230}
231
232template <int KIND>
233bool Expr<Type<TypeCategory::Logical, KIND>>::operator==(
234 const Expr<Type<TypeCategory::Logical, KIND>> &that) const {
235 return u == that.u;
236}
237
238template <int KIND>
239bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
240 const Expr<Type<TypeCategory::Character, KIND>> &that) const {
241 return u == that.u;
242}
243
244template <int KIND>
245bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==(
246 const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const {
247 return u == that.u;
248}
249
250template <TypeCategory CAT>
251bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
252 return u == that.u;
253}
254
255bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const {
256 return u == that.u;
257}
258
259bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const {
260 return u == that.u;
261}
262
263bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const {
264 return u == that.u;
265}
266
267DynamicType StructureConstructor::GetType() const { return result_.GetType(); }
268
269std::optional<Expr<SomeType>> StructureConstructor::CreateParentComponent(
270 const Symbol &component) const {
271 if (const semantics::DerivedTypeSpec *
272 parentSpec{GetParentTypeSpec(derivedTypeSpec())}) {
273 StructureConstructor structureConstructor{*parentSpec};
274 if (const auto *parentDetails{
275 component.detailsIf<semantics::DerivedTypeDetails>()}) {
276 auto parentIter{parentDetails->componentNames().begin()};
277 for (const auto &childIter : values_) {
278 if (parentIter == parentDetails->componentNames().end()) {
279 break; // There are more components in the child
280 }
281 SymbolRef componentSymbol{childIter.first};
282 structureConstructor.Add(
283 *componentSymbol, common::Clone(childIter.second.value()));
284 ++parentIter;
285 }
286 Constant<SomeDerived> constResult{std::move(structureConstructor)};
287 Expr<SomeDerived> result{std::move(constResult)};
288 return std::optional<Expr<SomeType>>{result};
289 }
290 }
291 return std::nullopt;
292}
293
294static const Symbol *GetParentComponentSymbol(const Symbol &symbol) {
295 if (symbol.test(Symbol::Flag::ParentComp)) {
296 // we have a created parent component
297 const auto &compObject{symbol.get<semantics::ObjectEntityDetails>()};
298 if (const semantics::DeclTypeSpec * compType{compObject.type()}) {
299 const semantics::DerivedTypeSpec &dtSpec{compType->derivedTypeSpec()};
300 const semantics::Symbol &compTypeSymbol{dtSpec.typeSymbol()};
301 return &compTypeSymbol;
302 }
303 }
304 if (symbol.detailsIf<semantics::DerivedTypeDetails>()) {
305 // we have an implicit parent type component
306 return &symbol;
307 }
308 return nullptr;
309}
310
311std::optional<Expr<SomeType>> StructureConstructor::Find(
312 const Symbol &component) const {
313 if (auto iter{values_.find(component)}; iter != values_.end()) {
314 return iter->second.value();
315 }
316 // The component wasn't there directly, see if we're looking for the parent
317 // component of an extended type
318 if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) {
319 return CreateParentComponent(*typeSymbol);
320 }
321 // Look for the component in the parent type component. The parent type
322 // component is always the first one
323 if (!values_.empty()) {
324 const Expr<SomeType> *parentExpr{&values_.begin()->second.value()};
325 if (const Expr<SomeDerived> *derivedExpr{
326 std::get_if<Expr<SomeDerived>>(&parentExpr->u)}) {
327 if (const Constant<SomeDerived> *constExpr{
328 std::get_if<Constant<SomeDerived>>(&derivedExpr->u)}) {
329 if (std::optional<StructureConstructor> parentComponentValue{
330 constExpr->GetScalarValue()}) {
331 // Try to find the component in the parent structure constructor
332 return parentComponentValue->Find(component);
333 }
334 }
335 }
336 }
337 return std::nullopt;
338}
339
340StructureConstructor &StructureConstructor::Add(
341 const Symbol &symbol, Expr<SomeType> &&expr) {
342 values_.emplace(symbol, std::move(expr));
343 return *this;
344}
345
346GenericExprWrapper::~GenericExprWrapper() {}
347
348void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; }
349
350GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
351
352void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) {
353 delete p;
354}
355
356template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
357 return common::visit(
358 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
359 u);
360}
361
362int Expr<SomeCharacter>::GetKind() const {
363 return common::visit(
364 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
365 u);
366}
367
368std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
369 return common::visit([](const auto &kx) { return kx.LEN(); }, u);
370}
371
372#ifdef _MSC_VER // disable bogus warning about missing definitions
373#pragma warning(disable : 4661)
374#endif
375INSTANTIATE_EXPRESSION_TEMPLATES
376} // namespace Fortran::evaluate
377

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