From 402cc8c4e9e25581d99c38ffec5c8d2ab5132145 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 19 Feb 2019 17:06:28 -0800 Subject: [PATCH] [flang] Represent NULL() Original-commit: flang-compiler/f18@2c3368fb5f6178bb997936bb506deecc2d8b7d03 Reviewed-on: https://github.com/flang-compiler/f18/pull/311 Tree-same-pre-rewrite: false --- flang/lib/evaluate/expression.cc | 9 ++++++--- flang/lib/evaluate/expression.h | 20 +++++++++++++------- flang/lib/evaluate/fold.cc | 12 ++++++++---- flang/lib/evaluate/intrinsics.cc | 24 +++++++++++++++--------- flang/lib/evaluate/tools.cc | 7 ++++++- flang/lib/evaluate/tools.h | 34 +++++++++++++++++++++++++++++++++- flang/lib/semantics/expression.cc | 7 +++++++ 7 files changed, 88 insertions(+), 25 deletions(-) diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index 637468c..5146c72 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -146,6 +146,7 @@ std::ostream &ExpressionBase::AsFortran(std::ostream &o) const { [&](const BOZLiteralConstant &x) { o << "z'" << x.Hexadecimal() << "'"; }, + [&](const NullPointer &) { o << "NULL()"; }, [&](const CopyableIndirection &s) { s->AsFortran(o); }, [&](const ImpliedDoIndex &i) { o << i.name.ToString(); }, [&](const auto &x) { x.AsFortran(o); }, @@ -201,11 +202,13 @@ std::optional ExpressionBase::GetType() const { } else { return std::visit( [](const auto &x) -> std::optional { - if constexpr (!std::is_same_v, - BOZLiteralConstant>) { + using Ty = std::decay_t; + if constexpr (std::is_same_v || + std::is_same_v) { + return std::nullopt; // typeless really means "no type" + } else { return x.GetType(); } - return std::nullopt; // typeless really means "no type" }, derived().u); } diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index 3a626da..8271a65 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -98,12 +98,6 @@ public: static Derived Rewrite(FoldingContext &, Derived &&); }; -// BOZ literal "typeless" constants must be wide enough to hold a numeric -// value of any supported kind of INTEGER or REAL. They must also be -// distinguishable from other integer constants, since they are permitted -// to be used in only a few situations. -using BOZLiteralConstant = typename LargestReal::Scalar::Word; - // Operations always have specific Fortran result types (i.e., with known // intrinsic type category and kind parameter value). The classes that // represent the operations all inherit from this Operation<> base class @@ -725,6 +719,18 @@ public: common::MapTemplate> u; }; +// BOZ literal "typeless" constants must be wide enough to hold a numeric +// value of any supported kind of INTEGER or REAL. They must also be +// distinguishable from other integer constants, since they are permitted +// to be used in only a few situations. +using BOZLiteralConstant = typename LargestReal::Scalar::Word; + +// Null pointers without MOLD= arguments are typed by context. +struct NullPointer { + constexpr bool operator==(const NullPointer &) const { return true; } + constexpr int Rank() const { return 0; } +}; + // A completely generic expression, polymorphic across all of the intrinsic type // categories and each of their kinds. template<> class Expr : public ExpressionBase { @@ -757,7 +763,7 @@ public: } private: - using Others = std::variant; + using Others = std::variant; using Categories = common::MapTemplate; public: diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index ca68247..ee91d7d 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -759,11 +759,14 @@ Expr ExpressionBase::Rewrite(FoldingContext &context, Expr &&expr) { return FoldOperation(context, std::move(x)); } else if constexpr (std::is_same_v) { return FoldOperation(context, std::move(x)); - } else if constexpr (std::is_same_v>) { - return std::move(expr); } else { - return Expr{Fold(context, std::move(x))}; + using Ty = std::decay_t; + if constexpr (std::is_same_v || + std::is_same_v) { + return std::move(expr); + } else { + return Expr{Fold(context, std::move(x))}; + } } }, std::move(expr.u)); @@ -789,6 +792,7 @@ struct ConstExprContext { bool IsConstExpr(ConstExprContext &, const BOZLiteralConstant &) { return true; } +bool IsConstExpr(ConstExprContext &, const NullPointer &) { return true; } template bool IsConstExpr(ConstExprContext &, const Constant &) { return true; } diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 14de420..ab76dc8 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -1163,9 +1163,9 @@ std::optional IntrinsicInterface::Match( } } - return {SpecificCall{ + return std::make_optional( SpecificIntrinsic{name, std::move(resultType), resultRank, attrs}, - std::move(rearranged)}}; + std::move(rearranged)); } class IntrinsicProcTable::Implementation { @@ -1254,9 +1254,9 @@ std::optional IntrinsicProcTable::Implementation::Probe( // Special cases of intrinsic functions if (call.name.ToString() == "null") { if (arguments.size() == 0) { - // TODO: NULL() result type is determined by context - // Can pass that context in, or return a token distinguishing - // NULL, or represent NULL as a new kind of top-level expression + return std::make_optional( + SpecificIntrinsic{"null"s}, std::move(arguments)); + // TODO pmk work in progress - fold into NullPointer (where?) } else if (arguments.size() > 1) { genericErrors.Say("too many arguments to NULL()"_err_en_US); } else if (arguments[0].has_value() && arguments[0]->keyword.has_value() && @@ -1264,10 +1264,16 @@ std::optional IntrinsicProcTable::Implementation::Probe( genericErrors.Say("unknown argument '%s' to NULL()"_err_en_US, arguments[0]->keyword->ToString().data()); } else { - // TODO: Argument must be pointer, procedure pointer, or allocatable. - // Characteristics, including dynamic length type parameter values, - // must be taken from the MOLD argument. - // TODO: set Attr::POINTER on NULL result + Expr &mold{*arguments[0]->value}; + if (IsPointerOrAllocatable(mold)) { + return std::make_optional( + SpecificIntrinsic{"null"s, mold.GetType(), mold.Rank(), + semantics::Attrs{semantics::Attr::POINTER}}, + std::move(arguments)); + } else { + genericErrors.Say("MOLD argument to NULL() must be a pointer " + "or allocatable"_err_en_US); + } } } // No match diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc index 4d93f23..6a16deb 100644 --- a/flang/lib/evaluate/tools.cc +++ b/flang/lib/evaluate/tools.cc @@ -347,6 +347,10 @@ std::optional> Negation( messages.Say("BOZ literal cannot be negated"_err_en_US); return NoExpr(); }, + [&](NullPointer &&) { + messages.Say("NULL() cannot be negated"_err_en_US); + return NoExpr(); + }, [&](Expr &&x) { return Package(-std::move(x)); }, [&](Expr &&x) { return Package(-std::move(x)); }, [&](Expr &&x) { return Package(-std::move(x)); }, @@ -501,7 +505,8 @@ std::optional> ConvertToNumeric(int kind, Expr &&x) { return std::visit( [=](auto &&cx) -> std::optional> { using cxType = std::decay_t; - if constexpr (!std::is_same_v) { + if constexpr (!std::is_same_v && + !std::is_same_v) { if constexpr (IsNumericTypeCategory(ResultType::category)) { return std::make_optional( Expr{ConvertToKind(kind, std::move(cx))}); diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h index 4f9b99e..9656482 100644 --- a/flang/lib/evaluate/tools.h +++ b/flang/lib/evaluate/tools.h @@ -20,6 +20,7 @@ #include "../common/idioms.h" #include "../common/unwrap.h" #include "../parser/message.h" +#include "../semantics/attr.h" #include "../semantics/symbol.h" #include #include @@ -124,6 +125,10 @@ inline Expr AsGenericExpr(BOZLiteralConstant &&x) { return Expr{std::move(x)}; } +inline Expr AsGenericExpr(NullPointer &&x) { + return Expr{std::move(x)}; +} + Expr GetComplexPart( const Expr &, bool isImaginary = false); @@ -140,7 +145,8 @@ auto UnwrapExpr(B &x) -> common::Constify * { using Ty = std::decay_t; if constexpr (std::is_same_v) { return &x; - } else if constexpr (std::is_same_v) { + } else if constexpr (std::is_same_v || + std::is_same_v) { return nullptr; } else if constexpr (std::is_same_v>>) { return common::Unwrap(x.u); @@ -521,5 +527,31 @@ struct TypeKindVisitor { int kind; VALUE value; }; + +template const semantics::Symbol *GetLastSymbol(const A &) { + return nullptr; +} + +template +const semantics::Symbol *GetLastSymbol(const Designator &x) { + return x.GetLastSymbol(); +} + +template const semantics::Symbol *GetLastSymbol(const Expr &x) { + return std::visit([](const auto &y) { return GetLastSymbol(y); }, x.u); +} + +template semantics::Attrs GetAttrs(const A &x) { + if (const semantics::Symbol * symbol{GetLastSymbol(x)}) { + return symbol->attrs(); + } else { + return {}; + } +} + +template bool IsPointerOrAllocatable(const A &x) { + return GetAttrs(x).HasAny( + semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE}); +} } #endif // FORTRAN_EVALUATE_TOOLS_H_ diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 666d089..b1d127b 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -96,6 +96,7 @@ static std::optional ExtractDataRef(Expr &&expr) { [](BOZLiteralConstant &&) -> std::optional { return std::nullopt; }, + [](NullPointer &&) -> std::optional { return std::nullopt; }, [](auto &&catExpr) { return ExtractDataRef(std::move(catExpr)); }, }, std::move(expr.u)); @@ -1644,6 +1645,9 @@ static MaybeExpr AnalyzeExpr( [&](BOZLiteralConstant &&boz) { return operand; // ignore parentheses around typeless constants }, + [&](NullPointer &&boz) { + return operand; // ignore parentheses around NULL() + }, [&](Expr &&) { // TODO: parenthesized derived type variable return operand; @@ -1669,6 +1673,9 @@ static MaybeExpr AnalyzeExpr( std::visit( common::visitors{ [](const BOZLiteralConstant &) {}, // allow +Z'1', it's harmless + [&](const NullPointer &) { + context.Say("+NULL() is not allowed"_err_en_US); + }, [&](const auto &catExpr) { TypeCategory cat{ResultType::category}; if (cat != TypeCategory::Integer && cat != TypeCategory::Real && -- 2.7.4