1 // Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved.
2 //
3 // Licensed under the Apache License, Version 2.0 (the "License");
4 // you may not use this file except in compliance with the License.
5 // You may obtain a copy of the License at
6 //
7 // http://www.apache.org/licenses/LICENSE-2.0
8 //
9 // Unless required by applicable law or agreed to in writing, software
10 // distributed under the License is distributed on an "AS IS" BASIS,
11 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 // See the License for the specific language governing permissions and
13 // limitations under the License.
14
15 #include "expression.h"
16 #include "common.h"
17 #include "int-power.h"
18 #include "tools.h"
19 #include "variable.h"
20 #include "../common/idioms.h"
21 #include "../parser/message.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 *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 for classes without EVALUATE_UNION_CLASS_BOILERPLATE()
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 R>
operator ==(const ArrayConstructorValues<R> & that) const124 bool ArrayConstructorValues<R>::operator==(
125 const ArrayConstructorValues<R> &that) const {
126 return values_ == that.values_;
127 }
128
129 template<int KIND>
operator ==(const ArrayConstructor & that) const130 bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
131 const ArrayConstructor &that) const {
132 return length_ == that.length_ &&
133 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
134 }
135
operator ==(const ArrayConstructor & that) const136 bool ArrayConstructor<SomeDerived>::operator==(
137 const ArrayConstructor &that) const {
138 return result_ == that.result_ &&
139 static_cast<const Base &>(*this) == static_cast<const Base &>(that);
140 ;
141 }
142
StructureConstructor(const semantics::DerivedTypeSpec & spec,const StructureConstructorValues & values)143 StructureConstructor::StructureConstructor(
144 const semantics::DerivedTypeSpec &spec,
145 const StructureConstructorValues &values)
146 : result_{spec}, values_{values} {}
StructureConstructor(const semantics::DerivedTypeSpec & spec,StructureConstructorValues && values)147 StructureConstructor::StructureConstructor(
148 const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values)
149 : result_{spec}, values_{std::move(values)} {}
150
operator ==(const StructureConstructor & that) const151 bool StructureConstructor::operator==(const StructureConstructor &that) const {
152 return result_ == that.result_ && values_ == that.values_;
153 }
154
GetType() const155 DynamicType StructureConstructor::GetType() const { return result_.GetType(); }
156
Find(const Symbol * component) const157 const Expr<SomeType> *StructureConstructor::Find(
158 const Symbol *component) const {
159 if (auto iter{values_.find(component)}; iter != values_.end()) {
160 return &iter->second.value();
161 } else {
162 return nullptr;
163 }
164 }
165
Add(const Symbol & symbol,Expr<SomeType> && expr)166 StructureConstructor &StructureConstructor::Add(
167 const Symbol &symbol, Expr<SomeType> &&expr) {
168 values_.emplace(&symbol, std::move(expr));
169 return *this;
170 }
171
172 GenericExprWrapper::~GenericExprWrapper() = default;
173
operator ==(const GenericExprWrapper & that) const174 bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const {
175 return v == that.v;
176 }
177
GetKind() const178 template<TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
179 return std::visit(
180 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
181 u);
182 }
183
GetKind() const184 int Expr<SomeCharacter>::GetKind() const {
185 return std::visit(
186 [](const auto &kx) { return std::decay_t<decltype(kx)>::Result::kind; },
187 u);
188 }
189
LEN() const190 std::optional<Expr<SubscriptInteger>> Expr<SomeCharacter>::LEN() const {
191 return std::visit([](const auto &kx) { return kx.LEN(); }, u);
192 }
193
194 INSTANTIATE_EXPRESSION_TEMPLATES
195 }
196 DEFINE_DELETER(Fortran::evaluate::GenericExprWrapper)
197