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/Frontend/OpenMP/OMP.h" |
15 | #include "llvm/Support/raw_ostream.h" |
16 | #include <algorithm> |
17 | |
18 | namespace Fortran::parser { |
19 | |
20 | // R867 |
21 | ImportStmt::ImportStmt(common::ImportKind &&k, std::list<Name> &&n) |
22 | : kind{k}, names(std::move(n)) { |
23 | CHECK(kind == common::ImportKind::Default || |
24 | kind == common::ImportKind::Only || names.empty()); |
25 | } |
26 | |
27 | // R873 |
28 | CommonStmt::CommonStmt(std::optional<Name> &&name, |
29 | std::list<CommonBlockObject> &&objects, std::list<Block> &&others) { |
30 | blocks.emplace_front(std::move(name), std::move(objects)); |
31 | blocks.splice(blocks.end(), std::move(others)); |
32 | } |
33 | |
34 | // R901 designator |
35 | bool Designator::EndsInBareName() const { |
36 | return common::visit( |
37 | common::visitors{ |
38 | [](const DataRef &dr) { |
39 | return std::holds_alternative<Name>(dr.u) || |
40 | std::holds_alternative<common::Indirection<StructureComponent>>( |
41 | dr.u); |
42 | }, |
43 | [](const Substring &) { return false; }, |
44 | }, |
45 | u); |
46 | } |
47 | |
48 | // R911 data-ref -> part-ref [% part-ref]... |
49 | DataRef::DataRef(std::list<PartRef> &&prl) : u{std::move(prl.front().name)} { |
50 | for (bool first{true}; !prl.empty(); first = false, prl.pop_front()) { |
51 | PartRef &pr{prl.front()}; |
52 | if (!first) { |
53 | u = common::Indirection<StructureComponent>::Make( |
54 | std::move(*this), std::move(pr.name)); |
55 | } |
56 | if (!pr.subscripts.empty()) { |
57 | u = common::Indirection<ArrayElement>::Make( |
58 | std::move(*this), std::move(pr.subscripts)); |
59 | } |
60 | if (pr.imageSelector) { |
61 | u = common::Indirection<CoindexedNamedObject>::Make( |
62 | std::move(*this), std::move(*pr.imageSelector)); |
63 | } |
64 | } |
65 | } |
66 | |
67 | // R1001 - R1022 expression |
68 | Expr::Expr(Designator &&x) |
69 | : u{common::Indirection<Designator>::Make(std::move(x))} {} |
70 | Expr::Expr(FunctionReference &&x) |
71 | : u{common::Indirection<FunctionReference>::Make(std::move(x))} {} |
72 | |
73 | const std::optional<LoopControl> &DoConstruct::GetLoopControl() const { |
74 | const NonLabelDoStmt &doStmt{ |
75 | std::get<Statement<NonLabelDoStmt>>(t).statement}; |
76 | const std::optional<LoopControl> &control{ |
77 | std::get<std::optional<LoopControl>>(doStmt.t)}; |
78 | return control; |
79 | } |
80 | |
81 | bool DoConstruct::IsDoNormal() const { |
82 | const std::optional<LoopControl> &control{GetLoopControl()}; |
83 | return control && std::holds_alternative<LoopControl::Bounds>(control->u); |
84 | } |
85 | |
86 | bool DoConstruct::IsDoWhile() const { |
87 | const std::optional<LoopControl> &control{GetLoopControl()}; |
88 | return control && std::holds_alternative<ScalarLogicalExpr>(control->u); |
89 | } |
90 | |
91 | bool DoConstruct::IsDoConcurrent() const { |
92 | const std::optional<LoopControl> &control{GetLoopControl()}; |
93 | return control && std::holds_alternative<LoopControl::Concurrent>(control->u); |
94 | } |
95 | |
96 | static Designator MakeArrayElementRef( |
97 | const Name &name, std::list<Expr> &&subscripts) { |
98 | ArrayElement arrayElement{DataRef{Name{name}}, std::list<SectionSubscript>{}}; |
99 | for (Expr &expr : subscripts) { |
100 | arrayElement.subscripts.push_back( |
101 | SectionSubscript{Integer{common::Indirection{std::move(expr)}}}); |
102 | } |
103 | return Designator{DataRef{common::Indirection{std::move(arrayElement)}}}; |
104 | } |
105 | |
106 | static Designator MakeArrayElementRef( |
107 | StructureComponent &&sc, std::list<Expr> &&subscripts) { |
108 | ArrayElement arrayElement{DataRef{common::Indirection{std::move(sc)}}, |
109 | std::list<SectionSubscript>{}}; |
110 | for (Expr &expr : subscripts) { |
111 | arrayElement.subscripts.push_back( |
112 | SectionSubscript{Integer{common::Indirection{std::move(expr)}}}); |
113 | } |
114 | return Designator{DataRef{common::Indirection{std::move(arrayElement)}}}; |
115 | } |
116 | |
117 | // Set source in any type of node that has it. |
118 | template <typename T> T WithSource(CharBlock source, T &&x) { |
119 | x.source = source; |
120 | return std::move(x); |
121 | } |
122 | |
123 | static Expr ActualArgToExpr(ActualArgSpec &arg) { |
124 | return common::visit( |
125 | common::visitors{ |
126 | [&](common::Indirection<Expr> &y) { return std::move(y.value()); }, |
127 | [&](common::Indirection<Variable> &y) { |
128 | return common::visit( |
129 | common::visitors{ |
130 | [&](common::Indirection<Designator> &z) { |
131 | return WithSource( |
132 | z.value().source, Expr{std::move(z.value())}); |
133 | }, |
134 | [&](common::Indirection<FunctionReference> &z) { |
135 | return WithSource( |
136 | z.value().source, Expr{std::move(z.value())}); |
137 | }, |
138 | }, |
139 | y.value().u); |
140 | }, |
141 | [&](auto &) -> Expr { common::die("unexpected type" ); }, |
142 | }, |
143 | std::get<ActualArg>(arg.t).u); |
144 | } |
145 | |
146 | Designator FunctionReference::ConvertToArrayElementRef() { |
147 | std::list<Expr> args; |
148 | for (auto &arg : std::get<std::list<ActualArgSpec>>(v.t)) { |
149 | args.emplace_back(ActualArgToExpr(arg)); |
150 | } |
151 | return common::visit( |
152 | common::visitors{ |
153 | [&](const Name &name) { |
154 | return WithSource( |
155 | source, MakeArrayElementRef(name, std::move(args))); |
156 | }, |
157 | [&](ProcComponentRef &pcr) { |
158 | return WithSource(source, |
159 | MakeArrayElementRef(std::move(pcr.v.thing), std::move(args))); |
160 | }, |
161 | }, |
162 | std::get<ProcedureDesignator>(v.t).u); |
163 | } |
164 | |
165 | StructureConstructor FunctionReference::ConvertToStructureConstructor( |
166 | const semantics::DerivedTypeSpec &derived) { |
167 | Name name{std::get<parser::Name>(std::get<ProcedureDesignator>(v.t).u)}; |
168 | std::list<ComponentSpec> components; |
169 | for (auto &arg : std::get<std::list<ActualArgSpec>>(v.t)) { |
170 | std::optional<Keyword> keyword; |
171 | if (auto &kw{std::get<std::optional<Keyword>>(arg.t)}) { |
172 | keyword.emplace(Keyword{Name{kw->v}}); |
173 | } |
174 | components.emplace_back( |
175 | std::move(keyword), ComponentDataSource{ActualArgToExpr(arg)}); |
176 | } |
177 | DerivedTypeSpec spec{std::move(name), std::list<TypeParamSpec>{}}; |
178 | spec.derivedTypeSpec = &derived; |
179 | return StructureConstructor{std::move(spec), std::move(components)}; |
180 | } |
181 | |
182 | StructureConstructor ArrayElement::ConvertToStructureConstructor( |
183 | const semantics::DerivedTypeSpec &derived) { |
184 | Name name{std::get<parser::Name>(base.u)}; |
185 | std::list<ComponentSpec> components; |
186 | for (auto &subscript : subscripts) { |
187 | components.emplace_back(std::optional<Keyword>{}, |
188 | ComponentDataSource{std::move(*Unwrap<Expr>(subscript))}); |
189 | } |
190 | DerivedTypeSpec spec{std::move(name), std::list<TypeParamSpec>{}}; |
191 | spec.derivedTypeSpec = &derived; |
192 | return StructureConstructor{std::move(spec), std::move(components)}; |
193 | } |
194 | |
195 | Substring ArrayElement::ConvertToSubstring() { |
196 | auto iter{subscripts.begin()}; |
197 | CHECK(iter != subscripts.end()); |
198 | auto &triplet{std::get<SubscriptTriplet>(iter->u)}; |
199 | CHECK(!std::get<2>(triplet.t)); |
200 | CHECK(++iter == subscripts.end()); |
201 | return Substring{std::move(base), |
202 | SubstringRange{std::get<0>(std::move(triplet.t)), |
203 | std::get<1>(std::move(triplet.t))}}; |
204 | } |
205 | |
206 | // R1544 stmt-function-stmt |
207 | // Convert this stmt-function-stmt to an assignment to the result of a |
208 | // pointer-valued function call -- which itself will be converted to a |
209 | // much more likely array element assignment statement if it needs |
210 | // to be. |
211 | Statement<ActionStmt> StmtFunctionStmt::ConvertToAssignment() { |
212 | auto &funcName{std::get<Name>(t)}; |
213 | auto &funcArgs{std::get<std::list<Name>>(t)}; |
214 | auto &funcExpr{std::get<Scalar<Expr>>(t).thing}; |
215 | CharBlock source{funcName.source}; |
216 | // Extend source to include closing parenthesis |
217 | if (funcArgs.empty()) { |
218 | CHECK(*source.end() == '('); |
219 | source = CharBlock{source.begin(), source.end() + 1}; |
220 | } |
221 | std::list<ActualArgSpec> actuals; |
222 | for (const Name &arg : funcArgs) { |
223 | actuals.emplace_back(std::optional<Keyword>{}, |
224 | ActualArg{Expr{WithSource( |
225 | arg.source, Designator{DataRef{Name{arg.source, arg.symbol}}})}}); |
226 | source.ExtendToCover(arg.source); |
227 | } |
228 | CHECK(*source.end() == ')'); |
229 | source = CharBlock{source.begin(), source.end() + 1}; |
230 | FunctionReference funcRef{ |
231 | Call{ProcedureDesignator{Name{funcName.source, funcName.symbol}}, |
232 | std::move(actuals)}}; |
233 | funcRef.source = source; |
234 | auto variable{Variable{common::Indirection{std::move(funcRef)}}}; |
235 | return Statement{std::nullopt, |
236 | ActionStmt{common::Indirection{ |
237 | AssignmentStmt{std::move(variable), std::move(funcExpr)}}}}; |
238 | } |
239 | |
240 | CharBlock Variable::GetSource() const { |
241 | return common::visit( |
242 | common::visitors{ |
243 | [&](const common::Indirection<Designator> &des) { |
244 | return des.value().source; |
245 | }, |
246 | [&](const common::Indirection<parser::FunctionReference> &call) { |
247 | return call.value().source; |
248 | }, |
249 | }, |
250 | u); |
251 | } |
252 | |
253 | llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Name &x) { |
254 | return os << x.ToString(); |
255 | } |
256 | |
257 | OmpDirectiveName::OmpDirectiveName(const Verbatim &name) { |
258 | std::string_view nameView{name.source.begin(), name.source.size()}; |
259 | std::string nameLower{ToLowerCaseLetters(nameView)}; |
260 | // The function getOpenMPDirectiveKind will return OMPD_unknown in two cases: |
261 | // (1) if the given string doesn't match any actual directive, or |
262 | // (2) if the given string was "unknown". |
263 | // The Verbatim(<token>) parser will succeed as long as the given token |
264 | // matches the source. |
265 | // Since using "construct<OmpDirectiveName>(verbatim(...))" will succeed |
266 | // if the verbatim parser succeeds, in order to get OMPD_unknown the |
267 | // token given to Verbatim must be invalid. Because it's an internal issue |
268 | // asserting is ok. |
269 | v = llvm::omp::getOpenMPDirectiveKind(nameLower); |
270 | assert(v != llvm::omp::Directive::OMPD_unknown && "Invalid directive name" ); |
271 | source = name.source; |
272 | } |
273 | |
274 | OmpDependenceType::Value OmpDoacross::GetDepType() const { |
275 | return common::visit( // |
276 | common::visitors{ |
277 | [](const OmpDoacross::Sink &) { |
278 | return OmpDependenceType::Value::Sink; |
279 | }, |
280 | [](const OmpDoacross::Source &) { |
281 | return OmpDependenceType::Value::Source; |
282 | }, |
283 | }, |
284 | u); |
285 | } |
286 | |
287 | OmpTaskDependenceType::Value OmpDependClause::TaskDep::GetTaskDepType() const { |
288 | using Modifier = OmpDependClause::TaskDep::Modifier; |
289 | auto &modifiers{std::get<std::optional<std::list<Modifier>>>(t)}; |
290 | if (modifiers) { |
291 | for (auto &m : *modifiers) { |
292 | if (auto *dep{std::get_if<OmpTaskDependenceType>(&m.u)}) { |
293 | return dep->v; |
294 | } |
295 | } |
296 | llvm_unreachable("expecting OmpTaskDependenceType in TaskDep" ); |
297 | } else { |
298 | llvm_unreachable("expecting modifiers on OmpDependClause::TaskDep" ); |
299 | } |
300 | } |
301 | |
302 | std::string OmpTraitSelectorName::ToString() const { |
303 | return common::visit( // |
304 | common::visitors{ |
305 | [&](Value v) { // |
306 | return std::string(EnumToString(v)); |
307 | }, |
308 | [&](llvm::omp::Directive d) { |
309 | return llvm::omp::getOpenMPDirectiveName( |
310 | d, llvm::omp::FallbackVersion) |
311 | .str(); |
312 | }, |
313 | [&](const std::string &s) { // |
314 | return s; |
315 | }, |
316 | }, |
317 | u); |
318 | } |
319 | |
320 | std::string OmpTraitSetSelectorName::ToString() const { |
321 | return std::string(EnumToString(v)); |
322 | } |
323 | |
324 | llvm::omp::Clause OpenMPAtomicConstruct::GetKind() const { |
325 | auto &dirSpec{std::get<OmpDirectiveSpecification>(t)}; |
326 | for (auto &clause : dirSpec.Clauses().v) { |
327 | switch (clause.Id()) { |
328 | case llvm::omp::Clause::OMPC_read: |
329 | case llvm::omp::Clause::OMPC_write: |
330 | case llvm::omp::Clause::OMPC_update: |
331 | return clause.Id(); |
332 | default: |
333 | break; |
334 | } |
335 | } |
336 | return llvm::omp::Clause::OMPC_update; |
337 | } |
338 | |
339 | bool OpenMPAtomicConstruct::IsCapture() const { |
340 | auto &dirSpec{std::get<OmpDirectiveSpecification>(t)}; |
341 | return llvm::any_of(dirSpec.Clauses().v, [](auto &clause) { |
342 | return clause.Id() == llvm::omp::Clause::OMPC_capture; |
343 | }); |
344 | } |
345 | |
346 | bool OpenMPAtomicConstruct::IsCompare() const { |
347 | auto &dirSpec{std::get<OmpDirectiveSpecification>(t)}; |
348 | return llvm::any_of(dirSpec.Clauses().v, [](auto &clause) { |
349 | return clause.Id() == llvm::omp::Clause::OMPC_compare; |
350 | }); |
351 | } |
352 | } // namespace Fortran::parser |
353 | |
354 | template <typename C> static llvm::omp::Clause getClauseIdForClass(C &&) { |
355 | using namespace Fortran; |
356 | using A = llvm::remove_cvref_t<C>; // A is referenced in OMP.inc |
357 | // The code included below contains a sequence of checks like the following |
358 | // for each OpenMP clause |
359 | // if constexpr (std::is_same_v<A, parser::OmpClause::AcqRel>) |
360 | // return llvm::omp::Clause::OMPC_acq_rel; |
361 | // [...] |
362 | #define GEN_FLANG_CLAUSE_PARSER_KIND_MAP |
363 | #include "llvm/Frontend/OpenMP/OMP.inc" |
364 | } |
365 | |
366 | namespace Fortran::parser { |
367 | llvm::omp::Clause OmpClause::Id() const { |
368 | return std::visit([](auto &&s) { return getClauseIdForClass(s); }, u); |
369 | } |
370 | |
371 | const OmpArgumentList &OmpDirectiveSpecification::Arguments() const { |
372 | static OmpArgumentList empty{decltype(OmpArgumentList::v){}}; |
373 | if (auto &arguments = std::get<std::optional<OmpArgumentList>>(t)) { |
374 | return *arguments; |
375 | } |
376 | return empty; |
377 | } |
378 | |
379 | const OmpClauseList &OmpDirectiveSpecification::Clauses() const { |
380 | static OmpClauseList empty{decltype(OmpClauseList::v){}}; |
381 | if (auto &clauses = std::get<std::optional<OmpClauseList>>(t)) { |
382 | return *clauses; |
383 | } |
384 | return empty; |
385 | } |
386 | } // namespace Fortran::parser |
387 | |