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>>
LEN() const31 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>
derived()72 typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() {
73 return *static_cast<Derived *>(this);
74 }
75
76 template <typename A>
derived() const77 const typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() const {
78 return *static_cast<const Derived *>(this);
79 }
80 #endif
81
82 template <typename A>
GetType() const83 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
Rank() const98 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 // Equality testing
111
operator ==(const ImpliedDoIndex & that) const112 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {
113 return name == that.name;
114 }
115
116 template <typename T>
operator ==(const ImpliedDo<T> & that) const117 bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const {
118 return name_ == that.name_ && lower_ == that.lower_ &&
119 upper_ == that.upper_ && stride_ == that.stride_ &&
120 values_ == that.values_;
121 }
122
123 template <typename T>
operator ==(const ArrayConstructorValue<T> & that) const124 bool ArrayConstructorValue<T>::operator==(
125 const ArrayConstructorValue<T> &that) const {
126 return u == that.u;
127 }
128
129 template <typename R>
operator ==(const ArrayConstructorValues<R> & that) const130 bool ArrayConstructorValues<R>::operator==(
131 const ArrayConstructorValues<R> &that) const {
132 return values_ == that.values_;
133 }
134
135 template <int KIND>
operator ==(const ArrayConstructor & that) const136 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
137 const ArrayConstructor &that) const {
138 return length_ == that.length_ &&
139 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
140 }
141
operator ==(const ArrayConstructor & that) const142 bool ArrayConstructor<SomeDerived>::operator==(
143 const ArrayConstructor &that) const {
144 return result_ == that.result_ &&
145 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
146 ;
147 }
148
StructureConstructor(const semantics::DerivedTypeSpec & spec,const StructureConstructorValues & values)149 StructureConstructor::StructureConstructor(
150 const semantics::DerivedTypeSpec &spec,
151 const StructureConstructorValues &values)
152 : result_{spec}, values_{values} {}
StructureConstructor(const semantics::DerivedTypeSpec & spec,StructureConstructorValues && values)153 StructureConstructor::StructureConstructor(
154 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values)
155 : result_{spec}, values_{std::move(values)} {}
156
operator ==(const StructureConstructor & that) const157 bool StructureConstructor::operator==(const StructureConstructor &that) const {
158 return result_ == that.result_ && values_ == that.values_;
159 }
160
operator ==(const Relational<SomeType> & that) const161 bool Relational<SomeType>::operator==(const Relational<SomeType> &that) const {
162 return u == that.u;
163 }
164
165 template <int KIND>
operator ==(const Expr<Type<TypeCategory::Integer,KIND>> & that) const166 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(
167 const Expr<Type<TypeCategory::Integer, KIND>> &that) const {
168 return u == that.u;
169 }
170
171 template <int KIND>
operator ==(const Expr<Type<TypeCategory::Real,KIND>> & that) const172 bool Expr<Type<TypeCategory::Real, KIND>>::operator==(
173 const Expr<Type<TypeCategory::Real, KIND>> &that) const {
174 return u == that.u;
175 }
176
177 template <int KIND>
operator ==(const Expr<Type<TypeCategory::Complex,KIND>> & that) const178 bool Expr<Type<TypeCategory::Complex, KIND>>::operator==(
179 const Expr<Type<TypeCategory::Complex, KIND>> &that) const {
180 return u == that.u;
181 }
182
183 template <int KIND>
operator ==(const Expr<Type<TypeCategory::Logical,KIND>> & that) const184 bool Expr<Type<TypeCategory::Logical, KIND>>::operator==(
185 const Expr<Type<TypeCategory::Logical, KIND>> &that) const {
186 return u == that.u;
187 }
188
189 template <int KIND>
operator ==(const Expr<Type<TypeCategory::Character,KIND>> & that) const190 bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
191 const Expr<Type<TypeCategory::Character, KIND>> &that) const {
192 return u == that.u;
193 }
194
195 template <TypeCategory CAT>
operator ==(const Expr<SomeKind<CAT>> & that) const196 bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
197 return u == that.u;
198 }
199
operator ==(const Expr<SomeDerived> & that) const200 bool Expr<SomeDerived>::operator==(const Expr<SomeDerived> &that) const {
201 return u == that.u;
202 }
203
operator ==(const Expr<SomeCharacter> & that) const204 bool Expr<SomeCharacter>::operator==(const Expr<SomeCharacter> &that) const {
205 return u == that.u;
206 }
207
operator ==(const Expr<SomeType> & that) const208 bool Expr<SomeType>::operator==(const Expr<SomeType> &that) const {
209 return u == that.u;
210 }
211
GetType() const212 DynamicType StructureConstructor::GetType() const { return result_.GetType(); }
213
CreateParentComponent(const Symbol & component) const214 std::optional<Expr<SomeType>> StructureConstructor::CreateParentComponent(
215 const Symbol &component) const {
216 if (const semantics::DerivedTypeSpec *
217 parentSpec{GetParentTypeSpec(derivedTypeSpec())}) {
218 StructureConstructor structureConstructor{*parentSpec};
219 if (const auto *parentDetails{
220 component.detailsIf<semantics::DerivedTypeDetails>()}) {
221 auto parentIter{parentDetails->componentNames().begin()};
222 for (const auto &childIter : values_) {
223 if (parentIter == parentDetails->componentNames().end()) {
224 break; // There are more components in the child
225 }
226 SymbolRef componentSymbol{childIter.first};
227 structureConstructor.Add(
228 *componentSymbol, common::Clone(childIter.second.value()));
229 ++parentIter;
230 }
231 Constant<SomeDerived> constResult{std::move(structureConstructor)};
232 Expr<SomeDerived> result{std::move(constResult)};
233 return std::optional<Expr<SomeType>>{result};
234 }
235 }
236 return std::nullopt;
237 }
238
GetParentComponentSymbol(const Symbol & symbol)239 static const Symbol *GetParentComponentSymbol(const Symbol &symbol) {
240 if (symbol.test(Symbol::Flag::ParentComp)) {
241 // we have a created parent component
242 const auto &compObject{symbol.get<semantics::ObjectEntityDetails>()};
243 if (const semantics::DeclTypeSpec * compType{compObject.type()}) {
244 const semantics::DerivedTypeSpec &dtSpec{compType->derivedTypeSpec()};
245 const semantics::Symbol &compTypeSymbol{dtSpec.typeSymbol()};
246 return &compTypeSymbol;
247 }
248 }
249 if (symbol.detailsIf<semantics::DerivedTypeDetails>()) {
250 // we have an implicit parent type component
251 return &symbol;
252 }
253 return nullptr;
254 }
255
Find(const Symbol & component) const256 std::optional<Expr<SomeType>> StructureConstructor::Find(
257 const Symbol &component) const {
258 if (auto iter{values_.find(component)}; iter != values_.end()) {
259 return iter->second.value();
260 }
261 // The component wasn't there directly, see if we're looking for the parent
262 // component of an extended type
263 if (const Symbol * typeSymbol{GetParentComponentSymbol(component)}) {
264 return CreateParentComponent(*typeSymbol);
265 }
266 // Look for the component in the parent type component. The parent type
267 // component is always the first one
268 if (!values_.empty()) {
269 const Expr<SomeType> *parentExpr{&values_.begin()->second.value()};
270 if (const Expr<SomeDerived> *derivedExpr{
271 std::get_if<Expr<SomeDerived>>(&parentExpr->u)}) {
272 if (const Constant<SomeDerived> *constExpr{
273 std::get_if<Constant<SomeDerived>>(&derivedExpr->u)}) {
274 if (std::optional<StructureConstructor> parentComponentValue{
275 constExpr->GetScalarValue()}) {
276 // Try to find the component in the parent structure constructor
277 return parentComponentValue->Find(component);
278 }
279 }
280 }
281 }
282 return std::nullopt;
283 }
284
Add(const Symbol & symbol,Expr<SomeType> && expr)285 StructureConstructor &StructureConstructor::Add(
286 const Symbol &symbol, Expr<SomeType> &&expr) {
287 values_.emplace(symbol, std::move(expr));
288 return *this;
289 }
290
~GenericExprWrapper()291 GenericExprWrapper::~GenericExprWrapper() {}
292
Deleter(GenericExprWrapper * p)293 void GenericExprWrapper::Deleter(GenericExprWrapper *p) { delete p; }
294
~GenericAssignmentWrapper()295 GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
296
Deleter(GenericAssignmentWrapper * p)297 void GenericAssignmentWrapper::Deleter(GenericAssignmentWrapper *p) {
298 delete p;
299 }
300
GetKind() const301 template <TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
302 return std::visit(
303 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
304 u);
305 }
306
GetKind() const307 int Expr<SomeCharacter>::GetKind() const {
308 return std::visit(
309 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
310 u);
311 }
312
LEN() const313 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
314 return std::visit([](const auto &kx) { return kx.LEN(); }, u);
315 }
316
317 INSTANTIATE_EXPRESSION_TEMPLATES
318 } // namespace Fortran::evaluate
319