1 //===-- include/flang/Semantics/expression.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_SEMANTICS_EXPRESSION_H_
10 #define FORTRAN_SEMANTICS_EXPRESSION_H_
11
12 #include "semantics.h"
13 #include "flang/Common/Fortran.h"
14 #include "flang/Common/indirection.h"
15 #include "flang/Common/restorer.h"
16 #include "flang/Evaluate/characteristics.h"
17 #include "flang/Evaluate/check-expression.h"
18 #include "flang/Evaluate/expression.h"
19 #include "flang/Evaluate/fold.h"
20 #include "flang/Evaluate/tools.h"
21 #include "flang/Evaluate/type.h"
22 #include "flang/Parser/char-block.h"
23 #include "flang/Parser/parse-tree-visitor.h"
24 #include "flang/Parser/parse-tree.h"
25 #include "flang/Parser/tools.h"
26 #include <map>
27 #include <optional>
28 #include <type_traits>
29 #include <variant>
30
31 using namespace Fortran::parser::literals;
32
33 namespace Fortran::parser {
34 struct SourceLocationFindingVisitor {
PreSourceLocationFindingVisitor35 template <typename A> bool Pre(const A &x) {
36 if constexpr (HasSource<A>::value) {
37 source.ExtendToCover(x.source);
38 return false;
39 } else {
40 return true;
41 }
42 }
PostSourceLocationFindingVisitor43 template <typename A> void Post(const A &) {}
PostSourceLocationFindingVisitor44 void Post(const CharBlock &at) { source.ExtendToCover(at); }
45
46 CharBlock source;
47 };
48
FindSourceLocation(const A & x)49 template <typename A> CharBlock FindSourceLocation(const A &x) {
50 SourceLocationFindingVisitor visitor;
51 Walk(x, visitor);
52 return visitor.source;
53 }
54 } // namespace Fortran::parser
55
56 using namespace Fortran::parser::literals;
57
58 // The expression semantic analysis code has its implementation in
59 // namespace Fortran::evaluate, but the exposed API to it is in the
60 // namespace Fortran::semantics (below).
61 //
62 // The ExpressionAnalyzer wraps a SemanticsContext reference
63 // and implements constraint checking on expressions using the
64 // parse tree node wrappers that mirror the grammar annotations used
65 // in the Fortran standard (i.e., scalar-, constant-, &c.).
66
67 namespace Fortran::evaluate {
68
69 class IntrinsicProcTable;
70
71 struct SetExprHelper {
SetExprHelperSetExprHelper72 explicit SetExprHelper(GenericExprWrapper &&expr) : expr_{std::move(expr)} {}
SetSetExprHelper73 void Set(parser::TypedExpr &x) {
74 x.Reset(new GenericExprWrapper{std::move(expr_)},
75 evaluate::GenericExprWrapper::Deleter);
76 }
SetSetExprHelper77 void Set(const parser::Expr &x) { Set(x.typedExpr); }
SetSetExprHelper78 void Set(const parser::Variable &x) { Set(x.typedExpr); }
SetSetExprHelper79 void Set(const parser::DataStmtConstant &x) { Set(x.typedExpr); }
SetSetExprHelper80 template <typename T> void Set(const common::Indirection<T> &x) {
81 Set(x.value());
82 }
SetSetExprHelper83 template <typename T> void Set(const T &x) {
84 if constexpr (ConstraintTrait<T>) {
85 Set(x.thing);
86 } else if constexpr (WrapperTrait<T>) {
87 Set(x.v);
88 }
89 }
90
91 GenericExprWrapper expr_;
92 };
93
ResetExpr(const T & x)94 template <typename T> void ResetExpr(const T &x) {
95 SetExprHelper{GenericExprWrapper{/* error indicator */}}.Set(x);
96 }
97
SetExpr(const T & x,Expr<SomeType> && expr)98 template <typename T> void SetExpr(const T &x, Expr<SomeType> &&expr) {
99 SetExprHelper{GenericExprWrapper{std::move(expr)}}.Set(x);
100 }
101
102 class ExpressionAnalyzer {
103 public:
104 using MaybeExpr = std::optional<Expr<SomeType>>;
105
ExpressionAnalyzer(semantics::SemanticsContext & sc)106 explicit ExpressionAnalyzer(semantics::SemanticsContext &sc) : context_{sc} {}
ExpressionAnalyzer(semantics::SemanticsContext & sc,FoldingContext & fc)107 ExpressionAnalyzer(semantics::SemanticsContext &sc, FoldingContext &fc)
108 : context_{sc}, foldingContext_{fc} {}
109 ExpressionAnalyzer(ExpressionAnalyzer &) = default;
110
context()111 semantics::SemanticsContext &context() const { return context_; }
112
GetFoldingContext()113 FoldingContext &GetFoldingContext() const { return foldingContext_; }
114
GetContextualMessages()115 parser::ContextualMessages &GetContextualMessages() {
116 return foldingContext_.messages();
117 }
118
Say(A &&...args)119 template <typename... A> parser::Message *Say(A &&...args) {
120 return GetContextualMessages().Say(std::forward<A>(args)...);
121 }
122
123 template <typename T, typename... A>
SayAt(const T & parsed,A &&...args)124 parser::Message *SayAt(const T &parsed, A &&...args) {
125 return Say(parser::FindSourceLocation(parsed), std::forward<A>(args)...);
126 }
127
128 int GetDefaultKind(common::TypeCategory);
129 DynamicType GetDefaultKindOfType(common::TypeCategory);
130
131 // Return false and emit error if these checks fail:
132 bool CheckIntrinsicKind(TypeCategory, std::int64_t kind);
133 bool CheckIntrinsicSize(TypeCategory, std::int64_t size);
134
135 // Manage a set of active implied DO loops.
136 bool AddImpliedDo(parser::CharBlock, int kind);
137 void RemoveImpliedDo(parser::CharBlock);
138
139 // When the argument is the name of an active implied DO index, returns
140 // its INTEGER kind type parameter.
141 std::optional<int> IsImpliedDo(parser::CharBlock) const;
142
143 // Allows a whole assumed-size array to appear for the lifetime of
144 // the returned value.
AllowWholeAssumedSizeArray()145 common::Restorer<bool> AllowWholeAssumedSizeArray() {
146 return common::ScopedSet(isWholeAssumedSizeArrayOk_, true);
147 }
148
DoNotUseSavedTypedExprs()149 common::Restorer<bool> DoNotUseSavedTypedExprs() {
150 return common::ScopedSet(useSavedTypedExprs_, false);
151 }
152
153 Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
154 const std::optional<parser::KindSelector> &);
155
156 MaybeExpr Analyze(const parser::Expr &);
157 MaybeExpr Analyze(const parser::Variable &);
158 MaybeExpr Analyze(const parser::Designator &);
159 MaybeExpr Analyze(const parser::DataStmtValue &);
160
Analyze(const common::Indirection<A> & x)161 template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
162 return Analyze(x.value());
163 }
Analyze(const std::optional<A> & x)164 template <typename A> MaybeExpr Analyze(const std::optional<A> &x) {
165 if (x) {
166 return Analyze(*x);
167 } else {
168 return std::nullopt;
169 }
170 }
171
172 // Implement constraint-checking wrappers from the Fortran grammar.
Analyze(const parser::Scalar<A> & x)173 template <typename A> MaybeExpr Analyze(const parser::Scalar<A> &x) {
174 auto result{Analyze(x.thing)};
175 if (result) {
176 if (int rank{result->Rank()}; rank != 0) {
177 SayAt(x, "Must be a scalar value, but is a rank-%d array"_err_en_US,
178 rank);
179 ResetExpr(x);
180 return std::nullopt;
181 }
182 }
183 return result;
184 }
Analyze(const parser::Constant<A> & x)185 template <typename A> MaybeExpr Analyze(const parser::Constant<A> &x) {
186 auto restorer{
187 GetFoldingContext().messages().SetLocation(FindSourceLocation(x))};
188 auto result{Analyze(x.thing)};
189 if (result) {
190 *result = Fold(std::move(*result));
191 if (!IsConstantExpr(*result)) { // C886, C887, C713
192 SayAt(x, "Must be a constant value"_err_en_US);
193 ResetExpr(x);
194 return std::nullopt;
195 } else {
196 // Save folded expression for later use
197 SetExpr(x, common::Clone(*result));
198 }
199 }
200 return result;
201 }
Analyze(const parser::Integer<A> & x)202 template <typename A> MaybeExpr Analyze(const parser::Integer<A> &x) {
203 auto result{Analyze(x.thing)};
204 if (!EnforceTypeConstraint(
205 parser::FindSourceLocation(x), result, TypeCategory::Integer)) {
206 ResetExpr(x);
207 return std::nullopt;
208 }
209 return result;
210 }
Analyze(const parser::Logical<A> & x)211 template <typename A> MaybeExpr Analyze(const parser::Logical<A> &x) {
212 auto result{Analyze(x.thing)};
213 if (!EnforceTypeConstraint(
214 parser::FindSourceLocation(x), result, TypeCategory::Logical)) {
215 ResetExpr(x);
216 return std::nullopt;
217 }
218 return result;
219 }
Analyze(const parser::DefaultChar<A> & x)220 template <typename A> MaybeExpr Analyze(const parser::DefaultChar<A> &x) {
221 auto result{Analyze(x.thing)};
222 if (!EnforceTypeConstraint(parser::FindSourceLocation(x), result,
223 TypeCategory::Character, true /* default kind */)) {
224 ResetExpr(x);
225 return std::nullopt;
226 }
227 return result;
228 }
229
230 MaybeExpr Analyze(const parser::Name &);
Analyze(const parser::DataRef & dr)231 MaybeExpr Analyze(const parser::DataRef &dr) {
232 return Analyze<parser::DataRef>(dr);
233 }
234 MaybeExpr Analyze(const parser::StructureComponent &);
235 MaybeExpr Analyze(const parser::SignedIntLiteralConstant &);
236 MaybeExpr Analyze(const parser::SignedRealLiteralConstant &);
237 MaybeExpr Analyze(const parser::SignedComplexLiteralConstant &);
238 MaybeExpr Analyze(const parser::StructureConstructor &);
239 MaybeExpr Analyze(const parser::InitialDataTarget &);
240 MaybeExpr Analyze(const parser::NullInit &);
241
242 void Analyze(const parser::CallStmt &);
243 const Assignment *Analyze(const parser::AssignmentStmt &);
244 const Assignment *Analyze(const parser::PointerAssignmentStmt &);
245
246 protected:
247 int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
248
249 private:
250 MaybeExpr Analyze(const parser::IntLiteralConstant &);
251 MaybeExpr Analyze(const parser::RealLiteralConstant &);
252 MaybeExpr Analyze(const parser::ComplexPart &);
253 MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
254 MaybeExpr Analyze(const parser::LogicalLiteralConstant &);
255 MaybeExpr Analyze(const parser::CharLiteralConstant &);
256 MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
257 MaybeExpr Analyze(const parser::BOZLiteralConstant &);
258 MaybeExpr Analyze(const parser::NamedConstant &);
259 MaybeExpr Analyze(const parser::DataStmtConstant &);
260 MaybeExpr Analyze(const parser::Substring &);
261 MaybeExpr Analyze(const parser::ArrayElement &);
262 MaybeExpr Analyze(const parser::CoindexedNamedObject &);
263 MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
264 MaybeExpr Analyze(const parser::ArrayConstructor &);
265 MaybeExpr Analyze(const parser::FunctionReference &,
266 std::optional<parser::StructureConstructor> * = nullptr);
267 MaybeExpr Analyze(const parser::Expr::Parentheses &);
268 MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
269 MaybeExpr Analyze(const parser::Expr::Negate &);
270 MaybeExpr Analyze(const parser::Expr::NOT &);
271 MaybeExpr Analyze(const parser::Expr::PercentLoc &);
272 MaybeExpr Analyze(const parser::Expr::DefinedUnary &);
273 MaybeExpr Analyze(const parser::Expr::Power &);
274 MaybeExpr Analyze(const parser::Expr::Multiply &);
275 MaybeExpr Analyze(const parser::Expr::Divide &);
276 MaybeExpr Analyze(const parser::Expr::Add &);
277 MaybeExpr Analyze(const parser::Expr::Subtract &);
278 MaybeExpr Analyze(const parser::Expr::ComplexConstructor &);
279 MaybeExpr Analyze(const parser::Expr::Concat &);
280 MaybeExpr Analyze(const parser::Expr::LT &);
281 MaybeExpr Analyze(const parser::Expr::LE &);
282 MaybeExpr Analyze(const parser::Expr::EQ &);
283 MaybeExpr Analyze(const parser::Expr::NE &);
284 MaybeExpr Analyze(const parser::Expr::GE &);
285 MaybeExpr Analyze(const parser::Expr::GT &);
286 MaybeExpr Analyze(const parser::Expr::AND &);
287 MaybeExpr Analyze(const parser::Expr::OR &);
288 MaybeExpr Analyze(const parser::Expr::EQV &);
289 MaybeExpr Analyze(const parser::Expr::NEQV &);
290 MaybeExpr Analyze(const parser::Expr::DefinedBinary &);
Analyze(const A & x)291 template <typename A> MaybeExpr Analyze(const A &x) {
292 return Analyze(x.u); // default case
293 }
Analyze(const std::variant<As...> & u)294 template <typename... As> MaybeExpr Analyze(const std::variant<As...> &u) {
295 return std::visit(
296 [&](const auto &x) {
297 using Ty = std::decay_t<decltype(x)>;
298 // Function references might turn out to be misparsed structure
299 // constructors; we have to try generic procedure resolution
300 // first to be sure.
301 if constexpr (common::IsTypeInList<parser::StructureConstructor,
302 As...>) {
303 std::optional<parser::StructureConstructor> ctor;
304 MaybeExpr result;
305 if constexpr (std::is_same_v<Ty,
306 common::Indirection<parser::FunctionReference>>) {
307 result = Analyze(x.value(), &ctor);
308 } else if constexpr (std::is_same_v<Ty,
309 parser::FunctionReference>) {
310 result = Analyze(x, &ctor);
311 } else {
312 return Analyze(x);
313 }
314 if (ctor) {
315 // A misparsed function reference is really a structure
316 // constructor. Repair the parse tree in situ.
317 const_cast<std::variant<As...> &>(u) = std::move(*ctor);
318 }
319 return result;
320 }
321 return Analyze(x);
322 },
323 u);
324 }
325
326 // Analysis subroutines
327 int AnalyzeKindParam(
328 const std::optional<parser::KindParam> &, int defaultKind);
329 template <typename PARSED>
330 MaybeExpr ExprOrVariable(const PARSED &, parser::CharBlock source);
331 template <typename PARSED> MaybeExpr IntLiteralConstant(const PARSED &);
332 MaybeExpr AnalyzeString(std::string &&, int kind);
333 std::optional<Expr<SubscriptInteger>> AsSubscript(MaybeExpr &&);
334 std::optional<Expr<SubscriptInteger>> TripletPart(
335 const std::optional<parser::Subscript> &);
336 std::optional<Subscript> AnalyzeSectionSubscript(
337 const parser::SectionSubscript &);
338 std::vector<Subscript> AnalyzeSectionSubscripts(
339 const std::list<parser::SectionSubscript> &);
340 MaybeExpr Designate(DataRef &&);
341 MaybeExpr CompleteSubscripts(ArrayRef &&);
342 MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
343 MaybeExpr TopLevelChecks(DataRef &&);
344 std::optional<Expr<SubscriptInteger>> GetSubstringBound(
345 const std::optional<parser::ScalarIntExpr> &);
346 MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
347
348 struct CalleeAndArguments {
349 // A non-component function reference may constitute a misparsed
350 // structure constructor, in which case its derived type's Symbol
351 // will appear here.
352 std::variant<ProcedureDesignator, SymbolRef> u;
353 ActualArguments arguments;
354 };
355
356 std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
357 const parser::ProcComponentRef &, ActualArguments &&);
358 std::optional<characteristics::Procedure> CheckCall(
359 parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
360 using AdjustActuals =
361 std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
362 bool ResolveForward(const Symbol &);
363 const Symbol *ResolveGeneric(const Symbol &, const ActualArguments &,
364 const AdjustActuals &, bool mightBeStructureConstructor = false);
365 void EmitGenericResolutionError(const Symbol &);
366 std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
367 ActualArguments &&, bool isSubroutine = false,
368 bool mightBeStructureConstructor = false);
369 std::optional<CalleeAndArguments> GetCalleeAndArguments(
370 const parser::ProcedureDesignator &, ActualArguments &&,
371 bool isSubroutine, bool mightBeStructureConstructor = false);
372
373 void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
374 bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
375 bool defaultKind = false);
376 MaybeExpr MakeFunctionRef(
377 parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
378 MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
Fold(T && expr)379 template <typename T> T Fold(T &&expr) {
380 return evaluate::Fold(foldingContext_, std::move(expr));
381 }
382
383 semantics::SemanticsContext &context_;
384 FoldingContext &foldingContext_{context_.foldingContext()};
385 std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
386 bool isWholeAssumedSizeArrayOk_{false};
387 bool useSavedTypedExprs_{true};
388 friend class ArgumentAnalyzer;
389 };
390
AreConformable(int leftRank,int rightRank)391 inline bool AreConformable(int leftRank, int rightRank) {
392 return leftRank == 0 || rightRank == 0 || leftRank == rightRank;
393 }
394
395 template <typename L, typename R>
AreConformable(const L & left,const R & right)396 bool AreConformable(const L &left, const R &right) {
397 return AreConformable(left.Rank(), right.Rank());
398 }
399
400 template <typename L, typename R>
ConformabilityCheck(parser::ContextualMessages & context,const L & left,const R & right)401 void ConformabilityCheck(
402 parser::ContextualMessages &context, const L &left, const R &right) {
403 if (!AreConformable(left, right)) {
404 context.Say("left operand has rank %d, right operand has rank %d"_err_en_US,
405 left.Rank(), right.Rank());
406 }
407 }
408 } // namespace Fortran::evaluate
409
410 namespace Fortran::semantics {
411
412 // Semantic analysis of one expression, variable, or designator.
413 template <typename A>
AnalyzeExpr(SemanticsContext & context,const A & expr)414 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
415 SemanticsContext &context, const A &expr) {
416 return evaluate::ExpressionAnalyzer{context}.Analyze(expr);
417 }
418
419 // Semantic analysis of an intrinsic type's KIND parameter expression.
420 evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
421 SemanticsContext &, common::TypeCategory,
422 const std::optional<parser::KindSelector> &);
423
424 void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
425 const evaluate::Assignment *AnalyzeAssignmentStmt(
426 SemanticsContext &, const parser::AssignmentStmt &);
427 const evaluate::Assignment *AnalyzePointerAssignmentStmt(
428 SemanticsContext &, const parser::PointerAssignmentStmt &);
429
430 // Semantic analysis of all expressions in a parse tree, which becomes
431 // decorated with typed representations for top-level expressions.
432 class ExprChecker {
433 public:
434 explicit ExprChecker(SemanticsContext &);
435
Pre(const A &)436 template <typename A> bool Pre(const A &) { return true; }
Post(const A &)437 template <typename A> void Post(const A &) {}
438 bool Walk(const parser::Program &);
439
Pre(const parser::Expr & x)440 bool Pre(const parser::Expr &x) {
441 exprAnalyzer_.Analyze(x);
442 return false;
443 }
Pre(const parser::Variable & x)444 bool Pre(const parser::Variable &x) {
445 exprAnalyzer_.Analyze(x);
446 return false;
447 }
Pre(const parser::DataStmtValue & x)448 bool Pre(const parser::DataStmtValue &x) {
449 exprAnalyzer_.Analyze(x);
450 return false;
451 }
452 bool Pre(const parser::DataImpliedDo &);
453
Pre(const parser::CallStmt & x)454 bool Pre(const parser::CallStmt &x) {
455 AnalyzeCallStmt(context_, x);
456 return false;
457 }
Pre(const parser::AssignmentStmt & x)458 bool Pre(const parser::AssignmentStmt &x) {
459 AnalyzeAssignmentStmt(context_, x);
460 return false;
461 }
Pre(const parser::PointerAssignmentStmt & x)462 bool Pre(const parser::PointerAssignmentStmt &x) {
463 AnalyzePointerAssignmentStmt(context_, x);
464 return false;
465 }
466
Pre(const parser::Scalar<A> & x)467 template <typename A> bool Pre(const parser::Scalar<A> &x) {
468 exprAnalyzer_.Analyze(x);
469 return false;
470 }
Pre(const parser::Constant<A> & x)471 template <typename A> bool Pre(const parser::Constant<A> &x) {
472 exprAnalyzer_.Analyze(x);
473 return false;
474 }
Pre(const parser::Integer<A> & x)475 template <typename A> bool Pre(const parser::Integer<A> &x) {
476 exprAnalyzer_.Analyze(x);
477 return false;
478 }
Pre(const parser::Logical<A> & x)479 template <typename A> bool Pre(const parser::Logical<A> &x) {
480 exprAnalyzer_.Analyze(x);
481 return false;
482 }
Pre(const parser::DefaultChar<A> & x)483 template <typename A> bool Pre(const parser::DefaultChar<A> &x) {
484 exprAnalyzer_.Analyze(x);
485 return false;
486 }
487
488 private:
489 SemanticsContext &context_;
490 evaluate::ExpressionAnalyzer exprAnalyzer_{context_};
491 };
492 } // namespace Fortran::semantics
493 #endif // FORTRAN_SEMANTICS_EXPRESSION_H_
494