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   // Dummy arguments that are TYPE(*) can be forwarded as actual arguments.
56   // Since that's the only thing one may do with them in Fortran, they're
57   // represented in expressions as a special case of an actual argument.
58   class AssumedType {
59   public:
60     explicit AssumedType(const Symbol &);
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType)61     DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType)
62     const Symbol &symbol() const { return symbol_; }
63     int Rank() const;
64     bool operator==(const AssumedType &that) const {
65       return &*symbol_ == &*that.symbol_;
66     }
67     llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
68 
69   private:
70     SymbolRef symbol_;
71   };
72 
73   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(ActualArgument)
74   explicit ActualArgument(Expr<SomeType> &&);
75   explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&);
76   explicit ActualArgument(AssumedType);
77   explicit ActualArgument(common::Label);
78   ~ActualArgument();
79   ActualArgument &operator=(Expr<SomeType> &&);
80 
UnwrapExpr()81   Expr<SomeType> *UnwrapExpr() {
82     if (auto *p{
83             std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
84       return &p->value();
85     } else {
86       return nullptr;
87     }
88   }
UnwrapExpr()89   const Expr<SomeType> *UnwrapExpr() const {
90     if (const auto *p{
91             std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
92       return &p->value();
93     } else {
94       return nullptr;
95     }
96   }
97 
GetAssumedTypeDummy()98   const Symbol *GetAssumedTypeDummy() const {
99     if (const AssumedType * aType{std::get_if<AssumedType>(&u_)}) {
100       return &aType->symbol();
101     } else {
102       return nullptr;
103     }
104   }
105 
GetLabel()106   common::Label GetLabel() const { return std::get<common::Label>(u_); }
107 
108   std::optional<DynamicType> GetType() const;
109   int Rank() const;
110   bool operator==(const ActualArgument &) const;
111   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
112 
keyword()113   std::optional<parser::CharBlock> keyword() const { return keyword_; }
set_keyword(parser::CharBlock x)114   ActualArgument &set_keyword(parser::CharBlock x) {
115     keyword_ = x;
116     return *this;
117   }
isAlternateReturn()118   bool isAlternateReturn() const {
119     return std::holds_alternative<common::Label>(u_);
120   }
isPassedObject()121   bool isPassedObject() const { return isPassedObject_; }
122   ActualArgument &set_isPassedObject(bool yes = true) {
123     isPassedObject_ = yes;
124     return *this;
125   }
126 
127   bool Matches(const characteristics::DummyArgument &) const;
dummyIntent()128   common::Intent dummyIntent() const { return dummyIntent_; }
set_dummyIntent(common::Intent intent)129   ActualArgument &set_dummyIntent(common::Intent intent) {
130     dummyIntent_ = intent;
131     return *this;
132   }
sourceLocation()133   std::optional<parser::CharBlock> sourceLocation() const {
134     return sourceLocation_;
135   }
set_sourceLocation(std::optional<parser::CharBlock> at)136   ActualArgument &set_sourceLocation(std::optional<parser::CharBlock> at) {
137     sourceLocation_ = at;
138     return *this;
139   }
140 
141   // Wrap this argument in parentheses
142   void Parenthesize();
143 
144   // TODO: Mark legacy %VAL and %REF arguments
145 
146 private:
147   // Subtlety: There is a distinction that must be maintained here between an
148   // actual argument expression that is a variable and one that is not,
149   // e.g. between X and (X).  The parser attempts to parse each argument
150   // first as a variable, then as an expression, and the distinction appears
151   // in the parse tree.
152   std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType,
153       common::Label>
154       u_;
155   std::optional<parser::CharBlock> keyword_;
156   bool isPassedObject_{false};
157   common::Intent dummyIntent_{common::Intent::Default};
158   std::optional<parser::CharBlock> sourceLocation_;
159 };
160 
161 using ActualArguments = std::vector<std::optional<ActualArgument>>;
162 
163 // Intrinsics are identified by their names and the characteristics
164 // of their arguments, at least for now.
165 using IntrinsicProcedure = std::string;
166 
167 struct SpecificIntrinsic {
168   SpecificIntrinsic(IntrinsicProcedure, characteristics::Procedure &&);
169   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(SpecificIntrinsic)
170   ~SpecificIntrinsic();
171   bool operator==(const SpecificIntrinsic &) const;
172   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
173 
174   IntrinsicProcedure name;
175   bool isRestrictedSpecific{false}; // if true, can only call it, not pass it
176   common::CopyableIndirection<characteristics::Procedure> characteristics;
177 };
178 
179 struct ProcedureDesignator {
EVALUATE_UNION_CLASS_BOILERPLATEProcedureDesignator180   EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
181   explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {}
ProcedureDesignatorProcedureDesignator182   explicit ProcedureDesignator(const Symbol &n) : u{n} {}
183   explicit ProcedureDesignator(Component &&);
184 
185   // Exactly one of these will return a non-null pointer.
186   const SpecificIntrinsic *GetSpecificIntrinsic() const;
187   const Symbol *GetSymbol() const; // symbol or component symbol
188 
189   // For references to NOPASS components and bindings only.
190   // References to PASS components and bindings are represented
191   // with the symbol below and the base object DataRef in the
192   // passed-object ActualArgument.
193   // Always null when the procedure is intrinsic.
194   const Component *GetComponent() const;
195 
196   const Symbol *GetInterfaceSymbol() const;
197 
198   std::string GetName() const;
199   std::optional<DynamicType> GetType() const;
200   int Rank() const;
201   bool IsElemental() const;
202   std::optional<Expr<SubscriptInteger>> LEN() const;
203   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
204 
205   std::variant<SpecificIntrinsic, SymbolRef,
206       common::CopyableIndirection<Component>>
207       u;
208 };
209 
210 class ProcedureRef {
211 public:
CLASS_BOILERPLATE(ProcedureRef)212   CLASS_BOILERPLATE(ProcedureRef)
213   ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
214       bool hasAlternateReturns = false)
215       : proc_{std::move(p)}, arguments_{std::move(a)},
216         hasAlternateReturns_{hasAlternateReturns} {}
217   ~ProcedureRef();
218   static void Deleter(ProcedureRef *);
219 
proc()220   ProcedureDesignator &proc() { return proc_; }
proc()221   const ProcedureDesignator &proc() const { return proc_; }
arguments()222   ActualArguments &arguments() { return arguments_; }
arguments()223   const ActualArguments &arguments() const { return arguments_; }
224 
225   std::optional<Expr<SubscriptInteger>> LEN() const;
226   int Rank() const;
IsElemental()227   bool IsElemental() const { return proc_.IsElemental(); }
hasAlternateReturns()228   bool hasAlternateReturns() const { return hasAlternateReturns_; }
229 
UnwrapArgExpr(int n)230   Expr<SomeType> *UnwrapArgExpr(int n) {
231     if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
232       return arguments_[n]->UnwrapExpr();
233     } else {
234       return nullptr;
235     }
236   }
UnwrapArgExpr(int n)237   const Expr<SomeType> *UnwrapArgExpr(int n) const {
238     if (static_cast<std::size_t>(n) < arguments_.size() && arguments_[n]) {
239       return arguments_[n]->UnwrapExpr();
240     } else {
241       return nullptr;
242     }
243   }
244 
245   bool operator==(const ProcedureRef &) const;
246   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
247 
248 protected:
249   ProcedureDesignator proc_;
250   ActualArguments arguments_;
251   bool hasAlternateReturns_;
252 };
253 
254 template <typename A> class FunctionRef : public ProcedureRef {
255 public:
256   using Result = A;
CLASS_BOILERPLATE(FunctionRef)257   CLASS_BOILERPLATE(FunctionRef)
258   explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
FunctionRef(ProcedureDesignator && p,ActualArguments && a)259   FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
260       : ProcedureRef{std::move(p), std::move(a)} {}
261 
GetType()262   std::optional<DynamicType> GetType() const { return proc_.GetType(); }
263 };
264 } // namespace Fortran::evaluate
265 #endif // FORTRAN_EVALUATE_CALL_H_
266