1 // Copyright (c) 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 // Defines data structures to represent "characteristics" of Fortran
16 // procedures and other entities as they are specified in section 15.3
17 // of Fortran 2018.
18
19 #ifndef FORTRAN_EVALUATE_CHARACTERISTICS_H_
20 #define FORTRAN_EVALUATE_CHARACTERISTICS_H_
21
22 #include "common.h"
23 #include "expression.h"
24 #include "shape.h"
25 #include "type.h"
26 #include "../common/Fortran.h"
27 #include "../common/enum-set.h"
28 #include "../common/idioms.h"
29 #include "../common/indirection.h"
30 #include "../semantics/symbol.h"
31 #include <optional>
32 #include <ostream>
33 #include <string>
34 #include <variant>
35 #include <vector>
36
37 namespace Fortran::evaluate {
38 class IntrinsicProcTable;
39 }
40 namespace Fortran::evaluate::characteristics {
41 struct Procedure;
42 }
43 extern template class Fortran::common::Indirection<
44 Fortran::evaluate::characteristics::Procedure, true>;
45
46 namespace Fortran::evaluate::characteristics {
47
48 using common::CopyableIndirection;
49
50 // Are these procedures distinguishable for a generic name?
51 bool Distinguishable(const Procedure &, const Procedure &);
52 // Are these procedures distinguishable for a generic operator or assignment?
53 bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
54
55 class TypeAndShape {
56 public:
57 ENUM_CLASS(Attr, AssumedRank, AssumedShape, AssumedSize, Coarray)
58 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
59
TypeAndShape(DynamicType t)60 explicit TypeAndShape(DynamicType t) : type_{t} { AcquireLEN(); }
TypeAndShape(DynamicType t,int rank)61 TypeAndShape(DynamicType t, int rank) : type_{t}, shape_(rank) {
62 AcquireLEN();
63 }
TypeAndShape(DynamicType t,Shape && s)64 TypeAndShape(DynamicType t, Shape &&s) : type_{t}, shape_{std::move(s)} {
65 AcquireLEN();
66 }
67 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape)
68
69 bool operator==(const TypeAndShape &) const;
70 static std::optional<TypeAndShape> Characterize(const semantics::Symbol &);
71 static std::optional<TypeAndShape> Characterize(
72 const semantics::ObjectEntityDetails &);
73 static std::optional<TypeAndShape> Characterize(
74 const semantics::ProcEntityDetails &);
75 static std::optional<TypeAndShape> Characterize(
76 const semantics::ProcInterface &);
77 static std::optional<TypeAndShape> Characterize(
78 const semantics::DeclTypeSpec &);
79 template<typename A>
Characterize(const A * p)80 static std::optional<TypeAndShape> Characterize(const A *p) {
81 return p ? Characterize(*p) : std::nullopt;
82 }
83
type()84 DynamicType type() const { return type_; }
set_type(DynamicType t)85 TypeAndShape &set_type(DynamicType t) {
86 type_ = t;
87 return *this;
88 }
LEN()89 const std::optional<Expr<SomeInteger>> &LEN() const { return LEN_; }
set_LEN(Expr<SomeInteger> && len)90 TypeAndShape &set_LEN(Expr<SomeInteger> &&len) {
91 LEN_ = std::move(len);
92 return *this;
93 }
shape()94 const Shape &shape() const { return shape_; }
attrs()95 const Attrs &attrs() const { return attrs_; }
96
Rank()97 int Rank() const { return GetRank(shape_); }
98 bool IsCompatibleWith(
99 parser::ContextualMessages &, const TypeAndShape &) const;
100
101 std::ostream &Dump(std::ostream &) const;
102
103 private:
104 void AcquireShape(const semantics::ObjectEntityDetails &);
105 void AcquireLEN();
106
107 protected:
108 DynamicType type_;
109 std::optional<Expr<SomeInteger>> LEN_;
110 Shape shape_;
111 Attrs attrs_;
112 };
113
114 template<typename T>
GetTypeAndShape(const Expr<T> & expr,FoldingContext & context)115 std::optional<TypeAndShape> GetTypeAndShape(
116 const Expr<T> &expr, FoldingContext &context) {
117 if (auto type{expr.GetType()}) {
118 if (auto shape{GetShape(context, expr)}) {
119 TypeAndShape result{*type, std::move(*shape)};
120 if (type->category() == TypeCategory::Character) {
121 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(expr)}) {
122 if (auto length{chExpr->LEN()}) {
123 result.set_LEN(Expr<SomeInteger>{std::move(*length)});
124 }
125 }
126 }
127 return result;
128 }
129 }
130 return std::nullopt;
131 }
132
133 // 15.3.2.2
134 struct DummyDataObject {
135 ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
136 Volatile, Pointer, Target)
137 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTSDummyDataObject138 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
139 explicit DummyDataObject(const TypeAndShape &t) : type{t} {}
DummyDataObjectDummyDataObject140 explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {}
DummyDataObjectDummyDataObject141 explicit DummyDataObject(DynamicType t) : type{t} {}
142 bool operator==(const DummyDataObject &) const;
143 static std::optional<DummyDataObject> Characterize(const semantics::Symbol &);
144 bool CanBePassedViaImplicitInterface() const;
145 std::ostream &Dump(std::ostream &) const;
146 TypeAndShape type;
147 std::vector<Expr<SubscriptInteger>> coshape;
148 common::Intent intent{common::Intent::Default};
149 Attrs attrs;
150 };
151
152 // 15.3.2.3
153 struct DummyProcedure {
154 ENUM_CLASS(Attr, Pointer, Optional)
155 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
156 explicit DummyProcedure(Procedure &&);
157 bool operator==(const DummyProcedure &) const;
158 static std::optional<DummyProcedure> Characterize(
159 const semantics::Symbol &, const IntrinsicProcTable &);
160 std::ostream &Dump(std::ostream &) const;
161 CopyableIndirection<Procedure> procedure;
162 common::EnumSet<Attr, Attr_enumSize> attrs;
163 };
164
165 // 15.3.2.4
166 struct AlternateReturn {
167 bool operator==(const AlternateReturn &) const { return true; }
168 std::ostream &Dump(std::ostream &) const;
169 };
170
171 // 15.3.2.1
172 struct DummyArgument {
DECLARE_CONSTRUCTORS_AND_ASSIGNMENTSDummyArgument173 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
174 explicit DummyArgument(std::string &&name, DummyDataObject &&x)
175 : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument176 explicit DummyArgument(std::string &&name, DummyProcedure &&x)
177 : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument178 explicit DummyArgument(AlternateReturn &&x) : u{std::move(x)} {}
179 bool operator==(const DummyArgument &) const;
180 static std::optional<DummyArgument> Characterize(
181 const semantics::Symbol &, const IntrinsicProcTable &);
182 bool IsOptional() const;
183 void SetOptional(bool = true);
184 bool CanBePassedViaImplicitInterface() const;
185 std::ostream &Dump(std::ostream &) const;
186 // name and pass are not characteristics and so does not participate in
187 // operator== but are needed to determine if procedures are distinguishable
188 std::string name;
189 bool pass{false}; // is this the PASS argument of its procedure
190 std::variant<DummyDataObject, DummyProcedure, AlternateReturn> u;
191 };
192
193 using DummyArguments = std::vector<DummyArgument>;
194
195 // 15.3.3
196 struct FunctionResult {
197 ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous)
198 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
199 explicit FunctionResult(DynamicType);
200 explicit FunctionResult(TypeAndShape &&);
201 explicit FunctionResult(Procedure &&);
202 ~FunctionResult();
203 bool operator==(const FunctionResult &) const;
204 static std::optional<FunctionResult> Characterize(
205 const Symbol &, const IntrinsicProcTable &);
206
207 bool IsAssumedLengthCharacter() const;
208
IsProcedurePointerFunctionResult209 const Procedure *IsProcedurePointer() const {
210 if (const auto *pp{std::get_if<CopyableIndirection<Procedure>>(&u)}) {
211 return &pp->value();
212 } else {
213 return nullptr;
214 }
215 }
GetTypeAndShapeFunctionResult216 const TypeAndShape *GetTypeAndShape() const {
217 return std::get_if<TypeAndShape>(&u);
218 }
SetTypeFunctionResult219 void SetType(DynamicType t) { std::get<TypeAndShape>(u).set_type(t); }
220 bool CanBeReturnedViaImplicitInterface() const;
221
222 std::ostream &Dump(std::ostream &) const;
223
224 common::EnumSet<Attr, Attr_enumSize> attrs;
225 std::variant<TypeAndShape, CopyableIndirection<Procedure>> u;
226 };
227
228 // 15.3.1
229 struct Procedure {
230 ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer)
231 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
232 Procedure(FunctionResult &&, DummyArguments &&, Attrs);
233 Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
234 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
235 bool operator==(const Procedure &) const;
236
237 // Characterizes the procedure represented by a symbol, which may be an
238 // "unrestricted specific intrinsic function".
239 static std::optional<Procedure> Characterize(
240 const semantics::Symbol &, const IntrinsicProcTable &);
241 static std::optional<Procedure> Characterize(
242 const ProcedureDesignator &, const IntrinsicProcTable &);
243 static std::optional<Procedure> Characterize(
244 const ProcedureRef &, const IntrinsicProcTable &);
245
IsFunctionProcedure246 bool IsFunction() const { return functionResult.has_value(); }
IsSubroutineProcedure247 bool IsSubroutine() const { return !IsFunction(); }
IsPureProcedure248 bool IsPure() const { return attrs.test(Attr::Pure); }
IsElementalProcedure249 bool IsElemental() const { return attrs.test(Attr::Elemental); }
IsBindCProcedure250 bool IsBindC() const { return attrs.test(Attr::BindC); }
HasExplicitInterfaceProcedure251 bool HasExplicitInterface() const {
252 return !attrs.test(Attr::ImplicitInterface);
253 }
254 bool CanBeCalledViaImplicitInterface() const;
255 std::ostream &Dump(std::ostream &) const;
256
257 std::optional<FunctionResult> functionResult;
258 DummyArguments dummyArguments;
259 Attrs attrs;
260
261 private:
ProcedureProcedure262 Procedure() {}
263 };
264
265 }
266 #endif // FORTRAN_EVALUATE_CHARACTERISTICS_H_
267