1 //===-- lib/Parser/parse-tree.cpp -----------------------------------------===//
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
7 //===----------------------------------------------------------------------===//
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"
17 namespace Fortran::parser
{
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());
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
));
34 bool Designator::EndsInBareName() const {
37 [](const DataRef
&dr
) {
38 return std::holds_alternative
<Name
>(dr
.u
) ||
39 std::holds_alternative
<common::Indirection
<StructureComponent
>>(
42 [](const Substring
&) { return false; },
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()};
52 u
= common::Indirection
<StructureComponent
>::Make(
53 std::move(*this), std::move(pr
.name
));
55 if (!pr
.subscripts
.empty()) {
56 u
= common::Indirection
<ArrayElement
>::Make(
57 std::move(*this), std::move(pr
.subscripts
));
59 if (pr
.imageSelector
) {
60 u
= common::Indirection
<CoindexedNamedObject
>::Make(
61 std::move(*this), std::move(*pr
.imageSelector
));
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
))} {}
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
)};
80 bool DoConstruct::IsDoNormal() const {
81 const std::optional
<LoopControl
> &control
{GetLoopControl()};
82 return control
&& std::holds_alternative
<LoopControl::Bounds
>(control
->u
);
85 bool DoConstruct::IsDoWhile() const {
86 const std::optional
<LoopControl
> &control
{GetLoopControl()};
87 return control
&& std::holds_alternative
<ScalarLogicalExpr
>(control
->u
);
90 bool DoConstruct::IsDoConcurrent() const {
91 const std::optional
<LoopControl
> &control
{GetLoopControl()};
92 return control
&& std::holds_alternative
<LoopControl::Concurrent
>(control
->u
);
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
)}}});
102 return Designator
{DataRef
{common::Indirection
{std::move(arrayElement
)}}};
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
)}}});
113 return Designator
{DataRef
{common::Indirection
{std::move(arrayElement
)}}};
116 // Set source in any type of node that has it.
117 template <typename T
> T
WithSource(CharBlock source
, T
&&x
) {
122 static Expr
ActualArgToExpr(ActualArgSpec
&arg
) {
125 [&](common::Indirection
<Expr
> &y
) { return std::move(y
.value()); },
126 [&](common::Indirection
<Variable
> &y
) {
129 [&](common::Indirection
<Designator
> &z
) {
131 z
.value().source
, Expr
{std::move(z
.value())});
133 [&](common::Indirection
<FunctionReference
> &z
) {
135 z
.value().v
.source
, Expr
{std::move(z
.value())});
140 [&](auto &) -> Expr
{ common::die("unexpected type"); },
142 std::get
<ActualArg
>(arg
.t
).u
);
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
));
152 [&](const Name
&name
) {
154 v
.source
, MakeArrayElementRef(name
, std::move(args
)));
156 [&](ProcComponentRef
&pcr
) {
157 return WithSource(v
.source
,
158 MakeArrayElementRef(std::move(pcr
.v
.thing
), std::move(args
)));
161 std::get
<ProcedureDesignator
>(v
.t
).u
);
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
}});
173 components
.emplace_back(
174 std::move(keyword
), ComponentDataSource
{ActualArgToExpr(arg
)});
176 DerivedTypeSpec spec
{std::move(name
), std::list
<TypeParamSpec
>{}};
177 spec
.derivedTypeSpec
= &derived
;
178 return StructureConstructor
{std::move(spec
), std::move(components
)};
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
))});
189 DerivedTypeSpec spec
{std::move(name
), std::list
<TypeParamSpec
>{}};
190 spec
.derivedTypeSpec
= &derived
;
191 return StructureConstructor
{std::move(spec
), std::move(components
)};
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
))}};
205 // R1544 stmt-function-stmt
206 // Convert this stmt-function-stmt to an array element assignment statement.
207 Statement
<ActionStmt
> StmtFunctionStmt::ConvertToAssignment() {
208 auto &funcName
{std::get
<Name
>(t
)};
209 auto &funcArgs
{std::get
<std::list
<Name
>>(t
)};
210 auto &funcExpr
{std::get
<Scalar
<Expr
>>(t
).thing
};
211 CharBlock source
{funcName
.source
};
212 std::list
<Expr
> subscripts
;
213 for (Name
&arg
: funcArgs
) {
214 subscripts
.push_back(WithSource(arg
.source
,
215 Expr
{common::Indirection
{
216 WithSource(arg
.source
, Designator
{DataRef
{Name
{arg
}}})}}));
217 source
.ExtendToCover(arg
.source
);
219 // extend source to include closing paren
220 if (funcArgs
.empty()) {
221 CHECK(*source
.end() == '(');
222 source
= CharBlock
{source
.begin(), source
.end() + 1};
224 CHECK(*source
.end() == ')');
225 source
= CharBlock
{source
.begin(), source
.end() + 1};
226 auto variable
{Variable
{common::Indirection
{WithSource(
227 source
, MakeArrayElementRef(funcName
, std::move(subscripts
)))}}};
228 return Statement
{std::nullopt
,
229 ActionStmt
{common::Indirection
{
230 AssignmentStmt
{std::move(variable
), std::move(funcExpr
)}}}};
233 CharBlock
Variable::GetSource() const {
236 [&](const common::Indirection
<Designator
> &des
) {
237 return des
.value().source
;
239 [&](const common::Indirection
<parser::FunctionReference
> &call
) {
240 return call
.value().v
.source
;
246 llvm::raw_ostream
&operator<<(llvm::raw_ostream
&os
, const Name
&x
) {
247 return os
<< x
.ToString();
249 } // namespace Fortran::parser