1 //===-- lib/Parser/parse-tree.cpp -----------------------------------------===//
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 #include "flang/Parser/parse-tree.h"
10 #include "flang/Common/idioms.h"
11 #include "flang/Common/indirection.h"
12 #include "flang/Parser/user-state.h"
13 #include <algorithm>
14 
15 // So "delete Expr;" calls an external destructor for its typedExpr.
16 namespace Fortran::evaluate {
17 struct GenericExprWrapper {
18   ~GenericExprWrapper();
19 };
20 struct GenericAssignmentWrapper {
21   ~GenericAssignmentWrapper();
22 };
23 }
24 
25 namespace Fortran::parser {
26 
27 // R867
28 ImportStmt::ImportStmt(common::ImportKind &&k, std::list<Name> &&n)
29   : kind{k}, names(std::move(n)) {
30   CHECK(kind == common::ImportKind::Default ||
31       kind == common::ImportKind::Only || names.empty());
32 }
33 
34 // R873
35 CommonStmt::CommonStmt(std::optional<Name> &&name,
36     std::list<CommonBlockObject> &&objects, std::list<Block> &&others) {
37   blocks.emplace_front(std::move(name), std::move(objects));
38   blocks.splice(blocks.end(), std::move(others));
39 }
40 
41 // R901 designator
42 bool Designator::EndsInBareName() const {
43   return std::visit(
44       common::visitors{
45           [](const DataRef &dr) {
46             return std::holds_alternative<Name>(dr.u) ||
47                 std::holds_alternative<common::Indirection<StructureComponent>>(
48                     dr.u);
49           },
50           [](const Substring &) { return false; },
51       },
52       u);
53 }
54 
55 // R911 data-ref -> part-ref [% part-ref]...
56 DataRef::DataRef(std::list<PartRef> &&prl) : u{std::move(prl.front().name)} {
57   for (bool first{true}; !prl.empty(); first = false, prl.pop_front()) {
58     PartRef &pr{prl.front()};
59     if (!first) {
60       u = common::Indirection<StructureComponent>::Make(
61           std::move(*this), std::move(pr.name));
62     }
63     if (!pr.subscripts.empty()) {
64       u = common::Indirection<ArrayElement>::Make(
65           std::move(*this), std::move(pr.subscripts));
66     }
67     if (pr.imageSelector) {
68       u = common::Indirection<CoindexedNamedObject>::Make(
69           std::move(*this), std::move(*pr.imageSelector));
70     }
71   }
72 }
73 
74 // R1001 - R1022 expression
75 Expr::Expr(Designator &&x)
76   : u{common::Indirection<Designator>::Make(std::move(x))} {}
77 Expr::Expr(FunctionReference &&x)
78   : u{common::Indirection<FunctionReference>::Make(std::move(x))} {}
79 
80 const std::optional<LoopControl> &DoConstruct::GetLoopControl() const {
81   const NonLabelDoStmt &doStmt{
82       std::get<Statement<NonLabelDoStmt>>(t).statement};
83   const std::optional<LoopControl> &control{
84       std::get<std::optional<LoopControl>>(doStmt.t)};
85   return control;
86 }
87 
88 bool DoConstruct::IsDoNormal() const {
89   const std::optional<LoopControl> &control{GetLoopControl()};
90   return control && std::holds_alternative<LoopControl::Bounds>(control->u);
91 }
92 
93 bool DoConstruct::IsDoWhile() const {
94   const std::optional<LoopControl> &control{GetLoopControl()};
95   return control && std::holds_alternative<ScalarLogicalExpr>(control->u);
96 }
97 
98 bool DoConstruct::IsDoConcurrent() const {
99   const std::optional<LoopControl> &control{GetLoopControl()};
100   return control && std::holds_alternative<LoopControl::Concurrent>(control->u);
101 }
102 
103 static Designator MakeArrayElementRef(
104     const Name &name, std::list<Expr> &&subscripts) {
105   ArrayElement arrayElement{DataRef{Name{name}}, std::list<SectionSubscript>{}};
106   for (Expr &expr : subscripts) {
107     arrayElement.subscripts.push_back(
108         SectionSubscript{Integer{common::Indirection{std::move(expr)}}});
109   }
110   return Designator{DataRef{common::Indirection{std::move(arrayElement)}}};
111 }
112 
113 static Designator MakeArrayElementRef(
114     StructureComponent &&sc, std::list<Expr> &&subscripts) {
115   ArrayElement arrayElement{DataRef{common::Indirection{std::move(sc)}},
116       std::list<SectionSubscript>{}};
117   for (Expr &expr : subscripts) {
118     arrayElement.subscripts.push_back(
119         SectionSubscript{Integer{common::Indirection{std::move(expr)}}});
120   }
121   return Designator{DataRef{common::Indirection{std::move(arrayElement)}}};
122 }
123 
124 // Set source in any type of node that has it.
125 template<typename T> T WithSource(CharBlock source, T &&x) {
126   x.source = source;
127   return std::move(x);
128 }
129 
130 static Expr ActualArgToExpr(ActualArgSpec &arg) {
131   return std::visit(
132       common::visitors{
133           [&](common::Indirection<Expr> &y) { return std::move(y.value()); },
134           [&](common::Indirection<Variable> &y) {
135             return std::visit(
136                 common::visitors{
137                     [&](common::Indirection<Designator> &z) {
138                       return WithSource(
139                           z.value().source, Expr{std::move(z.value())});
140                     },
141                     [&](common::Indirection<FunctionReference> &z) {
142                       return WithSource(
143                           z.value().v.source, Expr{std::move(z.value())});
144                     },
145                 },
146                 y.value().u);
147           },
148           [&](auto &) -> Expr { common::die("unexpected type"); },
149       },
150       std::get<ActualArg>(arg.t).u);
151 }
152 
153 Designator FunctionReference::ConvertToArrayElementRef() {
154   std::list<Expr> args;
155   for (auto &arg : std::get<std::list<ActualArgSpec>>(v.t)) {
156     args.emplace_back(ActualArgToExpr(arg));
157   }
158   return std::visit(
159       common::visitors{
160           [&](const Name &name) {
161             return WithSource(
162                 v.source, MakeArrayElementRef(name, std::move(args)));
163           },
164           [&](ProcComponentRef &pcr) {
165             return WithSource(v.source,
166                 MakeArrayElementRef(std::move(pcr.v.thing), std::move(args)));
167           },
168       },
169       std::get<ProcedureDesignator>(v.t).u);
170 }
171 
172 StructureConstructor FunctionReference::ConvertToStructureConstructor(
173     const semantics::DerivedTypeSpec &derived) {
174   Name name{std::get<parser::Name>(std::get<ProcedureDesignator>(v.t).u)};
175   std::list<ComponentSpec> components;
176   for (auto &arg : std::get<std::list<ActualArgSpec>>(v.t)) {
177     std::optional<Keyword> keyword;
178     if (auto &kw{std::get<std::optional<Keyword>>(arg.t)}) {
179       keyword.emplace(Keyword{Name{kw->v}});
180     }
181     components.emplace_back(
182         std::move(keyword), ComponentDataSource{ActualArgToExpr(arg)});
183   }
184   DerivedTypeSpec spec{std::move(name), std::list<TypeParamSpec>{}};
185   spec.derivedTypeSpec = &derived;
186   return StructureConstructor{std::move(spec), std::move(components)};
187 }
188 
189 Substring ArrayElement::ConvertToSubstring() {
190   auto iter{subscripts.begin()};
191   CHECK(iter != subscripts.end());
192   auto &triplet{std::get<SubscriptTriplet>(iter->u)};
193   CHECK(!std::get<2>(triplet.t));
194   CHECK(++iter == subscripts.end());
195   return Substring{std::move(base),
196       SubstringRange{std::get<0>(std::move(triplet.t)),
197           std::get<1>(std::move(triplet.t))}};
198 }
199 
200 // R1544 stmt-function-stmt
201 // Convert this stmt-function-stmt to an array element assignment statement.
202 Statement<ActionStmt> StmtFunctionStmt::ConvertToAssignment() {
203   auto &funcName{std::get<Name>(t)};
204   auto &funcArgs{std::get<std::list<Name>>(t)};
205   auto &funcExpr{std::get<Scalar<Expr>>(t).thing};
206   CharBlock source{funcName.source};
207   std::list<Expr> subscripts;
208   for (Name &arg : funcArgs) {
209     subscripts.push_back(WithSource(arg.source,
210         Expr{common::Indirection{
211             WithSource(arg.source, Designator{DataRef{Name{arg}}})}}));
212     source.ExtendToCover(arg.source);
213   }
214   // extend source to include closing paren
215   if (funcArgs.empty()) {
216     CHECK(*source.end() == '(');
217     source = CharBlock{source.begin(), source.end() + 1};
218   }
219   CHECK(*source.end() == ')');
220   source = CharBlock{source.begin(), source.end() + 1};
221   auto variable{Variable{common::Indirection{WithSource(
222       source, MakeArrayElementRef(funcName, std::move(subscripts)))}}};
223   return Statement{std::nullopt,
224       ActionStmt{common::Indirection{
225           AssignmentStmt{std::move(variable), std::move(funcExpr)}}}};
226 }
227 
228 CharBlock Variable::GetSource() const {
229   return std::visit(
230       common::visitors{
231           [&](const common::Indirection<Designator> &des) {
232             return des.value().source;
233           },
234           [&](const common::Indirection<parser::FunctionReference> &call) {
235             return call.value().v.source;
236           },
237       },
238       u);
239 }
240 
241 std::ostream &operator<<(std::ostream &os, const Name &x) {
242   return os << x.ToString();
243 }
244 
245 }
246 
247 template class std::unique_ptr<Fortran::evaluate::GenericExprWrapper>;
248 template class std::unique_ptr<Fortran::evaluate::GenericAssignmentWrapper>;
249