[flang] more intrinsics

Original-commit: flang-compiler/f18@2e7210be5b
Reviewed-on: https://github.com/flang-compiler/f18/pull/212
Tree-same-pre-rewrite: false

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

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<SpecificIntrinsic> 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));

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 <memory>
 #include <optional>
@@ -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<ActualArgument> &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};
 };

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

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<typename A> struct FunctionRef : public UntypedFunctionRef {
   static_assert(Result::isSpecificIntrinsicType ||
       std::is_same_v<Result, SomeKind<TypeCategory::Derived>>);
   // 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<typename A> struct FunctionRef : public UntypedFunctionRef {
   }
 };
 
+FOR_EACH_SPECIFIC_TYPE(extern template struct FunctionRef)
+
 template<typename A> 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_