forked from OSchip/llvm-project
[flang] Fold MERGE, use it in ISO_FORTRAN_ENV
Reduce use of intrinsic type KIND codes in ISO_FORTRAN_ENV Use COUNT([x]) rather than MERGE(1,0,x) Fix problems in array constructor expression analysis Original-commit: flang-compiler/f18@79018f7126 Reviewed-on: https://github.com/flang-compiler/f18/pull/836
This commit is contained in:
peter klausler
parent
fe7e36d46c
commit
e46cd9ee18
|
|
@ -364,7 +364,6 @@ Expr<T> Reshape(FoldingContext &context, FunctionRef<T> &&funcRef) {
|
|||
std::optional<std::vector<ConstantSubscript>> shape{
|
||||
GetIntegerVector<ConstantSubscript>(args[1])};
|
||||
std::optional<std::vector<int>> order{GetIntegerVector<int>(args[3])};
|
||||
|
||||
if (!source || !shape || (args[2] && !pad) || (args[3] && !order)) {
|
||||
return Expr<T>{std::move(funcRef)}; // Non-constant arguments
|
||||
} else if (!IsValidShape(shape.value())) {
|
||||
|
|
@ -565,6 +564,17 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
|
|||
return Expr<T>{std::move(funcRef)};
|
||||
}
|
||||
|
||||
template<typename T>
|
||||
Expr<T> FoldMerge(FoldingContext &context, FunctionRef<T> &&funcRef) {
|
||||
return FoldElementalIntrinsic<T, T, T, LogicalResult>(context,
|
||||
std::move(funcRef),
|
||||
ScalarFunc<T, T, T, LogicalResult>(
|
||||
[](const Scalar<T> &ifTrue, const Scalar<T> &ifFalse,
|
||||
const Scalar<LogicalResult> &predicate) -> Scalar<T> {
|
||||
return predicate.IsTrue() ? ifTrue : ifFalse;
|
||||
}));
|
||||
}
|
||||
|
||||
template<int KIND>
|
||||
Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
|
||||
FoldingContext &context,
|
||||
|
|
@ -587,6 +597,18 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
|
|||
}));
|
||||
} else if (name == "bit_size") {
|
||||
return Expr<T>{Scalar<T>::bits};
|
||||
} else if (name == "count") {
|
||||
if (!args[1]) { // TODO: COUNT(x,DIM=d)
|
||||
if (const auto *constant{UnwrapConstantValue<LogicalResult>(args[0])}) {
|
||||
std::int64_t result{0};
|
||||
for (const auto &element : constant->values()) {
|
||||
if (element.IsTrue()) {
|
||||
++result;
|
||||
}
|
||||
}
|
||||
return Expr<T>{result};
|
||||
}
|
||||
}
|
||||
} else if (name == "digits") {
|
||||
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
|
||||
return Expr<T>{std::visit(
|
||||
|
|
@ -780,6 +802,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
|
|||
},
|
||||
sx->u);
|
||||
}
|
||||
} else if (name == "merge") {
|
||||
return FoldMerge<T>(context, std::move(funcRef));
|
||||
} else if (name == "merge_bits") {
|
||||
return FoldElementalIntrinsic<T, T, T, T>(
|
||||
context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
|
||||
|
|
@ -898,9 +922,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
|
|||
return UBOUND(context, std::move(funcRef));
|
||||
}
|
||||
// TODO:
|
||||
// ceiling, count, cshift, dot_product, eoshift,
|
||||
// ceiling, cshift, dot_product, eoshift,
|
||||
// findloc, floor, iall, iany, iparity, ibits, image_status, index, ishftc,
|
||||
// len_trim, matmul, max, maxloc, maxval, merge, min,
|
||||
// len_trim, matmul, maxloc, maxval,
|
||||
// minloc, minval, mod, modulo, nint, not, pack, product, reduce,
|
||||
// scan, sign, spread, sum, transfer, transpose, unpack, verify
|
||||
return Expr<T>{std::move(funcRef)};
|
||||
|
|
@ -1037,6 +1061,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
|
|||
return Expr<T>{Scalar<T>::HUGE()};
|
||||
} else if (name == "max") {
|
||||
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
|
||||
} else if (name == "merge") {
|
||||
return FoldMerge<T>(context, std::move(funcRef));
|
||||
} else if (name == "min") {
|
||||
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
|
||||
} else if (name == "real") {
|
||||
|
|
@ -1050,7 +1076,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
|
|||
return Expr<T>{Scalar<T>::TINY()};
|
||||
}
|
||||
// TODO: anint, cshift, dim, dot_product, eoshift, fraction, matmul,
|
||||
// max, maxval, merge, min, minval, modulo, nearest, norm2, pack, product,
|
||||
// maxval, minval, modulo, nearest, norm2, pack, product,
|
||||
// reduce, rrspacing, scale, set_exponent, spacing, spread,
|
||||
// sum, transfer, transpose, unpack, bessel_jn (transformational) and
|
||||
// bessel_yn (transformational)
|
||||
|
|
@ -1100,8 +1126,10 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
|
|||
return Fold(context,
|
||||
Expr<T>{ComplexConstructor<KIND>{ToReal<KIND>(context, std::move(re)),
|
||||
ToReal<KIND>(context, std::move(im))}});
|
||||
} else if (name == "merge") {
|
||||
return FoldMerge<T>(context, std::move(funcRef));
|
||||
}
|
||||
// TODO: cshift, dot_product, eoshift, matmul, merge, pack, product,
|
||||
// TODO: cshift, dot_product, eoshift, matmul, pack, product,
|
||||
// reduce, spread, sum, transfer, transpose, unpack
|
||||
return Expr<T>{std::move(funcRef)};
|
||||
}
|
||||
|
|
@ -1172,9 +1200,11 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
|
|||
[&fptr](const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
|
||||
return Scalar<T>{std::invoke(fptr, i, j)};
|
||||
}));
|
||||
} else if (name == "merge") {
|
||||
return FoldMerge<T>(context, std::move(funcRef));
|
||||
}
|
||||
// TODO: btest, cshift, dot_product, eoshift, is_iostat_end,
|
||||
// is_iostat_eor, lge, lgt, lle, llt, logical, matmul, merge, out_of_range,
|
||||
// is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
|
||||
// pack, parity, reduce, spread, transfer, transpose, unpack
|
||||
return Expr<T>{std::move(funcRef)};
|
||||
}
|
||||
|
|
@ -1201,12 +1231,14 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
|
|||
context, std::move(funcRef), CharacterUtils<KIND>::ADJUSTR);
|
||||
} else if (name == "max") {
|
||||
return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
|
||||
} else if (name == "merge") {
|
||||
return FoldMerge<T>(context, std::move(funcRef));
|
||||
} else if (name == "min") {
|
||||
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
|
||||
} else if (name == "new_line") {
|
||||
return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}};
|
||||
}
|
||||
// TODO: cshift, eoshift, max, maxval, merge, min, minval, pack, reduce,
|
||||
// TODO: cshift, eoshift, maxval, minval, pack, reduce,
|
||||
// repeat, spread, transfer, transpose, trim, unpack
|
||||
return Expr<T>{std::move(funcRef)};
|
||||
}
|
||||
|
|
@ -1643,10 +1675,7 @@ private:
|
|||
Fold(context_, Expr<SubscriptInteger>{iDo.stride()})};
|
||||
std::optional<ConstantSubscript> start{ToInt64(lower)}, end{ToInt64(upper)},
|
||||
step{ToInt64(stride)};
|
||||
if (start && end && step) {
|
||||
if (*step == 0) {
|
||||
return false;
|
||||
}
|
||||
if (start && end && step && *step != 0) {
|
||||
bool result{true};
|
||||
ConstantSubscript &j{context_.StartImpliedDo(iDo.name(), *start)};
|
||||
if (*step > 0) {
|
||||
|
|
|
|||
|
|
@ -1058,31 +1058,83 @@ int ExpressionAnalyzer::IntegerTypeSpecKind(
|
|||
|
||||
// Array constructors
|
||||
|
||||
class ArrayConstructorContext : private ExpressionAnalyzer {
|
||||
// Inverts a collection of generic ArrayConstructorValues<SomeType> that
|
||||
// all happen to have the same actual type T into one ArrayConstructor<T>.
|
||||
template<typename T>
|
||||
ArrayConstructorValues<T> MakeSpecific(
|
||||
ArrayConstructorValues<SomeType> &&from) {
|
||||
ArrayConstructorValues<T> to;
|
||||
for (ArrayConstructorValue<SomeType> &x : from) {
|
||||
std::visit(
|
||||
common::visitors{
|
||||
[&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
|
||||
auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
|
||||
to.Push(std::move(DEREF(typed)));
|
||||
},
|
||||
[&](ImpliedDo<SomeType> &&impliedDo) {
|
||||
to.Push(ImpliedDo<T>{impliedDo.name(),
|
||||
std::move(impliedDo.lower()), std::move(impliedDo.upper()),
|
||||
std::move(impliedDo.stride()),
|
||||
MakeSpecific<T>(std::move(impliedDo.values()))});
|
||||
},
|
||||
},
|
||||
std::move(x.u));
|
||||
}
|
||||
return to;
|
||||
}
|
||||
|
||||
class ArrayConstructorContext {
|
||||
public:
|
||||
ArrayConstructorContext(
|
||||
ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &t)
|
||||
: ExpressionAnalyzer{c}, type_{t} {}
|
||||
ArrayConstructorContext(ArrayConstructorContext &) = default;
|
||||
void Push(MaybeExpr &&);
|
||||
void Add(const parser::AcValue &);
|
||||
std::optional<DynamicTypeWithLength> &type() const { return type_; }
|
||||
const ArrayConstructorValues<SomeType> &values() { return values_; }
|
||||
ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &&t)
|
||||
: exprAnalyzer_{c}, type_{std::move(t)} {}
|
||||
|
||||
private:
|
||||
template<int KIND, typename A>
|
||||
std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
|
||||
const A &x) {
|
||||
if (MaybeExpr y{Analyze(x)}) {
|
||||
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
|
||||
CHECK(intExpr);
|
||||
return ConvertToType<Type<TypeCategory::Integer, KIND>>(
|
||||
std::move(*intExpr));
|
||||
void Add(const parser::AcValue &);
|
||||
MaybeExpr ToExpr();
|
||||
|
||||
// These interfaces allow *this to be used as a type visitor argument to
|
||||
// common::SearchTypes() to convert the array constructor to a typed
|
||||
// expression in ToExpr().
|
||||
using Result = MaybeExpr;
|
||||
using Types = AllTypes;
|
||||
template<typename T> Result Test() {
|
||||
if (type_ && type_->category() == T::category) {
|
||||
if constexpr (T::category == TypeCategory::Derived) {
|
||||
return AsMaybeExpr(ArrayConstructor<T>{
|
||||
type_->GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values_))});
|
||||
} else if (type_->kind() == T::kind) {
|
||||
if constexpr (T::category == TypeCategory::Character) {
|
||||
if (auto len{type_->LEN()}) {
|
||||
return AsMaybeExpr(ArrayConstructor<T>{
|
||||
*std::move(len), MakeSpecific<T>(std::move(values_))});
|
||||
}
|
||||
} else {
|
||||
return AsMaybeExpr(
|
||||
ArrayConstructor<T>{MakeSpecific<T>(std::move(values_))});
|
||||
}
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
std::optional<DynamicTypeWithLength> &type_;
|
||||
private:
|
||||
void Push(MaybeExpr &&);
|
||||
|
||||
template<int KIND, typename A>
|
||||
std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
|
||||
const A &x) {
|
||||
if (MaybeExpr y{exprAnalyzer_.Analyze(x)}) {
|
||||
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
|
||||
return ConvertToType<Type<TypeCategory::Integer, KIND>>(
|
||||
std::move(DEREF(intExpr)));
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
// Nested array constructors all reference the same ExpressionAnalyzer,
|
||||
// which represents the nest of active implied DO loop indices.
|
||||
ExpressionAnalyzer &exprAnalyzer_;
|
||||
std::optional<DynamicTypeWithLength> type_;
|
||||
bool explicitType_{type_.has_value()};
|
||||
std::optional<std::int64_t> constantLength_;
|
||||
ArrayConstructorValues<SomeType> values_;
|
||||
|
|
@ -1117,9 +1169,10 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
|
|||
values_.Push(std::move(*x));
|
||||
if (auto thisLen{ToInt64(xType.LEN())}) {
|
||||
if (constantLength_) {
|
||||
if (context().warnOnNonstandardUsage() &&
|
||||
if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
|
||||
*thisLen != *constantLength_) {
|
||||
Say("Character literal in array constructor without explicit "
|
||||
exprAnalyzer_.Say(
|
||||
"Character literal in array constructor without explicit "
|
||||
"type has different length than earlier element"_en_US);
|
||||
}
|
||||
if (*thisLen > *constantLength_) {
|
||||
|
|
@ -1135,14 +1188,16 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
|
|||
}
|
||||
}
|
||||
} else {
|
||||
Say("Values in array constructor must have the same declared type "
|
||||
exprAnalyzer_.Say(
|
||||
"Values in array constructor must have the same declared type "
|
||||
"when no explicit type appears"_err_en_US);
|
||||
}
|
||||
} else {
|
||||
if (auto cast{ConvertToType(*type_, std::move(*x))}) {
|
||||
values_.Push(std::move(*cast));
|
||||
} else {
|
||||
Say("Value in array constructor could not be converted to the type "
|
||||
exprAnalyzer_.Say(
|
||||
"Value in array constructor could not be converted to the type "
|
||||
"of the array"_err_en_US);
|
||||
}
|
||||
}
|
||||
|
|
@ -1168,19 +1223,19 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
|
|||
if (!type_) {
|
||||
type_ = DynamicTypeWithLength{IntType::GetType()};
|
||||
}
|
||||
ArrayConstructorContext nested{*this};
|
||||
parser::CharBlock name;
|
||||
nested.Push(Expr<SomeType>{
|
||||
Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{name}}}});
|
||||
values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
||||
std::move(*upper), std::move(*stride),
|
||||
std::move(nested.values_)});
|
||||
auto v{std::move(values_)};
|
||||
parser::CharBlock anonymous;
|
||||
Push(Expr<SomeType>{
|
||||
Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{anonymous}}}});
|
||||
std::swap(v, values_);
|
||||
values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
|
||||
std::move(*upper), std::move(*stride), std::move(v)});
|
||||
}
|
||||
},
|
||||
[&](const common::Indirection<parser::Expr> &expr) {
|
||||
auto restorer{
|
||||
GetContextualMessages().SetLocation(expr.value().source)};
|
||||
if (MaybeExpr v{Analyze(expr.value())}) {
|
||||
auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
|
||||
expr.value().source)};
|
||||
if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
|
||||
Push(std::move(*v));
|
||||
}
|
||||
},
|
||||
|
|
@ -1189,111 +1244,55 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
|
|||
std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
|
||||
const auto &bounds{
|
||||
std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
|
||||
Analyze(bounds.name);
|
||||
exprAnalyzer_.Analyze(bounds.name);
|
||||
parser::CharBlock name{bounds.name.thing.thing.source};
|
||||
const Symbol *symbol{bounds.name.thing.thing.symbol};
|
||||
int kind{IntType::kind};
|
||||
if (const auto dynamicType{DynamicType::From(symbol)}) {
|
||||
kind = dynamicType->kind();
|
||||
}
|
||||
bool inserted{AddAcImpliedDo(name, kind)};
|
||||
if (!inserted) {
|
||||
SayAt(name,
|
||||
"Implied DO index is active in surrounding implied DO loop "
|
||||
"and may not have the same name"_err_en_US);
|
||||
}
|
||||
if (exprAnalyzer_.AddAcImpliedDo(name, kind)) {
|
||||
std::optional<Expr<IntType>> lower{
|
||||
GetSpecificIntExpr<IntType::kind>(bounds.lower)};
|
||||
std::optional<Expr<IntType>> upper{
|
||||
GetSpecificIntExpr<IntType::kind>(bounds.upper)};
|
||||
if (lower && upper) {
|
||||
std::optional<Expr<IntType>> stride{
|
||||
GetSpecificIntExpr<IntType::kind>(bounds.step)};
|
||||
ArrayConstructorContext nested{*this};
|
||||
auto v{std::move(values_)};
|
||||
for (const auto &value :
|
||||
std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
|
||||
nested.Add(value);
|
||||
Add(value);
|
||||
}
|
||||
if (lower && upper) {
|
||||
if (!stride) {
|
||||
stride = Expr<IntType>{1};
|
||||
}
|
||||
std::swap(v, values_);
|
||||
values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
||||
std::move(*upper), std::move(*stride),
|
||||
std::move(nested.values_)});
|
||||
std::move(*upper), std::move(*stride), std::move(v)});
|
||||
}
|
||||
if (inserted) {
|
||||
RemoveAcImpliedDo(name);
|
||||
exprAnalyzer_.RemoveAcImpliedDo(name);
|
||||
} else {
|
||||
exprAnalyzer_.SayAt(name,
|
||||
"Implied DO index is active in surrounding implied DO loop "
|
||||
"and may not have the same name"_err_en_US);
|
||||
}
|
||||
},
|
||||
},
|
||||
x.u);
|
||||
}
|
||||
|
||||
// Inverts a collection of generic ArrayConstructorValues<SomeType> that
|
||||
// all happen to have the same actual type T into one ArrayConstructor<T>.
|
||||
template<typename T>
|
||||
ArrayConstructorValues<T> MakeSpecific(
|
||||
ArrayConstructorValues<SomeType> &&from) {
|
||||
ArrayConstructorValues<T> to;
|
||||
for (ArrayConstructorValue<SomeType> &x : from) {
|
||||
std::visit(
|
||||
common::visitors{
|
||||
[&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
|
||||
auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
|
||||
CHECK(typed);
|
||||
to.Push(std::move(*typed));
|
||||
},
|
||||
[&](ImpliedDo<SomeType> &&impliedDo) {
|
||||
to.Push(ImpliedDo<T>{impliedDo.name(),
|
||||
std::move(impliedDo.lower()), std::move(impliedDo.upper()),
|
||||
std::move(impliedDo.stride()),
|
||||
MakeSpecific<T>(std::move(impliedDo.values()))});
|
||||
},
|
||||
},
|
||||
std::move(x.u));
|
||||
MaybeExpr ArrayConstructorContext::ToExpr() {
|
||||
return common::SearchTypes(std::move(*this));
|
||||
}
|
||||
return to;
|
||||
}
|
||||
|
||||
struct ArrayConstructorTypeVisitor {
|
||||
using Result = MaybeExpr;
|
||||
using Types = AllTypes;
|
||||
template<typename T> Result Test() {
|
||||
if (type.category() == T::category) {
|
||||
if constexpr (T::category == TypeCategory::Derived) {
|
||||
return AsMaybeExpr(ArrayConstructor<T>{
|
||||
type.GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values))});
|
||||
} else if (type.kind() == T::kind) {
|
||||
if constexpr (T::category == TypeCategory::Character) {
|
||||
if (auto len{type.LEN()}) {
|
||||
return AsMaybeExpr(ArrayConstructor<T>{
|
||||
*std::move(len), MakeSpecific<T>(std::move(values))});
|
||||
}
|
||||
} else {
|
||||
return AsMaybeExpr(
|
||||
ArrayConstructor<T>{MakeSpecific<T>(std::move(values))});
|
||||
}
|
||||
}
|
||||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
DynamicTypeWithLength type;
|
||||
ArrayConstructorValues<SomeType> values;
|
||||
};
|
||||
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
|
||||
const parser::AcSpec &acSpec{array.v};
|
||||
std::optional<DynamicTypeWithLength> type{AnalyzeTypeSpec(acSpec.type)};
|
||||
ArrayConstructorContext context{*this, type};
|
||||
ArrayConstructorContext acContext{*this, AnalyzeTypeSpec(acSpec.type)};
|
||||
for (const parser::AcValue &value : acSpec.values) {
|
||||
context.Add(value);
|
||||
acContext.Add(value);
|
||||
}
|
||||
if (type) {
|
||||
ArrayConstructorTypeVisitor visitor{
|
||||
std::move(*type), std::move(context.values())};
|
||||
return common::SearchTypes(std::move(visitor));
|
||||
}
|
||||
return std::nullopt;
|
||||
return acContext.ToExpr();
|
||||
}
|
||||
|
||||
MaybeExpr ExpressionAnalyzer::Analyze(
|
||||
|
|
|
|||
|
|
@ -19,20 +19,113 @@ include '../runtime/magic-numbers.h' ! for IOSTAT= error/end code values
|
|||
|
||||
module iso_fortran_env
|
||||
|
||||
integer, parameter :: atomic_int_kind = 8
|
||||
integer, parameter :: atomic_logical_kind = 8
|
||||
implicit none
|
||||
|
||||
integer, parameter :: character_kinds(*) = [1, 2, 4]
|
||||
integer, parameter :: int8 = 1, int16 = 2, int32 = 4, int64 = 8, int128 = 16
|
||||
integer, parameter :: integer_kinds(*) = [int8, int16, int32, int64, int128]
|
||||
integer, parameter :: atomic_int_kind = selected_int_kind(18)
|
||||
integer, parameter :: atomic_logical_kind = atomic_int_kind
|
||||
|
||||
! TODO: Use PACK([x],test) in place of the array constructor idiom
|
||||
! [(x, integer::j=1,COUNT([test]))] below once PACK() can be folded.
|
||||
|
||||
integer, parameter, private :: &
|
||||
selectedASCII = selected_char_kind('ASCII'), &
|
||||
selectedUCS_2 = selected_char_kind('UCS-2'), &
|
||||
selectedUnicode = selected_char_kind('ISO_10646')
|
||||
integer, parameter :: character_kinds(*) = [ &
|
||||
[(selectedASCII, integer :: j=1, count([selectedASCII >= 0]))], &
|
||||
[(selectedUCS_2, integer :: j=1, count([selectedUCS_2 >= 0]))], &
|
||||
[(selectedUnicode, integer :: j=1, count([selectedUnicode >= 0]))]]
|
||||
|
||||
integer, parameter, private :: &
|
||||
selectedInt8 = selected_int_kind(2), &
|
||||
selectedInt16 = selected_int_kind(4), &
|
||||
selectedInt32 = selected_int_kind(9), &
|
||||
selectedInt64 = selected_int_kind(18),&
|
||||
selectedInt128 = selected_int_kind(38), &
|
||||
safeInt8 = merge(selectedInt8, selected_int_kind(0), &
|
||||
selectedInt8 >= 0), &
|
||||
safeInt16 = merge(selectedInt16, selected_int_kind(0), &
|
||||
selectedInt16 >= 0), &
|
||||
safeInt32 = merge(selectedInt32, selected_int_kind(0), &
|
||||
selectedInt32 >= 0), &
|
||||
safeInt64 = merge(selectedInt64, selected_int_kind(0), &
|
||||
selectedInt64 >= 0), &
|
||||
safeInt128 = merge(selectedInt128, selected_int_kind(0), &
|
||||
selectedInt128 >= 0)
|
||||
integer, parameter :: &
|
||||
logical8 = 1, logical16 = 2, logical32 = 4, logical64 = 8
|
||||
integer, parameter :: logical_kinds(*) = &
|
||||
[logical8, logical16, logical32, logical64]
|
||||
int8 = merge(selectedInt8, merge(-2, -1, selectedInt8 >= 0), &
|
||||
digits(int(0,kind=safeInt8)) == 7), &
|
||||
int16 = merge(selectedInt16, merge(-2, -1, selectedInt16 >= 0), &
|
||||
digits(int(0,kind=safeInt16)) == 15), &
|
||||
int32 = merge(selectedInt32, merge(-2, -1, selectedInt32 >= 0), &
|
||||
digits(int(0,kind=safeInt32)) == 31), &
|
||||
int64 = merge(selectedInt64, merge(-2, -1, selectedInt64 >= 0), &
|
||||
digits(int(0,kind=safeInt64)) == 63), &
|
||||
int128 = merge(selectedInt128, merge(-2, -1, selectedInt128 >= 0), &
|
||||
digits(int(0,kind=safeInt128)) == 127)
|
||||
|
||||
integer, parameter :: integer_kinds(*) = [ &
|
||||
selected_int_kind(0), &
|
||||
((selected_int_kind(k), &
|
||||
integer :: j=1, count([selected_int_kind(k) >= 0 .and. &
|
||||
selected_int_kind(k) /= &
|
||||
selected_int_kind(k-1)])), &
|
||||
integer :: k=1, 39)]
|
||||
|
||||
integer, parameter :: &
|
||||
real16 = 2, real32 = 4, real64 = 8, real80 = 10, real128 = 16
|
||||
integer, parameter :: real_kinds(*) = &
|
||||
[real16, 3, real32, real64, real80, real128]
|
||||
logical8 = int8, logical16 = int16, logical32 = int32, logical64 = int64
|
||||
integer, parameter :: logical_kinds(*) = [ &
|
||||
[(logical8, integer :: j=1, count([logical8 >= 0]))], &
|
||||
[(logical16, integer :: j=1, count([logical16 >= 0]))], &
|
||||
[(logical32, integer :: j=1, count([logical32 >= 0]))], &
|
||||
[(logical64, integer :: j=1, count([logical64 >= 0]))]]
|
||||
|
||||
integer, parameter, private :: &
|
||||
selectedReal16 = selected_real_kind(3, 4), & ! IEEE half
|
||||
selectedBfloat16 = selected_real_kind(2, 37), & ! truncated IEEE single
|
||||
selectedReal32 = selected_real_kind(6, 37), & ! IEEE single
|
||||
selectedReal64 = selected_real_kind(15, 307), & ! IEEE double
|
||||
selectedReal80 = selected_real_kind(18, 4931), & ! 80x87 extended
|
||||
selectedReal64x2 = selected_real_kind(31, 307), & ! "double-double"
|
||||
selectedReal128 = selected_real_kind(33, 9863), & ! IEEE quad
|
||||
safeReal16 = merge(selectedReal16, selected_real_kind(0,0), &
|
||||
selectedReal16 >= 0), &
|
||||
safeBfloat16 = merge(selectedBfloat16, selected_real_kind(0,0), &
|
||||
selectedBfloat16 >= 0), &
|
||||
safeReal32 = merge(selectedReal32, selected_real_kind(0,0), &
|
||||
selectedReal32 >= 0), &
|
||||
safeReal64 = merge(selectedReal64, selected_real_kind(0,0), &
|
||||
selectedReal64 >= 0), &
|
||||
safeReal80 = merge(selectedReal80, selected_real_kind(0,0), &
|
||||
selectedReal80 >= 0), &
|
||||
safeReal64x2 = merge(selectedReal64x2, selected_real_kind(0,0), &
|
||||
selectedReal64x2 >= 0), &
|
||||
safeReal128 = merge(selectedReal128, selected_real_kind(0,0), &
|
||||
selectedReal128 >= 0)
|
||||
integer, parameter :: &
|
||||
real16 = merge(selectedReal16, merge(-2, -1, selectedReal16 >= 0), &
|
||||
digits(real(0,kind=safeReal16)) == 11), &
|
||||
bfloat16 = merge(selectedBfloat16, merge(-2, -1, selectedBfloat16 >= 0), &
|
||||
digits(real(0,kind=safeBfloat16)) == 8), &
|
||||
real32 = merge(selectedReal32, merge(-2, -1, selectedReal32 >= 0), &
|
||||
digits(real(0,kind=safeReal32)) == 24), &
|
||||
real64 = merge(selectedReal64, merge(-2, -1, selectedReal64 >= 0), &
|
||||
digits(real(0,kind=safeReal64)) == 53), &
|
||||
real80 = merge(selectedReal80, merge(-2, -1, selectedReal80 >= 0), &
|
||||
digits(real(0,kind=safeReal80)) == 64), &
|
||||
real64x2 = merge(selectedReal64x2, merge(-2, -1, selectedReal64x2 >= 0), &
|
||||
digits(real(0,kind=safeReal64x2)) == 106), &
|
||||
real128 = merge(selectedReal128, merge(-2, -1, selectedReal128 >= 0), &
|
||||
digits(real(0,kind=safeReal128)) == 112)
|
||||
|
||||
integer, parameter :: real_kinds(*) = [ &
|
||||
[(real16, integer :: j=1, count([real16 >= 0]))], &
|
||||
[(bfloat16, integer :: j=1, count([bfloat16 >= 0]))], &
|
||||
[(real32, integer :: j=1, count([real32 >= 0]))], &
|
||||
[(real64, integer :: j=1, count([real64 >= 0]))], &
|
||||
[(real80, integer :: j=1, count([real80 >= 0]))], &
|
||||
[(real64x2, integer :: j=1, count([real64x2 >= 0]))], &
|
||||
[(real128, integer :: j=1, count([real128 >= 0]))]]
|
||||
|
||||
integer, parameter :: current_team = -1, initial_team = -2, parent_team = -3
|
||||
|
||||
|
|
@ -76,4 +169,3 @@ module iso_fortran_env
|
|||
compiler_version = 'f18 in development'
|
||||
end function compiler_version
|
||||
end module iso_fortran_env
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue