03618fd5e3
Original-commit: flang-compiler/f18@f75c3e0ccf Reviewed-on: https://github.com/flang-compiler/f18/pull/225 Tree-same-pre-rewrite: false
1336 lines
55 KiB
C++
1336 lines
55 KiB
C++
// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
// you may not use this file except in compliance with the License.
|
|
// You may obtain a copy of the License at
|
|
//
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
|
|
#include "intrinsics.h"
|
|
#include "expression.h"
|
|
#include "tools.h"
|
|
#include "type.h"
|
|
#include "../common/enum-set.h"
|
|
#include "../common/fortran.h"
|
|
#include "../common/idioms.h"
|
|
#include "../semantics/default-kinds.h"
|
|
#include <algorithm>
|
|
#include <map>
|
|
#include <ostream>
|
|
#include <sstream>
|
|
#include <string>
|
|
#include <utility>
|
|
|
|
using namespace Fortran::parser::literals;
|
|
|
|
namespace Fortran::evaluate {
|
|
|
|
using common::TypeCategory;
|
|
|
|
// This file defines the supported intrinsic procedures and implements
|
|
// their recognition and validation. It is largely table-driven. See
|
|
// documentation/intrinsics.md and section 16 of the Fortran 2018 standard
|
|
// for full details on each of the intrinsics. Be advised, they have
|
|
// complicated details, and the design of these tables has to accommodate
|
|
// that complexity.
|
|
|
|
// Dummy arguments to generic intrinsic procedures are each specified by
|
|
// their keyword name (rarely used, but always defined), allowable type
|
|
// categories, a kind pattern, a rank pattern, and information about
|
|
// optionality and defaults. The kind and rank patterns are represented
|
|
// here with code values that are significant to the matching/validation engine.
|
|
|
|
// These are small bit-sets of type category enumerators.
|
|
// Note that typeless (BOZ literal) values don't have a distinct type category.
|
|
// These typeless arguments are represented in the tables as if they were
|
|
// INTEGER with a special "typeless" kind code. Arguments of intrinsic types
|
|
// that can also be be typeless values are encoded with an "elementalOrBOZ"
|
|
// rank pattern.
|
|
using CategorySet = common::EnumSet<TypeCategory, 8>;
|
|
static constexpr CategorySet IntType{TypeCategory::Integer};
|
|
static constexpr CategorySet RealType{TypeCategory::Real};
|
|
static constexpr CategorySet ComplexType{TypeCategory::Complex};
|
|
static constexpr CategorySet CharType{TypeCategory::Character};
|
|
static constexpr CategorySet LogicalType{TypeCategory::Logical};
|
|
static constexpr CategorySet IntOrRealType{IntType | RealType};
|
|
static constexpr CategorySet FloatingType{RealType | ComplexType};
|
|
static constexpr CategorySet NumericType{IntType | RealType | ComplexType};
|
|
static constexpr CategorySet RelatableType{IntType | RealType | CharType};
|
|
static constexpr CategorySet IntrinsicType{
|
|
IntType | RealType | ComplexType | CharType | LogicalType};
|
|
static constexpr CategorySet AnyType{
|
|
IntrinsicType | CategorySet{TypeCategory::Derived}};
|
|
|
|
ENUM_CLASS(KindCode, none, defaultIntegerKind,
|
|
defaultRealKind, // is also the default COMPLEX kind
|
|
doublePrecision, defaultCharKind, defaultLogicalKind,
|
|
any, // matches any kind value; each instance is independent
|
|
typeless, // BOZ literals are INTEGER with this kind
|
|
teamType, // TEAM_TYPE from module ISO_FORTRAN_ENV (for coarrays)
|
|
kindArg, // this argument is KIND=
|
|
effectiveKind, // for function results: same "kindArg", possibly defaulted
|
|
dimArg, // this argument is DIM=
|
|
same, // match any kind; all "same" kinds must be equal
|
|
likeMultiply, // for DOT_PRODUCT and MATMUL
|
|
)
|
|
|
|
struct TypePattern {
|
|
CategorySet categorySet;
|
|
KindCode kindCode{KindCode::none};
|
|
std::ostream &Dump(std::ostream &) const;
|
|
};
|
|
|
|
// Abbreviations for argument and result patterns in the intrinsic prototypes:
|
|
|
|
// Match specific kinds of intrinsic types
|
|
static constexpr TypePattern DefaultInt{IntType, KindCode::defaultIntegerKind};
|
|
static constexpr TypePattern DefaultReal{RealType, KindCode::defaultRealKind};
|
|
static constexpr TypePattern DefaultComplex{
|
|
ComplexType, KindCode::defaultRealKind};
|
|
static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
|
|
static constexpr TypePattern DefaultLogical{
|
|
LogicalType, KindCode::defaultLogicalKind};
|
|
static constexpr TypePattern BOZ{IntType, KindCode::typeless};
|
|
static constexpr TypePattern TEAM_TYPE{IntType, KindCode::teamType};
|
|
static constexpr TypePattern DoublePrecision{
|
|
RealType, KindCode::doublePrecision};
|
|
|
|
// Match any kind of some intrinsic or derived types
|
|
static constexpr TypePattern AnyInt{IntType, KindCode::any};
|
|
static constexpr TypePattern AnyReal{RealType, KindCode::any};
|
|
static constexpr TypePattern AnyIntOrReal{IntOrRealType, KindCode::any};
|
|
static constexpr TypePattern AnyComplex{ComplexType, KindCode::any};
|
|
static constexpr TypePattern AnyNumeric{NumericType, KindCode::any};
|
|
static constexpr TypePattern AnyChar{CharType, KindCode::any};
|
|
static constexpr TypePattern AnyLogical{LogicalType, KindCode::any};
|
|
static constexpr TypePattern AnyRelatable{RelatableType, KindCode::any};
|
|
static constexpr TypePattern Anything{AnyType, KindCode::any};
|
|
|
|
// Match some kind of some intrinsic type(s); all "Same" values must match,
|
|
// even when not in the same category (e.g., SameComplex and SameReal).
|
|
// Can be used to specify a result so long as at least one argument is
|
|
// a "Same".
|
|
static constexpr TypePattern SameInt{IntType, KindCode::same};
|
|
static constexpr TypePattern SameReal{RealType, KindCode::same};
|
|
static constexpr TypePattern SameIntOrReal{IntOrRealType, KindCode::same};
|
|
static constexpr TypePattern SameComplex{ComplexType, KindCode::same};
|
|
static constexpr TypePattern SameFloating{FloatingType, KindCode::same};
|
|
static constexpr TypePattern SameNumeric{NumericType, KindCode::same};
|
|
static constexpr TypePattern SameChar{CharType, KindCode::same};
|
|
static constexpr TypePattern SameLogical{LogicalType, KindCode::same};
|
|
static constexpr TypePattern SameRelatable{RelatableType, KindCode::same};
|
|
static constexpr TypePattern SameIntrinsic{IntrinsicType, KindCode::same};
|
|
static constexpr TypePattern SameDerivedType{
|
|
CategorySet{TypeCategory::Derived}, KindCode::same};
|
|
static constexpr TypePattern SameType{AnyType, KindCode::same};
|
|
|
|
// For DOT_PRODUCT and MATMUL, the result type depends on the arguments
|
|
static constexpr TypePattern ResultLogical{LogicalType, KindCode::likeMultiply};
|
|
static constexpr TypePattern ResultNumeric{NumericType, KindCode::likeMultiply};
|
|
|
|
// Result types with known category and KIND=
|
|
static constexpr TypePattern KINDInt{IntType, KindCode::effectiveKind};
|
|
static constexpr TypePattern KINDReal{RealType, KindCode::effectiveKind};
|
|
static constexpr TypePattern KINDComplex{ComplexType, KindCode::effectiveKind};
|
|
static constexpr TypePattern KINDChar{CharType, KindCode::effectiveKind};
|
|
static constexpr TypePattern KINDLogical{LogicalType, KindCode::effectiveKind};
|
|
|
|
// The default rank pattern for dummy arguments and function results is
|
|
// "elemental".
|
|
ENUM_CLASS(Rank,
|
|
elemental, // scalar, or array that conforms with other array arguments
|
|
elementalOrBOZ, // elemental, or typeless BOZ literal scalar
|
|
scalar, vector,
|
|
shape, // INTEGER vector of known length and no negative element
|
|
matrix,
|
|
array, // not scalar, rank is known and greater than zero
|
|
known, // rank is known and can be scalar
|
|
anyOrAssumedRank, // rank can be unknown
|
|
conformable, // scalar, or array of same rank & shape as "array" argument
|
|
reduceOperation, // a pure function with constraints for REDUCE
|
|
dimReduced, // scalar if no DIM= argument, else rank(array)-1
|
|
dimRemoved, // scalar, or rank(array)-1
|
|
rankPlus1, // rank(known)+1
|
|
shaped, // rank is length of SHAPE vector
|
|
)
|
|
|
|
ENUM_CLASS(Optionality, required, optional,
|
|
defaultsToSameKind, // for MatchingDefaultKIND
|
|
defaultsToDefaultForResult, // for DefaultingKIND
|
|
defaultsToSubscriptKind, // for SubscriptDefaultKIND
|
|
repeats, // for MAX/MIN and their several variants
|
|
)
|
|
|
|
struct IntrinsicDummyArgument {
|
|
const char *keyword{nullptr};
|
|
TypePattern typePattern;
|
|
Rank rank{Rank::elemental};
|
|
Optionality optionality{Optionality::required};
|
|
std::ostream &Dump(std::ostream &) const;
|
|
};
|
|
|
|
// constexpr abbreviations for popular arguments:
|
|
// DefaultingKIND is a KIND= argument whose default value is the appropriate
|
|
// KIND(0), KIND(0.0), KIND(''), &c. value for the function result.
|
|
static constexpr IntrinsicDummyArgument DefaultingKIND{"kind",
|
|
{IntType, KindCode::kindArg}, Rank::scalar,
|
|
Optionality::defaultsToDefaultForResult};
|
|
// MatchingDefaultKIND is a KIND= argument whose default value is the
|
|
// kind of any "Same" function argument (viz., the one whose kind pattern is
|
|
// "same").
|
|
static constexpr IntrinsicDummyArgument MatchingDefaultKIND{"kind",
|
|
{IntType, KindCode::kindArg}, Rank::scalar,
|
|
Optionality::defaultsToSameKind};
|
|
// SubscriptDefaultKind is a KIND= argument whose default value is
|
|
// the kind of INTEGER used for address calculations.
|
|
static constexpr IntrinsicDummyArgument SubscriptDefaultKIND{"kind",
|
|
{IntType, KindCode::kindArg}, Rank::scalar,
|
|
Optionality::defaultsToSubscriptKind};
|
|
static constexpr IntrinsicDummyArgument OptionalDIM{
|
|
"dim", {IntType, KindCode::dimArg}, Rank::scalar, Optionality::optional};
|
|
static constexpr IntrinsicDummyArgument OptionalMASK{
|
|
"mask", AnyLogical, Rank::conformable, Optionality::optional};
|
|
|
|
struct IntrinsicInterface {
|
|
static constexpr int maxArguments{7}; // if not a MAX/MIN(...)
|
|
const char *name{nullptr};
|
|
IntrinsicDummyArgument dummy[maxArguments];
|
|
TypePattern result;
|
|
Rank rank{Rank::elemental};
|
|
std::optional<SpecificCall> Match(const CallCharacteristics &,
|
|
const semantics::IntrinsicTypeDefaultKinds &, ActualArguments &,
|
|
parser::ContextualMessages &messages) const;
|
|
std::ostream &Dump(std::ostream &) const;
|
|
};
|
|
|
|
// GENERIC INTRINSIC FUNCTION INTERFACES
|
|
// Each entry in this table defines a pattern. Some intrinsic
|
|
// functions have more than one such pattern. Besides the name
|
|
// of the intrinsic function, each pattern has specifications for
|
|
// the dummy arguments and for the result of the function.
|
|
// The dummy argument patterns each have a name (this are from the
|
|
// standard, but rarely appear in actual code), a type and kind
|
|
// pattern, allowable ranks, and optionality indicators.
|
|
// Be advised, the default rank pattern is "elemental".
|
|
static const IntrinsicInterface genericIntrinsicFunction[]{
|
|
{"abs", {{"a", SameIntOrReal}}, SameIntOrReal},
|
|
{"abs", {{"a", SameComplex}}, SameReal},
|
|
{"achar", {{"i", AnyInt}, DefaultingKIND}, KINDChar},
|
|
{"acos", {{"x", SameFloating}}, SameFloating},
|
|
{"acosh", {{"x", SameFloating}}, SameFloating},
|
|
{"adjustl", {{"string", SameChar}}, SameChar},
|
|
{"adjustr", {{"string", SameChar}}, SameChar},
|
|
{"aimag", {{"x", SameComplex}}, SameReal},
|
|
{"aint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
|
|
{"all", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
|
|
Rank::dimReduced},
|
|
{"anint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
|
|
{"any", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
|
|
Rank::dimReduced},
|
|
{"asin", {{"x", SameFloating}}, SameFloating},
|
|
{"asinh", {{"x", SameFloating}}, SameFloating},
|
|
{"atan", {{"x", SameFloating}}, SameFloating},
|
|
{"atan", {{"y", SameReal}, {"x", SameReal}}, SameReal},
|
|
{"atan2", {{"y", SameReal}, {"x", SameReal}}, SameReal},
|
|
{"atanh", {{"x", SameFloating}}, SameFloating},
|
|
{"bessel_j0", {{"x", SameReal}}, SameReal},
|
|
{"bessel_j1", {{"x", SameReal}}, SameReal},
|
|
{"bessel_jn", {{"n", AnyInt}, {"x", SameReal}}, SameReal},
|
|
{"bessel_jn",
|
|
{{"n1", AnyInt, Rank::scalar}, {"n2", AnyInt, Rank::scalar},
|
|
{"x", SameReal, Rank::scalar}},
|
|
SameReal, Rank::vector},
|
|
{"bessel_y0", {{"x", SameReal}}, SameReal},
|
|
{"bessel_y1", {{"x", SameReal}}, SameReal},
|
|
{"bessel_yn", {{"n", AnyInt}, {"x", SameReal}}, SameReal},
|
|
{"bessel_yn",
|
|
{{"n1", AnyInt, Rank::scalar}, {"n2", AnyInt, Rank::scalar},
|
|
{"x", SameReal, Rank::scalar}},
|
|
SameReal, Rank::vector},
|
|
{"bge",
|
|
{{"i", AnyInt, Rank::elementalOrBOZ},
|
|
{"j", AnyInt, Rank::elementalOrBOZ}},
|
|
DefaultLogical},
|
|
{"bgt",
|
|
{{"i", AnyInt, Rank::elementalOrBOZ},
|
|
{"j", AnyInt, Rank::elementalOrBOZ}},
|
|
DefaultLogical},
|
|
{"ble",
|
|
{{"i", AnyInt, Rank::elementalOrBOZ},
|
|
{"j", AnyInt, Rank::elementalOrBOZ}},
|
|
DefaultLogical},
|
|
{"blt",
|
|
{{"i", AnyInt, Rank::elementalOrBOZ},
|
|
{"j", AnyInt, Rank::elementalOrBOZ}},
|
|
DefaultLogical},
|
|
{"btest", {{"i", AnyInt}, {"pos", AnyInt}}, DefaultLogical},
|
|
{"ceiling", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
|
|
{"char", {{"i", AnyInt}, DefaultingKIND}, KINDChar},
|
|
{"cmplx", {{"x", AnyComplex}, DefaultingKIND}, KINDComplex},
|
|
{"cmplx",
|
|
{{"x", SameIntOrReal, Rank::elementalOrBOZ},
|
|
{"y", SameIntOrReal, Rank::elementalOrBOZ}, DefaultingKIND},
|
|
KINDComplex},
|
|
{"command_argument_count", {}, DefaultInt, Rank::scalar},
|
|
{"conjg", {{"z", SameComplex}}, SameComplex},
|
|
{"cos", {{"x", SameFloating}}, SameFloating},
|
|
{"cosh", {{"x", SameFloating}}, SameFloating},
|
|
{"count", {{"mask", AnyLogical, Rank::array}, OptionalDIM, DefaultingKIND},
|
|
KINDInt, Rank::dimReduced},
|
|
{"cshift",
|
|
{{"array", SameType, Rank::array}, {"shift", AnyInt, Rank::dimRemoved},
|
|
OptionalDIM},
|
|
SameType, Rank::array},
|
|
{"dble", {{"a", AnyNumeric, Rank::elementalOrBOZ}}, DoublePrecision},
|
|
{"dim", {{"x", SameIntOrReal}, {"y", SameIntOrReal}}, SameIntOrReal},
|
|
{"dot_product",
|
|
{{"vector_a", AnyLogical, Rank::vector},
|
|
{"vector_b", AnyLogical, Rank::vector}},
|
|
ResultLogical, Rank::scalar},
|
|
{"dot_product",
|
|
{{"vector_a", AnyComplex, Rank::vector},
|
|
{"vector_b", AnyNumeric, Rank::vector}},
|
|
ResultNumeric, Rank::scalar}, // conjugates vector_a
|
|
{"dot_product",
|
|
{{"vector_a", AnyIntOrReal, Rank::vector},
|
|
{"vector_b", AnyNumeric, Rank::vector}},
|
|
ResultNumeric, Rank::scalar},
|
|
{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision},
|
|
{"dshiftl",
|
|
{{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
|
|
{"shift", AnyInt}},
|
|
SameInt},
|
|
{"dshiftl", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"dshiftr",
|
|
{{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
|
|
{"shift", AnyInt}},
|
|
SameInt},
|
|
{"dshiftr", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"eoshift",
|
|
{{"array", SameIntrinsic, Rank::array},
|
|
{"shift", AnyInt, Rank::dimRemoved},
|
|
{"boundary", SameIntrinsic, Rank::dimRemoved,
|
|
Optionality::optional},
|
|
OptionalDIM},
|
|
SameIntrinsic, Rank::array},
|
|
{"eoshift",
|
|
{{"array", SameDerivedType, Rank::array},
|
|
{"shift", AnyInt, Rank::dimRemoved},
|
|
{"boundary", SameDerivedType, Rank::dimRemoved}, OptionalDIM},
|
|
SameDerivedType, Rank::array},
|
|
{"erf", {{"x", SameReal}}, SameReal},
|
|
{"erfc", {{"x", SameReal}}, SameReal},
|
|
{"erfc_scaled", {{"x", SameReal}}, SameReal},
|
|
{"exp", {{"x", SameFloating}}, SameFloating},
|
|
{"exponent", {{"x", AnyReal}}, DefaultInt},
|
|
{"findloc",
|
|
{{"array", AnyNumeric, Rank::array},
|
|
{"value", AnyNumeric, Rank::scalar}, OptionalDIM, OptionalMASK,
|
|
SubscriptDefaultKIND,
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
KINDInt, Rank::dimReduced},
|
|
{"findloc",
|
|
{{"array", SameChar, Rank::array}, {"value", SameChar, Rank::scalar},
|
|
OptionalDIM, OptionalMASK, SubscriptDefaultKIND,
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
KINDInt, Rank::dimReduced},
|
|
{"findloc",
|
|
{{"array", AnyLogical, Rank::array},
|
|
{"value", AnyLogical, Rank::scalar}, OptionalDIM, OptionalMASK,
|
|
SubscriptDefaultKIND,
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
KINDInt, Rank::dimReduced},
|
|
{"floor", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
|
|
{"fraction", {{"x", SameReal}}, SameReal},
|
|
{"gamma", {{"x", SameReal}}, SameReal},
|
|
{"hypot", {{"x", SameReal}, {"y", SameReal}}, SameReal},
|
|
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
|
|
{"iall", {{"array", SameInt, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameInt, Rank::dimReduced},
|
|
{"iany", {{"array", SameInt, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameInt, Rank::dimReduced},
|
|
{"iparity", {{"array", SameInt, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameInt, Rank::dimReduced},
|
|
{"iand", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt},
|
|
{"iand", {{"i", BOZ}, {"j", SameInt}}, SameInt},
|
|
{"ibclr", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
|
|
{"ibits", {{"i", SameInt}, {"pos", AnyInt}, {"len", AnyInt}}, SameInt},
|
|
{"ibset", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
|
|
{"ichar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
|
|
{"ieor", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt},
|
|
{"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
|
|
{"image_status",
|
|
{{"image", SameInt},
|
|
{"team", TEAM_TYPE, Rank::scalar, Optionality::optional}},
|
|
DefaultInt},
|
|
{"index",
|
|
{{"string", SameChar}, {"substring", SameChar},
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional},
|
|
SubscriptDefaultKIND},
|
|
KINDInt},
|
|
{"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt},
|
|
{"ior", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt},
|
|
{"ior", {{"i", BOZ}, {"j", SameInt}}, SameInt},
|
|
{"ishft", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"ishftc",
|
|
{{"i", SameInt}, {"shift", AnyInt},
|
|
{"size", AnyInt, Rank::elemental, Optionality::optional}},
|
|
SameInt},
|
|
{"is_iostat_end", {{"i", AnyInt}}, DefaultLogical},
|
|
{"is_iostat_eor", {{"i", AnyInt}}, DefaultLogical},
|
|
{"lbound",
|
|
{{"array", Anything, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
|
|
KINDInt, Rank::vector},
|
|
{"lbound",
|
|
{{"array", Anything, Rank::anyOrAssumedRank},
|
|
{"dim", {IntType, KindCode::dimArg}, Rank::scalar},
|
|
SubscriptDefaultKIND},
|
|
KINDInt, Rank::scalar},
|
|
{"leadz", {{"i", AnyInt}}, DefaultInt},
|
|
{"len", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt},
|
|
{"len_trim", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt},
|
|
{"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
|
|
{"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
|
|
{"lle", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
|
|
{"llt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
|
|
{"log", {{"x", SameFloating}}, SameFloating},
|
|
{"log10", {{"x", SameReal}}, SameReal},
|
|
{"logical", {{"l", AnyLogical}, DefaultingKIND}, KINDLogical},
|
|
{"log_gamma", {{"x", SameReal}}, SameReal},
|
|
{"matmul",
|
|
{{"array_a", AnyLogical, Rank::vector},
|
|
{"array_b", AnyLogical, Rank::matrix}},
|
|
ResultLogical, Rank::vector},
|
|
{"matmul",
|
|
{{"array_a", AnyLogical, Rank::matrix},
|
|
{"array_b", AnyLogical, Rank::vector}},
|
|
ResultLogical, Rank::vector},
|
|
{"matmul",
|
|
{{"array_a", AnyLogical, Rank::matrix},
|
|
{"array_b", AnyLogical, Rank::matrix}},
|
|
ResultLogical, Rank::matrix},
|
|
{"matmul",
|
|
{{"array_a", AnyNumeric, Rank::vector},
|
|
{"array_b", AnyNumeric, Rank::matrix}},
|
|
ResultNumeric, Rank::vector},
|
|
{"matmul",
|
|
{{"array_a", AnyNumeric, Rank::matrix},
|
|
{"array_b", AnyNumeric, Rank::vector}},
|
|
ResultNumeric, Rank::vector},
|
|
{"matmul",
|
|
{{"array_a", AnyNumeric, Rank::matrix},
|
|
{"array_b", AnyNumeric, Rank::matrix}},
|
|
ResultNumeric, Rank::matrix},
|
|
{"maskl", {{"i", AnyInt}, DefaultingKIND}, KINDInt},
|
|
{"maskr", {{"i", AnyInt}, DefaultingKIND}, KINDInt},
|
|
{"max",
|
|
{{"a1", SameRelatable}, {"a2", SameRelatable},
|
|
{"a3", SameRelatable, Rank::elemental, Optionality::repeats}},
|
|
SameRelatable},
|
|
{"maxloc",
|
|
{{"array", AnyRelatable, Rank::array}, OptionalDIM, OptionalMASK,
|
|
SubscriptDefaultKIND,
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
KINDInt, Rank::dimReduced},
|
|
{"maxval",
|
|
{{"array", SameRelatable, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameRelatable, Rank::dimReduced},
|
|
{"merge",
|
|
{{"tsource", SameType}, {"fsource", SameType}, {"mask", AnyLogical}},
|
|
SameType},
|
|
{"merge_bits",
|
|
{{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
|
|
{"mask", SameInt, Rank::elementalOrBOZ}},
|
|
SameInt},
|
|
{"merge_bits",
|
|
{{"i", BOZ}, {"j", SameInt}, {"mask", SameInt, Rank::elementalOrBOZ}},
|
|
SameInt},
|
|
{"min",
|
|
{{"a1", SameRelatable}, {"a2", SameRelatable},
|
|
{"a3", SameRelatable, Rank::elemental, Optionality::repeats}},
|
|
SameRelatable},
|
|
{"minloc",
|
|
{{"array", AnyRelatable, Rank::array}, OptionalDIM, OptionalMASK,
|
|
SubscriptDefaultKIND,
|
|
{"back", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
KINDInt, Rank::dimReduced},
|
|
{"minval",
|
|
{{"array", SameRelatable, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameRelatable, Rank::dimReduced},
|
|
{"mod", {{"a", SameIntOrReal}, {"p", SameIntOrReal}}, SameIntOrReal},
|
|
{"modulo", {{"a", SameIntOrReal}, {"p", SameIntOrReal}}, SameIntOrReal},
|
|
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
|
|
{"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
|
|
{"norm2", {{"x", SameReal, Rank::array}, OptionalDIM}, SameReal,
|
|
Rank::dimReduced},
|
|
{"not", {{"i", SameInt}}, SameInt},
|
|
// NULL() is a special case handled in Probe() below
|
|
{"out_of_range",
|
|
{{"x", AnyIntOrReal}, {"mold", AnyIntOrReal, Rank::scalar}},
|
|
DefaultLogical},
|
|
{"out_of_range",
|
|
{{"x", AnyReal}, {"mold", AnyInt, Rank::scalar},
|
|
{"round", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
DefaultLogical},
|
|
{"out_of_range", {{"x", AnyReal}, {"mold", AnyReal}}, DefaultLogical},
|
|
{"pack",
|
|
{{"array", SameType, Rank::array},
|
|
{"mask", AnyLogical, Rank::conformable},
|
|
{"vector", SameType, Rank::vector, Optionality::optional}},
|
|
SameType, Rank::vector},
|
|
{"parity", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
|
|
Rank::dimReduced},
|
|
{"popcnt", {{"i", AnyInt}}, DefaultInt},
|
|
{"poppar", {{"i", AnyInt}}, DefaultInt},
|
|
{"product",
|
|
{{"array", SameNumeric, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameNumeric, Rank::dimReduced},
|
|
{"real", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND},
|
|
KINDReal},
|
|
{"reduce",
|
|
{{"array", SameType, Rank::array},
|
|
{"operation", SameType, Rank::reduceOperation}, OptionalDIM,
|
|
OptionalMASK, {"identity", SameType, Rank::scalar},
|
|
{"ordered", AnyLogical, Rank::scalar, Optionality::optional}},
|
|
SameType, Rank::dimReduced},
|
|
{"repeat", {{"string", SameChar, Rank::scalar}, {"ncopies", AnyInt}},
|
|
SameChar, Rank::scalar},
|
|
{"reshape",
|
|
{{"source", SameType, Rank::array}, {"shape", AnyInt, Rank::shape},
|
|
{"pad", SameType, Rank::array, Optionality::optional},
|
|
{"order", AnyInt, Rank::vector, Optionality::optional}},
|
|
SameType, Rank::shaped},
|
|
{"rrspacing", {{"x", SameReal}}, SameReal},
|
|
{"scale", {{"x", SameReal}, {"i", AnyInt}}, SameReal},
|
|
{"scan",
|
|
{{"string", SameChar}, {"set", SameChar},
|
|
{"back", AnyLogical, Rank::elemental, Optionality::optional},
|
|
SubscriptDefaultKIND},
|
|
KINDInt},
|
|
{"selected_char_kind", {{"name", DefaultChar, Rank::scalar}}, DefaultInt,
|
|
Rank::scalar},
|
|
{"selected_int_kind", {{"r", AnyInt, Rank::scalar}}, DefaultInt,
|
|
Rank::scalar},
|
|
{"selected_real_kind",
|
|
{{"p", AnyInt, Rank::scalar},
|
|
{"r", AnyInt, Rank::scalar, Optionality::optional},
|
|
{"radix", AnyInt, Rank::scalar, Optionality::optional}},
|
|
DefaultInt, Rank::scalar},
|
|
{"selected_real_kind",
|
|
{{"p", AnyInt, Rank::scalar, Optionality::optional},
|
|
{"r", AnyInt, Rank::scalar},
|
|
{"radix", AnyInt, Rank::scalar, Optionality::optional}},
|
|
DefaultInt, Rank::scalar},
|
|
{"selected_real_kind",
|
|
{{"p", AnyInt, Rank::scalar, Optionality::optional},
|
|
{"r", AnyInt, Rank::scalar, Optionality::optional},
|
|
{"radix", AnyInt, Rank::scalar}},
|
|
DefaultInt, Rank::scalar},
|
|
{"set_exponent", {{"x", SameReal}, {"i", AnyInt}}, SameReal},
|
|
{"shape",
|
|
{{"source", Anything, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
|
|
KINDInt, Rank::vector},
|
|
{"shifta", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"shiftl", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"shiftr", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
|
|
{"sign", {{"a", SameIntOrReal}, {"b", SameIntOrReal}}, SameIntOrReal},
|
|
{"sin", {{"x", SameFloating}}, SameFloating},
|
|
{"sinh", {{"x", SameFloating}}, SameFloating},
|
|
{"size",
|
|
{{"array", Anything, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
|
|
KINDInt, Rank::vector},
|
|
{"size",
|
|
{{"array", Anything, Rank::anyOrAssumedRank},
|
|
{"dim", {IntType, KindCode::dimArg}, Rank::scalar},
|
|
SubscriptDefaultKIND},
|
|
KINDInt, Rank::scalar},
|
|
{"spacing", {{"x", SameReal}}, SameReal},
|
|
{"spread",
|
|
{{"source", SameType, Rank::known},
|
|
{"dim", {IntType, KindCode::dimArg}, Rank::scalar /*not optional*/},
|
|
{"ncopies", AnyInt, Rank::scalar}},
|
|
SameType, Rank::rankPlus1},
|
|
{"sqrt", {{"x", SameFloating}}, SameFloating},
|
|
{"sum", {{"array", SameNumeric, Rank::array}, OptionalDIM, OptionalMASK},
|
|
SameNumeric, Rank::dimReduced},
|
|
{"tan", {{"x", SameFloating}}, SameFloating},
|
|
{"tanh", {{"x", SameFloating}}, SameFloating},
|
|
{"trailz", {{"i", AnyInt}}, DefaultInt},
|
|
{"transfer",
|
|
{{"source", Anything, Rank::known}, {"mold", SameType, Rank::scalar}},
|
|
SameType, Rank::scalar},
|
|
{"transfer",
|
|
{{"source", Anything, Rank::known}, {"mold", SameType, Rank::array}},
|
|
SameType, Rank::vector},
|
|
{"transfer",
|
|
{{"source", Anything, Rank::known}, {"mold", SameType, Rank::known},
|
|
{"size", AnyInt, Rank::scalar}},
|
|
SameType, Rank::vector},
|
|
{"transpose", {{"matrix", SameType, Rank::matrix}}, SameType, Rank::matrix},
|
|
{"trim", {{"string", SameChar, Rank::scalar}}, SameChar, Rank::scalar},
|
|
{"ubound",
|
|
{{"array", Anything, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
|
|
KINDInt, Rank::vector},
|
|
{"ubound",
|
|
{{"array", Anything, Rank::anyOrAssumedRank},
|
|
{"dim", {IntType, KindCode::dimArg}, Rank::scalar},
|
|
SubscriptDefaultKIND},
|
|
KINDInt, Rank::scalar},
|
|
{"unpack",
|
|
{{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
|
|
{"field", SameType, Rank::conformable}},
|
|
SameType, Rank::conformable},
|
|
{"verify",
|
|
{{"string", SameChar}, {"set", SameChar},
|
|
{"back", AnyLogical, Rank::elemental, Optionality::optional},
|
|
SubscriptDefaultKIND},
|
|
KINDInt},
|
|
};
|
|
|
|
// TODO: Coarray intrinsic functions
|
|
// LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX,
|
|
// NUM_IMAGES, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE,
|
|
// COSHAPE
|
|
// TODO: Object characteristic inquiry functions
|
|
// ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS,
|
|
// PRESENT, RANK, SAME_TYPE, STORAGE_SIZE
|
|
// TODO: Type inquiry intrinsic functions - these return constants
|
|
// BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT,
|
|
// NEW_LINE, PRECISION, RADIX, RANGE, TINY
|
|
// TODO: Non-standard intrinsic functions
|
|
// AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
|
|
// COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL,
|
|
// DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, LOC,
|
|
// QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM,
|
|
// INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF,
|
|
// MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
|
|
// IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,
|
|
// EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC
|
|
// probably more (these are PGI + Intel, possibly incomplete)
|
|
|
|
struct SpecificIntrinsicInterface : public IntrinsicInterface {
|
|
const char *generic{nullptr};
|
|
bool isRestrictedSpecific{
|
|
false}; // when true, can only be called, not passed
|
|
};
|
|
|
|
static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
|
|
{{"abs", {{"a", DefaultReal}}, DefaultReal}},
|
|
{{"acos", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"aimag", {{"z", DefaultComplex}}, DefaultReal}},
|
|
{{"aint", {{"a", DefaultReal}}, DefaultReal}},
|
|
{{"alog", {{"x", DefaultReal}}, DefaultReal}, "log"},
|
|
{{"alog10", {{"x", DefaultReal}}, DefaultReal}, "log10"},
|
|
{{"amax0",
|
|
{{"a1", DefaultInt}, {"a2", DefaultInt},
|
|
{"a3", DefaultInt, Rank::elemental, Optionality::repeats}},
|
|
DefaultReal},
|
|
"max", true},
|
|
{{"amax1",
|
|
{{"a1", DefaultReal}, {"a2", DefaultReal},
|
|
{"a3", DefaultReal, Rank::elemental, Optionality::repeats}},
|
|
DefaultReal},
|
|
"max", true},
|
|
{{"amin0",
|
|
{{"a1", DefaultInt}, {"a2", DefaultInt},
|
|
{"a3", DefaultInt, Rank::elemental, Optionality::repeats}},
|
|
DefaultReal},
|
|
"min", true},
|
|
{{"amin1",
|
|
{{"a1", DefaultReal}, {"a2", DefaultReal},
|
|
{"a3", DefaultReal, Rank::elemental, Optionality::repeats}},
|
|
DefaultReal},
|
|
"min", true},
|
|
{{"amod", {{"a", DefaultReal}, {"p", DefaultReal}}, DefaultReal}, "mod"},
|
|
{{"anint", {{"a", DefaultReal}}, DefaultReal}},
|
|
{{"asin", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"atan", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"atan2", {{"y", DefaultReal}, {"x", DefaultReal}}, DefaultReal}},
|
|
{{"cabs", {{"a", DefaultComplex}}, DefaultReal}, "abs"},
|
|
{{"ccos", {{"a", DefaultComplex}}, DefaultComplex}, "cos"},
|
|
{{"cexp", {{"a", DefaultComplex}}, DefaultComplex}, "exp"},
|
|
{{"clog", {{"a", DefaultComplex}}, DefaultComplex}, "log"},
|
|
{{"conjg", {{"a", DefaultComplex}}, DefaultComplex}},
|
|
{{"cos", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"csin", {{"a", DefaultComplex}}, DefaultComplex}, "sin"},
|
|
{{"csqrt", {{"a", DefaultComplex}}, DefaultComplex}, "sqrt"},
|
|
{{"ctan", {{"a", DefaultComplex}}, DefaultComplex}, "tan"},
|
|
{{"dabs", {{"a", DoublePrecision}}, DoublePrecision}, "abs"},
|
|
{{"dacos", {{"x", DoublePrecision}}, DoublePrecision}, "acos"},
|
|
{{"dasin", {{"x", DoublePrecision}}, DoublePrecision}, "asin"},
|
|
{{"datan", {{"x", DoublePrecision}}, DoublePrecision}, "atan"},
|
|
{{"datan2", {{"y", DoublePrecision}, {"x", DoublePrecision}},
|
|
DoublePrecision},
|
|
"atan2"},
|
|
{{"dcos", {{"x", DoublePrecision}}, DoublePrecision}, "cos"},
|
|
{{"dcosh", {{"x", DoublePrecision}}, DoublePrecision}, "cosh"},
|
|
{{"ddim", {{"x", DoublePrecision}, {"y", DoublePrecision}},
|
|
DoublePrecision},
|
|
"dim"},
|
|
{{"dexp", {{"x", DoublePrecision}}, DoublePrecision}, "exp"},
|
|
{{"dim", {{"x", DefaultReal}, {"y", DefaultReal}}, DefaultReal}},
|
|
{{"dint", {{"a", DoublePrecision}}, DoublePrecision}, "aint"},
|
|
{{"dlog", {{"x", DoublePrecision}}, DoublePrecision}, "log"},
|
|
{{"dlog10", {{"x", DoublePrecision}}, DoublePrecision}, "log10"},
|
|
{{"dmax1",
|
|
{{"a1", DoublePrecision}, {"a2", DoublePrecision},
|
|
{"a3", DoublePrecision, Rank::elemental, Optionality::repeats}},
|
|
DoublePrecision},
|
|
"max", true},
|
|
{{"dmin1",
|
|
{{"a1", DoublePrecision}, {"a2", DoublePrecision},
|
|
{"a3", DoublePrecision, Rank::elemental, Optionality::repeats}},
|
|
DoublePrecision},
|
|
"min", true},
|
|
{{"dmod", {{"a", DoublePrecision}, {"p", DoublePrecision}},
|
|
DoublePrecision},
|
|
"mod"},
|
|
{{"dnint", {{"a", DoublePrecision}}, DoublePrecision}, "anint"},
|
|
{{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision}},
|
|
{{"dsign", {{"a", DoublePrecision}, {"b", DoublePrecision}},
|
|
DoublePrecision},
|
|
"sign"},
|
|
{{"dsin", {{"x", DoublePrecision}}, DoublePrecision}, "sin"},
|
|
{{"dsinh", {{"x", DoublePrecision}}, DoublePrecision}, "sinh"},
|
|
{{"dsqrt", {{"x", DoublePrecision}}, DoublePrecision}, "sqrt"},
|
|
{{"dtan", {{"x", DoublePrecision}}, DoublePrecision}, "tan"},
|
|
{{"dtanh", {{"x", DoublePrecision}}, DoublePrecision}, "tanh"},
|
|
{{"exp", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"float", {{"i", DefaultInt}}, DefaultReal}, "real", true},
|
|
{{"iabs", {{"a", DefaultInt}}, DefaultInt}, "abs"},
|
|
{{"idim", {{"x", DefaultInt}, {"y", DefaultInt}}, DefaultInt}, "dim"},
|
|
{{"idint", {{"a", DoublePrecision}}, DefaultInt}, "int", true},
|
|
{{"idnint", {{"a", DoublePrecision}}, DefaultInt}, "nint"},
|
|
{{"ifix", {{"a", DefaultReal}}, DefaultInt}, "int", true},
|
|
{{"index", {{"string", DefaultChar}, {"substring", DefaultChar}},
|
|
DefaultInt}},
|
|
{{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"},
|
|
{{"len", {{"string", DefaultChar}}, DefaultInt}},
|
|
{{"log", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"log10", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"max0",
|
|
{{"a1", DefaultInt}, {"a2", DefaultInt},
|
|
{"a3", DefaultInt, Rank::elemental, Optionality::repeats}},
|
|
DefaultInt},
|
|
"max", true},
|
|
{{"max1",
|
|
{{"a1", DefaultReal}, {"a2", DefaultReal},
|
|
{"a3", DefaultReal, Rank::elemental, Optionality::repeats}},
|
|
DefaultInt},
|
|
"max", true},
|
|
{{"min0",
|
|
{{"a1", DefaultInt}, {"a2", DefaultInt},
|
|
{"a3", DefaultInt, Rank::elemental, Optionality::repeats}},
|
|
DefaultInt},
|
|
"min", true},
|
|
{{"min1",
|
|
{{"a1", DefaultReal}, {"a2", DefaultReal},
|
|
{"a3", DefaultReal, Rank::elemental, Optionality::repeats}},
|
|
DefaultInt},
|
|
"min", true},
|
|
{{"mod", {{"a", DefaultInt}, {"p", DefaultInt}}, DefaultInt}},
|
|
{{"nint", {{"a", DefaultReal}}, DefaultInt}},
|
|
{{"sign", {{"a", DefaultReal}, {"b", DefaultReal}}, DefaultReal}},
|
|
{{"sin", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"sinh", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"sngl", {{"a", DoublePrecision}}, DefaultReal}, "real", true},
|
|
{{"sqrt", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"tan", {{"x", DefaultReal}}, DefaultReal}},
|
|
{{"tanh", {{"x", DefaultReal}}, DefaultReal}},
|
|
};
|
|
|
|
// TODO: Intrinsic subroutines
|
|
// MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY,
|
|
// EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT,
|
|
// GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER,
|
|
// RANDOM_SEED, SYSTEM_CLOCK
|
|
// TODO: Atomic intrinsic subroutines: ATOMIC_ADD &al.
|
|
// TODO: Collective intrinsic subroutines: CO_BROADCAST &al.
|
|
|
|
// Intrinsic interface matching against the arguments of a particular
|
|
// procedure reference.
|
|
std::optional<SpecificCall> IntrinsicInterface::Match(
|
|
const CallCharacteristics &call,
|
|
const semantics::IntrinsicTypeDefaultKinds &defaults,
|
|
ActualArguments &arguments, parser::ContextualMessages &messages) const {
|
|
// Attempt to construct a 1-1 correspondence between the dummy arguments in
|
|
// a particular intrinsic procedure's generic interface and the actual
|
|
// arguments in a procedure reference.
|
|
std::size_t dummyArgPatterns{0};
|
|
for (; dummyArgPatterns < maxArguments &&
|
|
dummy[dummyArgPatterns].keyword != nullptr;
|
|
++dummyArgPatterns) {
|
|
}
|
|
std::vector<ActualArgument *> actualForDummy(dummyArgPatterns, nullptr);
|
|
// MAX and MIN (and others that map to them) allow their last argument to
|
|
// be repeated indefinitely. The actualForDummy vector is sized
|
|
// and null-initialized to the non-repeated dummy argument count,
|
|
// but additional actual argument pointers can be pushed on it
|
|
// when this flag is set.
|
|
bool repeatLastDummy{dummyArgPatterns > 0 &&
|
|
dummy[dummyArgPatterns - 1].optionality == Optionality::repeats};
|
|
int missingActualArguments{0};
|
|
for (std::optional<ActualArgument> &arg : arguments) {
|
|
if (!arg.has_value()) {
|
|
++missingActualArguments;
|
|
} else {
|
|
if (arg->isAlternateReturn) {
|
|
messages.Say(
|
|
"alternate return specifier not acceptable on call to intrinsic '%s'"_err_en_US,
|
|
name);
|
|
return std::nullopt;
|
|
}
|
|
bool found{false};
|
|
int slot{missingActualArguments};
|
|
for (std::size_t j{0}; j < dummyArgPatterns && !found; ++j) {
|
|
if (arg->keyword.has_value()) {
|
|
found = *arg->keyword == dummy[j].keyword;
|
|
if (found) {
|
|
if (const auto *previous{actualForDummy[j]}) {
|
|
if (previous->keyword.has_value()) {
|
|
messages.Say(*arg->keyword,
|
|
"repeated keyword argument to intrinsic '%s'"_err_en_US,
|
|
name);
|
|
} else {
|
|
messages.Say(*arg->keyword,
|
|
"keyword argument to intrinsic '%s' was supplied "
|
|
"positionally by an earlier actual argument"_err_en_US,
|
|
name);
|
|
}
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
} else {
|
|
found = actualForDummy[j] == nullptr && slot-- == 0;
|
|
}
|
|
if (found) {
|
|
actualForDummy[j] = &*arg;
|
|
}
|
|
}
|
|
if (!found) {
|
|
if (repeatLastDummy && !arg->keyword.has_value()) {
|
|
// MAX/MIN argument after the 2nd
|
|
actualForDummy.push_back(&*arg);
|
|
} else {
|
|
if (arg->keyword.has_value()) {
|
|
messages.Say(*arg->keyword,
|
|
"unknown keyword argument to intrinsic '%s'"_err_en_US, name);
|
|
} else {
|
|
messages.Say(
|
|
"too many actual arguments for intrinsic '%s'"_err_en_US, name);
|
|
}
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
std::size_t dummies{actualForDummy.size()};
|
|
|
|
// Check types and kinds of the actual arguments against the intrinsic's
|
|
// interface. Ensure that two or more arguments that have to have the same
|
|
// type and kind do so. Check for missing non-optional arguments now, too.
|
|
const ActualArgument *sameArg{nullptr};
|
|
const IntrinsicDummyArgument *kindDummyArg{nullptr};
|
|
const ActualArgument *kindArg{nullptr};
|
|
bool hasDimArg{false};
|
|
for (std::size_t j{0}; j < dummies; ++j) {
|
|
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
|
|
if (d.typePattern.kindCode == KindCode::kindArg) {
|
|
CHECK(kindDummyArg == nullptr);
|
|
kindDummyArg = &d;
|
|
}
|
|
const ActualArgument *arg{actualForDummy[j]};
|
|
if (!arg) {
|
|
if (d.optionality == Optionality::required) {
|
|
messages.Say("missing mandatory '%s=' argument"_err_en_US, d.keyword);
|
|
return std::nullopt; // missing non-OPTIONAL argument
|
|
} else {
|
|
continue;
|
|
}
|
|
}
|
|
std::optional<DynamicType> type{arg->GetType()};
|
|
if (!type.has_value()) {
|
|
CHECK(arg->Rank() == 0);
|
|
if (d.typePattern.kindCode == KindCode::typeless ||
|
|
d.rank == Rank::elementalOrBOZ) {
|
|
continue;
|
|
}
|
|
messages.Say(
|
|
"typeless (BOZ) not allowed for '%s=' argument"_err_en_US, d.keyword);
|
|
return std::nullopt;
|
|
} else if (!d.typePattern.categorySet.test(type->category)) {
|
|
messages.Say("actual argument for '%s=' has bad type '%s'"_err_en_US,
|
|
d.keyword, type->Dump().data());
|
|
return std::nullopt; // argument has invalid type category
|
|
}
|
|
bool argOk{false};
|
|
switch (d.typePattern.kindCode) {
|
|
case KindCode::none:
|
|
case KindCode::typeless:
|
|
case KindCode::teamType: // TODO: TEAM_TYPE
|
|
argOk = false;
|
|
break;
|
|
case KindCode::defaultIntegerKind:
|
|
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Integer);
|
|
break;
|
|
case KindCode::defaultRealKind:
|
|
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Real);
|
|
break;
|
|
case KindCode::doublePrecision:
|
|
argOk = type->kind == defaults.doublePrecisionKind();
|
|
break;
|
|
case KindCode::defaultCharKind:
|
|
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Character);
|
|
break;
|
|
case KindCode::defaultLogicalKind:
|
|
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Logical);
|
|
break;
|
|
case KindCode::any: argOk = true; break;
|
|
case KindCode::kindArg:
|
|
CHECK(type->category == TypeCategory::Integer);
|
|
CHECK(kindArg == nullptr);
|
|
kindArg = arg;
|
|
argOk = true;
|
|
break;
|
|
case KindCode::dimArg:
|
|
CHECK(type->category == TypeCategory::Integer);
|
|
hasDimArg = true;
|
|
argOk = true;
|
|
break;
|
|
case KindCode::same:
|
|
if (sameArg == nullptr) {
|
|
sameArg = arg;
|
|
}
|
|
argOk = *type == sameArg->GetType();
|
|
break;
|
|
case KindCode::effectiveKind:
|
|
common::die("INTERNAL: KindCode::effectiveKind appears on argument '%s' "
|
|
"for intrinsic '%s'",
|
|
d.keyword, name);
|
|
break;
|
|
default: CRASH_NO_CASE;
|
|
}
|
|
if (!argOk) {
|
|
messages.Say(
|
|
"actual argument for '%s=' has bad type or kind '%s'"_err_en_US,
|
|
d.keyword, type->Dump().data());
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
|
|
// Check the ranks of the arguments against the intrinsic's interface.
|
|
const ActualArgument *arrayArg{nullptr};
|
|
const ActualArgument *knownArg{nullptr};
|
|
const ActualArgument *shapeArg{nullptr};
|
|
int elementalRank{0};
|
|
for (std::size_t j{0}; j < dummies; ++j) {
|
|
const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
|
|
if (const ActualArgument * arg{actualForDummy[j]}) {
|
|
if (IsAssumedRank(*arg->value) && d.rank != Rank::anyOrAssumedRank) {
|
|
messages.Say("assumed-rank array cannot be forwarded to "
|
|
"'%s=' argument"_err_en_US,
|
|
d.keyword);
|
|
return std::nullopt;
|
|
}
|
|
int rank{arg->Rank()};
|
|
bool argOk{false};
|
|
switch (d.rank) {
|
|
case Rank::elemental:
|
|
case Rank::elementalOrBOZ:
|
|
if (elementalRank == 0) {
|
|
elementalRank = rank;
|
|
}
|
|
argOk = rank == 0 || rank == elementalRank;
|
|
break;
|
|
case Rank::scalar: argOk = rank == 0; break;
|
|
case Rank::vector: argOk = rank == 1; break;
|
|
case Rank::shape:
|
|
CHECK(shapeArg == nullptr);
|
|
shapeArg = arg;
|
|
argOk = rank == 1 && arg->VectorSize().has_value();
|
|
break;
|
|
case Rank::matrix: argOk = rank == 2; break;
|
|
case Rank::array:
|
|
argOk = rank > 0;
|
|
if (!arrayArg) {
|
|
arrayArg = arg;
|
|
} else {
|
|
argOk &= rank == arrayArg->Rank();
|
|
}
|
|
break;
|
|
case Rank::known:
|
|
CHECK(knownArg == nullptr);
|
|
knownArg = arg;
|
|
argOk = true;
|
|
break;
|
|
case Rank::anyOrAssumedRank: argOk = true; break;
|
|
case Rank::conformable:
|
|
CHECK(arrayArg != nullptr);
|
|
argOk = rank == 0 || rank == arrayArg->Rank();
|
|
break;
|
|
case Rank::dimRemoved:
|
|
CHECK(arrayArg != nullptr);
|
|
if (hasDimArg) {
|
|
argOk = rank + 1 == arrayArg->Rank();
|
|
} else {
|
|
argOk = rank == 0;
|
|
}
|
|
break;
|
|
case Rank::reduceOperation:
|
|
// TODO: Confirm that the argument is a pure function
|
|
// of two arguments with several constraints
|
|
CHECK(arrayArg != nullptr);
|
|
argOk = rank == 0;
|
|
break;
|
|
case Rank::dimReduced:
|
|
case Rank::rankPlus1:
|
|
case Rank::shaped:
|
|
common::die("INTERNAL: result-only rank code appears on argument '%s' "
|
|
"for intrinsic '%s'",
|
|
d.keyword, name);
|
|
default: CRASH_NO_CASE;
|
|
}
|
|
if (!argOk) {
|
|
messages.Say("'%s=' argument has unacceptable rank %d"_err_en_US,
|
|
d.keyword, rank);
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
}
|
|
|
|
// Calculate the characteristics of the function result, if any
|
|
std::optional<DynamicType> resultType;
|
|
if (result.categorySet.empty()) {
|
|
if (!call.isSubroutineCall) {
|
|
return std::nullopt;
|
|
}
|
|
CHECK(result.kindCode == KindCode::none);
|
|
} else {
|
|
// Determine the result type.
|
|
if (call.isSubroutineCall) {
|
|
return std::nullopt;
|
|
}
|
|
resultType = DynamicType{*result.categorySet.LeastElement(), 0};
|
|
switch (result.kindCode) {
|
|
case KindCode::defaultIntegerKind:
|
|
CHECK(result.categorySet == IntType);
|
|
CHECK(resultType->category == TypeCategory::Integer);
|
|
resultType->kind = defaults.GetDefaultKind(TypeCategory::Integer);
|
|
break;
|
|
case KindCode::defaultRealKind:
|
|
CHECK(result.categorySet == CategorySet{resultType->category});
|
|
CHECK(FloatingType.test(resultType->category));
|
|
resultType->kind = defaults.GetDefaultKind(TypeCategory::Real);
|
|
break;
|
|
case KindCode::doublePrecision:
|
|
CHECK(result.categorySet == RealType);
|
|
CHECK(resultType->category == TypeCategory::Real);
|
|
resultType->kind = defaults.doublePrecisionKind();
|
|
break;
|
|
case KindCode::defaultCharKind:
|
|
CHECK(result.categorySet == CharType);
|
|
CHECK(resultType->category == TypeCategory::Character);
|
|
resultType->kind = defaults.GetDefaultKind(TypeCategory::Character);
|
|
break;
|
|
case KindCode::defaultLogicalKind:
|
|
CHECK(result.categorySet == LogicalType);
|
|
CHECK(resultType->category == TypeCategory::Logical);
|
|
resultType->kind = defaults.GetDefaultKind(TypeCategory::Logical);
|
|
break;
|
|
case KindCode::same:
|
|
CHECK(sameArg != nullptr);
|
|
if (std::optional<DynamicType> aType{sameArg->GetType()}) {
|
|
if (result.categorySet.test(aType->category)) {
|
|
resultType = *aType;
|
|
} else {
|
|
resultType->kind = aType->kind;
|
|
}
|
|
}
|
|
break;
|
|
case KindCode::effectiveKind:
|
|
CHECK(kindDummyArg != nullptr);
|
|
CHECK(result.categorySet == CategorySet{resultType->category});
|
|
if (kindArg != nullptr) {
|
|
auto &expr{*kindArg->value};
|
|
CHECK(expr.Rank() == 0);
|
|
if (auto code{ToInt64(expr)}) {
|
|
if (IsValidKindOfIntrinsicType(resultType->category, *code)) {
|
|
resultType->kind = *code;
|
|
break;
|
|
}
|
|
}
|
|
messages.Say("'kind=' argument must be a constant scalar integer "
|
|
"whose value is a supported kind for the "
|
|
"intrinsic result type"_err_en_US);
|
|
return std::nullopt;
|
|
} else if (kindDummyArg->optionality == Optionality::defaultsToSameKind) {
|
|
CHECK(sameArg != nullptr);
|
|
resultType = *sameArg->GetType();
|
|
} else if (kindDummyArg->optionality ==
|
|
Optionality::defaultsToSubscriptKind) {
|
|
CHECK(resultType->category == TypeCategory::Integer);
|
|
resultType->kind = defaults.subscriptIntegerKind();
|
|
} else {
|
|
CHECK(kindDummyArg->optionality ==
|
|
Optionality::defaultsToDefaultForResult);
|
|
resultType->kind = defaults.GetDefaultKind(resultType->category);
|
|
}
|
|
break;
|
|
case KindCode::likeMultiply:
|
|
CHECK(dummies >= 2);
|
|
CHECK(actualForDummy[0] != nullptr);
|
|
CHECK(actualForDummy[1] != nullptr);
|
|
resultType = actualForDummy[0]->GetType()->ResultTypeForMultiply(
|
|
*actualForDummy[1]->GetType());
|
|
break;
|
|
case KindCode::typeless:
|
|
case KindCode::teamType:
|
|
case KindCode::any:
|
|
case KindCode::kindArg:
|
|
case KindCode::dimArg:
|
|
common::die(
|
|
"INTERNAL: bad KindCode appears on intrinsic '%s' result", name);
|
|
break;
|
|
default: CRASH_NO_CASE;
|
|
}
|
|
}
|
|
|
|
// At this point, the call is acceptable.
|
|
// Determine the rank of the function result.
|
|
int resultRank{0};
|
|
switch (rank) {
|
|
case Rank::elemental: resultRank = elementalRank; break;
|
|
case Rank::scalar: resultRank = 0; break;
|
|
case Rank::vector: resultRank = 1; break;
|
|
case Rank::matrix: resultRank = 2; break;
|
|
case Rank::conformable:
|
|
CHECK(arrayArg != nullptr);
|
|
resultRank = arrayArg->Rank();
|
|
break;
|
|
case Rank::dimReduced:
|
|
CHECK(arrayArg != nullptr);
|
|
resultRank = hasDimArg ? arrayArg->Rank() - 1 : 0;
|
|
break;
|
|
case Rank::rankPlus1:
|
|
CHECK(knownArg != nullptr);
|
|
resultRank = knownArg->Rank() + 1;
|
|
break;
|
|
case Rank::shaped:
|
|
CHECK(shapeArg != nullptr);
|
|
{
|
|
std::optional<int> shapeLen{shapeArg->VectorSize()};
|
|
CHECK(shapeLen.has_value());
|
|
resultRank = *shapeLen;
|
|
}
|
|
break;
|
|
case Rank::elementalOrBOZ:
|
|
case Rank::shape:
|
|
case Rank::array:
|
|
case Rank::known:
|
|
case Rank::anyOrAssumedRank:
|
|
case Rank::dimRemoved:
|
|
case Rank::reduceOperation:
|
|
common::die("INTERNAL: bad Rank code on intrinsic '%s' result", name);
|
|
break;
|
|
default: CRASH_NO_CASE;
|
|
}
|
|
CHECK(resultRank >= 0);
|
|
|
|
semantics::Attrs attrs;
|
|
if (elementalRank > 0) {
|
|
attrs.set(semantics::Attr::ELEMENTAL);
|
|
}
|
|
|
|
// Rearrange the actual arguments into dummy argument order.
|
|
ActualArguments rearranged(dummies);
|
|
for (std::size_t j{0}; j < dummies; ++j) {
|
|
if (ActualArgument * arg{actualForDummy[j]}) {
|
|
rearranged[j] = std::move(*arg);
|
|
}
|
|
}
|
|
|
|
return {SpecificCall{
|
|
SpecificIntrinsic{name, std::move(resultType), resultRank, attrs},
|
|
std::move(rearranged)}};
|
|
}
|
|
|
|
struct IntrinsicProcTable::Implementation {
|
|
explicit Implementation(const semantics::IntrinsicTypeDefaultKinds &dfts)
|
|
: defaults{dfts} {
|
|
for (const IntrinsicInterface &f : genericIntrinsicFunction) {
|
|
genericFuncs.insert(std::make_pair(std::string{f.name}, &f));
|
|
}
|
|
for (const SpecificIntrinsicInterface &f : specificIntrinsicFunction) {
|
|
specificFuncs.insert(std::make_pair(std::string{f.name}, &f));
|
|
}
|
|
}
|
|
|
|
std::optional<SpecificCall> Probe(const CallCharacteristics &,
|
|
ActualArguments &, parser::ContextualMessages *) const;
|
|
|
|
semantics::IntrinsicTypeDefaultKinds defaults;
|
|
std::multimap<std::string, const IntrinsicInterface *> genericFuncs;
|
|
std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs;
|
|
std::ostream &Dump(std::ostream &) const;
|
|
};
|
|
|
|
// Probe the configured intrinsic procedure pattern tables in search of a
|
|
// match for a given procedure reference.
|
|
std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
|
|
const CallCharacteristics &call, ActualArguments &arguments,
|
|
parser::ContextualMessages *messages) const {
|
|
if (call.isSubroutineCall) {
|
|
return std::nullopt; // TODO
|
|
}
|
|
parser::Messages *finalBuffer{messages ? messages->messages() : nullptr};
|
|
// Probe the specific intrinsic function table first.
|
|
parser::Messages specificBuffer;
|
|
parser::ContextualMessages specificErrors{
|
|
messages ? messages->at() : call.name,
|
|
finalBuffer ? &specificBuffer : nullptr};
|
|
std::string name{call.name.ToString()};
|
|
auto specificRange{specificFuncs.equal_range(name)};
|
|
for (auto iter{specificRange.first}; iter != specificRange.second; ++iter) {
|
|
if (auto specificCall{
|
|
iter->second->Match(call, defaults, arguments, specificErrors)}) {
|
|
if (const char *genericName{iter->second->generic}) {
|
|
specificCall->specificIntrinsic.name = genericName;
|
|
}
|
|
specificCall->specificIntrinsic.isRestrictedSpecific =
|
|
iter->second->isRestrictedSpecific;
|
|
return specificCall;
|
|
}
|
|
}
|
|
// Probe the generic intrinsic function table next.
|
|
parser::Messages genericBuffer;
|
|
parser::ContextualMessages genericErrors{
|
|
messages ? messages->at() : call.name,
|
|
finalBuffer ? &genericBuffer : nullptr};
|
|
auto genericRange{genericFuncs.equal_range(name)};
|
|
for (auto iter{genericRange.first}; iter != genericRange.second; ++iter) {
|
|
if (auto specificCall{
|
|
iter->second->Match(call, defaults, arguments, genericErrors)}) {
|
|
return specificCall;
|
|
}
|
|
}
|
|
// 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
|
|
} 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() &&
|
|
arguments[0]->keyword->ToString() != "mold") {
|
|
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
|
|
}
|
|
}
|
|
// No match
|
|
if (finalBuffer) {
|
|
if (genericBuffer.empty()) {
|
|
finalBuffer->Annex(std::move(specificBuffer));
|
|
} else {
|
|
finalBuffer->Annex(std::move(genericBuffer));
|
|
}
|
|
}
|
|
return std::nullopt;
|
|
}
|
|
|
|
IntrinsicProcTable::~IntrinsicProcTable() {
|
|
// Discard the configured tables.
|
|
delete impl_;
|
|
impl_ = nullptr;
|
|
}
|
|
|
|
IntrinsicProcTable IntrinsicProcTable::Configure(
|
|
const semantics::IntrinsicTypeDefaultKinds &defaults) {
|
|
IntrinsicProcTable result;
|
|
result.impl_ = new IntrinsicProcTable::Implementation(defaults);
|
|
return result;
|
|
}
|
|
|
|
std::optional<SpecificCall> IntrinsicProcTable::Probe(
|
|
const CallCharacteristics &call, ActualArguments &arguments,
|
|
parser::ContextualMessages *messages) const {
|
|
CHECK(impl_ != nullptr || !"IntrinsicProcTable: not configured");
|
|
return impl_->Probe(call, arguments, messages);
|
|
}
|
|
|
|
std::ostream &SpecificIntrinsic::Dump(std::ostream &o) const {
|
|
return o << name;
|
|
}
|
|
|
|
std::ostream &TypePattern::Dump(std::ostream &o) const {
|
|
if (categorySet == AnyType) {
|
|
o << "any type";
|
|
} else {
|
|
const char *sep = "";
|
|
auto set{categorySet};
|
|
while (auto least{set.LeastElement()}) {
|
|
o << sep << EnumToString(*least);
|
|
sep = " or ";
|
|
set.reset(*least);
|
|
}
|
|
}
|
|
o << '(' << EnumToString(kindCode) << ')';
|
|
return o;
|
|
}
|
|
|
|
std::ostream &IntrinsicDummyArgument::Dump(std::ostream &o) const {
|
|
if (keyword) {
|
|
o << keyword << '=';
|
|
}
|
|
return typePattern.Dump(o)
|
|
<< ' ' << EnumToString(rank) << ' ' << EnumToString(optionality);
|
|
}
|
|
|
|
std::ostream &IntrinsicInterface::Dump(std::ostream &o) const {
|
|
o << name;
|
|
char sep{'('};
|
|
for (const auto &d : dummy) {
|
|
if (d.typePattern.kindCode == KindCode::none) {
|
|
break;
|
|
}
|
|
d.Dump(o << sep);
|
|
sep = ',';
|
|
}
|
|
if (sep == '(') {
|
|
o << "()";
|
|
}
|
|
return result.Dump(o << " -> ") << ' ' << EnumToString(rank);
|
|
}
|
|
|
|
std::ostream &IntrinsicProcTable::Implementation::Dump(std::ostream &o) const {
|
|
o << "generic intrinsic functions:\n";
|
|
for (const auto &iter : genericFuncs) {
|
|
iter.second->Dump(o << iter.first << ": ") << '\n';
|
|
}
|
|
o << "specific intrinsic functions:\n";
|
|
for (const auto &iter : specificFuncs) {
|
|
iter.second->Dump(o << iter.first << ": ");
|
|
if (const char *g{iter.second->generic}) {
|
|
o << " -> " << g;
|
|
}
|
|
o << '\n';
|
|
}
|
|
return o;
|
|
}
|
|
|
|
std::ostream &IntrinsicProcTable::Dump(std::ostream &o) const {
|
|
return impl_->Dump(o);
|
|
}
|
|
}
|