return *this;
}
+IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_subscriptIntegerKind(
+ int k) {
+ subscriptIntegerKind_ = k;
+ return *this;
+}
+
IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_defaultRealKind(
int k) {
defaultRealKind_ = k;
#define FORTRAN_COMMON_DEFAULT_KINDS_H_
#include "Fortran.h"
-#include <cstdint>
// Represent the default values of the kind parameters of the
-// various intrinsic types. Most of these can be configured by
-// means of the compiler command line; subscriptIntegerKind,
-// however, is fixed at 8 because all address calculations are
-// 64-bit safe.
+// various intrinsic types. These can be configured by means of
+// the compiler command line.
namespace Fortran::common {
-using SubscriptCIntType = std::int64_t;
-
class IntrinsicTypeDefaultKinds {
public:
IntrinsicTypeDefaultKinds();
- static constexpr int subscriptIntegerKind() { return 8; }
+ int subscriptIntegerKind() const { return subscriptIntegerKind_; }
int doublePrecisionKind() const { return doublePrecisionKind_; }
int quadPrecisionKind() const { return quadPrecisionKind_; }
IntrinsicTypeDefaultKinds &set_defaultIntegerKind(int);
+ IntrinsicTypeDefaultKinds &set_subscriptIntegerKind(int);
IntrinsicTypeDefaultKinds &set_defaultRealKind(int);
IntrinsicTypeDefaultKinds &set_doublePrecisionKind(int);
IntrinsicTypeDefaultKinds &set_quadPrecisionKind(int);
// storage unit, so their kinds are also forced. Default COMPLEX must always
// comprise two default REAL components.
int defaultIntegerKind_{4};
+ int subscriptIntegerKind_{8}; // for large arrays
int defaultRealKind_{defaultIntegerKind_};
int doublePrecisionKind_{2 * defaultRealKind_};
int quadPrecisionKind_{2 * doublePrecisionKind_};
-// Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved.
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
}
}
-common::SubscriptCIntType &FoldingContext::StartImpliedDo(
- parser::CharBlock name, common::SubscriptCIntType n) {
+std::int64_t &FoldingContext::StartImpliedDo(
+ parser::CharBlock name, std::int64_t n) {
auto pair{impliedDos_.insert(std::make_pair(name, n))};
CHECK(pair.second);
return pair.first->second;
}
-std::optional<common::SubscriptCIntType> FoldingContext::GetImpliedDo(
+std::optional<std::int64_t> FoldingContext::GetImpliedDo(
parser::CharBlock name) const {
if (auto iter{impliedDos_.find(name)}; iter != impliedDos_.cend()) {
return {iter->second};
#include "intrinsics-library.h"
#include "../common/Fortran.h"
-#include "../common/default-kinds.h"
#include "../common/enum-set.h"
#include "../common/idioms.h"
#include "../common/indirection.h"
return hostIntrinsicsLibrary_;
}
- common::SubscriptCIntType &StartImpliedDo(
- parser::CharBlock, common::SubscriptCIntType = 1);
- std::optional<common::SubscriptCIntType> GetImpliedDo(
- parser::CharBlock) const;
+ std::int64_t &StartImpliedDo(parser::CharBlock, std::int64_t = 1);
+ std::optional<std::int64_t> GetImpliedDo(parser::CharBlock) const;
void EndImpliedDo(parser::CharBlock);
- std::map<parser::CharBlock, common::SubscriptCIntType> &impliedDos() {
+ std::map<parser::CharBlock, std::int64_t> &impliedDos() {
return impliedDos_;
}
bool flushSubnormalsToZero_{false};
bool bigEndian_{false};
const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
- std::map<parser::CharBlock, common::SubscriptCIntType> impliedDos_;
+ std::map<parser::CharBlock, std::int64_t> impliedDos_;
HostIntrinsicProceduresLibrary hostIntrinsicsLibrary_;
};
template<int KIND>
Constant<Type<TypeCategory::Character, KIND>>::Constant(
const Scalar<Result> &str)
- : values_{str}, length_{static_cast<LengthCIntType>(values_.size())} {}
+ : values_{str}, length_{static_cast<std::int64_t>(values_.size())} {}
template<int KIND>
Constant<Type<TypeCategory::Character, KIND>>::Constant(Scalar<Result> &&str)
: values_{std::move(str)}, length_{
- static_cast<LengthCIntType>(values_.size())} {}
+ static_cast<std::int64_t>(values_.size())} {}
template<int KIND>
-Constant<Type<TypeCategory::Character, KIND>>::Constant(LengthCIntType len,
+Constant<Type<TypeCategory::Character, KIND>>::Constant(std::int64_t len,
std::vector<Scalar<Result>> &&strings, ConstantSubscripts &&dims)
: length_{len}, shape_{std::move(dims)} {
CHECK(strings.size() == TotalElementCount(shape_));
values_.assign(strings.size() * length_,
static_cast<typename Scalar<Result>::value_type>(' '));
- LengthCIntType at{0};
+ std::int64_t at{0};
for (const auto &str : strings) {
- auto strLen{static_cast<LengthCIntType>(str.size())};
+ auto strLen{static_cast<std::int64_t>(str.size())};
if (strLen > length_) {
values_.replace(at, length_, str.substr(0, length_));
} else {
}
at += length_;
}
- CHECK(at == static_cast<LengthCIntType>(values_.size()));
+ CHECK(at == static_cast<std::int64_t>(values_.size()));
}
template<int KIND> Constant<Type<TypeCategory::Character, KIND>>::~Constant() {}
if (length_ == 0) {
return TotalElementCount(shape_);
} else {
- return static_cast<LengthCIntType>(values_.size()) / length_;
+ return static_cast<std::int64_t>(values_.size()) / length_;
}
}
std::size_t n{TotalElementCount(dims)};
CHECK(!empty() || n == 0);
std::vector<Element> elements;
- LengthCIntType at{0}, limit{static_cast<LengthCIntType>(values_.size())};
+ std::int64_t at{0}, limit{static_cast<std::int64_t>(values_.size())};
while (n-- > 0) {
elements.push_back(values_.substr(at, length_));
at += length_;
#include "formatting.h"
#include "type.h"
-#include "../common/default-kinds.h"
#include <map>
#include <ostream>
#include <vector>
// When describing shapes of constants or specifying 1-based subscript
// values as indices into constants, use a vector of integers.
-using ConstantSubscript = common::SubscriptCIntType;
+using ConstantSubscript = std::int64_t;
using ConstantSubscripts = std::vector<ConstantSubscript>;
inline int GetRank(const ConstantSubscripts &s) {
return static_cast<int>(s.size());
}
-using LengthCIntType = common::SubscriptCIntType;
-
std::size_t TotalElementCount(const ConstantSubscripts &);
inline ConstantSubscripts InitialSubscripts(int rank) {
CLASS_BOILERPLATE(Constant)
explicit Constant(const Scalar<Result> &);
explicit Constant(Scalar<Result> &&);
- Constant(LengthCIntType, std::vector<Element> &&, ConstantSubscripts &&);
+ Constant(std::int64_t, std::vector<Element> &&, ConstantSubscripts &&);
~Constant();
int Rank() const { return GetRank(shape_); }
std::size_t size() const;
const ConstantSubscripts &shape() const { return shape_; }
- LengthCIntType LEN() const { return length_; }
+ std::int64_t LEN() const { return length_; }
std::optional<Scalar<Result>> GetScalarValue() const {
if (shape_.empty()) {
private:
Scalar<Result> values_; // one contiguous string
- LengthCIntType length_;
+ std::int64_t length_;
ConstantSubscripts shape_;
};
}
// Build and return constant result
if constexpr (TR::category == TypeCategory::Character) {
- auto len{static_cast<LengthCIntType>(
- results.size() ? results[0].length() : 0)};
+ std::int64_t len{
+ static_cast<std::int64_t>(results.size() ? results[0].length() : 0)};
return Expr<TR>{Constant<TR>{len, std::move(results), std::move(shape)}};
} else {
return Expr<TR>{Constant<TR>{std::move(results), std::move(shape)}};
}
},
[](Triplet &triplet) -> std::optional<Constant<SubscriptInteger>> {
- std::optional<ConstantSubscript> lbi{1}, ubi;
- std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
+ std::optional<std::int64_t> lbi{1}, ubi;
+ std::optional<std::int64_t> stride{ToInt64(triplet.stride())};
if (auto lower{triplet.lower()}) {
lbi = ToInt64(*lower);
}
for (const auto &ss : subscripts) {
CHECK(ss.Rank() <= 1);
if (ss.Rank() == 1) {
- resultShape.push_back(static_cast<ConstantSubscript>(ss.size()));
+ resultShape.push_back(static_cast<std::int64_t>(ss.size()));
elements *= ss.size();
}
}
Expr<ImpliedDoIndex::Result> FoldOperation(
FoldingContext &context, ImpliedDoIndex &&iDo) {
- if (std::optional<common::SubscriptCIntType> value{
- context.GetImpliedDo(iDo.name)}) {
+ if (std::optional<std::int64_t> value{context.GetImpliedDo(iDo.name)}) {
return Expr<ImpliedDoIndex::Result>{*value};
} else {
return Expr<ImpliedDoIndex::Result>{std::move(iDo)};
Expr<T> FoldArray(ArrayConstructor<T> &&array) {
// Calls FoldArray(const ArrayConstructorValues<T> &) below
if (FoldArray(array)) {
- auto n{static_cast<ConstantSubscript>(elements_.size())};
+ auto n{static_cast<std::int64_t>(elements_.size())};
if constexpr (std::is_same_v<T, SomeDerived>) {
return Expr<T>{Constant<T>{array.GetType().GetDerivedTypeSpec(),
std::move(elements_), ConstantSubscripts{n}}};
} else if constexpr (T::category == TypeCategory::Character) {
auto length{Fold(context_, common::Clone(array.LEN()))};
- if (std::optional<LengthCIntType> lengthValue{ToInt64(length)}) {
+ if (std::optional<std::int64_t> lengthValue{ToInt64(length)}) {
return Expr<T>{Constant<T>{
*lengthValue, std::move(elements_), ConstantSubscripts{n}}};
}
Fold(context_, Expr<SubscriptInteger>{iDo.upper()})};
Expr<SubscriptInteger> stride{
Fold(context_, Expr<SubscriptInteger>{iDo.stride()})};
- std::optional<common::SubscriptCIntType> start{ToInt64(lower)},
- end{ToInt64(upper)}, step{ToInt64(stride)};
+ std::optional<std::int64_t> start{ToInt64(lower)}, end{ToInt64(upper)},
+ step{ToInt64(stride)};
if (start.has_value() && end.has_value() && step.has_value()) {
if (*step == 0) {
return false;
}
bool result{true};
- common::SubscriptCIntType &j{context_.StartImpliedDo(iDo.name(), *start)};
+ std::int64_t &j{context_.StartImpliedDo(iDo.name(), *start)};
if (*step > 0) {
for (; j <= *end; j += *step) {
result &= FoldArray(iDo.values());
}
using Result = Type<TypeCategory::Character, KIND>;
if (auto folded{OperandsAreConstants(x)}) {
- auto oldLength{static_cast<LengthCIntType>(folded->first.size())};
+ auto oldLength{static_cast<std::int64_t>(folded->first.size())};
auto newLength{folded->second.ToInt64()};
if (newLength < oldLength) {
folded->first.erase(newLength);
} else {
folded->first.append(newLength - oldLength, ' ');
}
- CHECK(static_cast<LengthCIntType>(folded->first.size()) == newLength);
+ CHECK(static_cast<std::int64_t>(folded->first.size()) == newLength);
return Expr<Result>{Constant<Result>{std::move(folded->first)}};
}
return Expr<Result>{std::move(x)};
if (Rank() > 0) {
o << '[' << GetType().AsFortran(std::to_string(length_)) << "::";
}
- auto total{static_cast<LengthCIntType>(size())};
- for (LengthCIntType j{0}; j < total; ++j) {
+ auto total{static_cast<std::int64_t>(size())};
+ for (std::int64_t j{0}; j < total; ++j) {
Scalar<Result> value{values_.substr(j * length_, length_)};
if (j > 0) {
o << ',';
lower_ = AsExpr(Constant<SubscriptInteger>{1});
}
lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
- std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
+ std::optional<std::int64_t> lbi{ToInt64(lower_.value().value())};
if (lbi.has_value() && *lbi < 1) {
context.messages().Say(
"Lower bound (%jd) on substring is less than one"_en_US,
upper_ = upper();
}
upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
- if (std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())}) {
+ if (std::optional<std::int64_t> ubi{ToInt64(upper_.value().value())}) {
auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)};
- std::optional<LengthCIntType> length;
+ std::optional<std::int64_t> length;
if (literal != nullptr) {
length = (*literal)->data().size();
} else if (const Symbol * symbol{GetLastSymbol()}) {
} else if (length.has_value() && *ubi > *length) {
context.messages().Say("Upper bound (%jd) on substring is greater "
"than character length (%jd)"_en_US,
- static_cast<std::intmax_t>(*ubi),
- static_cast<std::intmax_t>(*length));
+ static_cast<std::intmax_t>(*ubi), static_cast<std::int64_t>(*length));
*ubi = *length;
}
if (lbi.has_value() && literal != nullptr) {
}
parent_ = newStaticData;
lower_ = AsExpr(Constant<SubscriptInteger>{1});
- LengthCIntType length = newStaticData->data().size();
+ std::int64_t length = newStaticData->data().size();
upper_ = AsExpr(Constant<SubscriptInteger>{length});
switch (width) {
case 1:
defaultKinds.set_defaultRealKind(8);
} else if (arg == "-i8" || arg == "-fdefault-integer-8") {
defaultKinds.set_defaultIntegerKind(8);
+ } else if (arg == "-fno-large-arrays") {
+ defaultKinds.set_subscriptIntegerKind(4);
} else if (arg == "-help" || arg == "--help" || arg == "-?") {
std::cerr
<< "f18-parse-demo options:\n"
defaultKinds.set_defaultRealKind(8);
} else if (arg == "-i8" || arg == "-fdefault-integer-8") {
defaultKinds.set_defaultIntegerKind(8);
+ } else if (arg == "-fno-large-arrays") {
+ defaultKinds.set_subscriptIntegerKind(4);
} else if (arg == "-module") {
driver.moduleDirectory = args.front();
args.pop_front();