1 // Copyright (c) 2018-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 #ifndef FORTRAN_SEMANTICS_EXPRESSION_H_
16 #define FORTRAN_SEMANTICS_EXPRESSION_H_
17
18 #include "semantics.h"
19 #include "../common/Fortran.h"
20 #include "../common/indirection.h"
21 #include "../evaluate/characteristics.h"
22 #include "../evaluate/check-expression.h"
23 #include "../evaluate/expression.h"
24 #include "../evaluate/fold.h"
25 #include "../evaluate/tools.h"
26 #include "../evaluate/type.h"
27 #include "../parser/char-block.h"
28 #include "../parser/parse-tree-visitor.h"
29 #include "../parser/parse-tree.h"
30 #include <map>
31 #include <optional>
32 #include <variant>
33
34 using namespace Fortran::parser::literals;
35
36 namespace Fortran::parser {
37 struct SourceLocationFindingVisitor {
PreSourceLocationFindingVisitor38 template<typename A> bool Pre(const A &) { return true; }
PostSourceLocationFindingVisitor39 template<typename A> void Post(const A &) {}
PreSourceLocationFindingVisitor40 bool Pre(const Expr &x) {
41 source = x.source;
42 return false;
43 }
PreSourceLocationFindingVisitor44 bool Pre(const Designator &x) {
45 source = x.source;
46 return false;
47 }
PreSourceLocationFindingVisitor48 bool Pre(const Call &x) {
49 source = x.source;
50 return false;
51 }
PreSourceLocationFindingVisitor52 bool Pre(const CompilerDirective &x) {
53 source = x.source;
54 return false;
55 }
PreSourceLocationFindingVisitor56 bool Pre(const GenericSpec &x) {
57 source = x.source;
58 return false;
59 }
PreSourceLocationFindingVisitor60 template<typename A> bool Pre(const UnlabeledStatement<A> &stmt) {
61 source = stmt.source;
62 return false;
63 }
PostSourceLocationFindingVisitor64 void Post(const CharBlock &at) { source = at; }
65
66 CharBlock source;
67 };
68
FindSourceLocation(const A & x)69 template<typename A> CharBlock FindSourceLocation(const A &x) {
70 SourceLocationFindingVisitor visitor;
71 Walk(x, visitor);
72 return visitor.source;
73 }
74 }
75
76 using namespace Fortran::parser::literals;
77
78 // The expression semantic analysis code has its implementation in
79 // namespace Fortran::evaluate, but the exposed API to it is in the
80 // namespace Fortran::semantics (below).
81 //
82 // The ExpressionAnalyzer wraps a SemanticsContext reference
83 // and implements constraint checking on expressions using the
84 // parse tree node wrappers that mirror the grammar annotations used
85 // in the Fortran standard (i.e., scalar-, constant-, &c.).
86
87 namespace Fortran::evaluate {
88
89 class IntrinsicProcTable;
90
91 struct SetExprHelper {
SetExprHelperSetExprHelper92 SetExprHelper(GenericExprWrapper &&expr) : expr_{std::move(expr)} {}
SetSetExprHelper93 void Set(parser::Expr::TypedExpr &x) { x->v = std::move(expr_.v); }
SetSetExprHelper94 void Set(const parser::Expr &x) { Set(x.typedExpr); }
SetSetExprHelper95 void Set(const parser::Variable &x) { Set(x.typedExpr); }
SetSetExprHelper96 template<typename T> void Set(const common::Indirection<T> &x) {
97 Set(x.value());
98 }
SetSetExprHelper99 template<typename T> void Set(const T &x) {
100 if constexpr (ConstraintTrait<T>) {
101 Set(x.thing);
102 } else {
103 static_assert("bad type");
104 }
105 }
106
107 GenericExprWrapper expr_;
108 };
109
110 // Set the typedExpr data member to std::nullopt to indicate an error
ResetExpr(const T & x)111 template<typename T> void ResetExpr(const T &x) {
112 SetExprHelper{GenericExprWrapper{std::nullopt}}.Set(x);
113 }
114
SetExpr(const T & x,GenericExprWrapper && expr)115 template<typename T> void SetExpr(const T &x, GenericExprWrapper &&expr) {
116 SetExprHelper{std::move(expr)}.Set(x);
117 }
118
119 class ExpressionAnalyzer {
120 public:
121 using MaybeExpr = std::optional<Expr<SomeType>>;
122
ExpressionAnalyzer(semantics::SemanticsContext & sc)123 explicit ExpressionAnalyzer(semantics::SemanticsContext &sc) : context_{sc} {}
124 ExpressionAnalyzer(ExpressionAnalyzer &) = default;
125
context()126 semantics::SemanticsContext &context() const { return context_; }
127
GetFoldingContext()128 FoldingContext &GetFoldingContext() const {
129 return context_.foldingContext();
130 }
131
GetContextualMessages()132 parser::ContextualMessages &GetContextualMessages() {
133 return GetFoldingContext().messages();
134 }
135
Say(A &&...args)136 template<typename... A> parser::Message *Say(A &&... args) {
137 return GetContextualMessages().Say(std::forward<A>(args)...);
138 }
139
140 template<typename T, typename... A>
SayAt(const T & parsed,A &&...args)141 parser::Message *SayAt(const T &parsed, A &&... args) {
142 return Say(parser::FindSourceLocation(parsed), std::forward<A>(args)...);
143 }
144
145 int GetDefaultKind(common::TypeCategory);
146 DynamicType GetDefaultKindOfType(common::TypeCategory);
147
148 // Return false and emit error if these checks fail:
149 bool CheckIntrinsicKind(TypeCategory, std::int64_t kind);
150 bool CheckIntrinsicSize(TypeCategory, std::int64_t size);
151
152 // Manage a set of active array constructor implied DO loops.
153 bool AddAcImpliedDo(parser::CharBlock, int);
154 void RemoveAcImpliedDo(parser::CharBlock);
155 std::optional<int> IsAcImpliedDo(parser::CharBlock) const;
156
157 Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
158 const std::optional<parser::KindSelector> &);
159
160 MaybeExpr Analyze(const parser::Expr &);
161 MaybeExpr Analyze(const parser::Variable &);
162 MaybeExpr Analyze(const parser::Designator &);
163
Analyze(const common::Indirection<A> & x)164 template<typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
165 return Analyze(x.value());
166 }
Analyze(const std::optional<A> & x)167 template<typename A> MaybeExpr Analyze(const std::optional<A> &x) {
168 if (x.has_value()) {
169 return Analyze(*x);
170 } else {
171 return std::nullopt;
172 }
173 }
174
175 // Implement constraint-checking wrappers from the Fortran grammar.
Analyze(const parser::Scalar<A> & x)176 template<typename A> MaybeExpr Analyze(const parser::Scalar<A> &x) {
177 auto result{Analyze(x.thing)};
178 if (result.has_value()) {
179 if (int rank{result->Rank()}; rank != 0) {
180 SayAt(x, "Must be a scalar value, but is a rank-%d array"_err_en_US,
181 rank);
182 ResetExpr(x);
183 return std::nullopt;
184 }
185 }
186 return result;
187 }
Analyze(const parser::Constant<A> & x)188 template<typename A> MaybeExpr Analyze(const parser::Constant<A> &x) {
189 auto save{
190 GetFoldingContext().messages().SetLocation(FindSourceLocation(x))};
191 auto result{Analyze(x.thing)};
192 if (result.has_value()) {
193 *result = Fold(GetFoldingContext(), std::move(*result));
194 if (!IsConstantExpr(*result)) {
195 SayAt(x, "Must be a constant value"_err_en_US);
196 ResetExpr(x);
197 return std::nullopt;
198 } else {
199 // Save folded expression for later use
200 SetExpr(x, common::Clone(result));
201 }
202 }
203 return result;
204 }
Analyze(const parser::Integer<A> & x)205 template<typename A> MaybeExpr Analyze(const parser::Integer<A> &x) {
206 auto result{Analyze(x.thing)};
207 if (!EnforceTypeConstraint(
208 parser::FindSourceLocation(x), result, TypeCategory::Integer)) {
209 ResetExpr(x);
210 return std::nullopt;
211 }
212 return result;
213 }
Analyze(const parser::Logical<A> & x)214 template<typename A> MaybeExpr Analyze(const parser::Logical<A> &x) {
215 auto result{Analyze(x.thing)};
216 if (!EnforceTypeConstraint(
217 parser::FindSourceLocation(x), result, TypeCategory::Logical)) {
218 ResetExpr(x);
219 return std::nullopt;
220 }
221 return result;
222 }
Analyze(const parser::DefaultChar<A> & x)223 template<typename A> MaybeExpr Analyze(const parser::DefaultChar<A> &x) {
224 auto result{Analyze(x.thing)};
225 if (!EnforceTypeConstraint(parser::FindSourceLocation(x), result,
226 TypeCategory::Character, true /* default kind */)) {
227 ResetExpr(x);
228 return std::nullopt;
229 }
230 return result;
231 }
232
233 MaybeExpr Analyze(const parser::Name &);
Analyze(const parser::DataRef & dr)234 MaybeExpr Analyze(const parser::DataRef &dr) {
235 return Analyze<parser::DataRef>(dr);
236 }
237 MaybeExpr Analyze(const parser::StructureComponent &);
238
239 void Analyze(const parser::CallStmt &);
240
241 protected:
242 int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
243
244 private:
245 MaybeExpr Analyze(const parser::IntLiteralConstant &);
246 MaybeExpr Analyze(const parser::SignedIntLiteralConstant &);
247 MaybeExpr Analyze(const parser::RealLiteralConstant &);
248 MaybeExpr Analyze(const parser::SignedRealLiteralConstant &);
249 MaybeExpr Analyze(const parser::ComplexPart &);
250 MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
251 MaybeExpr Analyze(const parser::LogicalLiteralConstant &);
252 MaybeExpr Analyze(const parser::CharLiteralConstant &);
253 MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
254 MaybeExpr Analyze(const parser::BOZLiteralConstant &);
255 MaybeExpr Analyze(const parser::NamedConstant &);
256 MaybeExpr Analyze(const parser::Substring &);
257 MaybeExpr Analyze(const parser::ArrayElement &);
258 MaybeExpr Analyze(const parser::CoindexedNamedObject &);
259 MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
260 MaybeExpr Analyze(const parser::ArrayConstructor &);
261 MaybeExpr Analyze(const parser::StructureConstructor &);
262 MaybeExpr Analyze(const parser::FunctionReference &);
263 MaybeExpr Analyze(const parser::Expr::Parentheses &);
264 MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
265 MaybeExpr Analyze(const parser::Expr::Negate &);
266 MaybeExpr Analyze(const parser::Expr::NOT &);
267 MaybeExpr Analyze(const parser::Expr::PercentLoc &);
268 MaybeExpr Analyze(const parser::Expr::DefinedUnary &);
269 MaybeExpr Analyze(const parser::Expr::Power &);
270 MaybeExpr Analyze(const parser::Expr::Multiply &);
271 MaybeExpr Analyze(const parser::Expr::Divide &);
272 MaybeExpr Analyze(const parser::Expr::Add &);
273 MaybeExpr Analyze(const parser::Expr::Subtract &);
274 MaybeExpr Analyze(const parser::Expr::ComplexConstructor &);
275 MaybeExpr Analyze(const parser::Expr::Concat &);
276 MaybeExpr Analyze(const parser::Expr::LT &);
277 MaybeExpr Analyze(const parser::Expr::LE &);
278 MaybeExpr Analyze(const parser::Expr::EQ &);
279 MaybeExpr Analyze(const parser::Expr::NE &);
280 MaybeExpr Analyze(const parser::Expr::GE &);
281 MaybeExpr Analyze(const parser::Expr::GT &);
282 MaybeExpr Analyze(const parser::Expr::AND &);
283 MaybeExpr Analyze(const parser::Expr::OR &);
284 MaybeExpr Analyze(const parser::Expr::EQV &);
285 MaybeExpr Analyze(const parser::Expr::NEQV &);
286 MaybeExpr Analyze(const parser::Expr::XOR &);
287 MaybeExpr Analyze(const parser::Expr::DefinedBinary &);
Analyze(const A & x)288 template<typename A> MaybeExpr Analyze(const A &x) {
289 return Analyze(x.u); // default case
290 }
Analyze(const std::variant<As...> & u)291 template<typename... As> MaybeExpr Analyze(const std::variant<As...> &u) {
292 return std::visit([&](const auto &x) { return Analyze(x); }, u);
293 }
294
295 // Analysis subroutines
296 int AnalyzeKindParam(
297 const std::optional<parser::KindParam> &, int defaultKind);
298 template<typename PARSED> MaybeExpr ExprOrVariable(const PARSED &);
299 template<typename PARSED> MaybeExpr IntLiteralConstant(const PARSED &);
300 MaybeExpr AnalyzeString(std::string &&, int kind);
301 std::optional<Expr<SubscriptInteger>> AsSubscript(MaybeExpr &&);
302 std::optional<Expr<SubscriptInteger>> TripletPart(
303 const std::optional<parser::Subscript> &);
304 std::optional<Subscript> AnalyzeSectionSubscript(
305 const parser::SectionSubscript &);
306 std::vector<Subscript> AnalyzeSectionSubscripts(
307 const std::list<parser::SectionSubscript> &);
308 MaybeExpr Designate(DataRef &&);
309 MaybeExpr CompleteSubscripts(ArrayRef &&);
310 MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
311 MaybeExpr TopLevelChecks(DataRef &&);
312 std::optional<Expr<SubscriptInteger>> GetSubstringBound(
313 const std::optional<parser::ScalarIntExpr> &);
314
315 struct CalleeAndArguments {
316 ProcedureDesignator procedureDesignator;
317 ActualArguments arguments;
318 };
319
320 std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
321 const parser::ProcComponentRef &, ActualArguments &&);
322 std::optional<ActualArgument> AnalyzeActualArgument(const parser::Expr &);
323
324 MaybeExpr AnalyzeCall(const parser::Call &, bool isSubroutine);
325 std::optional<ActualArguments> AnalyzeArguments(
326 const parser::Call &, bool isSubroutine);
327 std::optional<characteristics::Procedure> CheckCall(
328 parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
329 const Symbol *ResolveGeneric(const Symbol &, ActualArguments &);
330 std::optional<CalleeAndArguments> GetCalleeAndArguments(
331 const parser::ProcedureDesignator &, ActualArguments &&,
332 bool isSubroutine);
333
334 void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
335 bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
336 bool defaultKind = false);
337 MaybeExpr MakeFunctionRef(
338 parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
339 MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
340
341 semantics::SemanticsContext &context_;
342 std::map<parser::CharBlock, int> acImpliedDos_; // values are INTEGER kinds
343 bool fatalErrors_{false};
344 };
345
346 template<typename L, typename R>
AreConformable(const L & left,const R & right)347 bool AreConformable(const L &left, const R &right) {
348 int leftRank{left.Rank()};
349 if (leftRank == 0) {
350 return true;
351 }
352 int rightRank{right.Rank()};
353 return rightRank == 0 || leftRank == rightRank;
354 }
355
356 template<typename L, typename R>
ConformabilityCheck(parser::ContextualMessages & context,const L & left,const R & right)357 void ConformabilityCheck(
358 parser::ContextualMessages &context, const L &left, const R &right) {
359 if (!AreConformable(left, right)) {
360 context.Say("left operand has rank %d, right operand has rank %d"_err_en_US,
361 left.Rank(), right.Rank());
362 }
363 }
364 } // namespace Fortran::evaluate
365
366 namespace Fortran::semantics {
367
368 // Semantic analysis of one expression.
369 template<typename A>
AnalyzeExpr(SemanticsContext & context,const A & expr)370 std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
371 SemanticsContext &context, const A &expr) {
372 return evaluate::ExpressionAnalyzer{context}.Analyze(expr);
373 }
374
375 // Semantic analysis of an intrinsic type's KIND parameter expression.
376 evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
377 SemanticsContext &, common::TypeCategory,
378 const std::optional<parser::KindSelector> &);
379
380 void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
381
382 // Semantic analysis of all expressions in a parse tree, which becomes
383 // decorated with typed representations for top-level expressions.
384 class ExprChecker {
385 public:
386 explicit ExprChecker(SemanticsContext &);
387
Pre(const A &)388 template<typename A> bool Pre(const A &) { return true; }
Post(const A &)389 template<typename A> void Post(const A &) {}
390 bool Walk(const parser::Program &);
391
Pre(const parser::Expr & x)392 bool Pre(const parser::Expr &x) {
393 AnalyzeExpr(context_, x);
394 return false;
395 }
Pre(const parser::Variable & x)396 bool Pre(const parser::Variable &x) {
397 AnalyzeExpr(context_, x);
398 return false;
399 }
Pre(const parser::CallStmt & x)400 bool Pre(const parser::CallStmt &x) {
401 AnalyzeCallStmt(context_, x);
402 return false;
403 }
404
Pre(const parser::Scalar<A> & x)405 template<typename A> bool Pre(const parser::Scalar<A> &x) {
406 AnalyzeExpr(context_, x);
407 return false;
408 }
Pre(const parser::Constant<A> & x)409 template<typename A> bool Pre(const parser::Constant<A> &x) {
410 AnalyzeExpr(context_, x);
411 return false;
412 }
Pre(const parser::Integer<A> & x)413 template<typename A> bool Pre(const parser::Integer<A> &x) {
414 AnalyzeExpr(context_, x);
415 return false;
416 }
Pre(const parser::Logical<A> & x)417 template<typename A> bool Pre(const parser::Logical<A> &x) {
418 AnalyzeExpr(context_, x);
419 return false;
420 }
Pre(const parser::DefaultChar<A> & x)421 template<typename A> bool Pre(const parser::DefaultChar<A> &x) {
422 AnalyzeExpr(context_, x);
423 return false;
424 }
425
426 private:
427 SemanticsContext &context_;
428 };
429 } // namespace Fortran::semantics
430 #endif // FORTRAN_SEMANTICS_EXPRESSION_H_
431