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