From 8efb8972c20af9f73fdb2508b62aab126ca0d0e1 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 10 Oct 2018 10:48:12 -0700 Subject: [PATCH] [flang] more intrinsics Original-commit: flang-compiler/f18@2e7210be5b2db80c8aa446c4313c8b8df697fac0 Reviewed-on: https://github.com/flang-compiler/f18/pull/212 Tree-same-pre-rewrite: false --- flang/lib/evaluate/call.cc | 3 +++ flang/lib/evaluate/intrinsics.cc | 28 +++++++++++++++++++++++++++- flang/lib/evaluate/intrinsics.h | 6 ++++-- flang/lib/evaluate/variable.cc | 1 - flang/lib/evaluate/variable.h | 11 ++++++----- 5 files changed, 40 insertions(+), 9 deletions(-) diff --git a/flang/lib/evaluate/call.cc b/flang/lib/evaluate/call.cc index 359790a9ecc7..6ea212f9756b 100644 --- a/flang/lib/evaluate/call.cc +++ b/flang/lib/evaluate/call.cc @@ -32,4 +32,7 @@ std::ostream &ActualArgument::Dump(std::ostream &o) const { } return value->Dump(o); } + +FOR_EACH_SPECIFIC_TYPE(template struct FunctionRef) + } // namespace Fortran::evaluate diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 22acc6f2c0cf..dd4ec9dbcd0b 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -434,7 +434,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"norm2", {{"x", SameReal, Rank::array}, OptionalDIM}, SameReal, Rank::dimReduced}, {"not", {{"i", SameInt}}, SameInt}, - // pmk WIP continue here in transformationals with NULL + // NULL() is a special case handled in Probe() below {"out_of_range", {{"x", SameIntOrReal}, {"mold", AnyIntOrReal, Rank::scalar}}, DftLogical}, @@ -457,6 +457,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ SameNumeric, Rank::dimReduced}, {"real", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDReal}, + // pmk WIP continue here with REDUCE + // TODO: repeat {"reshape", {{"source", SameType, Rank::array}, {"shape", AnyInt, Rank::shape}, {"pad", SameType, Rank::array, Optionality::optional}, @@ -469,7 +471,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"back", AnyLogical, Rank::elemental, Optionality::optional}, DefaultingKIND}, KINDInt}, + // TODO: selected_char/int/real_kind {"set_exponent", {{"x", SameReal}, {"i", AnyInt}}, SameReal}, + // TODO: shape {"shifta", {{"i", SameInt}, {"shift", AnyInt}}, SameInt}, {"shiftl", {{"i", SameInt}, {"shift", AnyInt}}, SameInt}, {"shiftr", {{"i", SameInt}, {"shift", AnyInt}}, SameInt}, @@ -523,6 +527,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ KINDInt}, }; +// TODO: Coarray intrinsic functions +// TODO: Inquiry intrinsic functions +// TODO: Object characteristic inquiry functions // Not covered by the table above: // MAX, MIN, MERGE @@ -993,6 +1000,25 @@ std::optional IntrinsicProcTable::Implementation::Probe( return specific; } } + // Special case intrinsic functions + if (call.name.ToString() == "null") { + if (call.argument.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 + } else if (call.argument.size() > 1) { + errors.Say("too many arguments to NULL()"_err_en_US); + } else if (call.argument[0].keyword.has_value() && + call.argument[0].keyword->ToString() != "mold") { + errors.Say("unknown argument '%s' to NULL()"_err_en_US, + call.argument[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. + } + } + // No match CHECK(!buffer.empty()); if (messages != nullptr && messages->messages() != nullptr) { messages->messages()->Annex(std::move(buffer)); diff --git a/flang/lib/evaluate/intrinsics.h b/flang/lib/evaluate/intrinsics.h index 77d7c7f64b21..ba1557371e36 100644 --- a/flang/lib/evaluate/intrinsics.h +++ b/flang/lib/evaluate/intrinsics.h @@ -18,7 +18,6 @@ #include "call.h" #include "type.h" #include "../common/idioms.h" -#include "../parser/char-block.h" #include "../parser/message.h" #include #include @@ -26,12 +25,14 @@ namespace Fortran::evaluate { +class Argument; + // Placeholder ENUM_CLASS(IntrinsicProcedure, IAND, IEOR, IOR, LEN, MAX, MIN) struct CallCharacteristics { parser::CharBlock name; - const std::vector &argument; + const Arguments &argument; bool isSubroutineCall{false}; }; @@ -41,6 +42,7 @@ struct SpecificIntrinsic { : name{n}, isElemental{isElem}, type{dt}, rank{r} {} const char *name; // not owner bool isElemental{false}; + bool isPointer{false}; // NULL() DynamicType type; int rank{0}; }; diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc index b90fd014314c..26f3bb7e30cb 100644 --- a/flang/lib/evaluate/variable.cc +++ b/flang/lib/evaluate/variable.cc @@ -477,6 +477,5 @@ const Symbol *ProcedureDesignator::GetSymbol() const { } FOR_EACH_CHARACTER_KIND(template class Designator) -FOR_EACH_SPECIFIC_TYPE(template struct FunctionRef) } // namespace Fortran::evaluate diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h index 17962c3908bf..2dc545692c49 100644 --- a/flang/lib/evaluate/variable.h +++ b/flang/lib/evaluate/variable.h @@ -21,6 +21,7 @@ // Fortran 2018 language standard (q.v.) and uses strong typing to ensure // that only admissable combinations can be constructed. +#include "call.h" #include "common.h" #include "intrinsics.h" #include "type.h" @@ -280,7 +281,8 @@ public: Variant u; }; -// TODO pmk: move more of these into call.h/cc... +FOR_EACH_CHARACTER_KIND(extern template class Designator) + struct ProcedureDesignator { EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator) explicit ProcedureDesignator(IntrinsicProcedure p) : u{p} {} @@ -319,7 +321,7 @@ template struct FunctionRef : public UntypedFunctionRef { static_assert(Result::isSpecificIntrinsicType || std::is_same_v>); // Subtlety: There is a distinction that must be maintained here between an - // actual argument expression that *is* a variable and one that is not, + // actual argument expression that is a variable and one that is not, // e.g. between X and (X). The parser attempts to parse each argument // first as a variable, then as an expression, and the distinction appears // in the parse tree. @@ -339,6 +341,8 @@ template struct FunctionRef : public UntypedFunctionRef { } }; +FOR_EACH_SPECIFIC_TYPE(extern template struct FunctionRef) + template struct Variable { using Result = A; static_assert(Result::isSpecificIntrinsicType || @@ -379,8 +383,5 @@ private: Arguments arguments_; }; -FOR_EACH_CHARACTER_KIND(extern template class Designator) - } // namespace Fortran::evaluate - #endif // FORTRAN_EVALUATE_VARIABLE_H_