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 24 namespace llvm { 25 class raw_ostream; 26 } 27 28 namespace Fortran::semantics { 29 class 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. 34 namespace Fortran::evaluate { 35 class Component; 36 class IntrinsicProcTable; 37 } // namespace Fortran::evaluate 38 namespace Fortran::evaluate::characteristics { 39 struct DummyArgument; 40 struct Procedure; 41 } // namespace Fortran::evaluate::characteristics 42 43 extern template class Fortran::common::Indirection<Fortran::evaluate::Component, 44 true>; 45 extern template class Fortran::common::Indirection< 46 Fortran::evaluate::characteristics::Procedure, true>; 47 48 namespace Fortran::evaluate { 49 50 using semantics::Symbol; 51 using SymbolRef = common::Reference<const Symbol>; 52 53 class ActualArgument { 54 public: 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 164 private: 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 179 using 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. 183 using IntrinsicProcedure = std::string; 184 185 struct 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 197 struct 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 230 using Chevrons = std::vector<Expr<SomeType>>; 231 232 class ProcedureRef { 233 public: 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 static constexpr int Corank() { return 0; } // TODO 254 bool IsElemental() const { return proc_.IsElemental(); } 255 bool hasAlternateReturns() const { return hasAlternateReturns_; } 256 257 Expr<SomeType> *UnwrapArgExpr(int n) { 258 if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) { 259 return arguments_[n]->UnwrapExpr(); 260 } else { 261 return nullptr; 262 } 263 } 264 const Expr<SomeType> *UnwrapArgExpr(int n) const { 265 if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) { 266 return arguments_[n]->UnwrapExpr(); 267 } else { 268 return nullptr; 269 } 270 } 271 272 bool operator==(const ProcedureRef &) const; 273 llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; 274 275 protected: 276 ProcedureDesignator proc_; 277 ActualArguments arguments_; 278 Chevrons chevrons_; 279 bool hasAlternateReturns_; 280 }; 281 282 template <typename A> class FunctionRef : public ProcedureRef { 283 public: 284 using Result = A; 285 CLASS_BOILERPLATE(FunctionRef) 286 explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {} 287 FunctionRef(ProcedureDesignator &&p, ActualArguments &&a) 288 : ProcedureRef{std::move(p), std::move(a)} {} 289 290 std::optional<DynamicType> GetType() const { 291 if constexpr (IsLengthlessIntrinsicType<A>) { 292 return A::GetType(); 293 } else if (auto type{proc_.GetType()}) { 294 // TODO: Non constant explicit length parameters of PDTs result should 295 // likely be dropped too. This is not as easy as for characters since some 296 // long lived DerivedTypeSpec pointer would need to be created here. It is 297 // not clear if this is causing any issue so far since the storage size of 298 // PDTs is independent of length parameters. 299 return type->DropNonConstantCharacterLength(); 300 } else { 301 return std::nullopt; 302 } 303 } 304 }; 305 } // namespace Fortran::evaluate 306 #endif // FORTRAN_EVALUATE_CALL_H_ 307