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 "type.h"
20 #include "flang/Common/Fortran-features.h"
21 #include "flang/Common/Fortran.h"
22 #include "flang/Common/enum-set.h"
23 #include "flang/Common/idioms.h"
24 #include "flang/Common/indirection.h"
25 #include "flang/Parser/char-block.h"
26 #include "flang/Semantics/symbol.h"
27 #include <optional>
28 #include <string>
29 #include <variant>
30 #include <vector>
31 
32 namespace llvm {
33 class raw_ostream;
34 }
35 
36 namespace Fortran::evaluate::characteristics {
37 struct Procedure;
38 }
39 extern template class Fortran::common::Indirection<
40     Fortran::evaluate::characteristics::Procedure, true>;
41 
42 namespace Fortran::evaluate::characteristics {
43 
44 using common::CopyableIndirection;
45 
46 // Are these procedures distinguishable for a generic name or FINAL?
47 bool Distinguishable(const common::LanguageFeatureControl &, const Procedure &,
48     const Procedure &);
49 // Are these procedures distinguishable for a generic operator or assignment?
50 bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &,
51     const Procedure &, const Procedure &);
52 
53 // Shapes of function results and dummy arguments have to have
54 // the same rank, the same deferred dimensions, and the same
55 // values for explicit dimensions when constant.
56 bool ShapesAreCompatible(const Shape &, const Shape &);
57 
58 class TypeAndShape {
59 public:
60   ENUM_CLASS(
61       Attr, AssumedRank, AssumedShape, AssumedSize, DeferredShape, Coarray)
62   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
63 
TypeAndShape(DynamicType t)64   explicit TypeAndShape(DynamicType t) : type_{t} { AcquireLEN(); }
TypeAndShape(DynamicType t,int rank)65   TypeAndShape(DynamicType t, int rank) : type_{t}, shape_(rank) {
66     AcquireLEN();
67   }
TypeAndShape(DynamicType t,Shape && s)68   TypeAndShape(DynamicType t, Shape &&s) : type_{t}, shape_{std::move(s)} {
69     AcquireLEN();
70   }
TypeAndShape(DynamicType t,std::optional<Shape> && s)71   TypeAndShape(DynamicType t, std::optional<Shape> &&s) : type_{t} {
72     if (s) {
73       shape_ = std::move(*s);
74     }
75     AcquireLEN();
76   }
77   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape)
78 
79   bool operator==(const TypeAndShape &) const;
80   bool operator!=(const TypeAndShape &that) const { return !(*this == that); }
81 
82   static std::optional<TypeAndShape> Characterize(
83       const semantics::Symbol &, FoldingContext &);
84   static std::optional<TypeAndShape> Characterize(
85       const semantics::ProcInterface &, FoldingContext &);
86   static std::optional<TypeAndShape> Characterize(
87       const semantics::DeclTypeSpec &, FoldingContext &);
88   static std::optional<TypeAndShape> Characterize(
89       const ActualArgument &, FoldingContext &);
90 
91   // Handle Expr<T> & Designator<T>
92   template <typename A>
Characterize(const A & x,FoldingContext & context)93   static std::optional<TypeAndShape> Characterize(
94       const A &x, FoldingContext &context) {
95     if (const auto *symbol{UnwrapWholeSymbolOrComponentDataRef(x)}) {
96       if (auto result{Characterize(*symbol, context)}) {
97         return result;
98       }
99     }
100     if (auto type{x.GetType()}) {
101       TypeAndShape result{*type, GetShape(context, x)};
102       if (type->category() == TypeCategory::Character) {
103         if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
104           if (auto length{chExpr->LEN()}) {
105             result.set_LEN(std::move(*length));
106           }
107         }
108       }
109       return std::move(result.Rewrite(context));
110     }
111     return std::nullopt;
112   }
113 
114   template <typename A>
Characterize(const std::optional<A> & x,FoldingContext & context)115   static std::optional<TypeAndShape> Characterize(
116       const std::optional<A> &x, FoldingContext &context) {
117     if (x) {
118       return Characterize(*x, context);
119     } else {
120       return std::nullopt;
121     }
122   }
123   template <typename A>
Characterize(const A * p,FoldingContext & context)124   static std::optional<TypeAndShape> Characterize(
125       const A *p, FoldingContext &context) {
126     if (p) {
127       return Characterize(*p, context);
128     } else {
129       return std::nullopt;
130     }
131   }
132 
type()133   DynamicType type() const { return type_; }
set_type(DynamicType t)134   TypeAndShape &set_type(DynamicType t) {
135     type_ = t;
136     return *this;
137   }
LEN()138   const std::optional<Expr<SubscriptInteger>> &LEN() const { return LEN_; }
set_LEN(Expr<SubscriptInteger> && len)139   TypeAndShape &set_LEN(Expr<SubscriptInteger> &&len) {
140     LEN_ = std::move(len);
141     return *this;
142   }
shape()143   const Shape &shape() const { return shape_; }
attrs()144   const Attrs &attrs() const { return attrs_; }
corank()145   int corank() const { return corank_; }
146 
Rank()147   int Rank() const { return GetRank(shape_); }
148   bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that,
149       const char *thisIs = "pointer", const char *thatIs = "target",
150       bool omitShapeConformanceCheck = false,
151       enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const;
152   std::optional<Expr<SubscriptInteger>> MeasureElementSizeInBytes(
153       FoldingContext &, bool align) const;
154   std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
155       FoldingContext &) const;
156 
157   // called by Fold() to rewrite in place
158   TypeAndShape &Rewrite(FoldingContext &);
159 
160   std::string AsFortran() const;
161   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
162 
163 private:
164   static std::optional<TypeAndShape> Characterize(
165       const semantics::AssocEntityDetails &, FoldingContext &);
166   static std::optional<TypeAndShape> Characterize(
167       const semantics::ProcEntityDetails &, FoldingContext &);
168   void AcquireAttrs(const semantics::Symbol &);
169   void AcquireLEN();
170   void AcquireLEN(const semantics::Symbol &);
171 
172 protected:
173   DynamicType type_;
174   std::optional<Expr<SubscriptInteger>> LEN_;
175   Shape shape_;
176   Attrs attrs_;
177   int corank_{0};
178 };
179 
180 // 15.3.2.2
181 struct DummyDataObject {
182   ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
183       Volatile, Pointer, Target)
184   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTSDummyDataObject185   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
186   explicit DummyDataObject(const TypeAndShape &t) : type{t} {}
DummyDataObjectDummyDataObject187   explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {}
DummyDataObjectDummyDataObject188   explicit DummyDataObject(DynamicType t) : type{t} {}
189   bool operator==(const DummyDataObject &) const;
190   bool operator!=(const DummyDataObject &that) const {
191     return !(*this == that);
192   }
193   bool IsCompatibleWith(
194       const DummyDataObject &, std::string *whyNot = nullptr) const;
195   static std::optional<DummyDataObject> Characterize(
196       const semantics::Symbol &, FoldingContext &);
197   bool CanBePassedViaImplicitInterface() const;
198   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
199   TypeAndShape type;
200   std::vector<Expr<SubscriptInteger>> coshape;
201   common::Intent intent{common::Intent::Default};
202   Attrs attrs;
203 };
204 
205 // 15.3.2.3
206 struct DummyProcedure {
207   ENUM_CLASS(Attr, Pointer, Optional)
208   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
209   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
210   explicit DummyProcedure(Procedure &&);
211   bool operator==(const DummyProcedure &) const;
212   bool operator!=(const DummyProcedure &that) const { return !(*this == that); }
213   bool IsCompatibleWith(
214       const DummyProcedure &, std::string *whyNot = nullptr) const;
215   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
216 
217   CopyableIndirection<Procedure> procedure;
218   common::Intent intent{common::Intent::Default};
219   Attrs attrs;
220 };
221 
222 // 15.3.2.4
223 struct AlternateReturn {
224   bool operator==(const AlternateReturn &) const { return true; }
225   bool operator!=(const AlternateReturn &) const { return false; }
226   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
227 };
228 
229 // 15.3.2.1
230 struct DummyArgument {
231   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
DummyArgumentDummyArgument232   DummyArgument(std::string &&name, DummyDataObject &&x)
233       : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument234   DummyArgument(std::string &&name, DummyProcedure &&x)
235       : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument236   explicit DummyArgument(AlternateReturn &&x) : u{std::move(x)} {}
237   ~DummyArgument();
238   bool operator==(const DummyArgument &) const;
239   bool operator!=(const DummyArgument &that) const { return !(*this == that); }
240   static std::optional<DummyArgument> FromActual(
241       std::string &&, const Expr<SomeType> &, FoldingContext &);
242   bool IsOptional() const;
243   void SetOptional(bool = true);
244   common::Intent GetIntent() const;
245   void SetIntent(common::Intent);
246   bool CanBePassedViaImplicitInterface() const;
247   bool IsTypelessIntrinsicDummy() const;
248   bool IsCompatibleWith(
249       const DummyArgument &, std::string *whyNot = nullptr) const;
250   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
251 
252   // name and pass are not characteristics and so do not participate in
253   // compatibility checks, but they are needed to determine whether
254   // procedures are distinguishable
255   std::string name;
256   bool pass{false}; // is this the PASS argument of its procedure
257   std::variant<DummyDataObject, DummyProcedure, AlternateReturn> u;
258 };
259 
260 using DummyArguments = std::vector<DummyArgument>;
261 
262 // 15.3.3
263 struct FunctionResult {
264   ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous)
265   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
266   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
267   explicit FunctionResult(DynamicType);
268   explicit FunctionResult(TypeAndShape &&);
269   explicit FunctionResult(Procedure &&);
270   ~FunctionResult();
271   bool operator==(const FunctionResult &) const;
272   bool operator!=(const FunctionResult &that) const { return !(*this == that); }
273   static std::optional<FunctionResult> Characterize(
274       const Symbol &, FoldingContext &);
275 
276   bool IsAssumedLengthCharacter() const;
277 
IsProcedurePointerFunctionResult278   const Procedure *IsProcedurePointer() const {
279     if (const auto *pp{std::get_if<CopyableIndirection<Procedure>>(&u)}) {
280       return &pp->value();
281     } else {
282       return nullptr;
283     }
284   }
GetTypeAndShapeFunctionResult285   const TypeAndShape *GetTypeAndShape() const {
286     return std::get_if<TypeAndShape>(&u);
287   }
SetTypeFunctionResult288   void SetType(DynamicType t) { std::get<TypeAndShape>(u).set_type(t); }
289   bool CanBeReturnedViaImplicitInterface() const;
290   bool IsCompatibleWith(
291       const FunctionResult &, std::string *whyNot = nullptr) const;
292 
293   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
294 
295   Attrs attrs;
296   std::variant<TypeAndShape, CopyableIndirection<Procedure>> u;
297 };
298 
299 // 15.3.1
300 struct Procedure {
301   ENUM_CLASS(
302       Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer, Subroutine)
303   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
ProcedureProcedure304   Procedure(){};
305   Procedure(FunctionResult &&, DummyArguments &&, Attrs);
306   Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
307   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
308   ~Procedure();
309   bool operator==(const Procedure &) const;
310   bool operator!=(const Procedure &that) const { return !(*this == that); }
311 
312   // Characterizes a procedure.  If a Symbol, it may be an
313   // "unrestricted specific intrinsic function".
314   // Error messages are produced when a procedure cannot be characterized.
315   static std::optional<Procedure> Characterize(
316       const semantics::Symbol &, FoldingContext &);
317   static std::optional<Procedure> Characterize(
318       const ProcedureDesignator &, FoldingContext &);
319   static std::optional<Procedure> Characterize(
320       const ProcedureRef &, FoldingContext &);
321 
322   // At most one of these will return true.
323   // For "EXTERNAL P" with no type for or calls to P, both will be false.
IsFunctionProcedure324   bool IsFunction() const { return functionResult.has_value(); }
IsSubroutineProcedure325   bool IsSubroutine() const { return attrs.test(Attr::Subroutine); }
326 
IsPureProcedure327   bool IsPure() const { return attrs.test(Attr::Pure); }
IsElementalProcedure328   bool IsElemental() const { return attrs.test(Attr::Elemental); }
IsBindCProcedure329   bool IsBindC() const { return attrs.test(Attr::BindC); }
HasExplicitInterfaceProcedure330   bool HasExplicitInterface() const {
331     return !attrs.test(Attr::ImplicitInterface);
332   }
333   int FindPassIndex(std::optional<parser::CharBlock>) const;
334   bool CanBeCalledViaImplicitInterface() const;
335   bool CanOverride(const Procedure &, std::optional<int> passIndex) const;
336   bool IsCompatibleWith(const Procedure &, std::string *whyNot = nullptr,
337       const SpecificIntrinsic * = nullptr) const;
338 
339   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
340 
341   std::optional<FunctionResult> functionResult;
342   DummyArguments dummyArguments;
343   Attrs attrs;
344 };
345 } // namespace Fortran::evaluate::characteristics
346 #endif // FORTRAN_EVALUATE_CHARACTERISTICS_H_
347