1 // Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
2 //
3 // Licensed under the Apache License, Version 2.0 (the "License");
4 // you may not use this file except in compliance with the License.
5 // You may obtain a copy of the License at
6 //
7 //     http://www.apache.org/licenses/LICENSE-2.0
8 //
9 // Unless required by applicable law or agreed to in writing, software
10 // distributed under the License is distributed on an "AS IS" BASIS,
11 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 // See the License for the specific language governing permissions and
13 // limitations under the License.
14 
15 // Defines data structures to represent "characteristics" of Fortran
16 // procedures and other entities as they are specified in section 15.3
17 // of Fortran 2018.
18 
19 #ifndef FORTRAN_EVALUATE_CHARACTERISTICS_H_
20 #define FORTRAN_EVALUATE_CHARACTERISTICS_H_
21 
22 #include "common.h"
23 #include "expression.h"
24 #include "shape.h"
25 #include "type.h"
26 #include "../common/Fortran.h"
27 #include "../common/enum-set.h"
28 #include "../common/idioms.h"
29 #include "../common/indirection.h"
30 #include "../semantics/symbol.h"
31 #include <optional>
32 #include <ostream>
33 #include <string>
34 #include <variant>
35 #include <vector>
36 
37 namespace Fortran::evaluate {
38 class IntrinsicProcTable;
39 }
40 namespace Fortran::evaluate::characteristics {
41 struct Procedure;
42 }
43 extern template class Fortran::common::Indirection<
44     Fortran::evaluate::characteristics::Procedure, true>;
45 
46 namespace Fortran::evaluate::characteristics {
47 
48 using common::CopyableIndirection;
49 
50 // Are these procedures distinguishable for a generic name?
51 bool Distinguishable(const Procedure &, const Procedure &);
52 // Are these procedures distinguishable for a generic operator or assignment?
53 bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
54 
55 class TypeAndShape {
56 public:
57   ENUM_CLASS(Attr, AssumedRank, AssumedShape, AssumedSize, Coarray)
58   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
59 
TypeAndShape(DynamicType t)60   explicit TypeAndShape(DynamicType t) : type_{t} { AcquireLEN(); }
TypeAndShape(DynamicType t,int rank)61   TypeAndShape(DynamicType t, int rank) : type_{t}, shape_(rank) {
62     AcquireLEN();
63   }
TypeAndShape(DynamicType t,Shape && s)64   TypeAndShape(DynamicType t, Shape &&s) : type_{t}, shape_{std::move(s)} {
65     AcquireLEN();
66   }
67   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape)
68 
69   bool operator==(const TypeAndShape &) const;
70   static std::optional<TypeAndShape> Characterize(const semantics::Symbol &);
71   static std::optional<TypeAndShape> Characterize(
72       const semantics::ObjectEntityDetails &);
73   static std::optional<TypeAndShape> Characterize(
74       const semantics::ProcEntityDetails &);
75   static std::optional<TypeAndShape> Characterize(
76       const semantics::ProcInterface &);
77   static std::optional<TypeAndShape> Characterize(
78       const semantics::DeclTypeSpec &);
79   template<typename A>
Characterize(const A * p)80   static std::optional<TypeAndShape> Characterize(const A *p) {
81     return p ? Characterize(*p) : std::nullopt;
82   }
83 
type()84   DynamicType type() const { return type_; }
set_type(DynamicType t)85   TypeAndShape &set_type(DynamicType t) {
86     type_ = t;
87     return *this;
88   }
LEN()89   const std::optional<Expr<SomeInteger>> &LEN() const { return LEN_; }
set_LEN(Expr<SomeInteger> && len)90   TypeAndShape &set_LEN(Expr<SomeInteger> &&len) {
91     LEN_ = std::move(len);
92     return *this;
93   }
shape()94   const Shape &shape() const { return shape_; }
attrs()95   const Attrs &attrs() const { return attrs_; }
96 
Rank()97   int Rank() const { return GetRank(shape_); }
98   bool IsCompatibleWith(
99       parser::ContextualMessages &, const TypeAndShape &) const;
100 
101   std::ostream &Dump(std::ostream &) const;
102 
103 private:
104   void AcquireShape(const semantics::ObjectEntityDetails &);
105   void AcquireLEN();
106 
107 protected:
108   DynamicType type_;
109   std::optional<Expr<SomeInteger>> LEN_;
110   Shape shape_;
111   Attrs attrs_;
112 };
113 
114 template<typename T>
GetTypeAndShape(const Expr<T> & expr,FoldingContext & context)115 std::optional<TypeAndShape> GetTypeAndShape(
116     const Expr<T> &expr, FoldingContext &context) {
117   if (auto type{expr.GetType()}) {
118     if (auto shape{GetShape(context, expr)}) {
119       TypeAndShape result{*type, std::move(*shape)};
120       if (type->category() == TypeCategory::Character) {
121         if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(expr)}) {
122           if (auto length{chExpr->LEN()}) {
123             result.set_LEN(Expr<SomeInteger>{std::move(*length)});
124           }
125         }
126       }
127       return result;
128     }
129   }
130   return std::nullopt;
131 }
132 
133 // 15.3.2.2
134 struct DummyDataObject {
135   ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,
136       Volatile, Pointer, Target)
137   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTSDummyDataObject138   DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyDataObject)
139   explicit DummyDataObject(const TypeAndShape &t) : type{t} {}
DummyDataObjectDummyDataObject140   explicit DummyDataObject(TypeAndShape &&t) : type{std::move(t)} {}
DummyDataObjectDummyDataObject141   explicit DummyDataObject(DynamicType t) : type{t} {}
142   bool operator==(const DummyDataObject &) const;
143   static std::optional<DummyDataObject> Characterize(const semantics::Symbol &);
144   bool CanBePassedViaImplicitInterface() const;
145   std::ostream &Dump(std::ostream &) const;
146   TypeAndShape type;
147   std::vector<Expr<SubscriptInteger>> coshape;
148   common::Intent intent{common::Intent::Default};
149   Attrs attrs;
150 };
151 
152 // 15.3.2.3
153 struct DummyProcedure {
154   ENUM_CLASS(Attr, Pointer, Optional)
155   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
156   explicit DummyProcedure(Procedure &&);
157   bool operator==(const DummyProcedure &) const;
158   static std::optional<DummyProcedure> Characterize(
159       const semantics::Symbol &, const IntrinsicProcTable &);
160   std::ostream &Dump(std::ostream &) const;
161   CopyableIndirection<Procedure> procedure;
162   common::EnumSet<Attr, Attr_enumSize> attrs;
163 };
164 
165 // 15.3.2.4
166 struct AlternateReturn {
167   bool operator==(const AlternateReturn &) const { return true; }
168   std::ostream &Dump(std::ostream &) const;
169 };
170 
171 // 15.3.2.1
172 struct DummyArgument {
DECLARE_CONSTRUCTORS_AND_ASSIGNMENTSDummyArgument173   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
174   explicit DummyArgument(std::string &&name, DummyDataObject &&x)
175     : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument176   explicit DummyArgument(std::string &&name, DummyProcedure &&x)
177     : name{std::move(name)}, u{std::move(x)} {}
DummyArgumentDummyArgument178   explicit DummyArgument(AlternateReturn &&x) : u{std::move(x)} {}
179   bool operator==(const DummyArgument &) const;
180   static std::optional<DummyArgument> Characterize(
181       const semantics::Symbol &, const IntrinsicProcTable &);
182   bool IsOptional() const;
183   void SetOptional(bool = true);
184   bool CanBePassedViaImplicitInterface() const;
185   std::ostream &Dump(std::ostream &) const;
186   // name and pass are not characteristics and so does not participate in
187   // operator== but are needed to determine if procedures are distinguishable
188   std::string name;
189   bool pass{false};  // is this the PASS argument of its procedure
190   std::variant<DummyDataObject, DummyProcedure, AlternateReturn> u;
191 };
192 
193 using DummyArguments = std::vector<DummyArgument>;
194 
195 // 15.3.3
196 struct FunctionResult {
197   ENUM_CLASS(Attr, Allocatable, Pointer, Contiguous)
198   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
199   explicit FunctionResult(DynamicType);
200   explicit FunctionResult(TypeAndShape &&);
201   explicit FunctionResult(Procedure &&);
202   ~FunctionResult();
203   bool operator==(const FunctionResult &) const;
204   static std::optional<FunctionResult> Characterize(
205       const Symbol &, const IntrinsicProcTable &);
206 
207   bool IsAssumedLengthCharacter() const;
208 
IsProcedurePointerFunctionResult209   const Procedure *IsProcedurePointer() const {
210     if (const auto *pp{std::get_if<CopyableIndirection<Procedure>>(&u)}) {
211       return &pp->value();
212     } else {
213       return nullptr;
214     }
215   }
GetTypeAndShapeFunctionResult216   const TypeAndShape *GetTypeAndShape() const {
217     return std::get_if<TypeAndShape>(&u);
218   }
SetTypeFunctionResult219   void SetType(DynamicType t) { std::get<TypeAndShape>(u).set_type(t); }
220   bool CanBeReturnedViaImplicitInterface() const;
221 
222   std::ostream &Dump(std::ostream &) const;
223 
224   common::EnumSet<Attr, Attr_enumSize> attrs;
225   std::variant<TypeAndShape, CopyableIndirection<Procedure>> u;
226 };
227 
228 // 15.3.1
229 struct Procedure {
230   ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer)
231   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
232   Procedure(FunctionResult &&, DummyArguments &&, Attrs);
233   Procedure(DummyArguments &&, Attrs);  // for subroutines and NULL()
234   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
235   bool operator==(const Procedure &) const;
236 
237   // Characterizes the procedure represented by a symbol, which may be an
238   // "unrestricted specific intrinsic function".
239   static std::optional<Procedure> Characterize(
240       const semantics::Symbol &, const IntrinsicProcTable &);
241   static std::optional<Procedure> Characterize(
242       const ProcedureDesignator &, const IntrinsicProcTable &);
243   static std::optional<Procedure> Characterize(
244       const ProcedureRef &, const IntrinsicProcTable &);
245 
IsFunctionProcedure246   bool IsFunction() const { return functionResult.has_value(); }
IsSubroutineProcedure247   bool IsSubroutine() const { return !IsFunction(); }
IsPureProcedure248   bool IsPure() const { return attrs.test(Attr::Pure); }
IsElementalProcedure249   bool IsElemental() const { return attrs.test(Attr::Elemental); }
IsBindCProcedure250   bool IsBindC() const { return attrs.test(Attr::BindC); }
HasExplicitInterfaceProcedure251   bool HasExplicitInterface() const {
252     return !attrs.test(Attr::ImplicitInterface);
253   }
254   bool CanBeCalledViaImplicitInterface() const;
255   std::ostream &Dump(std::ostream &) const;
256 
257   std::optional<FunctionResult> functionResult;
258   DummyArguments dummyArguments;
259   Attrs attrs;
260 
261 private:
ProcedureProcedure262   Procedure() {}
263 };
264 
265 }
266 #endif  // FORTRAN_EVALUATE_CHARACTERISTICS_H_
267