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