maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Implement folding of INDEX, SCAN, & VERIFY 

Fold LEN_TRIM

Fold REPEAT

Fix gcc build warning

Fix two tests that had illegal pointers to coarrays

Original-commit: flang-compiler/f18@36769996fa
Reviewed-on: https://github.com/flang-compiler/f18/pull/910
This commit is contained in:
peter klausler 2020-01-06 15:29:53 -08:00
parent e546a20972
commit 91a2f0c75c
9 changed files with 174 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
flang/lib/evaluate/character.h
View File

@ -64,6 +64,24 @@ public:
return str;
}
static std::int64_t INDEX(
const Character &str, const Character &substr, bool back = false) {
auto pos{back ? str.rfind(substr) : str.find(substr)};
return static_cast<std::int64_t>(pos == str.npos ? 0 : pos + 1);
}
static std::int64_t SCAN(
const Character &str, const Character &set, bool back = false) {
auto pos{back ? str.find_last_of(set) : str.find_first_of(set)};
return static_cast<std::int64_t>(pos == str.npos ? 0 : pos + 1);
}
static std::int64_t VERIFY(
const Character &str, const Character &set, bool back = false) {
auto pos{back ? str.find_last_not_of(set) : str.find_first_not_of(set)};
return static_cast<std::int64_t>(pos == str.npos ? 0 : pos + 1);
}
// Resize adds spaces on the right if the new size is bigger than the
// original, or by trimming the rightmost characters otherwise.
static Character Resize(const Character &str, std::size_t newLength) {
@ -75,6 +93,18 @@ public:
}
}
static std::int64_t LEN_TRIM(const Character &str) {
return VERIFY(str, Character{' '}, true);
}
static Character REPEAT(const Character &str, std::int64_t ncopies) {
Character result;
while (ncopies-- > 0) {
result += str;
}
return result;
}
private:
// Following helpers assume that character encodings contain ASCII
static constexpr CharT Space() { return 0x20; }

9
flang/lib/evaluate/fold-character.cc
View File

@ -38,9 +38,16 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "new_line") {
return Expr<T>{Constant<T>{CharacterUtils<KIND>::NEW_LINE()}};
} else if (name == "repeat") { // not elemental
if (auto scalars{GetScalarConstantArguments<T, SubscriptInteger>(
context, funcRef.arguments())}) {
return Expr<T>{Constant<T>{
CharacterUtils<KIND>::REPEAT(std::get<Scalar<T>>(*scalars),
std::get<Scalar<SubscriptInteger>>(*scalars).ToInt64())}};
}
}
// TODO: cshift, eoshift, maxval, minval, pack, reduce,
// repeat, spread, transfer, transpose, trim, unpack
// spread, transfer, transpose, trim, unpack
return Expr<T>{std::move(funcRef)};
}

63
flang/lib/evaluate/fold-implementation.h
View File

