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