@@ -1600,16 +1600,23 @@ class ArrayConstructorContext {
1600
1600
parser::CharBlock name, std::int64_t lower, std::int64_t upper,
1601
1601
std::int64_t stride);
1602
1602
1603
- template <int KIND, typename A >
1604
- std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr (
1605
- const A &x ) {
1606
- if (MaybeExpr y{exprAnalyzer_. Analyze (x)} ) {
1603
+ template <int KIND>
1604
+ std::optional<Expr<Type<TypeCategory::Integer, KIND>>> ToSpecificInt (
1605
+ MaybeExpr &&y ) {
1606
+ if (y ) {
1607
1607
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
1608
1608
return Fold (exprAnalyzer_.GetFoldingContext (),
1609
1609
ConvertToType<Type<TypeCategory::Integer, KIND>>(
1610
1610
std::move (DEREF (intExpr))));
1611
+ } else {
1612
+ return std::nullopt;
1611
1613
}
1612
- return std::nullopt;
1614
+ }
1615
+
1616
+ template <int KIND, typename A>
1617
+ std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr (
1618
+ const A &x) {
1619
+ return ToSpecificInt<KIND>(exprAnalyzer_.Analyze (x));
1613
1620
}
1614
1621
1615
1622
// Nested array constructors all reference the same ExpressionAnalyzer,
@@ -1772,26 +1779,45 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
1772
1779
1773
1780
// Transforms l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
1774
1781
void ArrayConstructorContext::Add (const parser::AcValue::Triplet &triplet) {
1775
- std::optional<Expr<ImpliedDoIntType>> lower{
1776
- GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<0 >(triplet.t ))};
1777
- std::optional<Expr<ImpliedDoIntType>> upper{
1778
- GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<1 >(triplet.t ))};
1779
- std::optional<Expr<ImpliedDoIntType>> stride{
1780
- GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<2 >(triplet.t ))};
1781
- if (lower && upper) {
1782
- if (!stride) {
1783
- stride = Expr<ImpliedDoIntType>{1 };
1784
- }
1785
- if (!type_) {
1786
- type_ = DynamicTypeWithLength{ImpliedDoIntType::GetType ()};
1782
+ MaybeExpr lowerExpr{exprAnalyzer_.Analyze (std::get<0 >(triplet.t ))};
1783
+ MaybeExpr upperExpr{exprAnalyzer_.Analyze (std::get<1 >(triplet.t ))};
1784
+ MaybeExpr strideExpr{exprAnalyzer_.Analyze (std::get<2 >(triplet.t ))};
1785
+ if (lowerExpr && upperExpr) {
1786
+ auto lowerType{lowerExpr->GetType ()};
1787
+ auto upperType{upperExpr->GetType ()};
1788
+ auto strideType{strideExpr ? strideExpr->GetType () : lowerType};
1789
+ if (lowerType && upperType && strideType) {
1790
+ int kind{lowerType->kind ()};
1791
+ if (upperType->kind () > kind) {
1792
+ kind = upperType->kind ();
1793
+ }
1794
+ if (strideType->kind () > kind) {
1795
+ kind = strideType->kind ();
1796
+ }
1797
+ auto lower{ToSpecificInt<ImpliedDoIntType::kind>(std::move (lowerExpr))};
1798
+ auto upper{ToSpecificInt<ImpliedDoIntType::kind>(std::move (upperExpr))};
1799
+ if (lower && upper) {
1800
+ auto stride{
1801
+ ToSpecificInt<ImpliedDoIntType::kind>(std::move (strideExpr))};
1802
+ if (!stride) {
1803
+ stride = Expr<ImpliedDoIntType>{1 };
1804
+ }
1805
+ DynamicType type{TypeCategory::Integer, kind};
1806
+ if (!type_) {
1807
+ type_ = DynamicTypeWithLength{type};
1808
+ }
1809
+ parser::CharBlock anonymous;
1810
+ if (auto converted{ConvertToType (type,
1811
+ AsGenericExpr (
1812
+ Expr<ImpliedDoIntType>{ImpliedDoIndex{anonymous}}))}) {
1813
+ auto v{std::move (values_)};
1814
+ Push (std::move (converted));
1815
+ std::swap (v, values_);
1816
+ values_.Push (ImpliedDo<SomeType>{anonymous, std::move (*lower),
1817
+ std::move (*upper), std::move (*stride), std::move (v)});
1818
+ }
1819
+ }
1787
1820
}
1788
- auto v{std::move (values_)};
1789
- parser::CharBlock anonymous;
1790
- Push (Expr<SomeType>{
1791
- Expr<SomeInteger>{Expr<ImpliedDoIntType>{ImpliedDoIndex{anonymous}}}});
1792
- std::swap (v, values_);
1793
- values_.Push (ImpliedDo<SomeType>{anonymous, std::move (*lower),
1794
- std::move (*upper), std::move (*stride), std::move (v)});
1795
1821
}
1796
1822
}
1797
1823
0 commit comments