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 33 namespace llvm { 34 class raw_ostream; 35 } 36 37 namespace Fortran::evaluate::characteristics { 38 struct Procedure; 39 } 40 extern template class Fortran::common::Indirection< 41 Fortran::evaluate::characteristics::Procedure, true>; 42 43 namespace Fortran::evaluate::characteristics { 44 45 using common::CopyableIndirection; 46 47 // Are these procedures distinguishable for a generic name or FINAL? 48 std::optional<bool> Distinguishable(const common::LanguageFeatureControl &, 49 const Procedure &, const Procedure &); 50 // Are these procedures distinguishable for a generic operator or assignment? 51 std::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. 58 bool ShapesAreCompatible(const std::optional<Shape> &, 59 const std::optional<Shape> &, bool *possibleWarning = nullptr); 60 61 class TypeAndShape { 62 public: 63 ENUM_CLASS(Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape) 64 using Attrs = common::EnumSet<Attr, Attr_enumSize>; 65 66 explicit TypeAndShape(DynamicType t) : type_{t}, shape_{Shape{}} { 67 AcquireLEN(); 68 } 69 TypeAndShape(DynamicType t, int rank) : type_{t}, shape_{Shape(rank)} { 70 AcquireLEN(); 71 } 72 TypeAndShape(DynamicType t, Shape &&s) : type_{t}, shape_{std::move(s)} { 73 AcquireLEN(); 74 } 75 TypeAndShape(DynamicType t, std::optional<Shape> &&s) : type_{t} { 76 shape_ = std::move(s); 77 AcquireLEN(); 78 } 79 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape) 80 81 bool operator==(const TypeAndShape &) const; 82 bool operator!=(const TypeAndShape &that) const { return !(*this == that); } 83 84 static std::optional<TypeAndShape> Characterize( 85 const semantics::Symbol &, FoldingContext &, bool invariantOnly = true); 86 static std::optional<TypeAndShape> Characterize( 87 const semantics::DeclTypeSpec &, FoldingContext &, 88 bool invariantOnly = true); 89 static std::optional<TypeAndShape> Characterize( 90 const ActualArgument &, FoldingContext &, bool invariantOnly = true); 91 92 // General case for Expr<T>, &c. 93 template <typename A> 94 static std::optional<TypeAndShape> Characterize( 95 const A &x, FoldingContext &context, bool invariantOnly = true) { 96 const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)}; 97 if (symbol && !symbol->owner().IsDerivedType()) { // Whole variable 98 if (auto result{Characterize(*symbol, context, invariantOnly)}) { 99 return result; 100 } 101 } 102 if (auto type{x.GetType()}) { 103 TypeAndShape result{*type, GetShape(context, x, invariantOnly)}; 104 result.corank_ = GetCorank(x); 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 std::optional<Shape> &shape() const { return shape_; } 176 const Attrs &attrs() const { return attrs_; } 177 int corank() const { return corank_; } 178 void set_corank(int n) { corank_ = n; } 179 180 // Return -1 for assumed-rank as a safety. 181 int Rank() const { return shape_ ? GetRank(*shape_) : -1; } 182 183 // Can sequence association apply to this argument? 184 bool CanBeSequenceAssociated() const { 185 constexpr Attrs notAssumedOrExplicitShape{~Attrs{Attr::AssumedSize}}; 186 return Rank() > 0 && (attrs() & notAssumedOrExplicitShape).none(); 187 } 188 189 bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that, 190 const char *thisIs = "pointer", const char *thatIs = "target", 191 bool omitShapeConformanceCheck = false, 192 enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const; 193 std::optional<Expr<SubscriptInteger>> MeasureElementSizeInBytes( 194 FoldingContext &, bool align) const; 195 std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes( 196 FoldingContext &) const; 197 198 // called by Fold() to rewrite in place 199 TypeAndShape &Rewrite(FoldingContext &); 200 201 std::string AsFortran() const; 202 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 203 204 private: 205 static std::optional<TypeAndShape> Characterize( 206 const semantics::AssocEntityDetails &, FoldingContext &, 207 bool invariantOnly = true); 208 void AcquireAttrs(const semantics::Symbol &); 209 void AcquireLEN(); 210 void AcquireLEN(const semantics::Symbol &); 211 212 protected: 213 DynamicType type_; 214 std::optional<Expr<SubscriptInteger>> LEN_; 215 std::optional<Shape> shape_; 216 Attrs attrs_; 217 int corank_{0}; 218 }; 219 220 // 15.3.2.2 221 struct DummyDataObject { 222 ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value, 223 Volatile, Pointer, Target, DeducedFromActual) 224 using Attrs = common::EnumSet<Attr, Attr_enumSize>; 225 static bool IdenticalSignificantAttrs(const Attrs &x, const Attrs &y) { 226 return (x - Attr::DeducedFromActual) == (y - Attr::DeducedFromActual); 227 } 228 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject) 229 explicit DummyDataObject(const TypeAndShape &t) : type{t} {} 230 explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {} 231 explicit DummyDataObject(DynamicType t) : type{t} {} 232 bool operator==(const DummyDataObject &) const; 233 bool operator!=(const DummyDataObject &that) const { 234 return !(*this == that); 235 } 236 bool IsCompatibleWith(const DummyDataObject &, std::string *whyNot = nullptr, 237 std::optional<std::string> *warning = nullptr) const; 238 static std::optional<DummyDataObject> Characterize( 239 const semantics::Symbol &, FoldingContext &); 240 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; 241 bool IsPassedByDescriptor(bool isBindC) const; 242 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 243 244 TypeAndShape type; 245 std::vector<Expr<SubscriptInteger>> coshape; 246 common::Intent intent{common::Intent::Default}; 247 Attrs attrs; 248 common::IgnoreTKRSet ignoreTKR; 249 std::optional<common::CUDADataAttr> cudaDataAttr; 250 }; 251 252 // 15.3.2.3 253 struct DummyProcedure { 254 ENUM_CLASS(Attr, Pointer, Optional) 255 using Attrs = common::EnumSet<Attr, Attr_enumSize>; 256 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure) 257 explicit DummyProcedure(Procedure &&); 258 bool operator==(const DummyProcedure &) const; 259 bool operator!=(const DummyProcedure &that) const { return !(*this == that); } 260 bool IsCompatibleWith( 261 const DummyProcedure &, std::string *whyNot = nullptr) const; 262 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; 263 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 264 265 CopyableIndirection<Procedure> procedure; 266 common::Intent intent{common::Intent::Default}; 267 Attrs attrs; 268 }; 269 270 // 15.3.2.4 271 struct AlternateReturn { 272 bool operator==(const AlternateReturn &) const { return true; } 273 bool operator!=(const AlternateReturn &) const { return false; } 274 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 275 }; 276 277 // 15.3.2.1 278 struct DummyArgument { 279 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument) 280 DummyArgument(std::string &&name, DummyDataObject &&x) 281 : name{std::move(name)}, u{std::move(x)} {} 282 DummyArgument(std::string &&name, DummyProcedure &&x) 283 : name{std::move(name)}, u{std::move(x)} {} 284 explicit DummyArgument(AlternateReturn &&x) : u{std::move(x)} {} 285 ~DummyArgument(); 286 bool operator==(const DummyArgument &) const; 287 bool operator!=(const DummyArgument &that) const { return !(*this == that); } 288 static std::optional<DummyArgument> FromActual(std::string &&, 289 const Expr<SomeType> &, FoldingContext &, bool forImplicitInterface); 290 static std::optional<DummyArgument> FromActual(std::string &&, 291 const ActualArgument &, FoldingContext &, bool forImplicitInterface); 292 bool IsOptional() const; 293 void SetOptional(bool = true); 294 common::Intent GetIntent() const; 295 void SetIntent(common::Intent); 296 bool CanBePassedViaImplicitInterface(std::string *whyNot = nullptr) const; 297 bool IsTypelessIntrinsicDummy() const; 298 bool IsCompatibleWith(const DummyArgument &, std::string *whyNot = nullptr, 299 std::optional<std::string> *warning = nullptr) const; 300 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 301 302 // name and pass are not characteristics and so do not participate in 303 // compatibility checks, but they are needed to determine whether 304 // procedures are distinguishable 305 std::string name; 306 bool pass{false}; // is this the PASS argument of its procedure 307 std::variant<DummyDataObject, DummyProcedure, AlternateReturn> u; 308 }; 309 310 using DummyArguments = std::vector<DummyArgument>; 311 312 // 15.3.3 313 struct FunctionResult { 314 ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous) 315 using Attrs = common::EnumSet<Attr, Attr_enumSize>; 316 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult) 317 explicit FunctionResult(DynamicType); 318 explicit FunctionResult(TypeAndShape &&); 319 explicit FunctionResult(Procedure &&); 320 ~FunctionResult(); 321 bool operator==(const FunctionResult &) const; 322 bool operator!=(const FunctionResult &that) const { return !(*this == that); } 323 static std::optional<FunctionResult> Characterize( 324 const Symbol &, FoldingContext &); 325 326 bool IsAssumedLengthCharacter() const; 327 328 const Procedure *IsProcedurePointer() const { 329 if (const auto *pp{std::get_if<CopyableIndirection<Procedure>>(&u)}) { 330 return &pp->value(); 331 } else { 332 return nullptr; 333 } 334 } 335 const TypeAndShape *GetTypeAndShape() const { 336 return std::get_if<TypeAndShape>(&u); 337 } 338 void SetType(DynamicType t) { std::get<TypeAndShape>(u).set_type(t); } 339 bool CanBeReturnedViaImplicitInterface(std::string *whyNot = nullptr) const; 340 bool IsCompatibleWith( 341 const FunctionResult &, std::string *whyNot = nullptr) const; 342 343 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 344 345 Attrs attrs; 346 std::variant<TypeAndShape, CopyableIndirection<Procedure>> u; 347 std::optional<common::CUDADataAttr> cudaDataAttr; 348 }; 349 350 // 15.3.1 351 struct Procedure { 352 ENUM_CLASS( 353 Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer, Subroutine) 354 using Attrs = common::EnumSet<Attr, Attr_enumSize>; 355 Procedure(){}; 356 Procedure(FunctionResult &&, DummyArguments &&, Attrs); 357 Procedure(DummyArguments &&, Attrs); // for subroutines and NULL() 358 DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure) 359 ~Procedure(); 360 bool operator==(const Procedure &) const; 361 bool operator!=(const Procedure &that) const { return !(*this == that); } 362 363 // Characterizes a procedure. If a Symbol, it may be an 364 // "unrestricted specific intrinsic function". 365 // Error messages are produced when a procedure cannot be characterized. 366 static std::optional<Procedure> Characterize( 367 const semantics::Symbol &, FoldingContext &); 368 static std::optional<Procedure> Characterize( 369 const ProcedureDesignator &, FoldingContext &, bool emitError); 370 static std::optional<Procedure> Characterize( 371 const ProcedureRef &, FoldingContext &); 372 static std::optional<Procedure> Characterize( 373 const Expr<SomeType> &, FoldingContext &); 374 // Characterizes the procedure being referenced, deducing dummy argument 375 // types from actual arguments in the case of an implicit interface. 376 static std::optional<Procedure> FromActuals( 377 const ProcedureDesignator &, const ActualArguments &, FoldingContext &); 378 379 // At most one of these will return true. 380 // For "EXTERNAL P" with no type for or calls to P, both will be false. 381 bool IsFunction() const { return functionResult.has_value(); } 382 bool IsSubroutine() const { return attrs.test(Attr::Subroutine); } 383 384 bool IsPure() const { return attrs.test(Attr::Pure); } 385 bool IsElemental() const { return attrs.test(Attr::Elemental); } 386 bool IsBindC() const { return attrs.test(Attr::BindC); } 387 bool HasExplicitInterface() const { 388 return !attrs.test(Attr::ImplicitInterface); 389 } 390 std::optional<int> FindPassIndex(std::optional<parser::CharBlock>) const; 391 bool CanBeCalledViaImplicitInterface(std::string *whyNot = nullptr) const; 392 bool CanOverride(const Procedure &, std::optional<int> passIndex) const; 393 bool IsCompatibleWith(const Procedure &, bool ignoreImplicitVsExplicit, 394 std::string *whyNot = nullptr, const SpecificIntrinsic * = nullptr, 395 std::optional<std::string> *warning = nullptr) const; 396 397 llvm::raw_ostream &Dump(llvm::raw_ostream &) const; 398 399 std::optional<FunctionResult> functionResult; 400 DummyArguments dummyArguments; 401 Attrs attrs; 402 std::optional<common::CUDASubprogramAttrs> cudaSubprogramAttrs; 403 }; 404 405 } // namespace Fortran::evaluate::characteristics 406 #endif // FORTRAN_EVALUATE_CHARACTERISTICS_H_ 407