@ -446,6 +446,47 @@ Constant<T> *Folder<T>::Folding(std::optional<ActualArgument> &arg) {
return nullptr;
}
template<typename... A, std::size_t... I>
std::optional<std::tuple<const Constant<A> *...>> GetConstantArgumentsHelper(
FoldingContext &context, ActualArguments &arguments,
std::index_sequence<I...>) {
static_assert(
(... && IsSpecificIntrinsicType<A>)); // TODO derived types for MERGE?
static_assert(sizeof...(A) > 0);
std::tuple<const Constant<A> *...> args{
Folder<A>{context}.Folding(arguments.at(I))...};
if ((... && (std::get<I>(args)))) {
return args;
} else {
return std::nullopt;
}
}
template<typename... A>
std::optional<std::tuple<const Constant<A> *...>> GetConstantArguments(
FoldingContext &context, ActualArguments &args) {
return GetConstantArgumentsHelper<A...>(
context, args, std::index_sequence_for<A...>{});
}
template<typename... A, std::size_t... I>
std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArgumentsHelper(
FoldingContext &context, ActualArguments &args, std::index_sequence<I...>) {
if (auto constArgs{GetConstantArguments<A...>(context, args)}) {
return std::tuple<Scalar<A>...>{
std::get<I>(*constArgs)->GetScalarValue().value()...};
} else {
return std::nullopt;
}
}
template<typename... A>
std::optional<std::tuple<Scalar<A>...>> GetScalarConstantArguments(
FoldingContext &context, ActualArguments &args) {
return GetScalarConstantArgumentsHelper<A...>(
context, args, std::index_sequence_for<A...>{});
}
// helpers to fold intrinsic function references
// Define callable types used in a common utility that
// takes care of array and cast/conversion aspects for elemental intrinsics
@ -461,18 +502,14 @@ template<template<typename, typename...> typename WrapperType, typename TR,
Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
FunctionRef<TR> &&funcRef, WrapperType<TR, TA...> func,
std::index_sequence<I...>) {
static_assert(
(... && IsSpecificIntrinsicType<TA>)); // TODO derived types for MERGE?
static_assert(sizeof...(TA) > 0);
std::tuple<const Constant<TA> *...> args{
Folder<TA>{context}.Folding(funcRef.arguments()[I])...};
if ((... && (std::get<I>(args)))) {
if (std::optional<std::tuple<const Constant<TA> *...>> args{
GetConstantArguments<TA...>(context, funcRef.arguments())}) {
// Compute the shape of the result based on shapes of arguments
ConstantSubscripts shape;
int rank{0};
const ConstantSubscripts *shapes[sizeof...(TA)]{
&std::get<I>(args)->shape()...};
const int ranks[sizeof...(TA)]{std::get<I>(args)->Rank()...};
&std::get<I>(*args)->shape()...};
const int ranks[sizeof...(TA)]{std::get<I>(*args)->Rank()...};
for (unsigned int i{0}; i < sizeof...(TA); ++i) {
if (ranks[i] > 0) {
if (rank == 0) {
@ -502,13 +539,13 @@ Expr<TR> FoldElementalIntrinsicHelper(FoldingContext &context,
if constexpr (std::is_same_v<WrapperType<TR, TA...>,
ScalarFuncWithContext<TR, TA...>>) {
results.emplace_back(func(context,
(ranks[I] ? std::get<I>(args)->At(index)
: std::get<I>(args)->GetScalarValue().value())...));
(ranks[I] ? std::get<I>(*args)->At(index)
: std::get<I>(*args)->GetScalarValue().value())...));
} else if constexpr (std::is_same_v<WrapperType<TR, TA...>,
ScalarFunc<TR, TA...>>) {
results.emplace_back(func(
(ranks[I] ? std::get<I>(args)->At(index)
: std::get<I>(args)->GetScalarValue().value())...));
(ranks[I] ? std::get<I>(*args)->At(index)
: std::get<I>(*args)->GetScalarValue().value())...));
}
} while (bounds.IncrementSubscripts(index));
}
@ -653,7 +690,7 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (name == "reshape") {
return Folder<T>{context}.Reshape(std::move(funcRef));
}
// TODO: other type independent transformational
// TODO: other type independent transformationals
if constexpr (!std::is_same_v<T, SomeDerived>) {
return FoldIntrinsicFunction(context, std::move(funcRef));
}

69
flang/lib/evaluate/fold-integer.cc
View File

