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