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