[&](const BOZLiteralConstant &x) {
o << "z'" << x.Hexadecimal() << "'";
},
+ [&](const NullPointer &) { o << "NULL()"; },
[&](const CopyableIndirection<Substring> &s) { s->AsFortran(o); },
[&](const ImpliedDoIndex &i) { o << i.name.ToString(); },
[&](const auto &x) { x.AsFortran(o); },
} else {
return std::visit(
[](const auto &x) -> std::optional<DynamicType> {
- if constexpr (!std::is_same_v<std::decay_t<decltype(x)>,
- BOZLiteralConstant>) {
+ using Ty = std::decay_t<decltype(x)>;
+ if constexpr (std::is_same_v<Ty, BOZLiteralConstant> ||
+ std::is_same_v<Ty, NullPointer>) {
+ return std::nullopt; // typeless really means "no type"
+ } else {
return x.GetType();
}
- return std::nullopt; // typeless really means "no type"
},
derived().u);
}
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
common::MapTemplate<Expr, CategoryTypes<CAT>> 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<SomeType> : public ExpressionBase<SomeType> {
}
private:
- using Others = std::variant<BOZLiteralConstant>;
+ using Others = std::variant<BOZLiteralConstant, NullPointer>;
using Categories = common::MapTemplate<Expr, SomeCategory>;
public:
return FoldOperation(context, std::move(x));
} else if constexpr (std::is_same_v<T, SomeDerived>) {
return FoldOperation(context, std::move(x));
- } else if constexpr (std::is_same_v<BOZLiteralConstant,
- std::decay_t<decltype(x)>>) {
- return std::move(expr);
} else {
- return Expr<T>{Fold(context, std::move(x))};
+ using Ty = std::decay_t<decltype(x)>;
+ if constexpr (std::is_same_v<Ty, BOZLiteralConstant> ||
+ std::is_same_v<Ty, NullPointer>) {
+ return std::move(expr);
+ } else {
+ return Expr<T>{Fold(context, std::move(x))};
+ }
}
},
std::move(expr.u));
bool IsConstExpr(ConstExprContext &, const BOZLiteralConstant &) {
return true;
}
+bool IsConstExpr(ConstExprContext &, const NullPointer &) { return true; }
template<typename A> bool IsConstExpr(ConstExprContext &, const Constant<A> &) {
return true;
}
}
}
- return {SpecificCall{
+ return std::make_optional<SpecificCall>(
SpecificIntrinsic{name, std::move(resultType), resultRank, attrs},
- std::move(rearranged)}};
+ std::move(rearranged));
}
class IntrinsicProcTable::Implementation {
// 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<SpecificCall>(
+ 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() &&
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<SomeType> &mold{*arguments[0]->value};
+ if (IsPointerOrAllocatable(mold)) {
+ return std::make_optional<SpecificCall>(
+ 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
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<SomeInteger> &&x) { return Package(-std::move(x)); },
[&](Expr<SomeReal> &&x) { return Package(-std::move(x)); },
[&](Expr<SomeComplex> &&x) { return Package(-std::move(x)); },
return std::visit(
[=](auto &&cx) -> std::optional<Expr<SomeType>> {
using cxType = std::decay_t<decltype(cx)>;
- if constexpr (!std::is_same_v<cxType, BOZLiteralConstant>) {
+ if constexpr (!std::is_same_v<cxType, BOZLiteralConstant> &&
+ !std::is_same_v<cxType, NullPointer>) {
if constexpr (IsNumericTypeCategory(ResultType<cxType>::category)) {
return std::make_optional(
Expr<SomeType>{ConvertToKind<TO>(kind, std::move(cx))});
#include "../common/idioms.h"
#include "../common/unwrap.h"
#include "../parser/message.h"
+#include "../semantics/attr.h"
#include "../semantics/symbol.h"
#include <array>
#include <optional>
return Expr<SomeType>{std::move(x)};
}
+inline Expr<SomeType> AsGenericExpr(NullPointer &&x) {
+ return Expr<SomeType>{std::move(x)};
+}
+
Expr<SomeReal> GetComplexPart(
const Expr<SomeComplex> &, bool isImaginary = false);
using Ty = std::decay_t<B>;
if constexpr (std::is_same_v<A, Ty>) {
return &x;
- } else if constexpr (std::is_same_v<Ty, BOZLiteralConstant>) {
+ } else if constexpr (std::is_same_v<Ty, BOZLiteralConstant> ||
+ std::is_same_v<Ty, NullPointer>) {
return nullptr;
} else if constexpr (std::is_same_v<Ty, Expr<ResultType<A>>>) {
return common::Unwrap<A>(x.u);
int kind;
VALUE value;
};
+
+template<typename A> const semantics::Symbol *GetLastSymbol(const A &) {
+ return nullptr;
+}
+
+template<typename T>
+const semantics::Symbol *GetLastSymbol(const Designator<T> &x) {
+ return x.GetLastSymbol();
+}
+
+template<typename T> const semantics::Symbol *GetLastSymbol(const Expr<T> &x) {
+ return std::visit([](const auto &y) { return GetLastSymbol(y); }, x.u);
+}
+
+template<typename A> semantics::Attrs GetAttrs(const A &x) {
+ if (const semantics::Symbol * symbol{GetLastSymbol(x)}) {
+ return symbol->attrs();
+ } else {
+ return {};
+ }
+}
+
+template<typename A> bool IsPointerOrAllocatable(const A &x) {
+ return GetAttrs(x).HasAny(
+ semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
+}
}
#endif // FORTRAN_EVALUATE_TOOLS_H_
[](BOZLiteralConstant &&) -> std::optional<DataRef> {
return std::nullopt;
},
+ [](NullPointer &&) -> std::optional<DataRef> { return std::nullopt; },
[](auto &&catExpr) { return ExtractDataRef(std::move(catExpr)); },
},
std::move(expr.u));
[&](BOZLiteralConstant &&boz) {
return operand; // ignore parentheses around typeless constants
},
+ [&](NullPointer &&boz) {
+ return operand; // ignore parentheses around NULL()
+ },
[&](Expr<SomeDerived> &&) {
// TODO: parenthesized derived type variable
return operand;
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<decltype(catExpr)>::category};
if (cat != TypeCategory::Integer && cat != TypeCategory::Real &&
projects / platform / upstream / llvm.git / commitdiff