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