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

1//===-- include/flang/Evaluate/call.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#ifndef FORTRAN_EVALUATE_CALL_H_
10#define FORTRAN_EVALUATE_CALL_H_
11
12#include "common.h"
13#include "constant.h"
14#include "formatting.h"
15#include "type.h"
16#include "flang/Common/Fortran.h"
17#include "flang/Common/indirection.h"
18#include "flang/Common/reference.h"
19#include "flang/Parser/char-block.h"
20#include "flang/Semantics/attr.h"
21#include <optional>
22#include <vector>
23
24namespace llvm {
25class raw_ostream;
26}
27
28namespace Fortran::semantics {
29class Symbol;
30}
31
32// Mutually referential data structures are represented here with forward
33// declarations of hitherto undefined class types and a level of indirection.
34namespace Fortran::evaluate {
35class Component;
36class IntrinsicProcTable;
37} // namespace Fortran::evaluate
38namespace Fortran::evaluate::characteristics {
39struct DummyArgument;
40struct Procedure;
41} // namespace Fortran::evaluate::characteristics
42
43extern template class Fortran::common::Indirection<Fortran::evaluate::Component,
44 true>;
45extern template class Fortran::common::Indirection<
46 Fortran::evaluate::characteristics::Procedure, true>;
47
48namespace Fortran::evaluate {
49
50using semantics::Symbol;
51using SymbolRef = common::Reference<const Symbol>;
52
53class ActualArgument {
54public:
55 ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef);
56 using Attrs = common::EnumSet<Attr, Attr_enumSize>;
57
58 // Dummy arguments that are TYPE(*) can be forwarded as actual arguments.
59 // Since that's the only thing one may do with them in Fortran, they're
60 // represented in expressions as a special case of an actual argument.
61 class AssumedType {
62 public:
63 explicit AssumedType(const Symbol &);
64 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType)
65 const Symbol &symbol() const { return symbol_; }
66 int Rank() const;
67 bool operator==(const AssumedType &that) const {
68 return &*symbol_ == &*that.symbol_;
69 }
70 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
71
72 private:
73 SymbolRef symbol_;
74 };
75
76 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(ActualArgument)
77 explicit ActualArgument(Expr<SomeType> &&);
78 explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&);
79 explicit ActualArgument(AssumedType);
80 explicit ActualArgument(common::Label);
81 ~ActualArgument();
82 ActualArgument &operator=(Expr<SomeType> &&);
83
84 Expr<SomeType> *UnwrapExpr() {
85 if (auto *p{
86 std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
87 return &p->value();
88 } else {
89 return nullptr;
90 }
91 }
92 const Expr<SomeType> *UnwrapExpr() const {
93 if (const auto *p{
94 std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
95 return &p->value();
96 } else {
97 return nullptr;
98 }
99 }
100
101 const Symbol *GetAssumedTypeDummy() const {
102 if (const AssumedType * aType{std::get_if<AssumedType>(&u_)}) {
103 return &aType->symbol();
104 } else {
105 return nullptr;
106 }
107 }
108
109 common::Label GetLabel() const { return std::get<common::Label>(u_); }
110
111 std::optional<DynamicType> GetType() const;
112 int Rank() const;
113 bool operator==(const ActualArgument &) const;
114 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
115
116 std::optional<parser::CharBlock> keyword() const { return keyword_; }
117 ActualArgument &set_keyword(parser::CharBlock x) {
118 keyword_ = x;
119 return *this;
120 }
121 bool isAlternateReturn() const {
122 return std::holds_alternative<common::Label>(u_);
123 }
124 bool isPassedObject() const { return attrs_.test(Attr::PassedObject); }
125 ActualArgument &set_isPassedObject(bool yes = true) {
126 if (yes) {
127 attrs_ = attrs_ + Attr::PassedObject;
128 } else {
129 attrs_ = attrs_ - Attr::PassedObject;
130 }
131 return *this;
132 }
133
134 bool Matches(const characteristics::DummyArgument &) const;
135 common::Intent dummyIntent() const { return dummyIntent_; }
136 ActualArgument &set_dummyIntent(common::Intent intent) {
137 dummyIntent_ = intent;
138 return *this;
139 }
140 std::optional<parser::CharBlock> sourceLocation() const {
141 return sourceLocation_;
142 }
143 ActualArgument &set_sourceLocation(std::optional<parser::CharBlock> at) {
144 sourceLocation_ = at;
145 return *this;
146 }
147
148 // Wrap this argument in parentheses
149 void Parenthesize();
150
151 // Legacy %VAL.
152 bool isPercentVal() const { return attrs_.test(Attr::PercentVal); };
153 ActualArgument &set_isPercentVal() {
154 attrs_ = attrs_ + Attr::PercentVal;
155 return *this;
156 }
157 // Legacy %REF.
158 bool isPercentRef() const { return attrs_.test(Attr::PercentRef); };
159 ActualArgument &set_isPercentRef() {
160 attrs_ = attrs_ + Attr::PercentRef;
161 return *this;
162 }
163
164private:
165 // Subtlety: There is a distinction that must be maintained here between an
166 // actual argument expression that is a variable and one that is not,
167 // e.g. between X and (X). The parser attempts to parse each argument
168 // first as a variable, then as an expression, and the distinction appears
169 // in the parse tree.
170 std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType,
171 common::Label>
172 u_;
173 std::optional<parser::CharBlock> keyword_;
174 Attrs attrs_;
175 common::Intent dummyIntent_{common::Intent::Default};
176 std::optional<parser::CharBlock> sourceLocation_;
177};
178
179using ActualArguments = std::vector<std::optional<ActualArgument>>;
180
181// Intrinsics are identified by their names and the characteristics
182// of their arguments, at least for now.
183using IntrinsicProcedure = std::string;
184
185struct SpecificIntrinsic {
186 SpecificIntrinsic(IntrinsicProcedure, characteristics::Procedure &&);
187 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(SpecificIntrinsic)
188 ~SpecificIntrinsic();
189 bool operator==(const SpecificIntrinsic &) const;
190 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
191
192 IntrinsicProcedure name;
193 bool isRestrictedSpecific{false}; // if true, can only call it, not pass it
194 common::CopyableIndirection<characteristics::Procedure> characteristics;
195};
196
197struct ProcedureDesignator {
198 EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
199 explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {}
200 explicit ProcedureDesignator(const Symbol &n) : u{n} {}
201 explicit ProcedureDesignator(Component &&);
202
203 // Exactly one of these will return a non-null pointer.
204 const SpecificIntrinsic *GetSpecificIntrinsic() const;
205 const Symbol *GetSymbol() const; // symbol or component symbol
206 const SymbolRef *UnwrapSymbolRef() const; // null if intrinsic or component
207
208 // For references to NOPASS components and bindings only.
209 // References to PASS components and bindings are represented
210 // with the symbol below and the base object DataRef in the
211 // passed-object ActualArgument.
212 // Always null when the procedure is intrinsic.
213 const Component *GetComponent() const;
214
215 const Symbol *GetInterfaceSymbol() const;
216
217 std::string GetName() const;
218 std::optional<DynamicType> GetType() const;
219 int Rank() const;
220 bool IsElemental() const;
221 bool IsPure() const;
222 std::optional<Expr<SubscriptInteger>> LEN() const;
223 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
224
225 std::variant<SpecificIntrinsic, SymbolRef,
226 common::CopyableIndirection<Component>>
227 u;
228};
229
230using Chevrons = std::vector<Expr<SomeType>>;
231
232class ProcedureRef {
233public:
234 CLASS_BOILERPLATE(ProcedureRef)
235 ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
236 bool hasAlternateReturns = false)
237 : proc_{std::move(p)}, arguments_{std::move(a)},
238 hasAlternateReturns_{hasAlternateReturns} {}
239 ~ProcedureRef();
240 static void Deleter(ProcedureRef *);
241
242 ProcedureDesignator &proc() { return proc_; }
243 const ProcedureDesignator &proc() const { return proc_; }
244 ActualArguments &arguments() { return arguments_; }
245 const ActualArguments &arguments() const { return arguments_; }
246 // CALL subr <<< kernel launch >>> (...); not function
247 Chevrons &chevrons() { return chevrons_; }
248 const Chevrons &chevrons() const { return chevrons_; }
249 void set_chevrons(Chevrons &&chevrons) { chevrons_ = std::move(chevrons); }
250
251 std::optional<Expr<SubscriptInteger>> LEN() const;
252 int Rank() const;
253 bool IsElemental() const { return proc_.IsElemental(); }
254 bool hasAlternateReturns() const { return hasAlternateReturns_; }
255
256 Expr<SomeType> *UnwrapArgExpr(int n) {
257 if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
258 return arguments_[n]->UnwrapExpr();
259 } else {
260 return nullptr;
261 }
262 }
263 const Expr<SomeType> *UnwrapArgExpr(int n) const {
264 if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
265 return arguments_[n]->UnwrapExpr();
266 } else {
267 return nullptr;
268 }
269 }
270
271 bool operator==(const ProcedureRef &) const;
272 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
273
274protected:
275 ProcedureDesignator proc_;
276 ActualArguments arguments_;
277 Chevrons chevrons_;
278 bool hasAlternateReturns_;
279};
280
281template <typename A> class FunctionRef : public ProcedureRef {
282public:
283 using Result = A;
284 CLASS_BOILERPLATE(FunctionRef)
285 explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
286 FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
287 : ProcedureRef{std::move(p), std::move(a)} {}
288
289 std::optional<DynamicType> GetType() const {
290 if constexpr (IsLengthlessIntrinsicType<A>) {
291 return A::GetType();
292 } else if (auto type{proc_.GetType()}) {
293 // TODO: Non constant explicit length parameters of PDTs result should
294 // likely be dropped too. This is not as easy as for characters since some
295 // long lived DerivedTypeSpec pointer would need to be created here. It is
296 // not clear if this is causing any issue so far since the storage size of
297 // PDTs is independent of length parameters.
298 return type->DropNonConstantCharacterLength();
299 } else {
300 return std::nullopt;
301 }
302 }
303};
304} // namespace Fortran::evaluate
305#endif // FORTRAN_EVALUATE_CALL_H_
306

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

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