Warning: This file is not a C or C++ file. It does not have highlighting.

1//===-- include/flang/Evaluate/characteristics.h ----------------*- C++ -*-===//
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// Defines data structures to represent "characteristics" of Fortran
10// procedures and other entities as they are specified in section 15.3
11// of Fortran 2018.
12
13#ifndef FORTRAN_EVALUATE_CHARACTERISTICS_H_
14#define FORTRAN_EVALUATE_CHARACTERISTICS_H_
15
16#include "common.h"
17#include "expression.h"
18#include "shape.h"
19#include "tools.h"
20#include "type.h"
21#include "flang/Common/Fortran-features.h"
22#include "flang/Common/Fortran.h"
23#include "flang/Common/enum-set.h"
24#include "flang/Common/idioms.h"
25#include "flang/Common/indirection.h"
26#include "flang/Parser/char-block.h"
27#include "flang/Semantics/symbol.h"
28#include <optional>
29#include <string>
30#include <variant>
31#include <vector>
32
33namespace llvm {
34class raw_ostream;
35}
36
37namespace Fortran::evaluate::characteristics {
38struct Procedure;
39}
40extern template class Fortran::common::Indirection<
41 Fortran::evaluate::characteristics::Procedure, true>;
42
43namespace Fortran::evaluate::characteristics {
44
45using common::CopyableIndirection;
46
47// Are these procedures distinguishable for a generic name or FINAL?
48std::optional<bool> Distinguishable(const common::LanguageFeatureControl &,
49 const Procedure &, const Procedure &);
50// Are these procedures distinguishable for a generic operator or assignment?
51std::optional<bool> DistinguishableOpOrAssign(
52 const common::LanguageFeatureControl &, const Procedure &,
53 const Procedure &);
54
55// Shapes of function results and dummy arguments have to have
56// the same rank, the same deferred dimensions, and the same
57// values for explicit dimensions when constant.
58bool ShapesAreCompatible(
59 const Shape &, const Shape &, bool *possibleWarning = nullptr);
60
61class TypeAndShape {
62public:
63 ENUM_CLASS(
64 Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape, Coarray)
65 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
66
67 explicit TypeAndShape(DynamicType t) : type_{t} { AcquireLEN(); }
68 TypeAndShape(DynamicType t, int rank) : type_{t}, shape_(rank) {
69 AcquireLEN();
70 }
71 TypeAndShape(DynamicType t, Shape &&s) : type_{t}, shape_{std::move(s)} {
72 AcquireLEN();
73 }
74 TypeAndShape(DynamicType t, std::optional<Shape> &&s) : type_{t} {
75 if (s) {
76 shape_ = std::move(*s);
77 }
78 AcquireLEN();
79 }
80 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape)
81
82 bool operator==(const TypeAndShape &) const;
83 bool operator!=(const TypeAndShape &that) const { return !(*this == that); }
84
85 static std::optional<TypeAndShape> Characterize(
86 const semantics::Symbol &, FoldingContext &, bool invariantOnly = true);
87 static std::optional<TypeAndShape> Characterize(
88 const semantics::DeclTypeSpec &, FoldingContext &,
89 bool invariantOnly = true);
90 static std::optional<TypeAndShape> Characterize(
91 const ActualArgument &, FoldingContext &, bool invariantOnly = true);
92
93 // General case for Expr<T>, &c.
94 template <typename A>
95 static std::optional<TypeAndShape> Characterize(
96 const A &x, FoldingContext &context, bool invariantOnly = true) {
97 const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)};
98 if (symbol && !symbol->owner().IsDerivedType()) { // Whole variable
99 if (auto result{Characterize(*symbol, context, invariantOnly)}) {
100 return result;
101 }
102 }
103 if (auto type{x.GetType()}) {
104 TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
105 if (type->category() == TypeCategory::Character) {
106 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
107 if (auto length{chExpr->LEN()}) {
108 result.set_LEN(std::move(*length));
109 }
110 }
111 }
112 if (symbol) { // component
113 result.AcquireAttrs(*symbol);
114 }
115 return std::move(result.Rewrite(context));
116 }
117 return std::nullopt;
118 }
119
120 // Specialization for character designators
121 template <int KIND>
122 static std::optional<TypeAndShape> Characterize(
123 const Designator<Type<TypeCategory::Character, KIND>> &x,
124 FoldingContext &context, bool invariantOnly = true) {
125 const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)};
126 if (symbol && !symbol->owner().IsDerivedType()) { // Whole variable
127 if (auto result{Characterize(*symbol, context, invariantOnly)}) {
128 return result;
129 }
130 }
131 if (auto type{x.GetType()}) {
132 TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
133 if (type->category() == TypeCategory::Character) {
134 if (auto length{x.LEN()}) {
135 result.set_LEN(std::move(*length));
136 }
137 }
138 if (symbol) { // component
139 result.AcquireAttrs(*symbol);
140 }
141 return std::move(result.Rewrite(context));
142 }
143 return std::nullopt;
144 }
145
146 template <typename A>
147 static std::optional<TypeAndShape> Characterize(const std::optional<A> &x,
148 FoldingContext &context, bool invariantOnly = true) {
149 if (x) {
150 return Characterize(*x, context, invariantOnly);
151 } else {
152 return std::nullopt;
153 }
154 }
155 template <typename A>
156 static std::optional<TypeAndShape> Characterize(
157 A *ptr, FoldingContext &context, bool invariantOnly = true) {
158 if (ptr) {
159 return Characterize(std::as_const(*ptr), context, invariantOnly);
160 } else {
161 return std::nullopt;
162 }
163 }
164
165 DynamicType type() const { return type_; }
166 TypeAndShape &set_type(DynamicType t) {
167 type_ = t;
168 return *this;
169 }
170 const std::optional<Expr<SubscriptInteger>> &LEN() const { return LEN_; }
171 TypeAndShape &set_LEN(Expr<SubscriptInteger> &&len) {
172 LEN_ = std::move(len);
173 return *this;
174 }
175 const Shape &shape() const { return shape_; }
176 const Attrs &attrs() const { return attrs_; }
177 int corank() const { return corank_; }
178
179 int Rank() const { return GetRank(shape_); }
180
181 // Can sequence association apply to this argument?
182 bool CanBeSequenceAssociated() const {
183 constexpr Attrs notAssumedOrExplicitShape{
184 ~Attrs{Attr::AssumedSize, Attr::Coarray}};
185 return Rank() > 0 && (attrs() & notAssumedOrExplicitShape).none();
186 }
187
188 bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that,
189 const char *thisIs = "pointer", const char *thatIs = "target",
190 bool omitShapeConformanceCheck = false,
191 enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const;
192 std::optional<Expr<SubscriptInteger>> MeasureElementSizeInBytes(
193 FoldingContext &, bool align) const;
194 std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
195 FoldingContext &) const;
196
197 // called by Fold() to rewrite in place
198 TypeAndShape &Rewrite(FoldingContext &);
199
200 std::string AsFortran() const;
201 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
202
203private:
204 static std::optional<TypeAndShape> Characterize(
205 const semantics::AssocEntityDetails &, FoldingContext &,
206 bool invariantOnly = true);
207 void AcquireAttrs(const semantics::Symbol &);
208 void AcquireLEN();
209 void AcquireLEN(const semantics::Symbol &);
210
211protected:
212 DynamicType type_;
213 std::optional<Expr<SubscriptInteger>> LEN_;
214 Shape shape_;
215 Attrs attrs_;
216 int corank_{0};
217};
218
219// 15.3.2.2
220struct DummyDataObject {
221 ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
222 Volatile, Pointer, Target, DeducedFromActual)
223 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
224 static bool IdenticalSignificantAttrs(const Attrs &x, const Attrs &y) {
225 return (x - Attr::DeducedFromActual) == (y - Attr::DeducedFromActual);
226 }
227 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
228 explicit DummyDataObject(const TypeAndShape &t) : type{t} {}
229 explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {}
230 explicit DummyDataObject(DynamicType t) : type{t} {}
231 bool operator==(const DummyDataObject &) const;
232 bool operator!=(const DummyDataObject &that) const {
233 return !(*this == that);
234 }
235 bool IsCompatibleWith(const DummyDataObject &, std::string *whyNot = nullptr,
236 std::optional<std::string> *warning = nullptr) const;
237 static std::optional<DummyDataObject> Characterize(
238 const semantics::Symbol &, FoldingContext &);
239 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const;
240 bool IsPassedByDescriptor(bool isBindC) const;
241 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
242
243 TypeAndShape type;
244 std::vector<Expr<SubscriptInteger>> coshape;
245 common::Intent intent{common::Intent::Default};
246 Attrs attrs;
247 common::IgnoreTKRSet ignoreTKR;
248 std::optional<common::CUDADataAttr> cudaDataAttr;
249};
250
251// 15.3.2.3
252struct DummyProcedure {
253 ENUM_CLASS(Attr, Pointer, Optional)
254 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
255 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
256 explicit DummyProcedure(Procedure &&);
257 bool operator==(const DummyProcedure &) const;
258 bool operator!=(const DummyProcedure &that) const { return !(*this == that); }
259 bool IsCompatibleWith(
260 const DummyProcedure &, std::string *whyNot = nullptr) const;
261 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const;
262 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
263
264 CopyableIndirection<Procedure> procedure;
265 common::Intent intent{common::Intent::Default};
266 Attrs attrs;
267};
268
269// 15.3.2.4
270struct AlternateReturn {
271 bool operator==(const AlternateReturn &) const { return true; }
272 bool operator!=(const AlternateReturn &) const { return false; }
273 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
274};
275
276// 15.3.2.1
277struct DummyArgument {
278 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
279 DummyArgument(std::string &&name, DummyDataObject &&x)
280 : name{std::move(name)}, u{std::move(x)} {}
281 DummyArgument(std::string &&name, DummyProcedure &&x)
282 : name{std::move(name)}, u{std::move(x)} {}
283 explicit DummyArgument(AlternateReturn &&x) : u{std::move(x)} {}
284 ~DummyArgument();
285 bool operator==(const DummyArgument &) const;
286 bool operator!=(const DummyArgument &that) const { return !(*this == that); }
287 static std::optional<DummyArgument> FromActual(std::string &&,
288 const Expr<SomeType> &, FoldingContext &, bool forImplicitInterface);
289 static std::optional<DummyArgument> FromActual(std::string &&,
290 const ActualArgument &, FoldingContext &, bool forImplicitInterface);
291 bool IsOptional() const;
292 void SetOptional(bool = true);
293 common::Intent GetIntent() const;
294 void SetIntent(common::Intent);
295 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const;
296 bool IsTypelessIntrinsicDummy() const;
297 bool IsCompatibleWith(const DummyArgument &, std::string *whyNot = nullptr,
298 std::optional<std::string> *warning = nullptr) const;
299 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
300
301 // name and pass are not characteristics and so do not participate in
302 // compatibility checks, but they are needed to determine whether
303 // procedures are distinguishable
304 std::string name;
305 bool pass{false}; // is this the PASS argument of its procedure
306 std::variant<DummyDataObject, DummyProcedure, AlternateReturn> u;
307};
308
309using DummyArguments = std::vector<DummyArgument>;
310
311// 15.3.3
312struct FunctionResult {
313 ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous)
314 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
315 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
316 explicit FunctionResult(DynamicType);
317 explicit FunctionResult(TypeAndShape &&);
318 explicit FunctionResult(Procedure &&);
319 ~FunctionResult();
320 bool operator==(const FunctionResult &) const;
321 bool operator!=(const FunctionResult &that) const { return !(*this == that); }
322 static std::optional<FunctionResult> Characterize(
323 const Symbol &, FoldingContext &);
324
325 bool IsAssumedLengthCharacter() const;
326
327 const Procedure *IsProcedurePointer() const {
328 if (const auto *pp{std::get_if<CopyableIndirection<Procedure>>(&u)}) {
329 return &pp->value();
330 } else {
331 return nullptr;
332 }
333 }
334 const TypeAndShape *GetTypeAndShape() const {
335 return std::get_if<TypeAndShape>(&u);
336 }
337 void SetType(DynamicType t) { std::get<TypeAndShape>(u).set_type(t); }
338 bool CanBeReturnedViaImplicitInterface(std::string *whyNot = nullptr) const;
339 bool IsCompatibleWith(
340 const FunctionResult &, std::string *whyNot = nullptr) const;
341
342 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
343
344 Attrs attrs;
345 std::variant<TypeAndShape, CopyableIndirection<Procedure>> u;
346 std::optional<common::CUDADataAttr> cudaDataAttr;
347};
348
349// 15.3.1
350struct Procedure {
351 ENUM_CLASS(
352 Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer, Subroutine)
353 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
354 Procedure(){};
355 Procedure(FunctionResult &&, DummyArguments &&, Attrs);
356 Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
357 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
358 ~Procedure();
359 bool operator==(const Procedure &) const;
360 bool operator!=(const Procedure &that) const { return !(*this == that); }
361
362 // Characterizes a procedure. If a Symbol, it may be an
363 // "unrestricted specific intrinsic function".
364 // Error messages are produced when a procedure cannot be characterized.
365 static std::optional<Procedure> Characterize(
366 const semantics::Symbol &, FoldingContext &);
367 static std::optional<Procedure> Characterize(
368 const ProcedureDesignator &, FoldingContext &, bool emitError);
369 static std::optional<Procedure> Characterize(
370 const ProcedureRef &, FoldingContext &);
371 static std::optional<Procedure> Characterize(
372 const Expr<SomeType> &, FoldingContext &);
373 // Characterizes the procedure being referenced, deducing dummy argument
374 // types from actual arguments in the case of an implicit interface.
375 static std::optional<Procedure> FromActuals(
376 const ProcedureDesignator &, const ActualArguments &, FoldingContext &);
377
378 // At most one of these will return true.
379 // For "EXTERNAL P" with no type for or calls to P, both will be false.
380 bool IsFunction() const { return functionResult.has_value(); }
381 bool IsSubroutine() const { return attrs.test(Attr::Subroutine); }
382
383 bool IsPure() const { return attrs.test(Attr::Pure); }
384 bool IsElemental() const { return attrs.test(Attr::Elemental); }
385 bool IsBindC() const { return attrs.test(Attr::BindC); }
386 bool HasExplicitInterface() const {
387 return !attrs.test(Attr::ImplicitInterface);
388 }
389 int FindPassIndex(std::optional<parser::CharBlock>) const;
390 bool CanBeCalledViaImplicitInterface(std::string *whyNot = nullptr) const;
391 bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
392 bool IsCompatibleWith(const Procedure &, bool ignoreImplicitVsExplicit,
393 std::string *whyNot = nullptr, const SpecificIntrinsic * = nullptr,
394 std::optional<std::string> *warning = nullptr) const;
395
396 llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
397
398 std::optional<FunctionResult> functionResult;
399 DummyArguments dummyArguments;
400 Attrs attrs;
401 std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs;
402};
403
404} // namespace Fortran::evaluate::characteristics
405#endif // FORTRAN_EVALUATE_CHARACTERISTICS_H_
406

Warning: This file is not a C or C++ file. It does not have highlighting.

source code of flang/include/flang/Evaluate/characteristics.h