@ -232,7 +232,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
sx->u);
} else {
common::die("exponent argument must be real");
DIE("exponent argument must be real");
}
} else if (name == "huge") {
return Expr<T>{Scalar<T>::HUGE()};
@ -294,6 +294,43 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
[&fptr](const Scalar<T> &i, const Scalar<Int4> &pos) -> Scalar<T> {
return std::invoke(fptr, i, static_cast<int>(pos.ToInt64()));
}));
} else if (name == "index" || name == "scan" || name == "verify") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
return std::visit(
[&](const auto &kch) -> Expr<T> {
using TC = typename std::decay_t<decltype(kch)>::Result;
if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK=
return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context,
std::move(funcRef),
ScalarFunc<T, TC, TC, LogicalResult>{
[&name](const Scalar<TC> &str, const Scalar<TC> &other,
const Scalar<LogicalResult> &back) -> Scalar<T> {
return name == "index"
? CharacterUtils<TC::kind>::INDEX(
str, other, back.IsTrue())
: name == "scan" ? CharacterUtils<TC::kind>::SCAN(
str, other, back.IsTrue())
: CharacterUtils<TC::kind>::VERIFY(
str, other, back.IsTrue());
}});
} else {
return FoldElementalIntrinsic<T, TC, TC>(context,
std::move(funcRef),
ScalarFunc<T, TC, TC>{
[&name](const Scalar<TC> &str,
const Scalar<TC> &other) -> Scalar<T> {
return name == "index"
? CharacterUtils<TC::kind>::INDEX(str, other)
: name == "scan"
? CharacterUtils<TC::kind>::SCAN(str, other)
: CharacterUtils<TC::kind>::VERIFY(str, other);
}});
}
},
charExpr->u);
} else {
DIE("first argument must be CHARACTER");
}
} else if (name == "int") {
if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
return std::visit(
@ -303,7 +340,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
IsNumericCategoryExpr<From>()) {
return Fold(context, ConvertToType<T>(std::move(x)));
}
common::die("int() argument type not valid");
DIE("int() argument type not valid");
},
std::move(expr->u));
}
@ -313,7 +350,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if constexpr (common::HasMember<T, IntegerTypes>) {
return Expr<T>{args[0].value().GetType()->kind()};
} else {
common::die("kind() result not integral");
DIE("kind() result not integral");
}
} else if (name == "lbound") {
return LBOUND(context, std::move(funcRef));
@ -330,7 +367,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}));
}
auto fptr{&Scalar<TI>::LEADZ};
if (name == "leadz") { // done in fprt definition
if (name == "leadz") { // done in fptr definition
} else if (name == "trailz") {
fptr = &Scalar<TI>::TRAILZ;
} else if (name == "popcnt") {
@ -346,7 +383,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
sn->u);
} else {
common::die("leadz argument must be integer");
DIE("leadz argument must be integer");
}
} else if (name == "len") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
@ -360,7 +397,21 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
charExpr->u);
} else {
common::die("len() argument must be of character type");
DIE("len() argument must be of character type");
}
} else if (name == "len_trim") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
return std::visit(
[&](const auto &kch) -> Expr<T> {
using TC = typename std::decay_t<decltype(kch)>::Result;
return FoldElementalIntrinsic<T, TC>(context, std::move(funcRef),
ScalarFunc<T, TC>{[](const Scalar<TC> &str) -> Scalar<T> {
return CharacterUtils<TC::kind>::LEN_TRIM(str);
}});
},
charExpr->u);
} else {
DIE("len_trim() argument must be of character type");
}
} else if (name == "maskl" || name == "maskr") {
// Argument can be of any kind but value has to be smaller than BIT_SIZE.
@ -526,10 +577,10 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
// TODO:
// cshift, dot_product, eoshift,
// findloc, iall, iany, iparity, ibits, image_status, index, ishftc,
// len_trim, matmul, maxloc, maxval,
// findloc, iall, iany, iparity, ibits, image_status, ishftc,
// matmul, maxloc, maxval,
// minloc, minval, not, pack, product, reduce,
// scan, sign, spread, sum, transfer, transpose, unpack, verify
// sign, spread, sum, transfer, transpose, unpack
return Expr<T>{std::move(funcRef)};
}

11
flang/lib/evaluate/fold-real.cc
View File

