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/indirection.h"
17 #include "flang/Common/reference.h"
18 #include "flang/Parser/char-block.h"
19 #include "flang/Semantics/attr.h"
20 #include <optional>
21 #include <vector>
22 
23 namespace llvm {
24 class raw_ostream;
25 }
26 
27 namespace Fortran::semantics {
28 class Symbol;
29 }
30 
31 // Mutually referential data structures are represented here with forward
32 // declarations of hitherto undefined class types and a level of indirection.
33 namespace Fortran::evaluate {
34 class Component;
35 class IntrinsicProcTable;
36 } // namespace Fortran::evaluate
37 namespace Fortran::evaluate::characteristics {
38 struct DummyArgument;
39 struct Procedure;
40 } // namespace Fortran::evaluate::characteristics
41 
42 extern template class Fortran::common::Indirection<Fortran::evaluate::Component,
43     true>;
44 extern template class Fortran::common::Indirection<
45     Fortran::evaluate::characteristics::Procedure, true>;
46 
47 namespace Fortran::evaluate {
48 
49 using semantics::Symbol;
50 using SymbolRef = common::Reference<const Symbol>;
51 
52 class ActualArgument {
53 public:
54   // Dummy arguments that are TYPE(*) can be forwarded as actual arguments.
55   // Since that's the only thing one may do with them in Fortran, they're
56   // represented in expressions as a special case of an actual argument.
57   class AssumedType {
58   public:
59     explicit AssumedType(const Symbol &);
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType)60     DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(AssumedType)
61     const Symbol &symbol() const { return symbol_; }
62     int Rank() const;
63     bool operator==(const AssumedType &that) const {
64       return &*symbol_ == &*that.symbol_;
65     }
66     llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
67 
68   private:
69     SymbolRef symbol_;
70   };
71 
72   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(ActualArgument)
73   explicit ActualArgument(Expr<SomeType> &&);
74   explicit ActualArgument(common::CopyableIndirection<Expr<SomeType>> &&);
75   explicit ActualArgument(AssumedType);
76   ~ActualArgument();
77   ActualArgument &operator=(Expr<SomeType> &&);
78 
UnwrapExpr()79   Expr<SomeType> *UnwrapExpr() {
80     if (auto *p{
81             std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
82       return &p->value();
83     } else {
84       return nullptr;
85     }
86   }
UnwrapExpr()87   const Expr<SomeType> *UnwrapExpr() const {
88     if (const auto *p{
89             std::get_if<common::CopyableIndirection<Expr<SomeType>>>(&u_)}) {
90       return &p->value();
91     } else {
92       return nullptr;
93     }
94   }
95 
GetAssumedTypeDummy()96   const Symbol *GetAssumedTypeDummy() const {
97     if (const AssumedType * aType{std::get_if<AssumedType>(&u_)}) {
98       return &aType->symbol();
99     } else {
100       return nullptr;
101     }
102   }
103 
104   std::optional<DynamicType> GetType() const;
105   int Rank() const;
106   bool operator==(const ActualArgument &) const;
107   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
108 
keyword()109   std::optional<parser::CharBlock> keyword() const { return keyword_; }
set_keyword(parser::CharBlock x)110   void set_keyword(parser::CharBlock x) { keyword_ = x; }
isAlternateReturn()111   bool isAlternateReturn() const { return isAlternateReturn_; }
set_isAlternateReturn()112   void set_isAlternateReturn() { isAlternateReturn_ = true; }
isPassedObject()113   bool isPassedObject() const { return isPassedObject_; }
114   void set_isPassedObject(bool yes = true) { isPassedObject_ = yes; }
115 
116   bool Matches(const characteristics::DummyArgument &) const;
dummyIntent()117   common::Intent dummyIntent() const { return dummyIntent_; }
set_dummyIntent(common::Intent intent)118   ActualArgument &set_dummyIntent(common::Intent intent) {
119     dummyIntent_ = intent;
120     return *this;
121   }
122 
123   // Wrap this argument in parentheses
124   void Parenthesize();
125 
126   // TODO: Mark legacy %VAL and %REF arguments
127 
128 private:
129   // Subtlety: There is a distinction that must be maintained here between an
130   // actual argument expression that is a variable and one that is not,
131   // e.g. between X and (X).  The parser attempts to parse each argument
132   // first as a variable, then as an expression, and the distinction appears
133   // in the parse tree.
134   std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType> u_;
135   std::optional<parser::CharBlock> keyword_;
136   bool isAlternateReturn_{false}; // whether expr is a "*label" number
137   bool isPassedObject_{false};
138   common::Intent dummyIntent_{common::Intent::Default};
139 };
140 
141 using ActualArguments = std::vector<std::optional<ActualArgument>>;
142 
143 // Intrinsics are identified by their names and the characteristics
144 // of their arguments, at least for now.
145 using IntrinsicProcedure = std::string;
146 
147 struct SpecificIntrinsic {
148   SpecificIntrinsic(IntrinsicProcedure, characteristics::Procedure &&);
149   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(SpecificIntrinsic)
150   ~SpecificIntrinsic();
151   bool operator==(const SpecificIntrinsic &) const;
152   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
153 
154   IntrinsicProcedure name;
155   bool isRestrictedSpecific{false}; // if true, can only call it, not pass it
156   common::CopyableIndirection<characteristics::Procedure> characteristics;
157 };
158 
159 struct ProcedureDesignator {
EVALUATE_UNION_CLASS_BOILERPLATEProcedureDesignator160   EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
161   explicit ProcedureDesignator(SpecificIntrinsic &&i) : u{std::move(i)} {}
ProcedureDesignatorProcedureDesignator162   explicit ProcedureDesignator(const Symbol &n) : u{n} {}
163   explicit ProcedureDesignator(Component &&);
164 
165   // Exactly one of these will return a non-null pointer.
166   const SpecificIntrinsic *GetSpecificIntrinsic() const;
167   const Symbol *GetSymbol() const; // symbol or component symbol
168 
169   // For references to NOPASS components and bindings only.
170   // References to PASS components and bindings are represented
171   // with the symbol below and the base object DataRef in the
172   // passed-object ActualArgument.
173   // Always null when the procedure is intrinsic.
174   const Component *GetComponent() const;
175 
176   const Symbol *GetInterfaceSymbol() const;
177 
178   std::string GetName() const;
179   std::optional<DynamicType> GetType() const;
180   int Rank() const;
181   bool IsElemental() const;
182   std::optional<Expr<SubscriptInteger>> LEN() const;
183   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
184 
185   std::variant<SpecificIntrinsic, SymbolRef,
186       common::CopyableIndirection<Component>>
187       u;
188 };
189 
190 class ProcedureRef {
191 public:
CLASS_BOILERPLATE(ProcedureRef)192   CLASS_BOILERPLATE(ProcedureRef)
193   ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
194       bool hasAlternateReturns = false)
195       : proc_{std::move(p)}, arguments_{std::move(a)},
196         hasAlternateReturns_{hasAlternateReturns} {}
197   ~ProcedureRef();
198   static void Deleter(ProcedureRef *);
199 
proc()200   ProcedureDesignator &proc() { return proc_; }
proc()201   const ProcedureDesignator &proc() const { return proc_; }
arguments()202   ActualArguments &arguments() { return arguments_; }
arguments()203   const ActualArguments &arguments() const { return arguments_; }
204 
205   std::optional<Expr<SubscriptInteger>> LEN() const;
206   int Rank() const;
IsElemental()207   bool IsElemental() const { return proc_.IsElemental(); }
hasAlternateReturns()208   bool hasAlternateReturns() const { return hasAlternateReturns_; }
209   bool operator==(const ProcedureRef &) const;
210   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
211 
212 protected:
213   ProcedureDesignator proc_;
214   ActualArguments arguments_;
215   bool hasAlternateReturns_;
216 };
217 
218 template <typename A> class FunctionRef : public ProcedureRef {
219 public:
220   using Result = A;
CLASS_BOILERPLATE(FunctionRef)221   CLASS_BOILERPLATE(FunctionRef)
222   explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
FunctionRef(ProcedureDesignator && p,ActualArguments && a)223   FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
224       : ProcedureRef{std::move(p), std::move(a)} {}
225 
GetType()226   std::optional<DynamicType> GetType() const { return proc_.GetType(); }
227   std::optional<Constant<Result>> Fold(FoldingContext &); // for intrinsics
228 };
229 
230 FOR_EACH_SPECIFIC_TYPE(extern template class FunctionRef, )
231 } // namespace Fortran::evaluate
232 #endif // FORTRAN_EVALUATE_CALL_H_
233