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