@ -101,14 +101,11 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return y.value;
}));
} else if (name == "dprod") {
if (auto *x{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
if (auto *y{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
return Fold(context,
Expr<T>{Multiply<T>{ConvertToType<T>(std::move(*x)),
ConvertToType<T>(std::move(*y))}});
}
if (auto scalars{GetScalarConstantArguments<T, T>(context, args)}) {
return Fold(context,
Expr<T>{Multiply<T>{
Expr<T>{std::get<0>(*scalars)}, Expr<T>{std::get<1>(*scalars)}}});
}
common::die("Wrong argument type in dprod()");
} else if (name == "epsilon") {
return Expr<T>{Scalar<T>::EPSILON()};
} else if (name == "huge") {

20
flang/lib/evaluate/logical.h
View File

@ -14,7 +14,7 @@
namespace Fortran::evaluate::value {
template<int BITS, bool IS_LIKE_C = false> class Logical {
template<int BITS, bool IS_LIKE_C = true> class Logical {
public:
static constexpr int bits{BITS};
@ -23,16 +23,19 @@ public:
static constexpr bool IsLikeC{BITS <= 8 || IS_LIKE_C};
constexpr Logical() {} // .FALSE.
constexpr Logical(const Logical &that) = default;
constexpr Logical(bool truth)
: word_{truth ? canonicalTrue : canonicalFalse} {}
constexpr Logical &operator=(const Logical &) = default;
template<int B, bool C>
constexpr Logical(Logical<B, C> x) : word_{Represent(x.IsTrue())} {}
constexpr Logical(bool truth) : word_{Represent(truth)} {}
template<int B> constexpr bool operator==(const Logical<B> &that) const {
template<int B, bool C> constexpr Logical &operator=(Logical<B, C> x) {
word_ = Represent(x.IsTrue());
}
template<int B, bool C>
constexpr bool operator==(const Logical<B, C> &that) const {
return IsTrue() == that.IsTrue();
}
// For static expression evaluation, all the bits will have the same value.
constexpr bool IsTrue() const {
if constexpr (IsLikeC) {
return !word_.IsZero();
@ -61,6 +64,9 @@ private:
using Word = Integer<bits>;
static constexpr Word canonicalTrue{IsLikeC ? -std::uint64_t{1} : 1};
static constexpr Word canonicalFalse{0};
static constexpr Word Represent(bool x) {
return x ? canonicalTrue : canonicalFalse;
}
constexpr Logical(const Word &w) : word_{w} {}
Word word_;
};

BIN
flang/test/evaluate/folding05.f90
View File

Binary file not shown.

8
flang/test/semantics/c_f_pointer.f90
View File

@ -3,7 +3,11 @@
program test
use iso_c_binding, only: c_ptr, c_f_pointer
type(c_ptr) :: scalarC, arrayC(1)
integer, pointer :: scalarIntF, arrayIntF(:), coindexed[*]
type :: with_pointer
integer, pointer :: p
end type
type(with_pointer) :: coindexed[*]
integer, pointer :: scalarIntF, arrayIntF(:)
character(len=:), pointer :: charDeferredF
integer :: j
call c_f_pointer(scalarC, scalarIntF) ! ok
@ -23,5 +27,5 @@ program test
!ERROR: FPTR= argument to C_F_POINTER() may not have a deferred type parameter
call c_f_pointer(scalarC, charDeferredF)
!ERROR: FPTR= argument to C_F_POINTER() may not be a coindexed object
call c_f_pointer(scalarC, coindexed[0])
call c_f_pointer(scalarC, coindexed[0]%p)
end program

6
flang/test/semantics/call08.f90
View File

@ -4,8 +4,6 @@ module m
real :: c1[*]
real, volatile :: c2[*]
real, pointer :: c3(:)[*]
real, pointer, contiguous :: c4(:)[*]
contains
@ -22,9 +20,11 @@ module m
real :: x(*)[*]
end subroutine
subroutine test(x)
subroutine test(x,c3,c4)
real :: scalar
real :: x(:)[*]
real, intent(in) :: c3(:)[*]
real, contiguous, intent(in) :: c4(:)[*]
call s01(c1) ! ok
call s02(c2) ! ok
call s03(c4) ! ok