namespace Fortran::common {
-// const A * -> std::optional<A>
-template<typename A> std::optional<A> GetIfNonNull(const A *p) {
- if (p) {
- return {*p};
- }
- return std::nullopt;
-}
-
-// const std::variant<..., A, ...> -> std::optional<A>
-// i.e., when a variant holds a value of a particular type, return a copy
-// of that value in a std::optional<>.
-template<typename A, typename VARIANT>
-std::optional<A> GetIf(const VARIANT &u) {
- return GetIfNonNull(std::get_if<A>(&u));
-}
-
-// std::optional<std::optional<A>> -> std::optional<A>
-template<typename A>
-std::optional<A> JoinOptional(std::optional<std::optional<A>> &&x) {
- if (x.has_value()) {
- return std::move(*x);
- }
- return std::nullopt;
-}
-
-// Move a value from one variant type to another. The types allowed in the
-// source variant must all be allowed in the destination variant type.
-template<typename TOV, typename FROMV> TOV MoveVariant(FROMV &&u) {
- return std::visit(
- [](auto &&x) -> TOV { return {std::move(x)}; }, std::move(u));
-}
-
// SearchTypeList<PREDICATE, TYPES...> scans a list of types. The zero-based
// index of the first type T in the list for which PREDICATE<T>::value() is
// true is returned, or -1 if the predicate is false for every type in the list.
template<typename A, typename... TYPES>
constexpr int TypeIndex{SearchTypeList<MatchType<A>::template Match, TYPES...>};
+// IsTypeInList<A, TYPES...> is a simple presence predicate.
+template<typename A, typename... TYPES>
+constexpr bool IsTypeInList{TypeIndex<A, TYPES...> >= 0};
+
// OverMembers extracts the list of types that constitute the alternatives
// of a std::variant or elements of a std::tuple and passes that list as
// parameter types to a given variadic template.
static constexpr int value() { return SearchTypeList<PREDICATE, Ts...>; }
};
};
+
template<template<typename> class PREDICATE, typename TorV>
constexpr int SearchMembers{
OverMembers<SearchMembersHelper<PREDICATE>::template Scanner,
TorV>::value()};
+template<typename A, typename TorV>
+constexpr bool HasMember{
+ SearchMembers<MatchType<A>::template Match, TorV> >= 0};
+
+// const A * -> std::optional<A>
+template<typename A> std::optional<A> GetIfNonNull(const A *p) {
+ if (p) {
+ return {*p};
+ }
+ return std::nullopt;
+}
+
+// const std::variant<..., A, ...> -> std::optional<A>
+// i.e., when a variant holds a value of a particular type, return a copy
+// of that value in a std::optional<>. The type A must be a valid
+// alternative for the variant.
+template<typename A, typename VARIANT>
+std::optional<A> GetIf(const VARIANT &u) {
+ return GetIfNonNull(std::get_if<A>(&u));
+}
+
+// std::optional<std::optional<A>> -> std::optional<A>
+template<typename A>
+std::optional<A> JoinOptional(std::optional<std::optional<A>> &&x) {
+ if (x.has_value()) {
+ return std::move(*x);
+ }
+ return std::nullopt;
+}
+
+// Move a value from one variant type to another. The types allowed in the
+// source variant must all be allowed in the destination variant type.
+template<typename TOV, typename FROMV> TOV MoveVariant(FROMV &&u) {
+ return std::visit(
+ [](auto &&x) -> TOV { return {std::move(x)}; }, std::move(u));
+}
+
// CombineTuples takes a list of std::tuple<> template instantiation types
// and constructs a new std::tuple type that concatenates all of their member
// types. E.g.,
template<typename D, typename R, typename... O>
auto Operation<D, R, O...>::Fold(FoldingContext &context)
-> std::optional<Constant<Result>> {
+ // TODO pmk: generalize
auto c0{operand<0>().Fold(context)};
if constexpr (operands() == 1) {
if (c0.has_value()) {
return std::visit(
[&](auto &x) -> std::optional<Const> {
using Thing = std::decay_t<decltype(x)>;
- if constexpr (IsConstantTrait<Thing>) {
+ if constexpr (std::is_same_v<Thing, Const>) {
return {x};
}
if constexpr (IsFoldableTrait<Thing>) {
if constexpr (ResultType<decltype(*c)>::isSpecificType) {
return {Const{c->value}};
} else {
- // pmk: this is ugly
return {Const{common::MoveVariant<GenericScalar>(c->value.u)}};
}
}
common::visitors{[](const Constant<Result> &c) {
// std::string::size_type isn't convertible to uint64_t
// on Darwin
- return Expr<SubscriptInteger>{
- static_cast<std::uint64_t>(c.value.size())};
+ return AsExpr(Constant<SubscriptInteger>{
+ static_cast<std::uint64_t>(c.value.size())});
},
[](const Concat<KIND> &c) {
return c.template operand<0>().LEN() +
template<typename RESULT>
auto ExpressionBase<RESULT>::ScalarValue() const
-> std::optional<Scalar<Result>> {
- using Const = Scalar<Result>;
- return std::visit(
- [](const auto &x) -> std::optional<Const> {
- using Ty = std::decay_t<decltype(x)>;
- if constexpr (IsConstantTrait<Ty>) {
- return {Const{x.value}};
- }
- // TODO: Also succeed for a parenthesized constant
- return std::nullopt;
- },
- derived().u);
+ if constexpr (Result::isSpecificType) {
+ if (auto c{common::GetIf<Constant<Result>>(derived().u)}) {
+ return {c->value};
+ }
+ // TODO: every specifically-typed Expr should support Parentheses
+ if constexpr (common::HasMember<Parentheses<Result>,
+ decltype(derived().u)>) {
+ if (auto p{common::GetIf<Parentheses<Result>>(derived().u)}) {
+ return p->template operand<0>().ScalarValue();
+ }
+ }
+ } else if constexpr (std::is_same_v<Result, SomeType>) {
+ return std::visit(
+ common::visitors{
+ [](const BOZLiteralConstant &) -> std::optional<Scalar<Result>> {
+ return std::nullopt;
+ },
+ [](const auto &catEx) -> std::optional<Scalar<Result>> {
+ if (auto cv{catEx.ScalarValue()}) {
+ // *cv is SomeKindScalar<CAT> for some category; rewrap it.
+ return {common::MoveVariant<GenericScalar>(std::move(cv->u))};
+ }
+ return std::nullopt;
+ }},
+ derived().u);
+ } else {
+ return std::visit(
+ [](const auto &kindEx) -> std::optional<Scalar<Result>> {
+ if (auto sv{kindEx.ScalarValue()}) {
+ return {SomeKindScalar<Result::category>{*sv}};
+ }
+ return std::nullopt;
+ },
+ derived().u);
+ }
+ return std::nullopt;
}
// Template instantiations to resolve the "extern template" declarations
common::MapOptional(std::move(f), std::move(x), std::move(y)));
}
-template<template<typename> class OPR, TypeCategory CAT>
-std::optional<Expr<SomeType>> PromoteAndCombine(
- Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
- return {Expr<SomeType>{std::visit(
- [&](auto &&xk, auto &&yk) -> Expr<SomeKind<CAT>> {
- using xt = ResultType<decltype(xk)>;
- using yt = ResultType<decltype(yk)>;
- using ToType = Type<CAT, std::max(xt::kind, yt::kind)>;
- return {Expr<ToType>{OPR<ToType>{EnsureKind<ToType>(std::move(xk)),
- EnsureKind<ToType>(std::move(yk))}}};
- },
- std::move(x.u), std::move(y.u))}};
+template<TypeCategory CAT>
+std::optional<Expr<SomeType>> Package(Expr<SomeKind<CAT>> &&catExpr) {
+ return {AsGenericExpr(std::move(catExpr))};
}
+// TODO pmk next: write in terms of ConvertRealOperands?
template<template<typename> class OPR>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &messages, Expr<SomeType> &&x,
Expr<SomeType> &&y) {
+
return std::visit(
common::visitors{[](Expr<SomeInteger> &&ix, Expr<SomeInteger> &&iy) {
- return PromoteAndCombine<OPR, TypeCategory::Integer>(
- std::move(ix), std::move(iy));
+ return Package(
+ PromoteAndCombine<OPR, TypeCategory::Integer>(
+ std::move(ix), std::move(iy)));
},
[](Expr<SomeReal> &&rx, Expr<SomeReal> &&ry) {
- return PromoteAndCombine<OPR, TypeCategory::Real>(
- std::move(rx), std::move(ry));
+ return Package(PromoteAndCombine<OPR, TypeCategory::Real>(
+ std::move(rx), std::move(ry)));
},
[](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
- return std::optional{Expr<SomeType>{std::visit(
+ return Package(std::visit(
[&](auto &&rxk) -> Expr<SomeReal> {
- using kindEx = decltype(rxk);
- using resultType = ResultType<kindEx>;
- return {kindEx{OPR<resultType>{std::move(rxk),
- ConvertToType<resultType>(std::move(iy))}}};
+ using resultType = ResultType<decltype(rxk)>;
+ return AsCategoryExpr(AsExpr(OPR<resultType>{std::move(rxk),
+ ConvertToType<resultType>(std::move(iy))}));
},
- std::move(rx.u))}};
+ std::move(rx.u)));
},
[](Expr<SomeInteger> &&ix, Expr<SomeReal> &&ry) {
- return std::optional{Expr<SomeType>{std::visit(
+ return Package(std::visit(
[&](auto &&ryk) -> Expr<SomeReal> {
- using kindEx = decltype(ryk);
- using resultType = ResultType<kindEx>;
- return {kindEx{
+ using resultType = ResultType<decltype(ryk)>;
+ return AsCategoryExpr(AsExpr(
OPR<resultType>{ConvertToType<resultType>(std::move(ix)),
- std::move(ryk)}}};
+ std::move(ryk)}));
},
- std::move(ry.u))}};
+ std::move(ry.u)));
},
[](Expr<SomeComplex> &&zx, Expr<SomeComplex> &&zy) {
- return PromoteAndCombine<OPR, TypeCategory::Complex>(
- std::move(zx), std::move(zy));
+ return Package(PromoteAndCombine<OPR, TypeCategory::Complex>(
+ std::move(zx), std::move(zy)));
},
// TODO pmk complex; Add/Sub different from Mult/Div
[&](auto &&, auto &&) {
// Generalizers: these take expressions of more specific types and wrap
// them in more abstract containers.
+template<typename A> Expr<ResultType<A>> AsExpr(const A &x) { return {x}; }
template<typename A> Expr<ResultType<A>> AsExpr(A &&x) {
return {std::move(x)};
}
template<TypeCategory CAT, int KIND>
+Expr<SomeKind<CAT>> AsCategoryExpr(const Expr<Type<CAT, KIND>> &x) {
+ return {x};
+}
+
+template<TypeCategory CAT, int KIND>
Expr<SomeKind<CAT>> AsCategoryExpr(Expr<Type<CAT, KIND>> &&x) {
return {std::move(x)};
}
+template<typename A> Expr<SomeType> AsGenericExpr(const A &x) { return {x}; }
+
template<typename A> Expr<SomeType> AsGenericExpr(A &&x) {
return {std::move(x)};
}
template<TypeCategory CAT, int KIND>
+Expr<SomeType> AsGenericExpr(const Expr<Type<CAT, KIND>> &x) {
+ return {AsCategoryExpr(x)};
+}
+template<TypeCategory CAT, int KIND>
Expr<SomeType> AsGenericExpr(Expr<Type<CAT, KIND>> &&x) {
return {AsCategoryExpr(std::move(x))};
}
template<typename TOTYPE>
Expr<TOTYPE> EnsureKind(Expr<SomeKind<TOTYPE::category>> &&x) {
using ToType = TOTYPE;
- if (auto *p{std::get_if<Expr<ToType>>(&x.u)}) {
- return std::move(*p);
+ static_assert(ToType::isSpecificType);
+ if (auto already{common::GetIf<Expr<ToType>>(x.u)}) {
+ return std::move(*already);
}
if constexpr (ToType::category == TypeCategory::Complex) {
return {std::visit(
}
}
+// Given two expressions of arbitrary kind in the same intrinsic type
+// category, convert one of them if necessary to the larger kind of the
+// other, then combine them with a operation and return a new expression
+// in the same type category.
+template<template<typename> class OPR, TypeCategory CAT>
+Expr<SomeKind<CAT>> PromoteAndCombine(
+ Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
+ return std::visit(
+ [&](auto &&xk, auto &&yk) -> Expr<SomeKind<CAT>> {
+ using xt = ResultType<decltype(xk)>;
+ using yt = ResultType<decltype(yk)>;
+ using ToType = Type<CAT, std::max(xt::kind, yt::kind)>;
+ return AsCategoryExpr(
+ AsExpr(OPR<ToType>{EnsureKind<ToType>(std::move(xk)),
+ EnsureKind<ToType>(std::move(yk))}));
+ },
+ std::move(x.u), std::move(y.u));
+}
+
+// Given two expressions of arbitrary type, try to combine them with a
+// numeric operation (e.g., Add), possibly with data type conversion of
+// one of the operands to the type of the other.
template<template<typename> class OPR>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+
extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
common::visitors{[](const std::string &s) {
// std::string::size_type isn't convertible to uint64_t
// on Darwin
- return Expr<SubscriptInteger>{
- static_cast<std::uint64_t>(s.size())};
+ return AsExpr(Constant<SubscriptInteger>{
+ static_cast<std::uint64_t>(s.size())});
},
[](const DataRef &x) { return x.LEN(); }},
u_);
}
std::optional<std::string> Substring::Fold(FoldingContext &context) {
- std::optional<Scalar<SubscriptInteger>> lbValue, ubValue;
- // pmk: streamline
- if (first_.has_value()) {
- if (auto c{(*first_)->Fold(context)}) {
- lbValue = c->value;
- }
- } else {
- if (auto c{first().Fold(context)}) {
- lbValue = c->value;
- }
- }
- if (lbValue.has_value()) {
- first_ = IndirectSubscriptIntegerExpr{Expr<SubscriptInteger>{*lbValue}};
- }
- if (last_.has_value()) {
- if (auto c{(*last_)->Fold(context)}) {
- ubValue = c->value;
- }
- } else {
- if (auto c{last().Fold(context)}) {
- ubValue = c->value;
- }
+ std::optional<Constant<SubscriptInteger>> lbConst{first().Fold(context)};
+ if (lbConst.has_value()) {
+ first_ = AsExpr(*lbConst);
}
- if (ubValue.has_value()) {
- last_ = IndirectSubscriptIntegerExpr{Expr<SubscriptInteger>{*ubValue}};
+ std::optional<Constant<SubscriptInteger>> ubConst{last().Fold(context)};
+ if (ubConst.has_value()) {
+ last_ = AsExpr(*ubConst);
}
- if (lbValue.has_value() && ubValue.has_value()) {
- std::int64_t lbi{lbValue->ToInt64()};
- std::int64_t ubi{ubValue->ToInt64()};
+ if (auto both{common::AllPresent(std::move(lbConst), std::move(ubConst))}) {
+ std::int64_t lbi{std::get<0>(*both).value.ToInt64()};
+ std::int64_t ubi{std::get<1>(*both).value.ToInt64()};
if (ubi < lbi) {
// These cases are well defined, and they produce zero-length results.
u_ = ""s;
- first_ = Expr<SubscriptInteger>{1};
- last_ = Expr<SubscriptInteger>{0};
+ first_ = AsExpr(Constant<SubscriptInteger>{1});
+ last_ = AsExpr(Constant<SubscriptInteger>{0});
return {""s};
}
if (lbi <= 0) {
"lower bound on substring (%jd) is less than one"_en_US,
static_cast<std::intmax_t>(lbi));
lbi = 1;
- first_ = Expr<SubscriptInteger>{lbi};
+ first_ = AsExpr(Constant<SubscriptInteger>{lbi});
}
if (ubi <= 0) {
u_ = ""s;
- last_ = Expr<SubscriptInteger>{0};
+ last_ = AsExpr(Constant<SubscriptInteger>{0});
return {""s};
}
if (std::string * str{std::get_if<std::string>(&u_)}) {
"upper bound on substring (%jd) is greater than character length (%jd)"_en_US,
static_cast<std::intmax_t>(ubi), static_cast<std::intmax_t>(len));
ubi = len;
- last_ = Expr<SubscriptInteger>{ubi};
+ last_ = AsExpr(Constant<SubscriptInteger>{ubi});
}
std::string result{str->substr(lbi - 1, ubi - lbi + 1)};
u_ = result;
// LEN()
static Expr<SubscriptInteger> SymbolLEN(const Symbol &sym) {
- return Expr<SubscriptInteger>{0}; // TODO
+ return AsExpr(Constant<SubscriptInteger>{0}); // TODO
}
Expr<SubscriptInteger> Component::LEN() const { return SymbolLEN(symbol()); }
Expr<SubscriptInteger> ArrayRef::LEN() const {
u_);
}
Expr<SubscriptInteger> Substring::LEN() const {
- return Extremum<SubscriptInteger>{
- Expr<SubscriptInteger>{0}, last() - first() + Expr<SubscriptInteger>{1}};
+ return Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
+ last() - first() + AsExpr(Constant<SubscriptInteger>{1})};
}
Expr<SubscriptInteger> ProcedureDesignator::LEN() const {
return std::visit(
[](const Component &c) { return c.LEN(); },
[](const auto &) {
CRASH_NO_CASE;
- return Expr<SubscriptInteger>{0};
+ return AsExpr(Constant<SubscriptInteger>{0});
}},
u_);
}
return std::nullopt;
}
-// pmk: document, maybe put elsewhere
+// pmk: restructure by extracting member function, document, maybe put elsewhere
template<TypeCategory CAT, typename VALUE> struct ConstantHelper {
+ using FuncResult = std::optional<Expr<evaluate::SomeKind<CAT>>>;
using Types = evaluate::CategoryTypes<CAT>;
- explicit ConstantHelper(VALUE &&x) : value{std::move(x)} {}
- template<int J> void SetKindTraverser(int kind) {
+ template<int J> FuncResult SetKindTraverser(int kind, VALUE &&value) {
if constexpr (J < std::tuple_size_v<Types>) {
using Ty = std::tuple_element_t<J, Types>;
if (kind == Ty::kind) {
- result = Expr<Ty>{evaluate::Constant<Ty>{std::move(value)}};
+ return {
+ AsCategoryExpr(AsExpr(evaluate::Constant<Ty>{std::move(value)}))};
} else {
- SetKindTraverser<J + 1>(kind);
+ return SetKindTraverser<J + 1>(kind, std::move(value));
}
+ } else {
+ return std::nullopt;
}
}
- void SetKind(int kind) { SetKindTraverser<0>(kind); }
- VALUE value;
- std::optional<Expr<evaluate::SomeKind<CAT>>> result;
+ std::optional<Expr<evaluate::SomeKind<CAT>>> SetKind(
+ int kind, VALUE &&value) {
+ return SetKindTraverser<0>(kind, std::move(value));
+ }
};
static std::optional<Expr<evaluate::SomeCharacter>> AnalyzeLiteral(
auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
ExpressionAnalyzer::KindParam{1})};
auto value{std::get<std::string>(x.t)};
- ConstantHelper<TypeCategory::Character, std::string> helper{std::move(value)};
- helper.SetKind(kind);
- if (!helper.result.has_value()) {
+ ConstantHelper<TypeCategory::Character, std::string> helper;
+ auto result{helper.SetKind(kind, std::move(value))};
+ if (!result.has_value()) {
ea.context().messages.Say("unsupported CHARACTER(KIND=%ju)"_err_en_US,
static_cast<std::uintmax_t>(kind));
}
- return std::move(helper.result);
+ return result;
}
template<typename A> MaybeExpr PackageGeneric(std::optional<A> &&x) {
auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
ea.defaultIntegerKind())};
auto value{std::get<0>(x.t)}; // std::(u)int64_t
- ConstantHelper<TypeCategory::Integer, decltype(value)> helper{
- std::move(value)};
- helper.SetKind(kind);
- if (!helper.result.has_value()) {
+ ConstantHelper<TypeCategory::Integer, decltype(value)> helper;
+ auto result{helper.SetKind(kind, std::move(value))};
+ if (!result.has_value()) {
ea.context().messages.Say("unsupported INTEGER(KIND=%ju)"_err_en_US,
static_cast<std::uintmax_t>(kind));
}
- return std::move(helper.result);
+ return result;
}
static std::optional<Expr<evaluate::SomeInteger>> AnalyzeLiteral(
Expr<RealType>{evaluate::Constant<RealType>{value}})};
}
+// TODO pmk: make like ConstantHelper above, clean both up
struct RealHelper {
RealHelper(parser::CharBlock lit, evaluate::FoldingContext &ctx)
: literal{lit}, context{ctx} {}
auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
ea.defaultLogicalKind())};
bool value{std::get<bool>(x.t)};
- ConstantHelper<TypeCategory::Logical, bool> helper{std::move(value)};
- helper.SetKind(kind);
- if (!helper.result.has_value()) {
+ ConstantHelper<TypeCategory::Logical, bool> helper;
+ auto result{helper.SetKind(kind, std::move(value))};
+ if (!result.has_value()) {
ea.context().messages.Say("unsupported LOGICAL(KIND=%ju)"_err_en_US,
static_cast<std::uintmax_t>(kind));
}
- return std::move(helper.result);
+ return result;
}
template<>
projects / platform / upstream / llvm.git / commitdiff