2020-02-25 23:11:52 +08:00
|
|
|
//===-- lib/Semantics/expression.cpp --------------------------------------===//
|
2018-07-14 07:55:11 +08:00
|
|
|
//
|
2019-12-21 04:52:07 +08:00
|
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
2018-07-14 07:55:11 +08:00
|
|
|
//
|
2020-01-11 04:12:03 +08:00
|
|
|
//===----------------------------------------------------------------------===//
|
2018-07-14 07:55:11 +08:00
|
|
|
|
2020-02-25 23:11:52 +08:00
|
|
|
#include "flang/Semantics/expression.h"
|
2019-10-10 07:30:34 +08:00
|
|
|
#include "check-call.h"
|
2020-01-07 01:16:18 +08:00
|
|
|
#include "pointer-assignment.h"
|
2020-02-25 23:11:52 +08:00
|
|
|
#include "flang/Common/idioms.h"
|
|
|
|
#include "flang/Evaluate/common.h"
|
|
|
|
#include "flang/Evaluate/fold.h"
|
|
|
|
#include "flang/Evaluate/tools.h"
|
|
|
|
#include "flang/Parser/characters.h"
|
|
|
|
#include "flang/Parser/dump-parse-tree.h"
|
|
|
|
#include "flang/Parser/parse-tree-visitor.h"
|
|
|
|
#include "flang/Parser/parse-tree.h"
|
|
|
|
#include "flang/Semantics/scope.h"
|
|
|
|
#include "flang/Semantics/semantics.h"
|
|
|
|
#include "flang/Semantics/symbol.h"
|
|
|
|
#include "flang/Semantics/tools.h"
|
2019-03-12 06:39:11 +08:00
|
|
|
#include <algorithm>
|
2018-08-14 04:33:31 +08:00
|
|
|
#include <functional>
|
2018-09-01 04:28:21 +08:00
|
|
|
#include <optional>
|
2019-02-15 04:51:20 +08:00
|
|
|
#include <set>
|
2019-12-12 07:06:24 +08:00
|
|
|
#include <sstream>
|
2019-04-13 07:50:58 +08:00
|
|
|
|
2018-12-01 07:23:33 +08:00
|
|
|
// Typedef for optional generic expressions (ubiquitous in this file)
|
2018-12-01 06:03:05 +08:00
|
|
|
using MaybeExpr =
|
|
|
|
std::optional<Fortran::evaluate::Expr<Fortran::evaluate::SomeType>>;
|
|
|
|
|
2018-09-13 02:20:30 +08:00
|
|
|
// Much of the code that implements semantic analysis of expressions is
|
2020-02-25 23:11:52 +08:00
|
|
|
// tightly coupled with their typed representations in lib/Evaluate,
|
2018-09-13 02:20:30 +08:00
|
|
|
// and appears here in namespace Fortran::evaluate for convenience.
|
2018-09-01 04:28:21 +08:00
|
|
|
namespace Fortran::evaluate {
|
2018-07-14 07:55:11 +08:00
|
|
|
|
2019-11-07 07:54:26 +08:00
|
|
|
using common::LanguageFeature;
|
2019-11-03 00:56:46 +08:00
|
|
|
using common::NumericOperator;
|
2018-08-15 05:35:51 +08:00
|
|
|
using common::TypeCategory;
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
static inline std::string ToUpperCase(const std::string &str) {
|
|
|
|
return parser::ToUpperCaseLetters(str);
|
|
|
|
}
|
|
|
|
|
2019-01-23 08:30:32 +08:00
|
|
|
struct DynamicTypeWithLength : public DynamicType {
|
2019-03-12 06:39:11 +08:00
|
|
|
explicit DynamicTypeWithLength(const DynamicType &t) : DynamicType{t} {}
|
2019-02-27 07:59:25 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> LEN() const;
|
2019-01-23 08:30:32 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> length;
|
|
|
|
};
|
|
|
|
|
2019-02-27 07:59:25 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (length) {
|
2019-02-27 07:59:25 +08:00
|
|
|
return length;
|
|
|
|
}
|
2019-05-14 00:33:18 +08:00
|
|
|
if (auto *lengthParam{charLength()}) {
|
|
|
|
if (const auto &len{lengthParam->GetExplicit()}) {
|
2019-02-27 07:59:25 +08:00
|
|
|
return ConvertToType<SubscriptInteger>(common::Clone(*len));
|
|
|
|
}
|
|
|
|
}
|
2019-12-12 07:06:24 +08:00
|
|
|
return std::nullopt; // assumed or deferred length
|
2019-02-27 07:59:25 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
|
2019-01-23 08:30:32 +08:00
|
|
|
const std::optional<parser::TypeSpec> &spec) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (spec) {
|
2019-01-23 08:30:32 +08:00
|
|
|
if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
|
|
|
|
// Name resolution sets TypeSpec::declTypeSpec only when it's valid
|
|
|
|
// (viz., an intrinsic type with valid known kind or a non-polymorphic
|
|
|
|
// & non-ABSTRACT derived type).
|
|
|
|
if (const semantics::IntrinsicTypeSpec *
|
|
|
|
intrinsic{typeSpec->AsIntrinsic()}) {
|
|
|
|
TypeCategory category{intrinsic->category()};
|
2019-02-27 07:59:25 +08:00
|
|
|
if (auto optKind{ToInt64(intrinsic->kind())}) {
|
|
|
|
int kind{static_cast<int>(*optKind)};
|
2019-01-23 08:30:32 +08:00
|
|
|
if (category == TypeCategory::Character) {
|
|
|
|
const semantics::CharacterTypeSpec &cts{
|
|
|
|
typeSpec->characterTypeSpec()};
|
2019-02-27 07:59:25 +08:00
|
|
|
const semantics::ParamValue &len{cts.length()};
|
2019-01-23 08:30:32 +08:00
|
|
|
// N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
|
|
|
|
// type guards, but not in array constructors.
|
2019-02-27 07:59:25 +08:00
|
|
|
return DynamicTypeWithLength{DynamicType{kind, len}};
|
|
|
|
} else {
|
|
|
|
return DynamicTypeWithLength{DynamicType{category, kind}};
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
} else if (const semantics::DerivedTypeSpec *
|
|
|
|
derived{typeSpec->AsDerived()}) {
|
2019-02-27 07:59:25 +08:00
|
|
|
return DynamicTypeWithLength{DynamicType{*derived}};
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// Wraps a object in an explicitly typed representation (e.g., Designator<>
|
|
|
|
// or FunctionRef<>) that has been instantiated on a dynamically chosen type.
|
|
|
|
template<TypeCategory CATEGORY, template<typename> typename WRAPPER,
|
2019-04-10 04:29:40 +08:00
|
|
|
typename WRAPPED>
|
|
|
|
common::IfNoLvalue<MaybeExpr, WRAPPED> WrapperHelper(int kind, WRAPPED &&x) {
|
2019-01-23 08:30:32 +08:00
|
|
|
return common::SearchTypes(
|
2018-12-04 03:40:53 +08:00
|
|
|
TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
|
|
|
|
}
|
|
|
|
|
2019-04-10 04:29:40 +08:00
|
|
|
template<template<typename> typename WRAPPER, typename WRAPPED>
|
|
|
|
common::IfNoLvalue<MaybeExpr, WRAPPED> TypedWrapper(
|
|
|
|
const DynamicType &dyType, WRAPPED &&x) {
|
2019-05-14 00:33:18 +08:00
|
|
|
switch (dyType.category()) {
|
2019-10-03 06:48:20 +08:00
|
|
|
SWITCH_COVERS_ALL_CASES
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Integer:
|
|
|
|
return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
|
2019-05-14 00:33:18 +08:00
|
|
|
dyType.kind(), std::move(x));
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Real:
|
|
|
|
return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
|
2019-05-14 00:33:18 +08:00
|
|
|
dyType.kind(), std::move(x));
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Complex:
|
|
|
|
return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
|
2019-05-14 00:33:18 +08:00
|
|
|
dyType.kind(), std::move(x));
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Character:
|
|
|
|
return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
|
2019-05-14 00:33:18 +08:00
|
|
|
dyType.kind(), std::move(x));
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Logical:
|
|
|
|
return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
|
2019-05-14 00:33:18 +08:00
|
|
|
dyType.kind(), std::move(x));
|
2018-12-04 03:40:53 +08:00
|
|
|
case TypeCategory::Derived:
|
|
|
|
return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
class ArgumentAnalyzer {
|
|
|
|
public:
|
2020-01-11 06:09:39 +08:00
|
|
|
explicit ArgumentAnalyzer(ExpressionAnalyzer &context)
|
|
|
|
: context_{context}, allowAssumedType_{false} {}
|
|
|
|
ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source,
|
|
|
|
bool allowAssumedType = false)
|
|
|
|
: context_{context}, source_{source}, allowAssumedType_{allowAssumedType} {}
|
2019-11-03 00:56:46 +08:00
|
|
|
bool fatalErrors() const { return fatalErrors_; }
|
2019-10-23 00:31:33 +08:00
|
|
|
ActualArguments &&GetActuals() {
|
2019-11-03 00:56:46 +08:00
|
|
|
CHECK(!fatalErrors_);
|
2019-10-23 00:31:33 +08:00
|
|
|
return std::move(actuals_);
|
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
const Expr<SomeType> &GetExpr(std::size_t i) const {
|
2019-11-03 00:56:46 +08:00
|
|
|
return DEREF(actuals_.at(i).value().UnwrapExpr());
|
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
Expr<SomeType> &&MoveExpr(std::size_t i) {
|
|
|
|
return std::move(DEREF(actuals_.at(i).value().UnwrapExpr()));
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
void Analyze(const common::Indirection<parser::Expr> &x) {
|
|
|
|
Analyze(x.value());
|
|
|
|
}
|
|
|
|
void Analyze(const parser::Expr &x) {
|
|
|
|
actuals_.emplace_back(AnalyzeExpr(x));
|
2019-11-10 01:29:31 +08:00
|
|
|
fatalErrors_ |= !actuals_.back();
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
void Analyze(const parser::Variable &);
|
2019-10-23 00:31:33 +08:00
|
|
|
void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
bool IsIntrinsicRelational(RelationalOperator) const;
|
|
|
|
bool IsIntrinsicLogical() const;
|
2019-11-07 07:54:26 +08:00
|
|
|
bool IsIntrinsicNumeric(NumericOperator) const;
|
2019-11-03 00:56:46 +08:00
|
|
|
bool IsIntrinsicConcat() const;
|
|
|
|
|
2019-11-07 07:54:26 +08:00
|
|
|
// Find and return a user-defined operator or report an error.
|
2019-11-03 00:56:46 +08:00
|
|
|
// The provided message is used if there is no such operator.
|
2020-01-03 01:55:03 +08:00
|
|
|
MaybeExpr TryDefinedOp(
|
|
|
|
const char *, parser::MessageFixedText &&, bool isUserOp = false);
|
2019-11-07 07:54:26 +08:00
|
|
|
template<typename E>
|
|
|
|
MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) {
|
|
|
|
return TryDefinedOp(
|
|
|
|
context_.context().languageFeatures().GetNames(opr), std::move(msg));
|
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
// Find and return a user-defined assignment
|
|
|
|
std::optional<ProcedureRef> TryDefinedAssignment();
|
|
|
|
std::optional<ProcedureRef> GetDefinedAssignmentProc();
|
2020-01-11 06:09:39 +08:00
|
|
|
void Dump(std::ostream &);
|
2019-11-03 00:56:46 +08:00
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
private:
|
2019-11-07 07:54:26 +08:00
|
|
|
MaybeExpr TryDefinedOp(
|
|
|
|
std::vector<const char *>, parser::MessageFixedText &&);
|
2019-12-17 03:33:55 +08:00
|
|
|
MaybeExpr TryBoundOp(const Symbol &, int passIndex);
|
2019-11-03 00:56:46 +08:00
|
|
|
std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
|
|
|
|
bool AreConformable() const;
|
2019-12-17 03:33:55 +08:00
|
|
|
const Symbol *FindBoundOp(parser::CharBlock, int passIndex);
|
|
|
|
bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
|
2019-11-03 00:56:46 +08:00
|
|
|
std::optional<DynamicType> GetType(std::size_t) const;
|
2019-12-03 00:55:44 +08:00
|
|
|
int GetRank(std::size_t) const;
|
2019-11-07 07:54:26 +08:00
|
|
|
bool IsBOZLiteral(std::size_t i) const {
|
2019-11-23 08:46:11 +08:00
|
|
|
return std::holds_alternative<BOZLiteralConstant>(GetExpr(i).u);
|
2019-11-07 07:54:26 +08:00
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
void SayNoMatch(const std::string &, bool isAssignment = false);
|
2019-11-03 00:56:46 +08:00
|
|
|
std::string TypeAsFortran(std::size_t);
|
|
|
|
bool AnyUntypedOperand();
|
2019-10-23 00:31:33 +08:00
|
|
|
|
|
|
|
ExpressionAnalyzer &context_;
|
|
|
|
ActualArguments actuals_;
|
2019-11-03 00:56:46 +08:00
|
|
|
parser::CharBlock source_;
|
|
|
|
bool fatalErrors_{false};
|
2020-01-11 06:09:39 +08:00
|
|
|
const bool allowAssumedType_;
|
2019-12-17 03:33:55 +08:00
|
|
|
const Symbol *sawDefinedOp_{nullptr};
|
2019-10-23 00:31:33 +08:00
|
|
|
};
|
|
|
|
|
2019-03-12 06:39:11 +08:00
|
|
|
// Wraps a data reference in a typed Designator<>, and a procedure
|
|
|
|
// or procedure pointer reference in a ProcedureDesignator.
|
|
|
|
MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
|
|
|
|
const Symbol &symbol{ref.GetLastSymbol().GetUltimate()};
|
|
|
|
if (semantics::IsProcedure(symbol)) {
|
|
|
|
if (auto *component{std::get_if<Component>(&ref.u)}) {
|
|
|
|
return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
|
2020-01-14 08:39:00 +08:00
|
|
|
} else if (!std::holds_alternative<SymbolRef>(ref.u)) {
|
|
|
|
DIE("unexpected alternative in DataRef");
|
|
|
|
} else if (!symbol.attrs().test(semantics::Attr::INTRINSIC)) {
|
|
|
|
return Expr<SomeType>{ProcedureDesignator{symbol}};
|
|
|
|
} else if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction(
|
|
|
|
symbol.name().ToString())}) {
|
|
|
|
SpecificIntrinsic intrinsic{
|
|
|
|
symbol.name().ToString(), std::move(*interface)};
|
|
|
|
intrinsic.isRestrictedSpecific = interface->isRestrictedSpecific;
|
|
|
|
return Expr<SomeType>{ProcedureDesignator{std::move(intrinsic)}};
|
2019-03-12 06:39:11 +08:00
|
|
|
} else {
|
2020-01-14 08:39:00 +08:00
|
|
|
Say("'%s' is not a specific intrinsic procedure"_err_en_US,
|
|
|
|
symbol.name());
|
|
|
|
return std::nullopt;
|
2019-03-12 06:39:11 +08:00
|
|
|
}
|
|
|
|
} else if (auto dyType{DynamicType::From(symbol)}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return TypedWrapper<Designator, DataRef>(*dyType, std::move(ref));
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
|
|
|
// Some subscript semantic checks must be deferred until all of the
|
2019-03-09 08:35:39 +08:00
|
|
|
// subscripts are in hand.
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
|
2019-03-09 04:55:57 +08:00
|
|
|
const Symbol &symbol{ref.GetLastSymbol().GetUltimate()};
|
2019-07-31 07:51:25 +08:00
|
|
|
const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()};
|
2018-12-04 03:40:53 +08:00
|
|
|
int symbolRank{symbol.Rank()};
|
2019-06-26 04:07:32 +08:00
|
|
|
int subscripts{static_cast<int>(ref.size())};
|
2019-02-01 08:04:17 +08:00
|
|
|
if (subscripts == 0) {
|
2019-07-31 07:51:25 +08:00
|
|
|
// nothing to check
|
|
|
|
} else if (subscripts != symbolRank) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbolRank, symbol.name(), subscripts);
|
2019-05-22 07:58:46 +08:00
|
|
|
return std::nullopt;
|
2019-06-26 04:07:32 +08:00
|
|
|
} else if (Component * component{ref.base().UnwrapComponent()}) {
|
2019-02-01 01:58:40 +08:00
|
|
|
int baseRank{component->base().Rank()};
|
2018-12-04 03:40:53 +08:00
|
|
|
if (baseRank > 0) {
|
2019-02-01 01:58:40 +08:00
|
|
|
int subscriptRank{0};
|
2019-02-01 08:04:17 +08:00
|
|
|
for (const auto &expr : ref.subscript()) {
|
2019-02-01 01:58:40 +08:00
|
|
|
subscriptRank += expr.Rank();
|
|
|
|
}
|
|
|
|
if (subscriptRank > 0) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("Subscripts of component '%s' of rank-%d derived type "
|
|
|
|
"array have rank %d but must all be scalar"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbol.name(), baseRank, subscriptRank);
|
2019-05-22 07:58:46 +08:00
|
|
|
return std::nullopt;
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
} else if (object) {
|
2018-12-04 03:40:53 +08:00
|
|
|
// C928 & C1002
|
2019-02-01 08:04:17 +08:00
|
|
|
if (Triplet * last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!last->upper() && object->IsAssumedSize()) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("Assumed-size array '%s' must have explicit final "
|
|
|
|
"subscript upper bound value"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbol.name());
|
2019-05-22 07:58:46 +08:00
|
|
|
return std::nullopt;
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return Designate(DataRef{std::move(ref)});
|
|
|
|
}
|
|
|
|
|
|
|
|
// Applies subscripts to a data reference.
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::ApplySubscripts(
|
2018-12-04 03:40:53 +08:00
|
|
|
DataRef &&dataRef, std::vector<Subscript> &&subscripts) {
|
|
|
|
return std::visit(
|
|
|
|
common::visitors{
|
2019-10-23 07:53:29 +08:00
|
|
|
[&](SymbolRef &&symbol) {
|
|
|
|
return CompleteSubscripts(ArrayRef{symbol, std::move(subscripts)});
|
2018-12-04 03:40:53 +08:00
|
|
|
},
|
2019-02-01 08:04:17 +08:00
|
|
|
[&](Component &&c) {
|
|
|
|
return CompleteSubscripts(
|
2019-03-08 06:46:31 +08:00
|
|
|
ArrayRef{std::move(c), std::move(subscripts)});
|
2019-02-01 08:04:17 +08:00
|
|
|
},
|
|
|
|
[&](auto &&) -> MaybeExpr {
|
2019-10-03 03:40:52 +08:00
|
|
|
DIE("bad base for ArrayRef");
|
2018-12-04 03:40:53 +08:00
|
|
|
return std::nullopt;
|
|
|
|
},
|
|
|
|
},
|
|
|
|
std::move(dataRef.u));
|
|
|
|
}
|
|
|
|
|
2019-07-31 07:51:25 +08:00
|
|
|
// Top-level checks for data references.
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
|
2018-12-04 03:40:53 +08:00
|
|
|
if (Component * component{std::get_if<Component>(&dataRef.u)}) {
|
2019-02-05 05:06:21 +08:00
|
|
|
const Symbol &symbol{component->GetLastSymbol()};
|
|
|
|
int componentRank{symbol.Rank()};
|
|
|
|
if (componentRank > 0) {
|
|
|
|
int baseRank{component->base().Rank()};
|
|
|
|
if (baseRank > 0) {
|
2019-03-17 01:04:18 +08:00
|
|
|
Say("Reference to whole rank-%d component '%%%s' of "
|
2019-03-08 06:46:31 +08:00
|
|
|
"rank-%d array of derived type is not allowed"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
componentRank, symbol.name(), baseRank);
|
2019-02-05 05:06:21 +08:00
|
|
|
}
|
|
|
|
}
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
return Designate(std::move(dataRef));
|
|
|
|
}
|
|
|
|
|
2019-03-09 08:35:39 +08:00
|
|
|
// Parse tree correction after a substring S(j:k) was misparsed as an
|
|
|
|
// array section. N.B. Fortran substrings have to have a range, not a
|
|
|
|
// single index.
|
|
|
|
static void FixMisparsedSubstring(const parser::Designator &d) {
|
|
|
|
auto &mutate{const_cast<parser::Designator &>(d)};
|
|
|
|
if (auto *dataRef{std::get_if<parser::DataRef>(&mutate.u)}) {
|
|
|
|
if (auto *ae{std::get_if<common::Indirection<parser::ArrayElement>>(
|
|
|
|
&dataRef->u)}) {
|
|
|
|
parser::ArrayElement &arrElement{ae->value()};
|
|
|
|
if (!arrElement.subscripts.empty()) {
|
|
|
|
auto iter{arrElement.subscripts.begin()};
|
|
|
|
if (auto *triplet{std::get_if<parser::SubscriptTriplet>(&iter->u)}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!std::get<2>(triplet->t) /* no stride */ &&
|
2019-03-09 08:35:39 +08:00
|
|
|
++iter == arrElement.subscripts.end() /* one subscript */) {
|
|
|
|
if (Symbol *
|
|
|
|
symbol{std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[](parser::Name &n) { return n.symbol; },
|
|
|
|
[](common::Indirection<parser::StructureComponent>
|
|
|
|
&sc) { return sc.value().component.symbol; },
|
|
|
|
[](auto &) -> Symbol * { return nullptr; },
|
|
|
|
},
|
|
|
|
arrElement.base.u)}) {
|
|
|
|
const Symbol &ultimate{symbol->GetUltimate()};
|
2019-03-15 07:28:06 +08:00
|
|
|
if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
|
2019-03-10 02:24:27 +08:00
|
|
|
if (!ultimate.IsObjectArray() &&
|
|
|
|
type->category() == semantics::DeclTypeSpec::Character) {
|
|
|
|
// The ambiguous S(j:k) was parsed as an array section
|
|
|
|
// reference, but it's now clear that it's a substring.
|
|
|
|
// Fix the parse tree in situ.
|
|
|
|
mutate.u = arrElement.ConvertToSubstring();
|
2019-03-09 08:35:39 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{GetContextualMessages().SetLocation(d.source)};
|
2019-03-09 08:35:39 +08:00
|
|
|
FixMisparsedSubstring(d);
|
2018-09-20 05:27:13 +08:00
|
|
|
// These checks have to be deferred to these "top level" data-refs where
|
|
|
|
// we can be sure that there are no following subscripts (yet).
|
2019-03-08 06:46:31 +08:00
|
|
|
if (MaybeExpr result{Analyze(d.u)}) {
|
2019-12-18 07:59:25 +08:00
|
|
|
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
|
2019-03-08 06:46:31 +08:00
|
|
|
return TopLevelChecks(std::move(*dataRef));
|
2018-09-19 00:34:59 +08:00
|
|
|
}
|
|
|
|
return result;
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2018-12-01 08:04:51 +08:00
|
|
|
// A utility subroutine to repackage optional expressions of various levels
|
|
|
|
// of type specificity as fully general MaybeExpr values.
|
2019-04-10 04:29:40 +08:00
|
|
|
template<typename A> common::IfNoLvalue<MaybeExpr, A> AsMaybeExpr(A &&x) {
|
2018-12-01 08:04:51 +08:00
|
|
|
return std::make_optional(AsGenericExpr(std::move(x)));
|
|
|
|
}
|
|
|
|
template<typename A> MaybeExpr AsMaybeExpr(std::optional<A> &&x) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (x) {
|
2018-12-01 08:04:51 +08:00
|
|
|
return AsMaybeExpr(std::move(*x));
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2018-09-19 00:34:59 +08:00
|
|
|
|
2019-01-10 07:06:07 +08:00
|
|
|
// Type kind parameter values for literal constants.
|
2019-03-08 06:46:31 +08:00
|
|
|
int ExpressionAnalyzer::AnalyzeKindParam(
|
2019-06-29 02:16:37 +08:00
|
|
|
const std::optional<parser::KindParam> &kindParam, int defaultKind) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!kindParam) {
|
2018-09-01 04:28:21 +08:00
|
|
|
return defaultKind;
|
2018-08-08 03:34:09 +08:00
|
|
|
}
|
2018-09-01 04:28:21 +08:00
|
|
|
return std::visit(
|
2018-11-30 01:27:34 +08:00
|
|
|
common::visitors{
|
|
|
|
[](std::uint64_t k) { return static_cast<int>(k); },
|
2018-09-01 04:28:21 +08:00
|
|
|
[&](const parser::Scalar<
|
|
|
|
parser::Integer<parser::Constant<parser::Name>>> &n) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (MaybeExpr ie{Analyze(n)}) {
|
2018-10-27 06:10:24 +08:00
|
|
|
if (std::optional<std::int64_t> i64{ToInt64(*ie)}) {
|
|
|
|
int iv = *i64;
|
|
|
|
if (iv == *i64) {
|
|
|
|
return iv;
|
2018-09-01 04:28:21 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return defaultKind;
|
|
|
|
},
|
2018-11-30 01:27:34 +08:00
|
|
|
},
|
2018-09-01 04:28:21 +08:00
|
|
|
kindParam->u);
|
|
|
|
}
|
|
|
|
|
2018-08-11 02:44:43 +08:00
|
|
|
// Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
|
2019-03-23 05:27:18 +08:00
|
|
|
struct IntTypeVisitor {
|
|
|
|
using Result = MaybeExpr;
|
|
|
|
using Types = IntegerTypes;
|
|
|
|
template<typename T> Result Test() {
|
2019-05-31 04:31:11 +08:00
|
|
|
if (T::kind >= kind) {
|
2019-03-23 05:27:18 +08:00
|
|
|
const char *p{digits.begin()};
|
2019-05-31 04:31:11 +08:00
|
|
|
auto value{T::Scalar::Read(p, 10, true /*signed*/)};
|
2019-03-23 05:27:18 +08:00
|
|
|
if (!value.overflow) {
|
2019-05-31 04:31:11 +08:00
|
|
|
if (T::kind > kind) {
|
|
|
|
if (!isDefaultKind ||
|
2019-11-07 07:54:26 +08:00
|
|
|
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
|
2019-05-31 04:31:11 +08:00
|
|
|
return std::nullopt;
|
|
|
|
} else if (analyzer.context().ShouldWarn(
|
2019-11-07 07:54:26 +08:00
|
|
|
LanguageFeature::BigIntLiterals)) {
|
2019-05-31 04:31:11 +08:00
|
|
|
analyzer.Say(digits,
|
|
|
|
"Integer literal is too large for default INTEGER(KIND=%d); "
|
|
|
|
"assuming INTEGER(KIND=%d)"_en_US,
|
|
|
|
kind, T::kind);
|
|
|
|
}
|
|
|
|
}
|
2019-03-23 05:27:18 +08:00
|
|
|
return Expr<SomeType>{
|
|
|
|
Expr<SomeInteger>{Expr<T>{Constant<T>{std::move(value.value)}}}};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-05-31 04:31:11 +08:00
|
|
|
ExpressionAnalyzer &analyzer;
|
2019-03-23 05:27:18 +08:00
|
|
|
parser::CharBlock digits;
|
|
|
|
int kind;
|
2019-05-31 04:31:11 +08:00
|
|
|
bool isDefaultKind;
|
2019-03-23 05:27:18 +08:00
|
|
|
};
|
|
|
|
|
2018-08-11 02:44:43 +08:00
|
|
|
template<typename PARSED>
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::IntLiteralConstant(const PARSED &x) {
|
2019-05-31 04:31:11 +08:00
|
|
|
const auto &kindParam{std::get<std::optional<parser::KindParam>>(x.t)};
|
2019-11-10 01:29:31 +08:00
|
|
|
bool isDefaultKind{!kindParam};
|
2019-05-31 04:31:11 +08:00
|
|
|
int kind{AnalyzeKindParam(kindParam, GetDefaultKind(TypeCategory::Integer))};
|
2019-03-23 05:27:18 +08:00
|
|
|
if (CheckIntrinsicKind(TypeCategory::Integer, kind)) {
|
|
|
|
auto digits{std::get<parser::CharBlock>(x.t)};
|
2019-05-31 04:31:11 +08:00
|
|
|
if (MaybeExpr result{common::SearchTypes(
|
|
|
|
IntTypeVisitor{*this, digits, kind, isDefaultKind})}) {
|
2019-03-23 05:27:18 +08:00
|
|
|
return result;
|
2019-05-31 04:31:11 +08:00
|
|
|
} else if (isDefaultKind) {
|
|
|
|
Say(digits,
|
|
|
|
"Integer literal is too large for any allowable "
|
|
|
|
"kind of INTEGER"_err_en_US);
|
2019-03-23 05:27:18 +08:00
|
|
|
} else {
|
2019-05-31 04:31:11 +08:00
|
|
|
Say(digits, "Integer literal is too large for INTEGER(KIND=%d)"_err_en_US,
|
2019-03-23 05:27:18 +08:00
|
|
|
kind);
|
|
|
|
}
|
2018-07-14 07:55:11 +08:00
|
|
|
}
|
2019-03-23 05:27:18 +08:00
|
|
|
return std::nullopt;
|
2018-07-14 07:55:11 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::IntLiteralConstant &x) {
|
|
|
|
return IntLiteralConstant(x);
|
2018-08-11 02:44:43 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2018-12-04 03:40:53 +08:00
|
|
|
const parser::SignedIntLiteralConstant &x) {
|
2019-03-08 06:46:31 +08:00
|
|
|
return IntLiteralConstant(x);
|
2018-08-11 02:44:43 +08:00
|
|
|
}
|
|
|
|
|
2018-09-01 04:28:21 +08:00
|
|
|
template<typename TYPE>
|
|
|
|
Constant<TYPE> ReadRealLiteral(
|
|
|
|
parser::CharBlock source, FoldingContext &context) {
|
2018-08-09 07:30:58 +08:00
|
|
|
const char *p{source.begin()};
|
2019-02-01 08:04:17 +08:00
|
|
|
auto valWithFlags{Scalar<TYPE>::Read(p, context.rounding())};
|
2018-08-09 07:30:58 +08:00
|
|
|
CHECK(p == source.end());
|
2018-09-01 04:28:21 +08:00
|
|
|
RealFlagWarnings(context, valWithFlags.flags, "conversion of REAL literal");
|
2018-08-09 07:30:58 +08:00
|
|
|
auto value{valWithFlags.value};
|
2019-02-01 08:04:17 +08:00
|
|
|
if (context.flushSubnormalsToZero()) {
|
2019-01-30 08:47:41 +08:00
|
|
|
value = value.FlushSubnormalToZero();
|
2018-08-09 07:30:58 +08:00
|
|
|
}
|
2018-09-01 04:28:21 +08:00
|
|
|
return {value};
|
2018-08-09 07:30:58 +08:00
|
|
|
}
|
|
|
|
|
2018-09-01 04:28:21 +08:00
|
|
|
struct RealTypeVisitor {
|
|
|
|
using Result = std::optional<Expr<SomeReal>>;
|
2019-01-23 08:30:32 +08:00
|
|
|
using Types = RealTypes;
|
2018-09-01 04:28:21 +08:00
|
|
|
|
|
|
|
RealTypeVisitor(int k, parser::CharBlock lit, FoldingContext &ctx)
|
|
|
|
: kind{k}, literal{lit}, context{ctx} {}
|
|
|
|
|
2019-01-23 08:30:32 +08:00
|
|
|
template<typename T> Result Test() {
|
|
|
|
if (kind == T::kind) {
|
|
|
|
return {AsCategoryExpr(ReadRealLiteral<T>(literal, context))};
|
2018-08-29 06:15:18 +08:00
|
|
|
}
|
2018-09-01 04:28:21 +08:00
|
|
|
return std::nullopt;
|
2018-08-23 04:36:45 +08:00
|
|
|
}
|
2018-08-29 06:15:18 +08:00
|
|
|
|
2018-09-01 04:28:21 +08:00
|
|
|
int kind;
|
2018-08-23 04:36:45 +08:00
|
|
|
parser::CharBlock literal;
|
2018-09-01 04:28:21 +08:00
|
|
|
FoldingContext &context;
|
2018-08-23 04:36:45 +08:00
|
|
|
};
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// Reads a real literal constant and encodes it with the right kind.
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
|
2018-09-01 04:28:21 +08:00
|
|
|
// Use a local message context around the real literal for better
|
|
|
|
// provenance on any messages.
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{GetContextualMessages().SetLocation(x.real.source)};
|
2020-02-27 12:19:48 +08:00
|
|
|
// If a kind parameter appears, it defines the kind of the literal and the
|
|
|
|
// letter used in an exponent part must be 'E' (e.g., the 'E' in
|
|
|
|
// "6.02214E+23"). In the absence of an explicit kind parameter, any
|
|
|
|
// exponent letter determines the kind. Otherwise, defaults apply.
|
2019-06-13 03:38:04 +08:00
|
|
|
auto &defaults{context_.defaultKinds()};
|
|
|
|
int defaultKind{defaults.GetDefaultKind(TypeCategory::Real)};
|
2018-08-09 07:30:58 +08:00
|
|
|
const char *end{x.real.source.end()};
|
2019-07-12 07:09:02 +08:00
|
|
|
char expoLetter{' '};
|
2018-09-01 04:28:21 +08:00
|
|
|
std::optional<int> letterKind;
|
2018-08-09 07:30:58 +08:00
|
|
|
for (const char *p{x.real.source.begin()}; p < end; ++p) {
|
|
|
|
if (parser::IsLetter(*p)) {
|
2019-07-12 07:09:02 +08:00
|
|
|
expoLetter = *p;
|
|
|
|
switch (expoLetter) {
|
2019-06-13 03:38:04 +08:00
|
|
|
case 'e': letterKind = defaults.GetDefaultKind(TypeCategory::Real); break;
|
|
|
|
case 'd': letterKind = defaults.doublePrecisionKind(); break;
|
|
|
|
case 'q': letterKind = defaults.quadPrecisionKind(); break;
|
2019-07-12 07:09:02 +08:00
|
|
|
default: Say("Unknown exponent letter '%c'"_err_en_US, expoLetter);
|
2018-08-09 07:30:58 +08:00
|
|
|
}
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (letterKind) {
|
2018-09-01 04:28:21 +08:00
|
|
|
defaultKind = *letterKind;
|
|
|
|
}
|
2019-03-08 06:46:31 +08:00
|
|
|
auto kind{AnalyzeKindParam(x.kind, defaultKind)};
|
2020-02-27 12:19:48 +08:00
|
|
|
if (x.kind && letterKind && expoLetter != 'e') { // C716
|
|
|
|
Say("Explicit kind parameter on REAL constant can only be used with"
|
|
|
|
" exponent letter 'E'"_err_en_US);
|
2018-08-09 07:30:58 +08:00
|
|
|
}
|
2019-01-23 08:30:32 +08:00
|
|
|
auto result{common::SearchTypes(
|
2019-03-08 06:46:31 +08:00
|
|
|
RealTypeVisitor{kind, x.real.source, GetFoldingContext()})};
|
2020-02-27 12:19:48 +08:00
|
|
|
if (!result) { // C717
|
2019-05-14 00:33:18 +08:00
|
|
|
Say("Unsupported REAL(KIND=%d)"_err_en_US, kind);
|
2018-09-01 04:28:21 +08:00
|
|
|
}
|
|
|
|
return AsMaybeExpr(std::move(result));
|
2018-08-09 07:30:58 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2018-12-04 03:40:53 +08:00
|
|
|
const parser::SignedRealLiteralConstant &x) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (auto result{Analyze(std::get<parser::RealLiteralConstant>(x.t))}) {
|
|
|
|
auto &realExpr{std::get<Expr<SomeReal>>(result->u)};
|
2018-08-11 02:44:43 +08:00
|
|
|
if (auto sign{std::get<std::optional<parser::Sign>>(x.t)}) {
|
|
|
|
if (sign == parser::Sign::Negative) {
|
2019-03-08 06:46:31 +08:00
|
|
|
return {AsGenericExpr(-std::move(realExpr))};
|
2018-08-11 02:44:43 +08:00
|
|
|
}
|
|
|
|
}
|
2018-08-17 02:46:18 +08:00
|
|
|
return result;
|
2018-08-11 02:44:43 +08:00
|
|
|
}
|
2018-08-17 02:46:18 +08:00
|
|
|
return std::nullopt;
|
2018-08-11 02:44:43 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexPart &x) {
|
|
|
|
return Analyze(x.u);
|
2018-08-08 03:34:09 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexLiteralConstant &z) {
|
|
|
|
return AsMaybeExpr(
|
|
|
|
ConstructComplex(GetContextualMessages(), Analyze(std::get<0>(z.t)),
|
|
|
|
Analyze(std::get<1>(z.t)), GetDefaultKind(TypeCategory::Real)));
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
// CHARACTER literal processing.
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::AnalyzeString(std::string &&string, int kind) {
|
|
|
|
if (!CheckIntrinsicKind(TypeCategory::Character, kind)) {
|
2018-11-06 05:48:00 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-06-19 03:34:23 +08:00
|
|
|
switch (kind) {
|
|
|
|
case 1:
|
|
|
|
return AsGenericExpr(Constant<Type<TypeCategory::Character, 1>>{
|
2019-06-29 02:16:37 +08:00
|
|
|
parser::DecodeString<std::string, parser::Encoding::LATIN_1>(
|
|
|
|
string, true)});
|
2019-06-19 03:34:23 +08:00
|
|
|
case 2:
|
2019-06-18 07:12:28 +08:00
|
|
|
return AsGenericExpr(Constant<Type<TypeCategory::Character, 2>>{
|
2019-06-29 02:16:37 +08:00
|
|
|
parser::DecodeString<std::u16string, parser::Encoding::UTF_8>(
|
|
|
|
string, true)});
|
2019-06-19 03:34:23 +08:00
|
|
|
case 4:
|
2019-06-18 07:12:28 +08:00
|
|
|
return AsGenericExpr(Constant<Type<TypeCategory::Character, 4>>{
|
2019-06-29 02:16:37 +08:00
|
|
|
parser::DecodeString<std::u32string, parser::Encoding::UTF_8>(
|
|
|
|
string, true)});
|
2019-06-19 03:34:23 +08:00
|
|
|
default: CRASH_NO_CASE;
|
2018-11-06 05:48:00 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
|
|
|
|
int kind{
|
|
|
|
AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t), 1)};
|
2018-09-01 04:28:21 +08:00
|
|
|
auto value{std::get<std::string>(x.t)};
|
2019-03-08 06:46:31 +08:00
|
|
|
return AnalyzeString(std::move(value), kind);
|
2018-08-08 03:34:09 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2018-12-04 03:40:53 +08:00
|
|
|
const parser::HollerithLiteralConstant &x) {
|
2019-03-08 06:46:31 +08:00
|
|
|
int kind{GetDefaultKind(TypeCategory::Character)};
|
2018-12-04 03:40:53 +08:00
|
|
|
auto value{x.v};
|
2019-03-08 06:46:31 +08:00
|
|
|
return AnalyzeString(std::move(value), kind);
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
// .TRUE. and .FALSE. of various kinds
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
|
|
|
|
auto kind{AnalyzeKindParam(std::get<std::optional<parser::KindParam>>(x.t),
|
|
|
|
GetDefaultKind(TypeCategory::Logical))};
|
2018-09-01 04:28:21 +08:00
|
|
|
bool value{std::get<bool>(x.t)};
|
2019-01-23 08:30:32 +08:00
|
|
|
auto result{common::SearchTypes(
|
2018-09-12 08:06:44 +08:00
|
|
|
TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
|
2018-09-01 04:28:21 +08:00
|
|
|
kind, std::move(value)})};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!result) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("unsupported LOGICAL(KIND=%d)"_err_en_US, kind);
|
2018-09-01 04:28:21 +08:00
|
|
|
}
|
2018-09-12 08:06:44 +08:00
|
|
|
return result;
|
|
|
|
}
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// BOZ typeless literals
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
|
2019-05-07 00:33:45 +08:00
|
|
|
const char *p{x.v.c_str()};
|
2018-09-13 02:20:30 +08:00
|
|
|
std::uint64_t base{16};
|
|
|
|
switch (*p++) {
|
|
|
|
case 'b': base = 2; break;
|
|
|
|
case 'o': base = 8; break;
|
|
|
|
case 'z': break;
|
|
|
|
case 'x': break;
|
|
|
|
default: CRASH_NO_CASE;
|
|
|
|
}
|
2018-12-04 03:40:53 +08:00
|
|
|
CHECK(*p == '"');
|
2019-03-23 05:27:18 +08:00
|
|
|
++p;
|
|
|
|
auto value{BOZLiteralConstant::Read(p, base, false /*unsigned*/)};
|
2018-12-04 03:40:53 +08:00
|
|
|
if (*p != '"') {
|
2019-05-07 00:33:45 +08:00
|
|
|
Say("Invalid digit ('%c') in BOZ literal '%s'"_err_en_US, *p, x.v);
|
2018-12-04 03:40:53 +08:00
|
|
|
return std::nullopt;
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
2018-12-04 03:40:53 +08:00
|
|
|
if (value.overflow) {
|
2019-05-07 00:33:45 +08:00
|
|
|
Say("BOZ literal '%s' too large"_err_en_US, x.v);
|
2018-12-04 03:40:53 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-12-21 05:03:30 +08:00
|
|
|
return AsGenericExpr(std::move(value.value));
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
|
|
|
|
2019-01-23 08:30:32 +08:00
|
|
|
// For use with SearchTypes to create a TypeParamInquiry with the
|
2019-01-10 07:06:07 +08:00
|
|
|
// right integer kind.
|
|
|
|
struct TypeParamInquiryVisitor {
|
|
|
|
using Result = std::optional<Expr<SomeInteger>>;
|
2019-01-23 08:30:32 +08:00
|
|
|
using Types = IntegerTypes;
|
2019-06-26 04:07:32 +08:00
|
|
|
TypeParamInquiryVisitor(int k, NamedEntity &&b, const Symbol ¶m)
|
2019-01-10 07:06:07 +08:00
|
|
|
: kind{k}, base{std::move(b)}, parameter{param} {}
|
2019-06-26 04:07:32 +08:00
|
|
|
TypeParamInquiryVisitor(int k, const Symbol ¶m)
|
|
|
|
: kind{k}, parameter{param} {}
|
2019-01-23 08:30:32 +08:00
|
|
|
template<typename T> Result Test() {
|
|
|
|
if (kind == T::kind) {
|
2019-01-10 07:06:07 +08:00
|
|
|
return Expr<SomeInteger>{
|
2019-01-23 08:30:32 +08:00
|
|
|
Expr<T>{TypeParamInquiry<T::kind>{std::move(base), parameter}}};
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
int kind;
|
2019-06-26 04:07:32 +08:00
|
|
|
std::optional<NamedEntity> base;
|
2019-01-10 07:06:07 +08:00
|
|
|
const Symbol ¶meter;
|
|
|
|
};
|
|
|
|
|
2019-05-14 00:33:18 +08:00
|
|
|
static std::optional<Expr<SomeInteger>> MakeBareTypeParamInquiry(
|
2018-12-05 02:55:32 +08:00
|
|
|
const Symbol *symbol) {
|
2019-05-04 02:29:15 +08:00
|
|
|
if (std::optional<DynamicType> dyType{DynamicType::From(symbol)}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
if (dyType->category() == TypeCategory::Integer) {
|
2019-06-26 04:07:32 +08:00
|
|
|
return common::SearchTypes(
|
|
|
|
TypeParamInquiryVisitor{dyType->kind(), *symbol});
|
2018-12-05 02:55:32 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// Names and named constants
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
|
|
|
|
if (std::optional<int> kind{IsAcImpliedDo(n.source)}) {
|
2019-01-23 08:30:32 +08:00
|
|
|
return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
|
|
|
|
*kind, AsExpr(ImpliedDoIndex{n.source})));
|
2019-12-12 07:06:24 +08:00
|
|
|
} else if (context_.HasError(n) || !n.symbol) {
|
2019-09-13 00:24:04 +08:00
|
|
|
return std::nullopt;
|
|
|
|
} else {
|
2019-03-09 04:55:57 +08:00
|
|
|
const Symbol &ultimate{n.symbol->GetUltimate()};
|
2019-09-13 04:43:16 +08:00
|
|
|
if (ultimate.has<semantics::TypeParamDetails>()) {
|
2019-03-09 04:55:57 +08:00
|
|
|
// A bare reference to a derived type parameter (within a parameterized
|
|
|
|
// derived type definition)
|
2019-05-14 00:33:18 +08:00
|
|
|
return AsMaybeExpr(MakeBareTypeParamInquiry(&ultimate));
|
2019-03-09 04:55:57 +08:00
|
|
|
} else {
|
2019-11-13 07:43:09 +08:00
|
|
|
if (n.symbol->attrs().test(semantics::Attr::VOLATILE)) {
|
|
|
|
if (const semantics::Scope *
|
|
|
|
pure{semantics::FindPureProcedureContaining(
|
2019-11-20 11:10:02 +08:00
|
|
|
context_.FindScope(n.source))}) {
|
2019-11-13 07:43:09 +08:00
|
|
|
SayAt(n,
|
2019-12-24 09:12:53 +08:00
|
|
|
"VOLATILE variable '%s' may not be referenced in pure subprogram '%s'"_err_en_US,
|
2019-11-13 07:43:09 +08:00
|
|
|
n.source, DEREF(pure->symbol()).name());
|
|
|
|
n.symbol->attrs().reset(semantics::Attr::VOLATILE);
|
|
|
|
}
|
|
|
|
}
|
2019-09-13 04:43:16 +08:00
|
|
|
return Designate(DataRef{*n.symbol});
|
2018-11-07 09:18:06 +08:00
|
|
|
}
|
2018-09-01 04:28:21 +08:00
|
|
|
}
|
2018-08-08 03:34:09 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
|
|
|
|
if (MaybeExpr value{Analyze(n.v)}) {
|
2020-01-04 02:38:51 +08:00
|
|
|
Expr<SomeType> folded{Fold(std::move(*value))};
|
2019-01-08 02:15:27 +08:00
|
|
|
if (IsConstantExpr(folded)) {
|
2018-10-27 06:10:24 +08:00
|
|
|
return {folded};
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
2020-02-27 12:19:48 +08:00
|
|
|
Say(n.v.source, "must be a constant"_err_en_US); // C718
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
|
|
|
// Substring references
|
2019-03-08 06:46:31 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::GetSubstringBound(
|
2018-12-04 03:40:53 +08:00
|
|
|
const std::optional<parser::ScalarIntExpr> &bound) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (bound) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (MaybeExpr expr{Analyze(*bound)}) {
|
2018-12-04 03:40:53 +08:00
|
|
|
if (expr->Rank() > 1) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("substring bound expression has rank %d"_err_en_US, expr->Rank());
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
|
|
|
|
if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
|
|
|
|
return {std::move(*ssIntExpr)};
|
|
|
|
}
|
|
|
|
return {Expr<SubscriptInteger>{
|
|
|
|
Convert<SubscriptInteger, TypeCategory::Integer>{
|
|
|
|
std::move(*intExpr)}}};
|
|
|
|
} else {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("substring bound expression is not INTEGER"_err_en_US);
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
}
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Substring &ss) {
|
|
|
|
if (MaybeExpr baseExpr{Analyze(std::get<parser::DataRef>(ss.t))}) {
|
2018-09-20 05:27:13 +08:00
|
|
|
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (MaybeExpr newBaseExpr{TopLevelChecks(std::move(*dataRef))}) {
|
2018-09-20 05:27:13 +08:00
|
|
|
if (std::optional<DataRef> checked{
|
|
|
|
ExtractDataRef(std::move(*newBaseExpr))}) {
|
|
|
|
const parser::SubstringRange &range{
|
|
|
|
std::get<parser::SubstringRange>(ss.t)};
|
|
|
|
std::optional<Expr<SubscriptInteger>> first{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSubstringBound(std::get<0>(range.t))};
|
2018-09-20 05:27:13 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> last{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSubstringBound(std::get<1>(range.t))};
|
2018-11-02 02:18:12 +08:00
|
|
|
const Symbol &symbol{checked->GetLastSymbol()};
|
2019-05-07 00:33:45 +08:00
|
|
|
if (std::optional<DynamicType> dynamicType{
|
|
|
|
DynamicType::From(symbol)}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
if (dynamicType->category() == TypeCategory::Character) {
|
2018-09-21 03:34:29 +08:00
|
|
|
return WrapperHelper<TypeCategory::Character, Designator,
|
2019-05-14 00:33:18 +08:00
|
|
|
Substring>(dynamicType->kind(),
|
2018-12-06 05:03:39 +08:00
|
|
|
Substring{std::move(checked.value()), std::move(first),
|
|
|
|
std::move(last)});
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
|
|
|
}
|
2019-03-08 06:46:31 +08:00
|
|
|
Say("substring may apply only to CHARACTER"_err_en_US);
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// CHARACTER literal substrings
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2018-12-04 03:40:53 +08:00
|
|
|
const parser::CharLiteralConstantSubstring &x) {
|
|
|
|
const parser::SubstringRange &range{std::get<parser::SubstringRange>(x.t)};
|
|
|
|
std::optional<Expr<SubscriptInteger>> lower{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSubstringBound(std::get<0>(range.t))};
|
2018-12-04 03:40:53 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> upper{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSubstringBound(std::get<1>(range.t))};
|
|
|
|
if (MaybeExpr string{Analyze(std::get<parser::CharLiteralConstant>(x.t))}) {
|
2018-12-04 03:40:53 +08:00
|
|
|
if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
|
2019-07-04 01:25:43 +08:00
|
|
|
Expr<SubscriptInteger> length{
|
|
|
|
std::visit([](const auto &ckExpr) { return ckExpr.LEN().value(); },
|
|
|
|
charExpr->u)};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!lower) {
|
2018-12-04 03:40:53 +08:00
|
|
|
lower = Expr<SubscriptInteger>{1};
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!upper) {
|
2018-12-06 05:03:39 +08:00
|
|
|
upper = Expr<SubscriptInteger>{
|
|
|
|
static_cast<std::int64_t>(ToInt64(length).value())};
|
2018-12-04 03:40:53 +08:00
|
|
|
}
|
|
|
|
return std::visit(
|
|
|
|
[&](auto &&ckExpr) -> MaybeExpr {
|
|
|
|
using Result = ResultType<decltype(ckExpr)>;
|
|
|
|
auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
|
2019-07-30 00:12:52 +08:00
|
|
|
CHECK(DEREF(cp).size() == 1);
|
2018-12-04 03:40:53 +08:00
|
|
|
StaticDataObject::Pointer staticData{StaticDataObject::Create()};
|
|
|
|
staticData->set_alignment(Result::kind)
|
|
|
|
.set_itemBytes(Result::kind)
|
2019-05-14 00:33:18 +08:00
|
|
|
.Push(cp->GetScalarValue().value());
|
2018-12-06 05:03:39 +08:00
|
|
|
Substring substring{std::move(staticData), std::move(lower.value()),
|
|
|
|
std::move(upper.value())};
|
2018-12-04 03:40:53 +08:00
|
|
|
return AsGenericExpr(Expr<SomeCharacter>{
|
|
|
|
Expr<Result>{Designator<Result>{std::move(substring)}}});
|
|
|
|
},
|
|
|
|
std::move(charExpr->u));
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
|
|
|
// Subscripted array references
|
2019-03-08 06:46:31 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::AsSubscript(
|
|
|
|
MaybeExpr &&expr) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (expr) {
|
2018-09-20 05:27:13 +08:00
|
|
|
if (expr->Rank() > 1) {
|
2019-10-11 07:06:05 +08:00
|
|
|
Say("Subscript expression has rank %d greater than 1"_err_en_US,
|
|
|
|
expr->Rank());
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
2018-09-12 08:06:44 +08:00
|
|
|
if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
|
|
|
|
if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
|
2019-10-11 07:06:05 +08:00
|
|
|
return std::move(*ssIntExpr);
|
|
|
|
} else {
|
|
|
|
return Expr<SubscriptInteger>{
|
|
|
|
Convert<SubscriptInteger, TypeCategory::Integer>{
|
|
|
|
std::move(*intExpr)}};
|
2018-09-12 08:06:44 +08:00
|
|
|
}
|
|
|
|
} else {
|
2019-10-11 07:06:05 +08:00
|
|
|
Say("Subscript expression is not INTEGER"_err_en_US);
|
2018-09-20 05:27:13 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::TripletPart(
|
2018-09-12 08:06:44 +08:00
|
|
|
const std::optional<parser::Subscript> &s) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (s) {
|
2019-03-08 06:46:31 +08:00
|
|
|
return AsSubscript(Analyze(*s));
|
2019-10-11 07:06:05 +08:00
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
2018-09-12 08:06:44 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
std::optional<Subscript> ExpressionAnalyzer::AnalyzeSectionSubscript(
|
|
|
|
const parser::SectionSubscript &ss) {
|
2018-09-12 08:06:44 +08:00
|
|
|
return std::visit(
|
2018-11-30 01:27:34 +08:00
|
|
|
common::visitors{
|
|
|
|
[&](const parser::SubscriptTriplet &t) {
|
2019-10-11 07:06:05 +08:00
|
|
|
return std::make_optional<Subscript>(Triplet{
|
2019-03-08 06:46:31 +08:00
|
|
|
TripletPart(std::get<0>(t.t)), TripletPart(std::get<1>(t.t)),
|
2019-10-11 07:06:05 +08:00
|
|
|
TripletPart(std::get<2>(t.t))});
|
2018-11-30 01:27:34 +08:00
|
|
|
},
|
2018-09-12 08:06:44 +08:00
|
|
|
[&](const auto &s) -> std::optional<Subscript> {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (auto subscriptExpr{AsSubscript(Analyze(s))}) {
|
2019-08-02 02:41:05 +08:00
|
|
|
return Subscript{std::move(*subscriptExpr)};
|
2018-09-12 08:06:44 +08:00
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2018-11-30 01:27:34 +08:00
|
|
|
},
|
|
|
|
},
|
2018-09-12 08:06:44 +08:00
|
|
|
ss.u);
|
|
|
|
}
|
|
|
|
|
2019-04-26 04:18:33 +08:00
|
|
|
// Empty result means an error occurred
|
2019-03-08 06:46:31 +08:00
|
|
|
std::vector<Subscript> ExpressionAnalyzer::AnalyzeSectionSubscripts(
|
2018-09-12 08:06:44 +08:00
|
|
|
const std::list<parser::SectionSubscript> &sss) {
|
2020-01-11 06:09:39 +08:00
|
|
|
bool error{false};
|
2018-09-12 08:06:44 +08:00
|
|
|
std::vector<Subscript> subscripts;
|
|
|
|
for (const auto &s : sss) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (auto subscript{AnalyzeSectionSubscript(s)}) {
|
2018-09-12 08:06:44 +08:00
|
|
|
subscripts.emplace_back(std::move(*subscript));
|
2019-04-26 04:18:33 +08:00
|
|
|
} else {
|
2020-01-11 06:09:39 +08:00
|
|
|
error = true;
|
2018-09-12 08:06:44 +08:00
|
|
|
}
|
|
|
|
}
|
2020-01-11 06:09:39 +08:00
|
|
|
return !error ? subscripts : std::vector<Subscript>{};
|
2018-09-12 08:06:44 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayElement &ae) {
|
|
|
|
std::vector<Subscript> subscripts{AnalyzeSectionSubscripts(ae.subscripts)};
|
|
|
|
if (MaybeExpr baseExpr{Analyze(ae.base)}) {
|
2018-09-19 00:34:59 +08:00
|
|
|
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
|
2019-04-26 04:18:33 +08:00
|
|
|
if (!subscripts.empty()) {
|
|
|
|
return ApplySubscripts(std::move(*dataRef), std::move(subscripts));
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
2019-04-26 04:18:33 +08:00
|
|
|
} else {
|
2019-05-14 00:33:18 +08:00
|
|
|
Say("Subscripts may be applied only to an object, component, or array constant"_err_en_US);
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
|
|
|
}
|
2018-09-13 02:20:30 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-01-10 07:06:07 +08:00
|
|
|
// Type parameter inquiries apply to data references, but don't depend
|
|
|
|
// on any trailing (co)subscripts.
|
2019-06-26 04:07:32 +08:00
|
|
|
static NamedEntity IgnoreAnySubscripts(Designator<SomeDerived> &&designator) {
|
2019-01-10 07:06:07 +08:00
|
|
|
return std::visit(
|
|
|
|
common::visitors{
|
2019-10-23 07:53:29 +08:00
|
|
|
[](SymbolRef &&symbol) { return NamedEntity{symbol}; },
|
2019-06-26 04:07:32 +08:00
|
|
|
[](Component &&component) {
|
|
|
|
return NamedEntity{std::move(component)};
|
|
|
|
},
|
2019-02-01 08:04:17 +08:00
|
|
|
[](ArrayRef &&arrayRef) { return std::move(arrayRef.base()); },
|
2019-01-10 07:06:07 +08:00
|
|
|
[](CoarrayRef &&coarrayRef) {
|
2019-06-26 04:07:32 +08:00
|
|
|
return NamedEntity{coarrayRef.GetLastSymbol()};
|
2019-01-10 07:06:07 +08:00
|
|
|
},
|
|
|
|
},
|
|
|
|
std::move(designator.u));
|
|
|
|
}
|
|
|
|
|
2018-12-05 02:55:32 +08:00
|
|
|
// Components of parent derived types are explicitly represented as such.
|
|
|
|
static std::optional<Component> CreateComponent(
|
|
|
|
DataRef &&base, const Symbol &component, const semantics::Scope &scope) {
|
|
|
|
if (&component.owner() == &scope) {
|
2019-05-14 00:33:18 +08:00
|
|
|
return Component{std::move(base), component};
|
2018-12-05 02:55:32 +08:00
|
|
|
}
|
|
|
|
if (const semantics::Scope * parentScope{scope.GetDerivedTypeParent()}) {
|
|
|
|
if (const Symbol * parentComponent{parentScope->GetSymbol()}) {
|
|
|
|
return CreateComponent(
|
|
|
|
DataRef{Component{std::move(base), *parentComponent}}, component,
|
|
|
|
*parentScope);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-01-10 07:06:07 +08:00
|
|
|
// Derived type component references and type parameter inquiries
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) {
|
2019-04-26 04:18:33 +08:00
|
|
|
MaybeExpr base{Analyze(sc.base)};
|
|
|
|
if (!base) {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
Symbol *sym{sc.component.symbol};
|
2019-04-26 05:47:39 +08:00
|
|
|
if (context_.HasError(sym)) {
|
2019-04-26 04:18:33 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-01-10 07:06:07 +08:00
|
|
|
const auto &name{sc.component.source};
|
2019-04-26 04:18:33 +08:00
|
|
|
if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
|
2019-12-17 03:33:55 +08:00
|
|
|
const auto *dtSpec{GetDerivedTypeSpec(dtExpr->GetType())};
|
2019-04-26 04:18:33 +08:00
|
|
|
if (sym->detailsIf<semantics::TypeParamDetails>()) {
|
|
|
|
if (auto *designator{UnwrapExpr<Designator<SomeDerived>>(*dtExpr)}) {
|
2019-05-04 02:29:15 +08:00
|
|
|
if (std::optional<DynamicType> dyType{DynamicType::From(*sym)}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
if (dyType->category() == TypeCategory::Integer) {
|
2019-04-26 04:18:33 +08:00
|
|
|
return AsMaybeExpr(
|
2019-05-14 00:33:18 +08:00
|
|
|
common::SearchTypes(TypeParamInquiryVisitor{dyType->kind(),
|
2019-04-26 04:18:33 +08:00
|
|
|
IgnoreAnySubscripts(std::move(*designator)), *sym}));
|
2019-02-01 01:58:40 +08:00
|
|
|
}
|
2018-12-05 02:55:32 +08:00
|
|
|
}
|
2019-05-31 07:14:24 +08:00
|
|
|
Say(name, "Type parameter is not INTEGER"_err_en_US);
|
2018-09-15 06:48:40 +08:00
|
|
|
} else {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say(name,
|
2019-05-31 07:14:24 +08:00
|
|
|
"A type parameter inquiry must be applied to "
|
2019-04-26 04:18:33 +08:00
|
|
|
"a designator"_err_en_US);
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
} else if (!dtSpec || !dtSpec->scope()) {
|
2019-10-25 05:55:25 +08:00
|
|
|
CHECK(context_.AnyFatalError() || !foldingContext_.messages().empty());
|
2019-03-12 06:39:11 +08:00
|
|
|
return std::nullopt;
|
2019-04-26 04:18:33 +08:00
|
|
|
} else if (std::optional<DataRef> dataRef{
|
|
|
|
ExtractDataRef(std::move(*dtExpr))}) {
|
|
|
|
if (auto component{
|
|
|
|
CreateComponent(std::move(*dataRef), *sym, *dtSpec->scope())}) {
|
|
|
|
return Designate(DataRef{std::move(*component)});
|
2019-01-08 05:31:50 +08:00
|
|
|
} else {
|
2019-05-31 07:14:24 +08:00
|
|
|
Say(name, "Component is not in scope of derived TYPE(%s)"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
dtSpec->typeSymbol().name());
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
|
|
|
} else {
|
2019-04-26 04:18:33 +08:00
|
|
|
Say(name,
|
2019-05-31 07:14:24 +08:00
|
|
|
"Base of component reference must be a data reference"_err_en_US);
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
2019-04-26 04:18:33 +08:00
|
|
|
} else if (auto *details{sym->detailsIf<semantics::MiscDetails>()}) {
|
|
|
|
// special part-ref: %re, %im, %kind, %len
|
|
|
|
// Type errors are detected and reported in semantics.
|
|
|
|
using MiscKind = semantics::MiscDetails::Kind;
|
|
|
|
MiscKind kind{details->kind()};
|
|
|
|
if (kind == MiscKind::ComplexPartRe || kind == MiscKind::ComplexPartIm) {
|
|
|
|
if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&base->u)}) {
|
|
|
|
if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*zExpr))}) {
|
|
|
|
Expr<SomeReal> realExpr{std::visit(
|
|
|
|
[&](const auto &z) {
|
|
|
|
using PartType = typename ResultType<decltype(z)>::Part;
|
|
|
|
auto part{kind == MiscKind::ComplexPartRe
|
|
|
|
? ComplexPart::Part::RE
|
|
|
|
: ComplexPart::Part::IM};
|
|
|
|
return AsCategoryExpr(Designator<PartType>{
|
|
|
|
ComplexPart{std::move(*dataRef), part}});
|
|
|
|
},
|
|
|
|
zExpr->u)};
|
|
|
|
return {AsGenericExpr(std::move(realExpr))};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else if (kind == MiscKind::KindParamInquiry ||
|
|
|
|
kind == MiscKind::LenParamInquiry) {
|
|
|
|
// Convert x%KIND -> intrinsic KIND(x), x%LEN -> intrinsic LEN(x)
|
2019-03-12 06:39:11 +08:00
|
|
|
return MakeFunctionRef(
|
|
|
|
name, ActualArguments{ActualArgument{std::move(*base)}});
|
2019-04-26 04:18:33 +08:00
|
|
|
} else {
|
2019-10-03 03:40:52 +08:00
|
|
|
DIE("unexpected MiscDetails::Kind");
|
2019-04-26 04:18:33 +08:00
|
|
|
}
|
|
|
|
} else {
|
|
|
|
Say(name, "derived type required before component reference"_err_en_US);
|
2018-09-15 06:48:40 +08:00
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-09-14 03:32:43 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
|
|
|
|
if (auto dataRef{ExtractDataRef(Analyze(x.base))}) {
|
|
|
|
std::vector<Subscript> subscripts;
|
2019-10-23 07:53:29 +08:00
|
|
|
SymbolVector reversed;
|
2019-09-14 03:32:43 +08:00
|
|
|
if (auto *aRef{std::get_if<ArrayRef>(&dataRef->u)}) {
|
|
|
|
subscripts = std::move(aRef->subscript());
|
2019-10-23 07:53:29 +08:00
|
|
|
reversed.push_back(aRef->GetLastSymbol());
|
2019-09-14 03:32:43 +08:00
|
|
|
if (Component * component{aRef->base().UnwrapComponent()}) {
|
|
|
|
*dataRef = std::move(component->base());
|
|
|
|
} else {
|
|
|
|
dataRef.reset();
|
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (dataRef) {
|
2019-09-14 03:32:43 +08:00
|
|
|
while (auto *component{std::get_if<Component>(&dataRef->u)}) {
|
2019-10-23 07:53:29 +08:00
|
|
|
reversed.push_back(component->GetLastSymbol());
|
2019-09-14 03:32:43 +08:00
|
|
|
*dataRef = std::move(component->base());
|
|
|
|
}
|
2019-10-23 07:53:29 +08:00
|
|
|
if (auto *baseSym{std::get_if<SymbolRef>(&dataRef->u)}) {
|
2019-09-14 03:32:43 +08:00
|
|
|
reversed.push_back(*baseSym);
|
|
|
|
} else {
|
|
|
|
Say("Base of coindexed named object has subscripts or cosubscripts"_err_en_US);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
std::vector<Expr<SubscriptInteger>> cosubscripts;
|
|
|
|
bool cosubsOk{true};
|
|
|
|
for (const auto &cosub :
|
|
|
|
std::get<std::list<parser::Cosubscript>>(x.imageSelector.t)) {
|
|
|
|
MaybeExpr coex{Analyze(cosub)};
|
|
|
|
if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(coex)}) {
|
|
|
|
cosubscripts.push_back(
|
|
|
|
ConvertToType<SubscriptInteger>(std::move(*intExpr)));
|
|
|
|
} else {
|
|
|
|
cosubsOk = false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (cosubsOk && !reversed.empty()) {
|
|
|
|
int numCosubscripts{static_cast<int>(cosubscripts.size())};
|
2019-10-23 07:53:29 +08:00
|
|
|
const Symbol &symbol{reversed.front()};
|
2019-09-14 03:32:43 +08:00
|
|
|
if (numCosubscripts != symbol.Corank()) {
|
|
|
|
Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
|
|
|
|
symbol.name(), symbol.Corank(), numCosubscripts);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
// TODO: stat=/team=/team_number=
|
|
|
|
// Reverse the chain of symbols so that the base is first and coarray
|
|
|
|
// ultimate component is last.
|
2019-10-23 07:53:29 +08:00
|
|
|
return Designate(
|
|
|
|
DataRef{CoarrayRef{SymbolVector{reversed.crbegin(), reversed.crend()},
|
|
|
|
std::move(subscripts), std::move(cosubscripts)}});
|
2019-09-14 03:32:43 +08:00
|
|
|
}
|
2018-08-08 03:34:09 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
int ExpressionAnalyzer::IntegerTypeSpecKind(
|
|
|
|
const parser::IntegerTypeSpec &spec) {
|
|
|
|
Expr<SubscriptInteger> value{
|
|
|
|
AnalyzeKindSelector(TypeCategory::Integer, spec.v)};
|
2019-01-23 08:30:32 +08:00
|
|
|
if (auto kind{ToInt64(value)}) {
|
|
|
|
return static_cast<int>(*kind);
|
|
|
|
}
|
2019-03-08 06:46:31 +08:00
|
|
|
SayAt(spec, "Constant INTEGER kind value required here"_err_en_US);
|
|
|
|
return GetDefaultKind(TypeCategory::Integer);
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
// Array constructors
|
|
|
|
|
2019-11-22 05:31:52 +08:00
|
|
|
// Inverts a collection of generic ArrayConstructorValues<SomeType> that
|
|
|
|
// all happen to have the same actual type T into one ArrayConstructor<T>.
|
|
|
|
template<typename T>
|
|
|
|
ArrayConstructorValues<T> MakeSpecific(
|
|
|
|
ArrayConstructorValues<SomeType> &&from) {
|
|
|
|
ArrayConstructorValues<T> to;
|
|
|
|
for (ArrayConstructorValue<SomeType> &x : from) {
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](common::CopyableIndirection<Expr<SomeType>> &&expr) {
|
|
|
|
auto *typed{UnwrapExpr<Expr<T>>(expr.value())};
|
|
|
|
to.Push(std::move(DEREF(typed)));
|
|
|
|
},
|
|
|
|
[&](ImpliedDo<SomeType> &&impliedDo) {
|
|
|
|
to.Push(ImpliedDo<T>{impliedDo.name(),
|
|
|
|
std::move(impliedDo.lower()), std::move(impliedDo.upper()),
|
|
|
|
std::move(impliedDo.stride()),
|
|
|
|
MakeSpecific<T>(std::move(impliedDo.values()))});
|
|
|
|
},
|
|
|
|
},
|
|
|
|
std::move(x.u));
|
|
|
|
}
|
|
|
|
return to;
|
|
|
|
}
|
|
|
|
|
|
|
|
class ArrayConstructorContext {
|
2019-02-16 04:20:30 +08:00
|
|
|
public:
|
|
|
|
ArrayConstructorContext(
|
2019-11-22 05:31:52 +08:00
|
|
|
ExpressionAnalyzer &c, std::optional<DynamicTypeWithLength> &&t)
|
|
|
|
: exprAnalyzer_{c}, type_{std::move(t)} {}
|
|
|
|
|
2019-01-23 08:30:32 +08:00
|
|
|
void Add(const parser::AcValue &);
|
2019-11-22 05:31:52 +08:00
|
|
|
MaybeExpr ToExpr();
|
|
|
|
|
|
|
|
// These interfaces allow *this to be used as a type visitor argument to
|
|
|
|
// common::SearchTypes() to convert the array constructor to a typed
|
|
|
|
// expression in ToExpr().
|
|
|
|
using Result = MaybeExpr;
|
|
|
|
using Types = AllTypes;
|
|
|
|
template<typename T> Result Test() {
|
|
|
|
if (type_ && type_->category() == T::category) {
|
|
|
|
if constexpr (T::category == TypeCategory::Derived) {
|
|
|
|
return AsMaybeExpr(ArrayConstructor<T>{
|
|
|
|
type_->GetDerivedTypeSpec(), MakeSpecific<T>(std::move(values_))});
|
|
|
|
} else if (type_->kind() == T::kind) {
|
|
|
|
if constexpr (T::category == TypeCategory::Character) {
|
|
|
|
if (auto len{type_->LEN()}) {
|
|
|
|
return AsMaybeExpr(ArrayConstructor<T>{
|
|
|
|
*std::move(len), MakeSpecific<T>(std::move(values_))});
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
return AsMaybeExpr(
|
|
|
|
ArrayConstructor<T>{MakeSpecific<T>(std::move(values_))});
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-02-16 04:20:30 +08:00
|
|
|
|
|
|
|
private:
|
2019-11-22 05:31:52 +08:00
|
|
|
void Push(MaybeExpr &&);
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
template<int KIND, typename A>
|
|
|
|
std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
|
|
|
|
const A &x) {
|
2019-11-22 05:31:52 +08:00
|
|
|
if (MaybeExpr y{exprAnalyzer_.Analyze(x)}) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
|
|
|
|
return ConvertToType<Type<TypeCategory::Integer, KIND>>(
|
2019-11-22 05:31:52 +08:00
|
|
|
std::move(DEREF(intExpr)));
|
2019-03-08 06:46:31 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-11-22 05:31:52 +08:00
|
|
|
// Nested array constructors all reference the same ExpressionAnalyzer,
|
|
|
|
// which represents the nest of active implied DO loop indices.
|
|
|
|
ExpressionAnalyzer &exprAnalyzer_;
|
|
|
|
std::optional<DynamicTypeWithLength> type_;
|
2019-02-16 04:20:30 +08:00
|
|
|
bool explicitType_{type_.has_value()};
|
|
|
|
std::optional<std::int64_t> constantLength_;
|
|
|
|
ArrayConstructorValues<SomeType> values_;
|
2019-01-23 08:30:32 +08:00
|
|
|
};
|
|
|
|
|
|
|
|
void ArrayConstructorContext::Push(MaybeExpr &&x) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!x) {
|
2019-03-12 06:39:11 +08:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
if (auto dyType{x->GetType()}) {
|
|
|
|
DynamicTypeWithLength xType{*dyType};
|
2019-01-23 08:30:32 +08:00
|
|
|
if (Expr<SomeCharacter> * charExpr{UnwrapExpr<Expr<SomeCharacter>>(*x)}) {
|
2019-05-14 00:33:18 +08:00
|
|
|
CHECK(xType.category() == TypeCategory::Character);
|
2019-01-23 08:30:32 +08:00
|
|
|
xType.length =
|
|
|
|
std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u);
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!type_) {
|
2019-01-23 08:30:32 +08:00
|
|
|
// If there is no explicit type-spec in an array constructor, the type
|
|
|
|
// of the array is the declared type of all of the elements, which must
|
2019-02-16 04:20:30 +08:00
|
|
|
// be well-defined and all match.
|
2019-01-23 08:30:32 +08:00
|
|
|
// TODO: Possible language extension: use the most general type of
|
|
|
|
// the values as the type of a numeric constructed array, convert all
|
|
|
|
// of the other values to that type. Alternative: let the first value
|
|
|
|
// determine the type, and convert the others to that type.
|
2019-02-16 04:20:30 +08:00
|
|
|
CHECK(!explicitType_);
|
|
|
|
type_ = std::move(xType);
|
|
|
|
constantLength_ = ToInt64(type_->length);
|
|
|
|
values_.Push(std::move(*x));
|
|
|
|
} else if (!explicitType_) {
|
|
|
|
if (static_cast<const DynamicType &>(*type_) ==
|
2019-01-23 08:30:32 +08:00
|
|
|
static_cast<const DynamicType &>(xType)) {
|
2019-02-16 04:20:30 +08:00
|
|
|
values_.Push(std::move(*x));
|
2019-02-27 07:59:25 +08:00
|
|
|
if (auto thisLen{ToInt64(xType.LEN())}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (constantLength_) {
|
2019-11-22 05:31:52 +08:00
|
|
|
if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
|
2019-02-16 04:20:30 +08:00
|
|
|
*thisLen != *constantLength_) {
|
2019-11-22 05:31:52 +08:00
|
|
|
exprAnalyzer_.Say(
|
|
|
|
"Character literal in array constructor without explicit "
|
2019-02-16 06:26:23 +08:00
|
|
|
"type has different length than earlier element"_en_US);
|
2019-02-16 04:20:30 +08:00
|
|
|
}
|
|
|
|
if (*thisLen > *constantLength_) {
|
2019-02-16 06:26:23 +08:00
|
|
|
// Language extension: use the longest literal to determine the
|
|
|
|
// length of the array constructor's character elements, not the
|
|
|
|
// first, when there is no explicit type.
|
2019-02-16 04:20:30 +08:00
|
|
|
*constantLength_ = *thisLen;
|
2019-02-27 07:59:25 +08:00
|
|
|
type_->length = xType.LEN();
|
2019-02-16 04:20:30 +08:00
|
|
|
}
|
|
|
|
} else {
|
|
|
|
constantLength_ = *thisLen;
|
2019-02-27 07:59:25 +08:00
|
|
|
type_->length = xType.LEN();
|
2019-02-16 04:20:30 +08:00
|
|
|
}
|
|
|
|
}
|
2019-01-23 08:30:32 +08:00
|
|
|
} else {
|
2019-11-22 05:31:52 +08:00
|
|
|
exprAnalyzer_.Say(
|
|
|
|
"Values in array constructor must have the same declared type "
|
2019-02-16 06:26:23 +08:00
|
|
|
"when no explicit type appears"_err_en_US);
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
} else {
|
2019-02-16 04:20:30 +08:00
|
|
|
if (auto cast{ConvertToType(*type_, std::move(*x))}) {
|
|
|
|
values_.Push(std::move(*cast));
|
2019-01-23 08:30:32 +08:00
|
|
|
} else {
|
2019-11-22 05:31:52 +08:00
|
|
|
exprAnalyzer_.Say(
|
|
|
|
"Value in array constructor could not be converted to the type "
|
2019-02-16 06:26:23 +08:00
|
|
|
"of the array"_err_en_US);
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void ArrayConstructorContext::Add(const parser::AcValue &x) {
|
|
|
|
using IntType = ResultType<ImpliedDoIndex>;
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](const parser::AcValue::Triplet &triplet) {
|
|
|
|
// Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
|
|
|
|
std::optional<Expr<IntType>> lower{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSpecificIntExpr<IntType::kind>(std::get<0>(triplet.t))};
|
2019-01-23 08:30:32 +08:00
|
|
|
std::optional<Expr<IntType>> upper{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSpecificIntExpr<IntType::kind>(std::get<1>(triplet.t))};
|
2019-01-23 08:30:32 +08:00
|
|
|
std::optional<Expr<IntType>> stride{
|
2019-03-08 06:46:31 +08:00
|
|
|
GetSpecificIntExpr<IntType::kind>(std::get<2>(triplet.t))};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (lower && upper) {
|
|
|
|
if (!stride) {
|
2019-01-23 08:30:32 +08:00
|
|
|
stride = Expr<IntType>{1};
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!type_) {
|
2019-02-16 04:20:30 +08:00
|
|
|
type_ = DynamicTypeWithLength{IntType::GetType()};
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
2019-11-22 05:31:52 +08:00
|
|
|
auto v{std::move(values_)};
|
|
|
|
parser::CharBlock anonymous;
|
|
|
|
Push(Expr<SomeType>{
|
|
|
|
Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{anonymous}}}});
|
|
|
|
std::swap(v, values_);
|
|
|
|
values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
|
|
|
|
std::move(*upper), std::move(*stride), std::move(v)});
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
},
|
|
|
|
[&](const common::Indirection<parser::Expr> &expr) {
|
2019-11-22 05:31:52 +08:00
|
|
|
auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
|
|
|
|
expr.value().source)};
|
|
|
|
if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
|
2019-01-23 08:30:32 +08:00
|
|
|
Push(std::move(*v));
|
|
|
|
}
|
|
|
|
},
|
|
|
|
[&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
|
|
|
|
const auto &control{
|
2019-03-06 04:28:08 +08:00
|
|
|
std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
|
2019-01-23 08:30:32 +08:00
|
|
|
const auto &bounds{
|
2019-05-09 23:32:27 +08:00
|
|
|
std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
|
2019-11-22 05:31:52 +08:00
|
|
|
exprAnalyzer_.Analyze(bounds.name);
|
2019-01-23 08:30:32 +08:00
|
|
|
parser::CharBlock name{bounds.name.thing.thing.source};
|
2019-07-17 20:19:10 +08:00
|
|
|
const Symbol *symbol{bounds.name.thing.thing.symbol};
|
2019-01-23 08:30:32 +08:00
|
|
|
int kind{IntType::kind};
|
2019-07-17 20:19:10 +08:00
|
|
|
if (const auto dynamicType{DynamicType::From(symbol)}) {
|
|
|
|
kind = dynamicType->kind();
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
2019-11-22 05:31:52 +08:00
|
|
|
if (exprAnalyzer_.AddAcImpliedDo(name, kind)) {
|
|
|
|
std::optional<Expr<IntType>> lower{
|
|
|
|
GetSpecificIntExpr<IntType::kind>(bounds.lower)};
|
|
|
|
std::optional<Expr<IntType>> upper{
|
|
|
|
GetSpecificIntExpr<IntType::kind>(bounds.upper)};
|
|
|
|
if (lower && upper) {
|
|
|
|
std::optional<Expr<IntType>> stride{
|
|
|
|
GetSpecificIntExpr<IntType::kind>(bounds.step)};
|
|
|
|
auto v{std::move(values_)};
|
|
|
|
for (const auto &value :
|
|
|
|
std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
|
|
|
|
Add(value);
|
|
|
|
}
|
|
|
|
if (!stride) {
|
|
|
|
stride = Expr<IntType>{1};
|
|
|
|
}
|
|
|
|
std::swap(v, values_);
|
|
|
|
values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
|
|
|
std::move(*upper), std::move(*stride), std::move(v)});
|
|
|
|
}
|
|
|
|
exprAnalyzer_.RemoveAcImpliedDo(name);
|
|
|
|
} else {
|
|
|
|
exprAnalyzer_.SayAt(name,
|
2019-02-16 06:26:23 +08:00
|
|
|
"Implied DO index is active in surrounding implied DO loop "
|
2019-03-12 06:39:11 +08:00
|
|
|
"and may not have the same name"_err_en_US);
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
},
|
|
|
|
},
|
|
|
|
x.u);
|
|
|
|
}
|
|
|
|
|
2019-11-22 05:31:52 +08:00
|
|
|
MaybeExpr ArrayConstructorContext::ToExpr() {
|
|
|
|
return common::SearchTypes(std::move(*this));
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
|
2019-01-23 08:30:32 +08:00
|
|
|
const parser::AcSpec &acSpec{array.v};
|
2019-11-22 05:31:52 +08:00
|
|
|
ArrayConstructorContext acContext{*this, AnalyzeTypeSpec(acSpec.type)};
|
2019-01-23 08:30:32 +08:00
|
|
|
for (const parser::AcValue &value : acSpec.values) {
|
2019-11-22 05:31:52 +08:00
|
|
|
acContext.Add(value);
|
2019-01-23 08:30:32 +08:00
|
|
|
}
|
2019-11-22 05:31:52 +08:00
|
|
|
return acContext.ToExpr();
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2019-02-09 08:35:02 +08:00
|
|
|
const parser::StructureConstructor &structure) {
|
2019-02-15 04:51:20 +08:00
|
|
|
auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
|
|
|
|
parser::CharBlock typeName{std::get<parser::Name>(parsedType.t).source};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!parsedType.derivedTypeSpec) {
|
2019-02-15 04:51:20 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
const auto &spec{*parsedType.derivedTypeSpec};
|
|
|
|
const Symbol &typeSymbol{spec.typeSymbol()};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
|
2019-06-22 05:07:39 +08:00
|
|
|
return std::nullopt; // error recovery
|
|
|
|
}
|
|
|
|
const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
|
|
|
|
const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
|
2019-02-15 04:51:20 +08:00
|
|
|
|
2019-02-15 06:37:55 +08:00
|
|
|
if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796
|
2019-11-02 04:08:16 +08:00
|
|
|
AttachDeclaration(Say(typeName,
|
|
|
|
"ABSTRACT derived type '%s' may not be used in a "
|
|
|
|
"structure constructor"_err_en_US,
|
|
|
|
typeName),
|
2019-11-23 05:20:58 +08:00
|
|
|
typeSymbol);
|
2019-02-15 06:37:55 +08:00
|
|
|
}
|
|
|
|
|
2019-08-13 03:10:43 +08:00
|
|
|
// This iterator traverses all of the components in the derived type and its
|
2019-02-15 04:51:20 +08:00
|
|
|
// parents. The symbols for whole parent components appear after their
|
|
|
|
// own components and before the components of the types that extend them.
|
|
|
|
// E.g., TYPE :: A; REAL X; END TYPE
|
|
|
|
// TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
|
|
|
|
// produces the component list X, A, Y.
|
|
|
|
// The order is important below because a structure constructor can
|
|
|
|
// initialize X or A by name, but not both.
|
2019-07-31 22:19:22 +08:00
|
|
|
auto components{semantics::OrderedComponentIterator{spec}};
|
2019-02-15 06:37:55 +08:00
|
|
|
auto nextAnonymous{components.begin()};
|
2019-02-15 04:51:20 +08:00
|
|
|
|
|
|
|
std::set<parser::CharBlock> unavailable;
|
|
|
|
bool anyKeyword{false};
|
|
|
|
StructureConstructor result{spec};
|
2019-03-12 06:39:11 +08:00
|
|
|
bool checkConflicts{true}; // until we hit one
|
2019-02-15 04:51:20 +08:00
|
|
|
|
|
|
|
for (const auto &component :
|
|
|
|
std::get<std::list<parser::ComponentSpec>>(structure.t)) {
|
|
|
|
const parser::Expr &expr{
|
2019-03-06 04:28:08 +08:00
|
|
|
std::get<parser::ComponentDataSource>(component.t).v.value()};
|
2019-02-15 04:51:20 +08:00
|
|
|
parser::CharBlock source{expr.source};
|
2019-03-12 06:39:11 +08:00
|
|
|
auto &messages{GetContextualMessages()};
|
|
|
|
auto restorer{messages.SetLocation(source)};
|
2019-02-15 06:37:55 +08:00
|
|
|
const Symbol *symbol{nullptr};
|
2019-06-22 05:07:39 +08:00
|
|
|
MaybeExpr value{Analyze(expr)};
|
|
|
|
std::optional<DynamicType> valueType{DynamicType::From(value)};
|
2019-02-15 04:51:20 +08:00
|
|
|
if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
anyKeyword = true;
|
2019-02-15 04:51:20 +08:00
|
|
|
source = kw->v.source;
|
2019-02-15 06:37:55 +08:00
|
|
|
symbol = kw->v.symbol;
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!symbol) {
|
2019-03-12 06:39:11 +08:00
|
|
|
auto componentIter{std::find_if(components.begin(), components.end(),
|
2019-10-23 07:53:29 +08:00
|
|
|
[=](const Symbol &symbol) { return symbol.name() == source; })};
|
2019-03-12 06:39:11 +08:00
|
|
|
if (componentIter != components.end()) {
|
2019-10-23 07:53:29 +08:00
|
|
|
symbol = &*componentIter;
|
2019-03-12 06:39:11 +08:00
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!symbol) { // C7101
|
2019-03-12 06:39:11 +08:00
|
|
|
Say(source,
|
|
|
|
"Keyword '%s=' does not name a component of derived type '%s'"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
source, typeName);
|
2019-03-12 06:39:11 +08:00
|
|
|
}
|
2019-02-15 06:37:55 +08:00
|
|
|
} else {
|
|
|
|
if (anyKeyword) { // C7100
|
2019-03-08 06:46:31 +08:00
|
|
|
Say(source,
|
2019-02-15 06:37:55 +08:00
|
|
|
"Value in structure constructor lacks a component name"_err_en_US);
|
|
|
|
checkConflicts = false; // stem cascade
|
|
|
|
}
|
2019-06-22 05:07:39 +08:00
|
|
|
// Here's a regrettably common extension of the standard: anonymous
|
|
|
|
// initialization of parent components, e.g., T(PT(1)) rather than
|
|
|
|
// T(1) or T(PT=PT(1)).
|
2019-11-10 01:29:31 +08:00
|
|
|
if (nextAnonymous == components.begin() && parentComponent &&
|
2019-06-22 05:07:39 +08:00
|
|
|
valueType == DynamicType::From(*parentComponent) &&
|
2019-11-07 07:54:26 +08:00
|
|
|
context().IsEnabled(LanguageFeature::AnonymousParents)) {
|
2019-06-22 05:07:39 +08:00
|
|
|
auto iter{
|
2019-10-23 07:53:29 +08:00
|
|
|
std::find(components.begin(), components.end(), *parentComponent)};
|
2019-06-22 05:07:39 +08:00
|
|
|
if (iter != components.end()) {
|
|
|
|
symbol = parentComponent;
|
|
|
|
nextAnonymous = ++iter;
|
2019-11-07 07:54:26 +08:00
|
|
|
if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
|
2019-06-22 05:07:39 +08:00
|
|
|
Say(source,
|
|
|
|
"Whole parent component '%s' in structure "
|
|
|
|
"constructor should not be anonymous"_en_US,
|
|
|
|
symbol->name());
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
while (!symbol && nextAnonymous != components.end()) {
|
2019-10-23 07:53:29 +08:00
|
|
|
const Symbol &next{*nextAnonymous};
|
|
|
|
++nextAnonymous;
|
|
|
|
if (!next.test(Symbol::Flag::ParentComp)) {
|
|
|
|
symbol = &next;
|
2019-02-09 08:35:02 +08:00
|
|
|
}
|
2019-02-15 06:37:55 +08:00
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!symbol) {
|
2019-03-08 06:46:31 +08:00
|
|
|
Say(source, "Unexpected value in structure constructor"_err_en_US);
|
2019-02-15 06:37:55 +08:00
|
|
|
}
|
|
|
|
}
|
2019-11-10 01:29:31 +08:00
|
|
|
if (symbol) {
|
2019-02-20 07:38:55 +08:00
|
|
|
if (checkConflicts) {
|
2019-02-15 06:37:55 +08:00
|
|
|
auto componentIter{
|
2019-10-23 07:53:29 +08:00
|
|
|
std::find(components.begin(), components.end(), *symbol)};
|
2019-02-15 06:37:55 +08:00
|
|
|
if (unavailable.find(symbol->name()) != unavailable.cend()) {
|
|
|
|
// C797, C798
|
2019-03-08 06:46:31 +08:00
|
|
|
Say(source,
|
2019-02-20 07:38:55 +08:00
|
|
|
"Component '%s' conflicts with another component earlier in "
|
|
|
|
"this structure constructor"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbol->name());
|
2019-02-15 06:37:55 +08:00
|
|
|
} else if (symbol->test(Symbol::Flag::ParentComp)) {
|
|
|
|
// Make earlier components unavailable once a whole parent appears.
|
|
|
|
for (auto it{components.begin()}; it != componentIter; ++it) {
|
2019-10-23 07:53:29 +08:00
|
|
|
unavailable.insert(it->name());
|
2019-02-15 04:51:20 +08:00
|
|
|
}
|
2019-02-15 06:37:55 +08:00
|
|
|
} else {
|
|
|
|
// Make whole parent components unavailable after any of their
|
|
|
|
// constituents appear.
|
|
|
|
for (auto it{componentIter}; it != components.end(); ++it) {
|
2019-10-23 07:53:29 +08:00
|
|
|
if (it->test(Symbol::Flag::ParentComp)) {
|
|
|
|
unavailable.insert(it->name());
|
2019-02-15 06:37:55 +08:00
|
|
|
}
|
|
|
|
}
|
2019-02-15 04:51:20 +08:00
|
|
|
}
|
2019-02-09 08:35:02 +08:00
|
|
|
}
|
2019-02-15 06:37:55 +08:00
|
|
|
unavailable.insert(symbol->name());
|
2019-11-10 01:29:31 +08:00
|
|
|
if (value) {
|
2019-02-22 04:10:07 +08:00
|
|
|
if (symbol->has<semantics::ProcEntityDetails>()) {
|
2019-03-12 06:39:11 +08:00
|
|
|
CHECK(IsPointer(*symbol));
|
|
|
|
} else if (symbol->has<semantics::ObjectEntityDetails>()) {
|
2019-03-02 09:33:20 +08:00
|
|
|
// C1594(4)
|
2019-03-12 06:39:11 +08:00
|
|
|
const auto &innermost{context_.FindScope(expr.source)};
|
2019-07-20 06:17:14 +08:00
|
|
|
if (const auto *pureProc{
|
2019-11-20 11:10:02 +08:00
|
|
|
semantics::FindPureProcedureContaining(innermost)}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
if (const Symbol *
|
|
|
|
pointer{semantics::FindPointerComponent(*symbol)}) {
|
2019-03-05 08:28:35 +08:00
|
|
|
if (const Symbol *
|
2019-03-12 06:39:11 +08:00
|
|
|
object{semantics::FindExternallyVisibleObject(
|
2019-07-20 06:17:14 +08:00
|
|
|
*value, *pureProc)}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
if (auto *msg{Say(expr.source,
|
2019-11-20 11:10:02 +08:00
|
|
|
"Externally visible object '%s' may not be "
|
2019-03-12 06:39:11 +08:00
|
|
|
"associated with pointer component '%s' in a "
|
2019-12-24 09:12:53 +08:00
|
|
|
"pure procedure"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
object->name(), pointer->name())}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
msg->Attach(object->name(), "Object declaration"_en_US)
|
|
|
|
.Attach(pointer->name(), "Pointer declaration"_en_US);
|
2019-03-05 08:28:35 +08:00
|
|
|
}
|
2019-03-02 09:33:20 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-03-12 06:39:11 +08:00
|
|
|
} else if (symbol->has<semantics::TypeParamDetails>()) {
|
|
|
|
Say(expr.source,
|
|
|
|
"Type parameter '%s' may not appear as a component "
|
|
|
|
"of a structure constructor"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbol->name());
|
2019-03-12 06:39:11 +08:00
|
|
|
continue;
|
|
|
|
} else {
|
|
|
|
Say(expr.source,
|
|
|
|
"Component '%s' is neither a procedure pointer "
|
|
|
|
"nor a data object"_err_en_US,
|
2019-05-07 00:33:45 +08:00
|
|
|
symbol->name());
|
2019-03-12 06:39:11 +08:00
|
|
|
continue;
|
|
|
|
}
|
|
|
|
if (IsPointer(*symbol)) {
|
2020-01-07 01:16:18 +08:00
|
|
|
semantics::CheckPointerAssignment(
|
2019-12-12 07:06:24 +08:00
|
|
|
GetFoldingContext(), *symbol, *value); // C7104, C7105
|
2020-01-04 02:38:51 +08:00
|
|
|
result.Add(*symbol, Fold(std::move(*value)));
|
2019-03-12 06:39:11 +08:00
|
|
|
} else if (MaybeExpr converted{
|
|
|
|
ConvertToType(*symbol, std::move(*value))}) {
|
|
|
|
result.Add(*symbol, std::move(*converted));
|
2019-07-19 06:08:50 +08:00
|
|
|
} else if (IsAllocatable(*symbol) &&
|
|
|
|
std::holds_alternative<NullPointer>(value->u)) {
|
|
|
|
// NULL() with no arguments allowed by 7.5.10 para 6 for ALLOCATABLE
|
2019-05-14 00:33:18 +08:00
|
|
|
} else if (auto symType{DynamicType::From(symbol)}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (valueType) {
|
2019-11-02 04:08:16 +08:00
|
|
|
AttachDeclaration(
|
|
|
|
Say(expr.source,
|
2019-05-14 00:33:18 +08:00
|
|
|
"Value in structure constructor of type %s is "
|
|
|
|
"incompatible with component '%s' of type %s"_err_en_US,
|
2019-06-22 05:07:39 +08:00
|
|
|
valueType->AsFortran(), symbol->name(),
|
2019-11-02 04:08:16 +08:00
|
|
|
symType->AsFortran()),
|
2019-11-23 05:20:58 +08:00
|
|
|
*symbol);
|
2019-05-14 00:33:18 +08:00
|
|
|
} else {
|
2019-11-02 04:08:16 +08:00
|
|
|
AttachDeclaration(
|
|
|
|
Say(expr.source,
|
2019-05-14 00:33:18 +08:00
|
|
|
"Value in structure constructor is incompatible with "
|
|
|
|
" component '%s' of type %s"_err_en_US,
|
2019-11-02 04:08:16 +08:00
|
|
|
symbol->name(), symType->AsFortran()),
|
2019-11-23 05:20:58 +08:00
|
|
|
*symbol);
|
2019-02-20 07:38:55 +08:00
|
|
|
}
|
|
|
|
}
|
2019-02-15 06:37:55 +08:00
|
|
|
}
|
2019-02-09 08:35:02 +08:00
|
|
|
}
|
|
|
|
}
|
2019-02-15 04:51:20 +08:00
|
|
|
|
|
|
|
// Ensure that unmentioned component objects have default initializers.
|
2019-10-23 07:53:29 +08:00
|
|
|
for (const Symbol &symbol : components) {
|
|
|
|
if (!symbol.test(Symbol::Flag::ParentComp) &&
|
|
|
|
unavailable.find(symbol.name()) == unavailable.cend() &&
|
|
|
|
!IsAllocatable(symbol)) {
|
2019-02-15 04:51:20 +08:00
|
|
|
if (const auto *details{
|
2019-10-23 07:53:29 +08:00
|
|
|
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (details->init()) {
|
2019-10-23 07:53:29 +08:00
|
|
|
result.Add(symbol, common::Clone(*details->init()));
|
2019-02-15 04:51:20 +08:00
|
|
|
} else { // C799
|
2019-11-02 04:08:16 +08:00
|
|
|
AttachDeclaration(Say(typeName,
|
|
|
|
"Structure constructor lacks a value for "
|
|
|
|
"component '%s'"_err_en_US,
|
|
|
|
symbol.name()),
|
2019-11-23 05:20:58 +08:00
|
|
|
symbol);
|
2019-02-15 04:51:20 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return AsMaybeExpr(Expr<SomeDerived>{std::move(result)});
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
|
|
|
|
2019-12-06 02:24:18 +08:00
|
|
|
static std::optional<parser::CharBlock> GetPassName(
|
|
|
|
const semantics::Symbol &proc) {
|
|
|
|
return std::visit(
|
|
|
|
[](const auto &details) {
|
|
|
|
if constexpr (std::is_base_of_v<semantics::WithPassArg,
|
|
|
|
std::decay_t<decltype(details)>>) {
|
|
|
|
return details.passName();
|
|
|
|
} else {
|
|
|
|
return std::optional<parser::CharBlock>{};
|
|
|
|
}
|
|
|
|
},
|
|
|
|
proc.details());
|
|
|
|
}
|
|
|
|
|
2019-12-17 03:33:55 +08:00
|
|
|
static int GetPassIndex(const Symbol &proc) {
|
|
|
|
CHECK(!proc.attrs().test(semantics::Attr::NOPASS));
|
|
|
|
std::optional<parser::CharBlock> passName{GetPassName(proc)};
|
|
|
|
const auto *interface{semantics::FindInterface(proc)};
|
|
|
|
if (!passName || !interface) {
|
|
|
|
return 0; // first argument is passed-object
|
|
|
|
}
|
|
|
|
const auto &subp{interface->get<semantics::SubprogramDetails>()};
|
|
|
|
int index{0};
|
|
|
|
for (const auto *arg : subp.dummyArgs()) {
|
|
|
|
if (arg && arg->name() == passName) {
|
|
|
|
return index;
|
2019-12-06 02:24:18 +08:00
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
++index;
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
DIE("PASS argument name not in dummy argument list");
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
2019-12-10 05:52:12 +08:00
|
|
|
// Injects an expression into an actual argument list as the "passed object"
|
|
|
|
// for a type-bound procedure reference that is not NOPASS. Adds an
|
|
|
|
// argument keyword if possible, but not when the passed object goes
|
|
|
|
// before a positional argument.
|
|
|
|
// e.g., obj%tbp(x) -> tbp(obj,x).
|
2019-12-24 09:12:53 +08:00
|
|
|
static void AddPassArg(ActualArguments &actuals, const Expr<SomeDerived> &expr,
|
2019-12-10 05:52:12 +08:00
|
|
|
const Symbol &component, bool isPassedObject = true) {
|
2019-12-10 05:36:19 +08:00
|
|
|
if (component.attrs().test(semantics::Attr::NOPASS)) {
|
2019-12-10 05:52:12 +08:00
|
|
|
return;
|
2019-12-10 05:36:19 +08:00
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
int passIndex{GetPassIndex(component)};
|
2019-12-10 05:36:19 +08:00
|
|
|
auto iter{actuals.begin()};
|
|
|
|
int at{0};
|
|
|
|
while (iter < actuals.end() && at < passIndex) {
|
|
|
|
if (*iter && (*iter)->keyword()) {
|
|
|
|
iter = actuals.end();
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
++iter;
|
|
|
|
++at;
|
|
|
|
}
|
2019-12-24 09:12:53 +08:00
|
|
|
ActualArgument passed{AsGenericExpr(common::Clone(expr))};
|
2019-12-10 05:52:12 +08:00
|
|
|
passed.set_isPassedObject(isPassedObject);
|
2019-12-17 03:33:55 +08:00
|
|
|
if (iter == actuals.end()) {
|
|
|
|
if (auto passName{GetPassName(component)}) {
|
|
|
|
passed.set_keyword(*passName);
|
|
|
|
}
|
2019-12-10 05:36:19 +08:00
|
|
|
}
|
|
|
|
actuals.emplace(iter, std::move(passed));
|
|
|
|
}
|
|
|
|
|
2019-12-17 03:33:55 +08:00
|
|
|
// Return the compile-time resolution of a procedure binding, if possible.
|
|
|
|
static const Symbol *GetBindingResolution(
|
|
|
|
const std::optional<DynamicType> &baseType, const Symbol &component) {
|
|
|
|
const auto *binding{component.detailsIf<semantics::ProcBindingDetails>()};
|
|
|
|
if (!binding) {
|
|
|
|
return nullptr;
|
|
|
|
}
|
|
|
|
if (!component.attrs().test(semantics::Attr::NON_OVERRIDABLE) &&
|
|
|
|
(!baseType || baseType->IsPolymorphic())) {
|
|
|
|
return nullptr;
|
|
|
|
}
|
|
|
|
return &binding->symbol();
|
|
|
|
}
|
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
|
|
|
|
const parser::ProcComponentRef &pcr, ActualArguments &&arguments)
|
|
|
|
-> std::optional<CalleeAndArguments> {
|
2019-04-13 07:50:58 +08:00
|
|
|
const parser::StructureComponent &sc{pcr.v.thing};
|
|
|
|
const auto &name{sc.component.source};
|
|
|
|
if (MaybeExpr base{Analyze(sc.base)}) {
|
2019-12-10 05:36:19 +08:00
|
|
|
if (const Symbol * sym{sc.component.symbol}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
|
2019-12-10 05:52:12 +08:00
|
|
|
if (sym->has<semantics::GenericDetails>()) {
|
2019-12-24 09:12:53 +08:00
|
|
|
AdjustActuals adjustment{
|
2019-12-17 03:33:55 +08:00
|
|
|
[&](const Symbol &proc, ActualArguments &actuals) {
|
|
|
|
if (!proc.attrs().test(semantics::Attr::NOPASS)) {
|
|
|
|
AddPassArg(actuals, std::move(*dtExpr), proc);
|
|
|
|
}
|
|
|
|
return true;
|
2019-12-24 09:12:53 +08:00
|
|
|
}};
|
|
|
|
sym = ResolveGeneric(*sym, arguments, adjustment);
|
2019-12-10 05:52:12 +08:00
|
|
|
if (!sym) {
|
2019-12-24 09:12:53 +08:00
|
|
|
EmitGenericResolutionError(*sc.component.symbol);
|
2019-12-10 05:52:12 +08:00
|
|
|
return std::nullopt;
|
2019-12-06 02:24:18 +08:00
|
|
|
}
|
2019-03-12 06:39:11 +08:00
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
if (const Symbol *
|
|
|
|
resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) {
|
2019-12-10 05:52:12 +08:00
|
|
|
AddPassArg(arguments, std::move(*dtExpr), *sym, false);
|
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{*resolution}, std::move(arguments)};
|
|
|
|
} else if (std::optional<DataRef> dataRef{
|
|
|
|
ExtractDataRef(std::move(*dtExpr))}) {
|
|
|
|
if (sym->attrs().test(semantics::Attr::NOPASS)) {
|
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{Component{std::move(*dataRef), *sym}},
|
|
|
|
std::move(arguments)};
|
2019-03-12 06:39:11 +08:00
|
|
|
} else {
|
2019-12-10 05:52:12 +08:00
|
|
|
AddPassArg(arguments,
|
|
|
|
Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
|
|
|
|
*sym);
|
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{*sym}, std::move(arguments)};
|
2019-03-12 06:39:11 +08:00
|
|
|
}
|
2019-04-13 07:50:58 +08:00
|
|
|
}
|
|
|
|
}
|
2019-12-10 05:52:12 +08:00
|
|
|
Say(name,
|
|
|
|
"Base of procedure component reference is not a derived-type object"_err_en_US);
|
2019-04-13 07:50:58 +08:00
|
|
|
}
|
|
|
|
}
|
2019-10-25 05:55:25 +08:00
|
|
|
CHECK(!GetContextualMessages().empty());
|
2019-04-13 07:50:58 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-10-10 07:08:13 +08:00
|
|
|
// Can actual be argument associated with dummy?
|
|
|
|
static bool CheckCompatibleArgument(bool isElemental,
|
|
|
|
const ActualArgument &actual, const characteristics::DummyArgument &dummy) {
|
|
|
|
return std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](const characteristics::DummyDataObject &x) {
|
|
|
|
characteristics::TypeAndShape dummyTypeAndShape{x.type};
|
|
|
|
if (!isElemental && actual.Rank() != dummyTypeAndShape.Rank()) {
|
|
|
|
return false;
|
|
|
|
} else if (auto actualType{actual.GetType()}) {
|
|
|
|
return dummyTypeAndShape.type().IsTkCompatibleWith(*actualType);
|
|
|
|
} else {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
},
|
|
|
|
[&](const characteristics::DummyProcedure &) {
|
|
|
|
const auto *expr{actual.UnwrapExpr()};
|
|
|
|
return expr && IsProcedurePointer(*expr);
|
|
|
|
},
|
|
|
|
[&](const characteristics::AlternateReturn &) {
|
2019-12-06 02:24:18 +08:00
|
|
|
return actual.isAlternateReturn();
|
2019-10-10 07:08:13 +08:00
|
|
|
},
|
|
|
|
},
|
|
|
|
dummy.u);
|
|
|
|
}
|
|
|
|
|
|
|
|
// Are the actual arguments compatible with the dummy arguments of procedure?
|
|
|
|
static bool CheckCompatibleArguments(
|
|
|
|
const characteristics::Procedure &procedure,
|
|
|
|
const ActualArguments &actuals) {
|
|
|
|
bool isElemental{procedure.IsElemental()};
|
|
|
|
const auto &dummies{procedure.dummyArguments};
|
|
|
|
CHECK(dummies.size() == actuals.size());
|
|
|
|
for (std::size_t i{0}; i < dummies.size(); ++i) {
|
|
|
|
const characteristics::DummyArgument &dummy{dummies[i]};
|
|
|
|
const std::optional<ActualArgument> &actual{actuals[i]};
|
|
|
|
if (actual && !CheckCompatibleArgument(isElemental, *actual, dummy)) {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
|
2019-12-10 05:36:19 +08:00
|
|
|
// Resolve a call to a generic procedure with given actual arguments.
|
2019-12-17 03:33:55 +08:00
|
|
|
// adjustActuals is called on procedure bindings to handle pass arg.
|
2019-12-10 05:36:19 +08:00
|
|
|
const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
|
2019-12-24 09:12:53 +08:00
|
|
|
const ActualArguments &actuals, const AdjustActuals &adjustActuals,
|
|
|
|
bool mightBeStructureConstructor) {
|
2019-10-10 07:08:13 +08:00
|
|
|
const Symbol *elemental{nullptr}; // matching elemental specific proc
|
2019-10-23 00:31:33 +08:00
|
|
|
const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
|
2019-10-23 07:53:29 +08:00
|
|
|
for (const Symbol &specific : details.specificProcs()) {
|
2019-10-10 07:08:13 +08:00
|
|
|
if (std::optional<characteristics::Procedure> procedure{
|
|
|
|
characteristics::Procedure::Characterize(
|
2019-10-23 07:53:29 +08:00
|
|
|
ProcedureDesignator{specific}, context_.intrinsics())}) {
|
2019-10-10 07:08:13 +08:00
|
|
|
ActualArguments localActuals{actuals};
|
2019-12-10 05:36:19 +08:00
|
|
|
if (specific.has<semantics::ProcBindingDetails>()) {
|
2019-12-17 03:33:55 +08:00
|
|
|
if (!adjustActuals.value()(specific, localActuals)) {
|
|
|
|
continue;
|
|
|
|
}
|
2019-12-10 05:36:19 +08:00
|
|
|
}
|
2019-10-23 00:31:33 +08:00
|
|
|
if (semantics::CheckInterfaceForGeneric(
|
|
|
|
*procedure, localActuals, GetFoldingContext())) {
|
|
|
|
if (CheckCompatibleArguments(*procedure, localActuals)) {
|
|
|
|
if (!procedure->IsElemental()) {
|
2019-10-23 07:53:29 +08:00
|
|
|
return &specific; // takes priority over elemental match
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-10-23 07:53:29 +08:00
|
|
|
elemental = &specific;
|
2019-10-10 07:08:13 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (elemental) {
|
|
|
|
return elemental;
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-12-10 05:52:12 +08:00
|
|
|
// Check parent derived type
|
|
|
|
if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
|
|
|
|
if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
|
|
|
|
if (extended->GetUltimate().has<semantics::GenericDetails>()) {
|
2019-12-21 05:03:30 +08:00
|
|
|
if (const Symbol *
|
2019-12-24 09:12:53 +08:00
|
|
|
result{ResolveGeneric(*extended, actuals, adjustActuals, false)}) {
|
2019-12-21 05:03:30 +08:00
|
|
|
return result;
|
|
|
|
}
|
2019-12-10 05:52:12 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-12-21 05:03:30 +08:00
|
|
|
if (mightBeStructureConstructor && details.derivedType()) {
|
|
|
|
return details.derivedType();
|
|
|
|
}
|
2019-12-24 09:12:53 +08:00
|
|
|
return nullptr;
|
|
|
|
}
|
|
|
|
|
|
|
|
void ExpressionAnalyzer::EmitGenericResolutionError(const Symbol &symbol) {
|
2019-10-23 00:31:33 +08:00
|
|
|
if (semantics::IsGenericDefinedOp(symbol)) {
|
|
|
|
Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
|
|
|
|
symbol.name());
|
2019-10-10 07:08:13 +08:00
|
|
|
} else {
|
|
|
|
Say("No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
|
|
|
|
symbol.name());
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
auto ExpressionAnalyzer::GetCalleeAndArguments(
|
|
|
|
const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
|
2019-12-21 05:03:30 +08:00
|
|
|
bool isSubroutine, bool mightBeStructureConstructor)
|
|
|
|
-> std::optional<CalleeAndArguments> {
|
2018-09-21 03:34:29 +08:00
|
|
|
return std::visit(
|
|
|
|
common::visitors{
|
2019-10-23 00:31:33 +08:00
|
|
|
[&](const parser::Name &name) {
|
2019-12-21 05:03:30 +08:00
|
|
|
return GetCalleeAndArguments(name, std::move(arguments),
|
|
|
|
isSubroutine, mightBeStructureConstructor);
|
2018-09-21 03:34:29 +08:00
|
|
|
},
|
2019-10-10 07:08:13 +08:00
|
|
|
[&](const parser::ProcComponentRef &pcr) {
|
2019-09-17 07:58:13 +08:00
|
|
|
return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
|
2018-09-21 03:34:29 +08:00
|
|
|
},
|
|
|
|
},
|
|
|
|
pd.u);
|
|
|
|
}
|
|
|
|
|
2019-12-21 05:03:30 +08:00
|
|
|
auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
|
|
|
|
ActualArguments &&arguments, bool isSubroutine,
|
|
|
|
bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
|
2019-10-23 00:31:33 +08:00
|
|
|
const Symbol *symbol{name.symbol};
|
|
|
|
if (context_.HasError(symbol)) {
|
2019-12-21 05:03:30 +08:00
|
|
|
return std::nullopt; // also handles null symbol
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-12-12 07:06:24 +08:00
|
|
|
const Symbol &ultimate{DEREF(symbol).GetUltimate()};
|
2019-10-23 00:31:33 +08:00
|
|
|
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
|
|
|
|
if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
|
2019-12-12 07:06:24 +08:00
|
|
|
CallCharacteristics{ultimate.name().ToString(), isSubroutine},
|
|
|
|
arguments, GetFoldingContext())}) {
|
2019-10-23 00:31:33 +08:00
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
|
|
|
|
std::move(specificCall->arguments)};
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
CheckForBadRecursion(name.source, ultimate);
|
|
|
|
if (ultimate.has<semantics::GenericDetails>()) {
|
2019-12-24 09:12:53 +08:00
|
|
|
ExpressionAnalyzer::AdjustActuals noAdjustment;
|
2019-12-21 05:03:30 +08:00
|
|
|
symbol = ResolveGeneric(
|
2019-12-24 09:12:53 +08:00
|
|
|
*symbol, arguments, noAdjustment, mightBeStructureConstructor);
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
if (symbol) {
|
2019-12-21 05:03:30 +08:00
|
|
|
if (symbol->GetUltimate().has<semantics::DerivedTypeDetails>()) {
|
|
|
|
if (mightBeStructureConstructor) {
|
|
|
|
return CalleeAndArguments{
|
|
|
|
semantics::SymbolRef{*symbol}, std::move(arguments)};
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{*symbol}, std::move(arguments)};
|
|
|
|
}
|
2019-12-24 09:12:53 +08:00
|
|
|
} else if (std::optional<SpecificCall> specificCall{
|
|
|
|
context_.intrinsics().Probe(
|
|
|
|
CallCharacteristics{
|
|
|
|
ultimate.name().ToString(), isSubroutine},
|
|
|
|
arguments, GetFoldingContext())}) {
|
|
|
|
// Generics can extend intrinsics
|
|
|
|
return CalleeAndArguments{
|
|
|
|
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
|
|
|
|
std::move(specificCall->arguments)};
|
|
|
|
} else {
|
|
|
|
EmitGenericResolutionError(*name.symbol);
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
}
|
2019-12-21 05:03:30 +08:00
|
|
|
return std::nullopt;
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
void ExpressionAnalyzer::CheckForBadRecursion(
|
|
|
|
parser::CharBlock callSite, const semantics::Symbol &proc) {
|
|
|
|
if (const auto *scope{proc.scope()}) {
|
|
|
|
if (scope->sourceRange().Contains(callSite)) {
|
|
|
|
parser::Message *msg{nullptr};
|
|
|
|
if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
|
|
|
|
msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
|
|
|
|
callSite);
|
2020-02-27 12:19:48 +08:00
|
|
|
} else if (IsAssumedLengthExternalCharacterFunction(proc)) {
|
|
|
|
msg = Say( // 15.6.2.1(3)
|
2019-09-17 07:58:13 +08:00
|
|
|
"Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
|
|
|
|
callSite);
|
|
|
|
}
|
2019-11-23 05:20:58 +08:00
|
|
|
AttachDeclaration(msg, proc);
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-07-02 07:54:53 +08:00
|
|
|
template<typename A> static const Symbol *AssumedTypeDummy(const A &x) {
|
2019-03-12 06:39:11 +08:00
|
|
|
if (const auto *designator{
|
2019-06-04 03:18:52 +08:00
|
|
|
std::get_if<common::Indirection<parser::Designator>>(&x.u)}) {
|
2019-03-12 06:39:11 +08:00
|
|
|
if (const auto *dataRef{
|
|
|
|
std::get_if<parser::DataRef>(&designator->value().u)}) {
|
|
|
|
if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
|
|
|
|
if (const Symbol * symbol{name->symbol}) {
|
|
|
|
if (const auto *type{symbol->GetType()}) {
|
|
|
|
if (type->category() == semantics::DeclTypeSpec::TypeStar) {
|
|
|
|
return symbol;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return nullptr;
|
|
|
|
}
|
|
|
|
|
2019-12-21 05:03:30 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
|
|
|
|
std::optional<parser::StructureConstructor> *structureConstructor) {
|
|
|
|
const parser::Call &call{funcRef.v};
|
|
|
|
auto restorer{GetContextualMessages().SetLocation(call.source)};
|
2020-01-11 06:09:39 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */};
|
2019-12-21 05:03:30 +08:00
|
|
|
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
|
|
|
|
analyzer.Analyze(arg, false /* not subroutine call */);
|
2019-12-18 02:53:20 +08:00
|
|
|
}
|
2019-12-21 05:03:30 +08:00
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
if (std::optional<CalleeAndArguments> callee{
|
|
|
|
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
|
|
|
|
analyzer.GetActuals(), false /* not subroutine */,
|
|
|
|
true /* might be structure constructor */)}) {
|
|
|
|
if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
|
|
|
|
return MakeFunctionRef(
|
|
|
|
call.source, std::move(*proc), std::move(callee->arguments));
|
|
|
|
} else if (structureConstructor) {
|
|
|
|
// Structure constructor misparsed as function reference?
|
|
|
|
CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
|
|
|
|
const Symbol &derivedType{*std::get<semantics::SymbolRef>(callee->u)};
|
|
|
|
const auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
|
|
|
|
if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
|
|
|
|
semantics::Scope &scope{context_.FindScope(name->source)};
|
|
|
|
const semantics::DeclTypeSpec &type{
|
|
|
|
semantics::FindOrInstantiateDerivedType(scope,
|
|
|
|
semantics::DerivedTypeSpec{
|
|
|
|
name->source, derivedType.GetUltimate()},
|
|
|
|
context_)};
|
|
|
|
auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
|
|
|
|
*structureConstructor =
|
|
|
|
mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
|
|
|
|
return Analyze(structureConstructor->value());
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
2019-09-05 03:45:08 +08:00
|
|
|
}
|
|
|
|
|
2019-12-21 05:03:30 +08:00
|
|
|
void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
|
|
|
|
const parser::Call &call{callStmt.v};
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{GetContextualMessages().SetLocation(call.source)};
|
2020-01-11 06:09:39 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */};
|
2019-10-23 00:31:33 +08:00
|
|
|
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
|
2019-12-21 05:03:30 +08:00
|
|
|
analyzer.Analyze(arg, true /* is subroutine call */);
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
if (!analyzer.fatalErrors()) {
|
2019-09-17 07:58:13 +08:00
|
|
|
if (std::optional<CalleeAndArguments> callee{
|
|
|
|
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
|
2019-12-21 05:03:30 +08:00
|
|
|
analyzer.GetActuals(), true /* subroutine */)}) {
|
|
|
|
ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
|
|
|
|
CHECK(proc);
|
|
|
|
if (CheckCall(call.source, *proc, callee->arguments)) {
|
|
|
|
callStmt.typedCall.reset(
|
|
|
|
new ProcedureRef{std::move(*proc), std::move(callee->arguments)});
|
2019-09-05 03:45:08 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-12-18 07:59:25 +08:00
|
|
|
const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
|
|
|
|
if (!x.typedAssignment) {
|
|
|
|
ArgumentAnalyzer analyzer{*this};
|
|
|
|
analyzer.Analyze(std::get<parser::Variable>(x.t));
|
|
|
|
analyzer.Analyze(std::get<parser::Expr>(x.t));
|
2020-01-15 09:39:29 +08:00
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
x.typedAssignment.reset(new GenericAssignmentWrapper{});
|
|
|
|
} else {
|
2019-12-18 07:59:25 +08:00
|
|
|
std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
|
2020-02-19 07:20:28 +08:00
|
|
|
Assignment assignment{
|
|
|
|
Fold(analyzer.MoveExpr(0)), Fold(analyzer.MoveExpr(1))};
|
|
|
|
if (procRef) {
|
|
|
|
assignment.u = std::move(*procRef);
|
|
|
|
}
|
|
|
|
x.typedAssignment.reset(
|
|
|
|
new GenericAssignmentWrapper{std::move(assignment)});
|
2019-12-18 07:59:25 +08:00
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
2020-01-15 09:39:29 +08:00
|
|
|
return common::GetPtrFromOptional(x.typedAssignment->v);
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
|
|
|
|
2020-01-04 02:38:51 +08:00
|
|
|
const Assignment *ExpressionAnalyzer::Analyze(
|
|
|
|
const parser::PointerAssignmentStmt &x) {
|
2020-01-15 09:39:29 +08:00
|
|
|
if (!x.typedAssignment) {
|
|
|
|
MaybeExpr lhs{Analyze(std::get<parser::DataRef>(x.t))};
|
|
|
|
MaybeExpr rhs{Analyze(std::get<parser::Expr>(x.t))};
|
2020-02-19 07:20:28 +08:00
|
|
|
if (!lhs || !rhs) {
|
|
|
|
x.typedAssignment.reset(new GenericAssignmentWrapper{});
|
|
|
|
} else {
|
|
|
|
Assignment assignment{std::move(*lhs), std::move(*rhs)};
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](const std::list<parser::BoundsRemapping> &list) {
|
|
|
|
Assignment::BoundsRemapping bounds;
|
2020-01-15 09:39:29 +08:00
|
|
|
for (const auto &elem : list) {
|
|
|
|
auto lower{AsSubscript(Analyze(std::get<0>(elem.t)))};
|
|
|
|
auto upper{AsSubscript(Analyze(std::get<1>(elem.t)))};
|
|
|
|
if (lower && upper) {
|
|
|
|
bounds.emplace_back(
|
|
|
|
Fold(std::move(*lower)), Fold(std::move(*upper)));
|
|
|
|
}
|
2020-01-04 02:38:51 +08:00
|
|
|
}
|
2020-02-19 07:20:28 +08:00
|
|
|
assignment.u = std::move(bounds);
|
|
|
|
},
|
|
|
|
[&](const std::list<parser::BoundsSpec> &list) {
|
|
|
|
Assignment::BoundsSpec bounds;
|
2020-01-15 09:39:29 +08:00
|
|
|
for (const auto &bound : list) {
|
|
|
|
if (auto lower{AsSubscript(Analyze(bound.v))}) {
|
|
|
|
bounds.emplace_back(Fold(std::move(*lower)));
|
|
|
|
}
|
2020-01-04 02:38:51 +08:00
|
|
|
}
|
2020-02-19 07:20:28 +08:00
|
|
|
assignment.u = std::move(bounds);
|
|
|
|
},
|
|
|
|
},
|
|
|
|
std::get<parser::PointerAssignmentStmt::Bounds>(x.t).u);
|
2020-01-15 09:39:29 +08:00
|
|
|
x.typedAssignment.reset(
|
2020-02-19 07:20:28 +08:00
|
|
|
new GenericAssignmentWrapper{std::move(assignment)});
|
2020-01-15 09:39:29 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
return common::GetPtrFromOptional(x.typedAssignment->v);
|
2020-01-04 02:38:51 +08:00
|
|
|
}
|
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
static bool IsExternalCalledImplicitly(
|
|
|
|
parser::CharBlock callSite, const ProcedureDesignator &proc) {
|
|
|
|
if (const auto *symbol{proc.GetSymbol()}) {
|
2019-10-10 07:08:13 +08:00
|
|
|
return symbol->has<semantics::SubprogramDetails>() &&
|
|
|
|
symbol->owner().IsGlobal() &&
|
|
|
|
!symbol->scope()->sourceRange().Contains(callSite);
|
2019-09-17 07:58:13 +08:00
|
|
|
} else {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
|
|
|
|
parser::CharBlock callSite, const ProcedureDesignator &proc,
|
|
|
|
ActualArguments &arguments) {
|
|
|
|
auto chars{
|
|
|
|
characteristics::Procedure::Characterize(proc, context_.intrinsics())};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (chars) {
|
2019-09-17 07:58:13 +08:00
|
|
|
bool treatExternalAsImplicit{IsExternalCalledImplicitly(callSite, proc)};
|
|
|
|
if (treatExternalAsImplicit && !chars->CanBeCalledViaImplicitInterface()) {
|
|
|
|
Say(callSite,
|
|
|
|
"References to the procedure '%s' require an explicit interface"_en_US,
|
|
|
|
DEREF(proc.GetSymbol()).name());
|
|
|
|
}
|
2019-10-11 04:09:35 +08:00
|
|
|
semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
|
|
|
|
context_.FindScope(callSite), treatExternalAsImplicit);
|
2019-11-13 07:43:09 +08:00
|
|
|
if (!chars->attrs.test(characteristics::Procedure::Attr::Pure)) {
|
|
|
|
if (const semantics::Scope *
|
|
|
|
pure{semantics::FindPureProcedureContaining(
|
2019-11-20 11:10:02 +08:00
|
|
|
context_.FindScope(callSite))}) {
|
2019-11-13 07:43:09 +08:00
|
|
|
Say(callSite,
|
2019-12-24 09:12:53 +08:00
|
|
|
"Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
|
2019-11-23 08:46:11 +08:00
|
|
|
DEREF(proc.GetSymbol()).name(), DEREF(pure->symbol()).name());
|
2019-11-13 07:43:09 +08:00
|
|
|
}
|
|
|
|
}
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
return chars;
|
|
|
|
}
|
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// Unary operations
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
|
|
|
|
if (MaybeExpr operand{Analyze(x.v.value())}) {
|
2019-05-04 02:29:15 +08:00
|
|
|
if (const semantics::Symbol * symbol{GetLastSymbol(*operand)}) {
|
|
|
|
if (const semantics::Symbol * result{FindFunctionResult(*symbol)}) {
|
|
|
|
if (semantics::IsProcedurePointer(*result)) {
|
|
|
|
Say("A function reference that returns a procedure "
|
2019-09-14 04:57:35 +08:00
|
|
|
"pointer may not be parenthesized"_err_en_US); // C1003
|
2019-05-04 02:29:15 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-11-23 06:58:26 +08:00
|
|
|
return Parenthesize(std::move(*operand));
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
|
|
|
|
NumericOperator opr, const parser::Expr::IntrinsicUnary &x) {
|
|
|
|
ArgumentAnalyzer analyzer{context};
|
|
|
|
analyzer.Analyze(x.v);
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
2019-11-07 07:54:26 +08:00
|
|
|
} else if (analyzer.IsIntrinsicNumeric(opr)) {
|
2019-11-03 00:56:46 +08:00
|
|
|
if (opr == NumericOperator::Add) {
|
2019-11-23 08:46:11 +08:00
|
|
|
return analyzer.MoveExpr(0);
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-11-23 08:46:11 +08:00
|
|
|
return Negation(context.GetContextualMessages(), analyzer.MoveExpr(0));
|
2019-05-04 02:29:15 +08:00
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
|
|
|
return analyzer.TryDefinedOp(AsFortran(opr),
|
|
|
|
"Operand of unary %s must be numeric; have %s"_err_en_US);
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::UnaryPlus &x) {
|
|
|
|
return NumericUnaryHelper(*this, NumericOperator::Add, x);
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Negate &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericUnaryHelper(*this, NumericOperator::Subtract, x);
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this};
|
|
|
|
analyzer.Analyze(x.v);
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
|
|
|
} else if (analyzer.IsIntrinsicLogical()) {
|
|
|
|
return AsGenericExpr(
|
2019-11-23 08:46:11 +08:00
|
|
|
LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u)));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-11-07 07:54:26 +08:00
|
|
|
return analyzer.TryDefinedOp(LogicalOperator::Not,
|
|
|
|
"Operand of %s must be LOGICAL; have %s"_err_en_US);
|
2018-09-13 02:20:30 +08:00
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-07-02 04:22:22 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
|
|
|
|
// Represent %LOC() exactly as if it had been a call to the LOC() extension
|
|
|
|
// intrinsic function.
|
|
|
|
// Use the actual source for the name of the call for error reporting.
|
2019-09-14 03:32:43 +08:00
|
|
|
std::optional<ActualArgument> arg;
|
|
|
|
if (const Symbol * assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
|
|
|
|
arg = ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
|
|
|
|
} else if (MaybeExpr argExpr{Analyze(x.v.value())}) {
|
|
|
|
arg = ActualArgument{std::move(*argExpr)};
|
2019-07-02 07:54:53 +08:00
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
2019-07-02 04:22:22 +08:00
|
|
|
}
|
2019-09-14 03:32:43 +08:00
|
|
|
parser::CharBlock at{GetContextualMessages().at()};
|
|
|
|
CHECK(at.size() >= 4);
|
|
|
|
parser::CharBlock loc{at.begin() + 1, 3};
|
|
|
|
CHECK(loc == "loc");
|
|
|
|
return MakeFunctionRef(loc, ActualArguments{std::move(*arg)});
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
|
|
|
|
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
|
2020-01-03 01:55:03 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this, name.source};
|
2019-10-23 00:31:33 +08:00
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
2020-01-03 01:55:03 +08:00
|
|
|
return analyzer.TryDefinedOp(name.source.ToString().c_str(),
|
|
|
|
"No operator %s defined for %s"_err_en_US, true);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
2020-01-03 01:55:03 +08:00
|
|
|
|
2018-12-04 03:40:53 +08:00
|
|
|
// Binary (dyadic) operations
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
template<template<typename> class OPR>
|
|
|
|
MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
|
|
|
|
const parser::Expr::IntrinsicBinary &x) {
|
|
|
|
ArgumentAnalyzer analyzer{context};
|
|
|
|
analyzer.Analyze(std::get<0>(x.t));
|
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
2019-11-07 07:54:26 +08:00
|
|
|
} else if (analyzer.IsIntrinsicNumeric(opr)) {
|
2019-01-10 07:06:07 +08:00
|
|
|
return NumericOperation<OPR>(context.GetContextualMessages(),
|
2019-11-23 08:46:11 +08:00
|
|
|
analyzer.MoveExpr(0), analyzer.MoveExpr(1),
|
2019-01-10 07:06:07 +08:00
|
|
|
context.GetDefaultKind(TypeCategory::Real));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
|
|
|
return analyzer.TryDefinedOp(AsFortran(opr),
|
|
|
|
"Operands of %s must be numeric; have %s and %s"_err_en_US);
|
2018-09-01 07:14:14 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericBinaryHelper<Power>(*this, NumericOperator::Power, x);
|
2018-09-01 07:14:14 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Multiply &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericBinaryHelper<Multiply>(*this, NumericOperator::Multiply, x);
|
2018-09-01 07:14:14 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Divide &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericBinaryHelper<Divide>(*this, NumericOperator::Divide, x);
|
2018-09-01 07:14:14 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Add &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericBinaryHelper<Add>(*this, NumericOperator::Add, x);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return NumericBinaryHelper<Subtract>(*this, NumericOperator::Subtract, x);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(
|
2018-12-04 03:40:53 +08:00
|
|
|
const parser::Expr::ComplexConstructor &x) {
|
2019-03-08 06:46:31 +08:00
|
|
|
auto re{Analyze(std::get<0>(x.t).value())};
|
|
|
|
auto im{Analyze(std::get<1>(x.t).value())};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (re && im) {
|
2019-03-08 06:46:31 +08:00
|
|
|
ConformabilityCheck(GetContextualMessages(), *re, *im);
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
2019-03-08 06:46:31 +08:00
|
|
|
return AsMaybeExpr(ConstructComplex(GetContextualMessages(), std::move(re),
|
|
|
|
std::move(im), GetDefaultKind(TypeCategory::Real)));
|
2018-09-01 07:14:14 +08:00
|
|
|
}
|
2018-08-08 03:34:09 +08:00
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this};
|
|
|
|
analyzer.Analyze(std::get<0>(x.t));
|
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
|
|
|
} else if (analyzer.IsIntrinsicConcat()) {
|
2018-09-08 07:54:33 +08:00
|
|
|
return std::visit(
|
2019-11-03 00:56:46 +08:00
|
|
|
[&](auto &&x, auto &&y) -> MaybeExpr {
|
|
|
|
using T = ResultType<decltype(x)>;
|
|
|
|
if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) {
|
|
|
|
return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)});
|
|
|
|
} else {
|
|
|
|
DIE("different types for intrinsic concat");
|
|
|
|
}
|
2018-09-08 07:54:33 +08:00
|
|
|
},
|
2019-11-23 08:46:11 +08:00
|
|
|
std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(0).u).u),
|
|
|
|
std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(1).u).u));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
|
|
|
return analyzer.TryDefinedOp("//",
|
|
|
|
"Operands of %s must be CHARACTER with the same kind; have %s and %s"_err_en_US);
|
2018-09-08 07:54:33 +08:00
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
// The Name represents a user-defined intrinsic operator.
|
|
|
|
// If the actuals match one of the specific procedures, return a function ref.
|
|
|
|
// Otherwise report the error in messages.
|
2019-12-17 03:33:55 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::AnalyzeDefinedOp(
|
2019-11-03 00:56:46 +08:00
|
|
|
const parser::Name &name, ActualArguments &&actuals) {
|
|
|
|
if (auto callee{GetCalleeAndArguments(name, std::move(actuals))}) {
|
2019-12-21 05:03:30 +08:00
|
|
|
CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
|
|
|
|
return MakeFunctionRef(name.source,
|
|
|
|
std::move(std::get<ProcedureDesignator>(callee->u)),
|
2019-11-03 00:56:46 +08:00
|
|
|
std::move(callee->arguments));
|
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
|
|
|
|
const parser::Expr::IntrinsicBinary &x) {
|
|
|
|
ArgumentAnalyzer analyzer{context};
|
|
|
|
analyzer.Analyze(std::get<0>(x.t));
|
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
|
|
|
} else if (analyzer.IsIntrinsicRelational(opr)) {
|
2019-01-10 07:06:07 +08:00
|
|
|
return AsMaybeExpr(Relate(context.GetContextualMessages(), opr,
|
2019-11-23 08:46:11 +08:00
|
|
|
analyzer.MoveExpr(0), analyzer.MoveExpr(1)));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
|
|
|
return analyzer.TryDefinedOp(opr,
|
|
|
|
"Operands of %s must have comparable types; have %s and %s"_err_en_US);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LT &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::LT, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LE &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::LE, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::EQ &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::EQ, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NE &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::NE, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::GE &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::GE, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::GT &x) {
|
|
|
|
return RelationHelper(*this, RelationalOperator::GT, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
|
|
|
|
const parser::Expr::IntrinsicBinary &x) {
|
|
|
|
ArgumentAnalyzer analyzer{context};
|
|
|
|
analyzer.Analyze(std::get<0>(x.t));
|
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
|
|
|
if (analyzer.fatalErrors()) {
|
|
|
|
return std::nullopt;
|
|
|
|
} else if (analyzer.IsIntrinsicLogical()) {
|
|
|
|
return AsGenericExpr(BinaryLogicalOperation(opr,
|
2019-11-23 08:46:11 +08:00
|
|
|
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u),
|
|
|
|
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u)));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-11-07 07:54:26 +08:00
|
|
|
return analyzer.TryDefinedOp(
|
|
|
|
opr, "Operands of %s must be LOGICAL; have %s and %s"_err_en_US);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::AND &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return LogicalBinaryHelper(*this, LogicalOperator::And, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::OR &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return LogicalBinaryHelper(*this, LogicalOperator::Or, x);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::EQV &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return LogicalBinaryHelper(*this, LogicalOperator::Eqv, x);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NEQV &x) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return LogicalBinaryHelper(*this, LogicalOperator::Neqv, x);
|
2018-09-08 06:25:10 +08:00
|
|
|
}
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
|
|
|
|
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
|
2020-01-03 01:55:03 +08:00
|
|
|
ArgumentAnalyzer analyzer{*this, name.source};
|
2019-10-23 00:31:33 +08:00
|
|
|
analyzer.Analyze(std::get<1>(x.t));
|
|
|
|
analyzer.Analyze(std::get<2>(x.t));
|
2020-01-03 01:55:03 +08:00
|
|
|
return analyzer.TryDefinedOp(name.source.ToString().c_str(),
|
|
|
|
"No operator %s defined for %s and %s"_err_en_US, true);
|
2018-09-08 01:33:32 +08:00
|
|
|
}
|
2018-12-05 07:52:50 +08:00
|
|
|
|
2019-08-07 18:51:13 +08:00
|
|
|
static void CheckFuncRefToArrayElementRefHasSubscripts(
|
|
|
|
semantics::SemanticsContext &context,
|
|
|
|
const parser::FunctionReference &funcRef) {
|
2019-12-21 05:03:30 +08:00
|
|
|
// Emit message if the function reference fix will end up an array element
|
2019-08-07 18:51:13 +08:00
|
|
|
// reference with no subscripts because it will not be possible to later tell
|
|
|
|
// the difference in expressions between empty subscript list due to bad
|
|
|
|
// subscripts error recovery or because the user did not put any.
|
|
|
|
if (std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t).empty()) {
|
|
|
|
auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
|
|
|
|
const auto *name{std::get_if<parser::Name>(&proc.u)};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!name) {
|
2019-08-08 18:46:14 +08:00
|
|
|
name = &std::get<parser::ProcComponentRef>(proc.u).v.thing.component;
|
|
|
|
}
|
2019-08-07 18:51:13 +08:00
|
|
|
auto &msg{context.Say(funcRef.v.source,
|
|
|
|
"Reference to array '%s' with empty subscript list"_err_en_US,
|
|
|
|
name->source)};
|
|
|
|
if (name->symbol) {
|
|
|
|
if (semantics::IsFunctionResultWithSameNameAsFunction(*name->symbol)) {
|
|
|
|
msg.Attach(name->source,
|
|
|
|
"A result variable must be declared with RESULT to allow recursive "
|
|
|
|
"function calls"_en_US);
|
|
|
|
} else {
|
2019-11-23 05:20:58 +08:00
|
|
|
AttachDeclaration(&msg, *name->symbol);
|
2019-08-07 18:51:13 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-09 07:16:30 +08:00
|
|
|
// Converts, if appropriate, an original misparse of ambiguous syntax like
|
2019-12-21 05:03:30 +08:00
|
|
|
// A(1) as a function reference into an array reference.
|
|
|
|
// Misparse structure constructors are detected elsewhere after generic
|
|
|
|
// function call resolution fails.
|
2019-03-09 04:55:57 +08:00
|
|
|
template<typename... A>
|
2019-05-14 00:33:18 +08:00
|
|
|
static void FixMisparsedFunctionReference(
|
2019-04-03 01:34:45 +08:00
|
|
|
semantics::SemanticsContext &context, const std::variant<A...> &constU) {
|
2019-03-09 04:55:57 +08:00
|
|
|
// The parse tree is updated in situ when resolving an ambiguous parse.
|
|
|
|
using uType = std::decay_t<decltype(constU)>;
|
|
|
|
auto &u{const_cast<uType &>(constU)};
|
|
|
|
if (auto *func{
|
|
|
|
std::get_if<common::Indirection<parser::FunctionReference>>(&u)}) {
|
|
|
|
parser::FunctionReference &funcRef{func->value()};
|
|
|
|
auto &proc{std::get<parser::ProcedureDesignator>(funcRef.v.t)};
|
2019-05-30 04:22:35 +08:00
|
|
|
if (Symbol *
|
|
|
|
origSymbol{std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](parser::Name &name) { return name.symbol; },
|
|
|
|
[&](parser::ProcComponentRef &pcr) {
|
|
|
|
return pcr.v.thing.component.symbol;
|
|
|
|
},
|
|
|
|
},
|
|
|
|
proc.u)}) {
|
|
|
|
Symbol &symbol{origSymbol->GetUltimate()};
|
2019-08-20 21:15:52 +08:00
|
|
|
if (symbol.has<semantics::ObjectEntityDetails>() ||
|
|
|
|
symbol.has<semantics::AssocEntityDetails>()) {
|
2019-08-21 17:42:34 +08:00
|
|
|
// Note that expression in AssocEntityDetails cannot be a procedure
|
|
|
|
// pointer as per C1105 so this cannot be a function reference.
|
2019-03-09 07:16:30 +08:00
|
|
|
if constexpr (common::HasMember<common::Indirection<parser::Designator>,
|
|
|
|
uType>) {
|
2019-08-07 18:51:13 +08:00
|
|
|
CheckFuncRefToArrayElementRefHasSubscripts(context, funcRef);
|
2019-03-09 04:55:57 +08:00
|
|
|
u = common::Indirection{funcRef.ConvertToArrayElementRef()};
|
2019-03-09 07:16:30 +08:00
|
|
|
} else {
|
2019-09-13 04:43:16 +08:00
|
|
|
DIE("can't fix misparsed function as array reference");
|
2019-03-09 04:55:57 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-12 06:39:11 +08:00
|
|
|
// Common handling of parser::Expr and parser::Variable
|
2019-04-20 03:55:36 +08:00
|
|
|
template<typename PARSED>
|
|
|
|
MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
|
2019-12-18 04:32:16 +08:00
|
|
|
if (!x.typedExpr) {
|
2019-04-20 03:55:36 +08:00
|
|
|
FixMisparsedFunctionReference(context_, x.u);
|
2019-04-12 08:22:16 +08:00
|
|
|
MaybeExpr result;
|
[flang] Semantic checks for C709, C710, and C711
C709 An assumed-type entity shall be a dummy data object that does not
have the ALLOCATABLE, CODIMENSION, INTENT (OUT), POINTER, or VALUE
attribute and is not an explicit-shape array.
C710 An assumed-type variable name shall not appear in a designator or
expression except as an actual argument corresponding to a dummy
argument that is assumed-type, or as the first argument to the intrinsic
function IS_CONTIGUOUS, LBOUND, PRESENT, RANK, SHAPE, SIZE, or UBOUND,
or the function C_LOC from the intrinsic module ISO_C_BINDING.
C711 An assumed-type actual argument that corresponds to an assumed-rank
dummy argument shall be assumed-shape or assumed-rank.
For C709 I added code to check-declarations.cpp. For this, I had to
distinguish between polymorphic types and assumed-type types to
eliminate multiple messages on the same line.
C710 was already checked, but I added a notation in the source.
For C711 I added code to check-call.cpp and the test call15.f90.
Original-commit: flang-compiler/f18@4a703f2b5a6484208a059dc0b456363c138a661d
Reviewed-on: https://github.com/flang-compiler/f18/pull/985
2020-02-15 07:53:11 +08:00
|
|
|
if (AssumedTypeDummy(x)) { // C710
|
2020-01-11 06:09:39 +08:00
|
|
|
Say("TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
|
2019-03-09 04:55:57 +08:00
|
|
|
} else {
|
2020-01-11 06:09:39 +08:00
|
|
|
if constexpr (std::is_same_v<PARSED, parser::Expr>) {
|
|
|
|
// Analyze the expression in a specified source position context for
|
|
|
|
// better error reporting.
|
|
|
|
auto restorer{GetContextualMessages().SetLocation(x.source)};
|
|
|
|
result = evaluate::Fold(foldingContext_, Analyze(x.u));
|
|
|
|
} else {
|
|
|
|
result = Analyze(x.u);
|
|
|
|
}
|
2019-04-12 08:22:16 +08:00
|
|
|
}
|
2019-04-20 08:14:50 +08:00
|
|
|
x.typedExpr.reset(new GenericExprWrapper{std::move(result)});
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!x.typedExpr->v) {
|
2019-04-13 07:50:58 +08:00
|
|
|
if (!context_.AnyFatalError()) {
|
2019-12-12 07:06:24 +08:00
|
|
|
std::stringstream dump;
|
|
|
|
parser::DumpTree(dump, x);
|
|
|
|
Say("Internal error: Expression analysis failed on: %s"_err_en_US,
|
|
|
|
dump.str());
|
2019-04-13 07:50:58 +08:00
|
|
|
}
|
2019-04-13 02:43:03 +08:00
|
|
|
fatalErrors_ = true;
|
2019-03-09 04:55:57 +08:00
|
|
|
}
|
2018-12-05 07:52:50 +08:00
|
|
|
}
|
2019-04-20 08:14:50 +08:00
|
|
|
return x.typedExpr->v;
|
2018-12-05 07:52:50 +08:00
|
|
|
}
|
2019-02-15 04:51:20 +08:00
|
|
|
|
2019-04-20 03:55:36 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &expr) {
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{GetContextualMessages().SetLocation(expr.source)};
|
2019-04-20 03:55:36 +08:00
|
|
|
return ExprOrVariable(expr);
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Variable &variable) {
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{GetContextualMessages().SetLocation(variable.GetSource())};
|
2019-04-20 03:55:36 +08:00
|
|
|
return ExprOrVariable(variable);
|
2019-01-17 09:18:10 +08:00
|
|
|
}
|
2019-01-10 07:06:07 +08:00
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
|
|
|
|
TypeCategory category,
|
2019-01-10 07:06:07 +08:00
|
|
|
const std::optional<parser::KindSelector> &selector) {
|
|
|
|
int defaultKind{GetDefaultKind(category)};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!selector) {
|
2018-12-05 02:55:32 +08:00
|
|
|
return Expr<SubscriptInteger>{defaultKind};
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
|
|
|
return std::visit(
|
|
|
|
common::visitors{
|
2020-01-04 02:38:51 +08:00
|
|
|
[&](const parser::ScalarIntConstantExpr &x) {
|
2019-03-08 06:46:31 +08:00
|
|
|
if (MaybeExpr kind{Analyze(x)}) {
|
2020-01-04 02:38:51 +08:00
|
|
|
Expr<SomeType> folded{Fold(std::move(*kind))};
|
2018-12-05 02:55:32 +08:00
|
|
|
if (std::optional<std::int64_t> code{ToInt64(folded)}) {
|
2019-02-09 08:03:23 +08:00
|
|
|
if (CheckIntrinsicKind(category, *code)) {
|
2018-12-05 02:55:32 +08:00
|
|
|
return Expr<SubscriptInteger>{*code};
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
2018-12-05 02:55:32 +08:00
|
|
|
} else if (auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(folded)}) {
|
|
|
|
return ConvertToType<SubscriptInteger>(std::move(*intExpr));
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
|
|
|
}
|
2018-12-05 02:55:32 +08:00
|
|
|
return Expr<SubscriptInteger>{defaultKind};
|
2019-01-10 07:06:07 +08:00
|
|
|
},
|
2020-01-04 02:38:51 +08:00
|
|
|
[&](const parser::KindSelector::StarSize &x) {
|
2019-01-10 07:06:07 +08:00
|
|
|
std::intmax_t size = x.v;
|
2019-02-09 08:03:23 +08:00
|
|
|
if (!CheckIntrinsicSize(category, size)) {
|
2018-12-05 02:55:32 +08:00
|
|
|
size = defaultKind;
|
2019-02-09 08:03:23 +08:00
|
|
|
} else if (category == TypeCategory::Complex) {
|
|
|
|
size /= 2;
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
2018-12-05 02:55:32 +08:00
|
|
|
return Expr<SubscriptInteger>{size};
|
2019-01-10 07:06:07 +08:00
|
|
|
},
|
|
|
|
},
|
|
|
|
selector->u);
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
int ExpressionAnalyzer::GetDefaultKind(common::TypeCategory category) {
|
2019-06-12 09:26:48 +08:00
|
|
|
return context_.GetDefaultKind(category);
|
2019-01-10 07:06:07 +08:00
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
DynamicType ExpressionAnalyzer::GetDefaultKindOfType(
|
2019-01-10 07:06:07 +08:00
|
|
|
common::TypeCategory category) {
|
|
|
|
return {category, GetDefaultKind(category)};
|
|
|
|
}
|
2019-01-23 08:30:32 +08:00
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
bool ExpressionAnalyzer::CheckIntrinsicKind(
|
2019-02-09 08:03:23 +08:00
|
|
|
TypeCategory category, std::int64_t kind) {
|
2020-02-27 12:19:48 +08:00
|
|
|
if (IsValidKindOfIntrinsicType(category, kind)) { // C712, C714, C715
|
2019-02-09 08:03:23 +08:00
|
|
|
return true;
|
|
|
|
} else {
|
|
|
|
Say("%s(KIND=%jd) is not a supported type"_err_en_US,
|
2019-11-03 00:56:46 +08:00
|
|
|
ToUpperCase(EnumToString(category)), kind);
|
2019-02-09 08:03:23 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
bool ExpressionAnalyzer::CheckIntrinsicSize(
|
2019-02-09 08:03:23 +08:00
|
|
|
TypeCategory category, std::int64_t size) {
|
|
|
|
if (category == TypeCategory::Complex) {
|
|
|
|
// COMPLEX*16 == COMPLEX(KIND=8)
|
|
|
|
if (size % 2 == 0 && IsValidKindOfIntrinsicType(category, size / 2)) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
} else if (IsValidKindOfIntrinsicType(category, size)) {
|
|
|
|
return true;
|
|
|
|
}
|
|
|
|
Say("%s*%jd is not a supported type"_err_en_US,
|
2019-11-03 00:56:46 +08:00
|
|
|
ToUpperCase(EnumToString(category)), size);
|
2019-02-09 08:03:23 +08:00
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
bool ExpressionAnalyzer::AddAcImpliedDo(parser::CharBlock name, int kind) {
|
2019-01-23 08:30:32 +08:00
|
|
|
return acImpliedDos_.insert(std::make_pair(name, kind)).second;
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
void ExpressionAnalyzer::RemoveAcImpliedDo(parser::CharBlock name) {
|
2019-01-23 08:30:32 +08:00
|
|
|
auto iter{acImpliedDos_.find(name)};
|
|
|
|
if (iter != acImpliedDos_.end()) {
|
|
|
|
acImpliedDos_.erase(iter);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-03-08 06:46:31 +08:00
|
|
|
std::optional<int> ExpressionAnalyzer::IsAcImpliedDo(
|
2019-01-23 08:30:32 +08:00
|
|
|
parser::CharBlock name) const {
|
|
|
|
auto iter{acImpliedDos_.find(name)};
|
|
|
|
if (iter != acImpliedDos_.cend()) {
|
|
|
|
return {iter->second};
|
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
}
|
2019-04-12 08:22:16 +08:00
|
|
|
|
2019-04-26 04:18:33 +08:00
|
|
|
bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
|
2019-04-12 08:22:16 +08:00
|
|
|
const MaybeExpr &result, TypeCategory category, bool defaultKind) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (result) {
|
2019-04-12 08:22:16 +08:00
|
|
|
if (auto type{result->GetType()}) {
|
2020-02-27 12:19:48 +08:00
|
|
|
if (type->category() != category) { // C885
|
2019-04-12 08:22:16 +08:00
|
|
|
Say(at, "Must have %s type, but is %s"_err_en_US,
|
2019-11-03 00:56:46 +08:00
|
|
|
ToUpperCase(EnumToString(category)),
|
|
|
|
ToUpperCase(type->AsFortran()));
|
2019-04-26 04:18:33 +08:00
|
|
|
return false;
|
2019-04-12 08:22:16 +08:00
|
|
|
} else if (defaultKind) {
|
2019-06-12 09:26:48 +08:00
|
|
|
int kind{context_.GetDefaultKind(category)};
|
2019-05-14 00:33:18 +08:00
|
|
|
if (type->kind() != kind) {
|
2019-04-12 08:22:16 +08:00
|
|
|
Say(at, "Must have default kind(%d) of %s type, but is %s"_err_en_US,
|
2019-11-03 00:56:46 +08:00
|
|
|
kind, ToUpperCase(EnumToString(category)),
|
|
|
|
ToUpperCase(type->AsFortran()));
|
2019-04-26 04:18:33 +08:00
|
|
|
return false;
|
2019-04-12 08:22:16 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
Say(at, "Must have %s type, but is typeless"_err_en_US,
|
2019-11-03 00:56:46 +08:00
|
|
|
ToUpperCase(EnumToString(category)));
|
2019-04-26 04:18:33 +08:00
|
|
|
return false;
|
2019-04-12 08:22:16 +08:00
|
|
|
}
|
|
|
|
}
|
2019-04-26 04:18:33 +08:00
|
|
|
return true;
|
2019-04-12 08:22:16 +08:00
|
|
|
}
|
2019-04-26 04:18:33 +08:00
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(parser::CharBlock callSite,
|
2019-03-12 06:39:11 +08:00
|
|
|
ProcedureDesignator &&proc, ActualArguments &&arguments) {
|
|
|
|
if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&proc.u)}) {
|
|
|
|
if (intrinsic->name == "null" && arguments.empty()) {
|
|
|
|
return Expr<SomeType>{NullPointer{}};
|
|
|
|
}
|
|
|
|
}
|
2019-09-17 07:58:13 +08:00
|
|
|
if (auto chars{CheckCall(callSite, proc, arguments)}) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (chars->functionResult) {
|
2019-03-12 06:39:11 +08:00
|
|
|
const auto &result{*chars->functionResult};
|
|
|
|
if (result.IsProcedurePointer()) {
|
|
|
|
return Expr<SomeType>{
|
|
|
|
ProcedureRef{std::move(proc), std::move(arguments)}};
|
|
|
|
} else {
|
|
|
|
// Not a procedure pointer, so type and shape are known.
|
2019-07-30 00:12:52 +08:00
|
|
|
return TypedWrapper<FunctionRef, ProcedureRef>(
|
|
|
|
DEREF(result.GetTypeAndShape()).type(),
|
2019-03-12 06:39:11 +08:00
|
|
|
ProcedureRef{std::move(proc), std::move(arguments)});
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-09-25 05:17:50 +08:00
|
|
|
if (const Symbol * symbol{proc.GetSymbol()}) {
|
|
|
|
if (const auto *details{
|
|
|
|
symbol->detailsIf<semantics::SubprogramNameDetails>()}) {
|
|
|
|
// If this symbol is still a SubprogramNameDetails, we must be
|
|
|
|
// checking a specification expression in a sibling module or internal
|
|
|
|
// procedure. Since recursion is disallowed in specification
|
|
|
|
// expressions, we should handle such references by processing the
|
|
|
|
// sibling procedure's specification part right now (recursively),
|
|
|
|
// but until we can do so, just complain about the forward reference.
|
|
|
|
// TODO: recursively process sibling's specification part.
|
2019-09-21 05:28:15 +08:00
|
|
|
if (details->kind() == semantics::SubprogramKind::Module) {
|
|
|
|
Say("The module function '%s' must have been previously defined "
|
|
|
|
"when referenced in a specification expression"_err_en_US,
|
|
|
|
symbol->name());
|
|
|
|
} else {
|
|
|
|
Say("The internal function '%s' cannot be referenced in "
|
|
|
|
"a specification expression"_err_en_US,
|
|
|
|
symbol->name());
|
|
|
|
}
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
}
|
2019-03-12 06:39:11 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
|
|
|
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
|
|
|
|
parser::CharBlock intrinsic, ActualArguments &&arguments) {
|
|
|
|
if (std::optional<SpecificCall> specificCall{
|
2019-12-12 07:06:24 +08:00
|
|
|
context_.intrinsics().Probe(CallCharacteristics{intrinsic.ToString()},
|
|
|
|
arguments, context_.foldingContext())}) {
|
2019-09-17 07:58:13 +08:00
|
|
|
return MakeFunctionRef(intrinsic,
|
2019-03-12 06:39:11 +08:00
|
|
|
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
|
|
|
|
std::move(specificCall->arguments));
|
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
}
|
2019-10-23 00:31:33 +08:00
|
|
|
|
2019-11-23 08:46:11 +08:00
|
|
|
void ArgumentAnalyzer::Analyze(const parser::Variable &x) {
|
|
|
|
source_.ExtendToCover(x.GetSource());
|
|
|
|
if (MaybeExpr expr{context_.Analyze(x)}) {
|
|
|
|
actuals_.emplace_back(std::move(*expr));
|
|
|
|
} else {
|
|
|
|
fatalErrors_ = true;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
void ArgumentAnalyzer::Analyze(
|
|
|
|
const parser::ActualArgSpec &arg, bool isSubroutine) {
|
|
|
|
// TODO: C1002: Allow a whole assumed-size array to appear if the dummy
|
|
|
|
// argument would accept it. Handle by special-casing the context
|
|
|
|
// ActualArg -> Variable -> Designator.
|
|
|
|
// TODO: Actual arguments that are procedures and procedure pointers need to
|
|
|
|
// be detected and represented (they're not expressions).
|
|
|
|
// TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
|
|
|
|
std::optional<ActualArgument> actual;
|
|
|
|
std::visit(
|
|
|
|
common::visitors{
|
|
|
|
[&](const common::Indirection<parser::Expr> &x) {
|
|
|
|
// TODO: Distinguish & handle procedure name and
|
|
|
|
// proc-component-ref
|
2019-11-03 00:56:46 +08:00
|
|
|
actual = AnalyzeExpr(x.value());
|
2019-10-23 00:31:33 +08:00
|
|
|
},
|
|
|
|
[&](const parser::AltReturnSpec &) {
|
|
|
|
if (!isSubroutine) {
|
|
|
|
context_.Say("alternate return specification may not appear on"
|
|
|
|
" function reference"_err_en_US);
|
|
|
|
}
|
|
|
|
},
|
|
|
|
[&](const parser::ActualArg::PercentRef &) {
|
|
|
|
context_.Say("TODO: %REF() argument"_err_en_US);
|
|
|
|
},
|
|
|
|
[&](const parser::ActualArg::PercentVal &) {
|
|
|
|
context_.Say("TODO: %VAL() argument"_err_en_US);
|
|
|
|
},
|
|
|
|
},
|
|
|
|
std::get<parser::ActualArg>(arg.t).u);
|
2019-11-10 01:29:31 +08:00
|
|
|
if (actual) {
|
2019-10-23 00:31:33 +08:00
|
|
|
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
|
2019-12-06 02:24:18 +08:00
|
|
|
actual->set_keyword(argKW->v.source);
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
actuals_.emplace_back(std::move(*actual));
|
|
|
|
} else {
|
2019-11-03 00:56:46 +08:00
|
|
|
fatalErrors_ = true;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
|
2019-12-03 00:55:44 +08:00
|
|
|
CHECK(actuals_.size() == 2);
|
|
|
|
return semantics::IsIntrinsicRelational(
|
|
|
|
opr, *GetType(0), GetRank(0), *GetType(1), GetRank(1));
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
2019-11-07 07:54:26 +08:00
|
|
|
bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
|
|
|
|
std::optional<DynamicType> type0{GetType(0)};
|
|
|
|
if (actuals_.size() == 1) {
|
|
|
|
if (IsBOZLiteral(0)) {
|
|
|
|
return opr == NumericOperator::Add;
|
|
|
|
} else {
|
2019-12-03 00:55:44 +08:00
|
|
|
return type0 && semantics::IsIntrinsicNumeric(*type0);
|
2019-11-07 07:54:26 +08:00
|
|
|
}
|
|
|
|
} else {
|
|
|
|
std::optional<DynamicType> type1{GetType(1)};
|
|
|
|
if (IsBOZLiteral(0) && type1) {
|
|
|
|
auto cat1{type1->category()};
|
|
|
|
return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
|
|
|
|
} else if (IsBOZLiteral(1) && type0) { // Integer/Real opr BOZ
|
|
|
|
auto cat0{type0->category()};
|
|
|
|
return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
|
|
|
|
} else {
|
2019-12-03 00:55:44 +08:00
|
|
|
return type0 && type1 &&
|
|
|
|
semantics::IsIntrinsicNumeric(*type0, GetRank(0), *type1, GetRank(1));
|
2019-11-07 07:54:26 +08:00
|
|
|
}
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
bool ArgumentAnalyzer::IsIntrinsicLogical() const {
|
2019-12-03 00:55:44 +08:00
|
|
|
if (actuals_.size() == 1) {
|
|
|
|
return semantics::IsIntrinsicLogical(*GetType(0));
|
|
|
|
return GetType(0)->category() == TypeCategory::Logical;
|
|
|
|
} else {
|
|
|
|
return semantics::IsIntrinsicLogical(
|
|
|
|
*GetType(0), GetRank(0), *GetType(1), GetRank(1));
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
bool ArgumentAnalyzer::IsIntrinsicConcat() const {
|
2019-12-03 00:55:44 +08:00
|
|
|
return semantics::IsIntrinsicConcat(
|
|
|
|
*GetType(0), GetRank(0), *GetType(1), GetRank(1));
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
|
2020-01-03 01:55:03 +08:00
|
|
|
const char *opr, parser::MessageFixedText &&error, bool isUserOp) {
|
2019-12-17 03:33:55 +08:00
|
|
|
if (AnyUntypedOperand()) {
|
|
|
|
context_.Say(
|
|
|
|
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
|
2019-11-03 00:56:46 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
{
|
|
|
|
auto restorer{context_.GetContextualMessages().DiscardMessages()};
|
2020-01-03 01:55:03 +08:00
|
|
|
std::string oprNameString{
|
|
|
|
isUserOp ? std::string{opr} : "operator("s + opr + ')'};
|
2019-12-17 03:33:55 +08:00
|
|
|
parser::CharBlock oprName{oprNameString};
|
|
|
|
const auto &scope{context_.context().FindScope(source_)};
|
|
|
|
if (Symbol * symbol{scope.FindSymbol(oprName)}) {
|
2020-01-03 01:55:03 +08:00
|
|
|
parser::Name name{symbol->name(), symbol};
|
2019-12-17 03:33:55 +08:00
|
|
|
if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
|
|
|
|
return result;
|
|
|
|
}
|
|
|
|
sawDefinedOp_ = symbol;
|
|
|
|
}
|
|
|
|
for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
|
|
|
|
if (const Symbol * symbol{FindBoundOp(oprName, passIndex)}) {
|
|
|
|
if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
|
|
|
|
return result;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (sawDefinedOp_) {
|
|
|
|
SayNoMatch(ToUpperCase(sawDefinedOp_->name().ToString()));
|
|
|
|
} else if (actuals_.size() == 1 || AreConformable()) {
|
|
|
|
context_.Say(
|
|
|
|
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-12-17 03:33:55 +08:00
|
|
|
context_.Say(
|
|
|
|
"Operands of %s are not conformable; have rank %d and rank %d"_err_en_US,
|
|
|
|
ToUpperCase(opr), actuals_[0]->Rank(), actuals_[1]->Rank());
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
return std::nullopt;
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
|
2019-11-07 07:54:26 +08:00
|
|
|
std::vector<const char *> oprs, parser::MessageFixedText &&error) {
|
|
|
|
for (std::size_t i{1}; i < oprs.size(); ++i) {
|
2019-12-17 03:33:55 +08:00
|
|
|
auto restorer{context_.GetContextualMessages().DiscardMessages()};
|
|
|
|
if (auto result{TryDefinedOp(oprs[i], std::move(error))}) {
|
|
|
|
return result;
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
2019-11-07 07:54:26 +08:00
|
|
|
return TryDefinedOp(oprs[0], std::move(error));
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
|
2019-12-17 03:33:55 +08:00
|
|
|
MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) {
|
|
|
|
ActualArguments localActuals{actuals_};
|
2020-01-03 01:55:03 +08:00
|
|
|
const Symbol *proc{GetBindingResolution(GetType(passIndex), symbol)};
|
2019-12-17 03:33:55 +08:00
|
|
|
if (!proc) {
|
|
|
|
proc = &symbol;
|
2020-01-03 01:55:03 +08:00
|
|
|
localActuals.at(passIndex).value().set_isPassedObject();
|
2019-12-17 03:33:55 +08:00
|
|
|
}
|
|
|
|
return context_.MakeFunctionRef(
|
|
|
|
source_, ProcedureDesignator{*proc}, std::move(localActuals));
|
|
|
|
}
|
|
|
|
|
2019-11-23 08:46:11 +08:00
|
|
|
std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
|
|
|
|
using semantics::Tristate;
|
|
|
|
const Expr<SomeType> &lhs{GetExpr(0)};
|
|
|
|
const Expr<SomeType> &rhs{GetExpr(1)};
|
2019-12-06 08:18:39 +08:00
|
|
|
std::optional<DynamicType> lhsType{lhs.GetType()};
|
|
|
|
std::optional<DynamicType> rhsType{rhs.GetType()};
|
|
|
|
int lhsRank{lhs.Rank()};
|
|
|
|
int rhsRank{rhs.Rank()};
|
|
|
|
Tristate isDefined{
|
|
|
|
semantics::IsDefinedAssignment(lhsType, lhsRank, rhsType, rhsRank)};
|
2019-11-23 08:46:11 +08:00
|
|
|
if (isDefined == Tristate::No) {
|
|
|
|
return std::nullopt; // user-defined assignment not allowed for these args
|
|
|
|
}
|
|
|
|
auto restorer{context_.GetContextualMessages().SetLocation(source_)};
|
2019-12-17 03:33:55 +08:00
|
|
|
if (std::optional<ProcedureRef> procRef{GetDefinedAssignmentProc()}) {
|
|
|
|
context_.CheckCall(source_, procRef->proc(), procRef->arguments());
|
|
|
|
return std::move(*procRef);
|
|
|
|
}
|
|
|
|
if (isDefined == Tristate::Yes) {
|
|
|
|
if (!lhsType || !rhsType || (lhsRank != rhsRank && rhsRank != 0) ||
|
|
|
|
!OkLogicalIntegerAssignment(lhsType->category(), rhsType->category())) {
|
|
|
|
SayNoMatch("ASSIGNMENT(=)", true);
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
return std::nullopt;
|
|
|
|
}
|
|
|
|
|
|
|
|
bool ArgumentAnalyzer::OkLogicalIntegerAssignment(
|
|
|
|
TypeCategory lhs, TypeCategory rhs) {
|
|
|
|
if (!context_.context().languageFeatures().IsEnabled(
|
|
|
|
common::LanguageFeature::LogicalIntegerAssignment)) {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
std::optional<parser::MessageFixedText> msg;
|
|
|
|
if (lhs == TypeCategory::Integer && rhs == TypeCategory::Logical) {
|
|
|
|
// allow assignment to LOGICAL from INTEGER as a legacy extension
|
|
|
|
msg = "nonstandard usage: assignment of LOGICAL to INTEGER"_en_US;
|
|
|
|
} else if (lhs == TypeCategory::Logical && rhs == TypeCategory::Integer) {
|
|
|
|
// ... and assignment to LOGICAL from INTEGER
|
|
|
|
msg = "nonstandard usage: assignment of INTEGER to LOGICAL"_en_US;
|
|
|
|
} else {
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
if (context_.context().languageFeatures().ShouldWarn(
|
|
|
|
common::LanguageFeature::LogicalIntegerAssignment)) {
|
|
|
|
context_.Say(std::move(*msg));
|
|
|
|
}
|
|
|
|
return true;
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
|
2019-12-17 03:33:55 +08:00
|
|
|
auto restorer{context_.GetContextualMessages().DiscardMessages()};
|
|
|
|
std::string oprNameString{"assignment(=)"};
|
|
|
|
parser::CharBlock oprName{oprNameString};
|
|
|
|
const Symbol *proc{nullptr};
|
2019-11-23 08:46:11 +08:00
|
|
|
const auto &scope{context_.context().FindScope(source_)};
|
2019-12-17 03:33:55 +08:00
|
|
|
if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
|
2019-12-24 09:12:53 +08:00
|
|
|
ExpressionAnalyzer::AdjustActuals noAdjustment;
|
|
|
|
if (const Symbol *
|
|
|
|
specific{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)}) {
|
2019-12-17 03:33:55 +08:00
|
|
|
proc = specific;
|
2019-12-24 09:12:53 +08:00
|
|
|
} else {
|
|
|
|
context_.EmitGenericResolutionError(*symbol);
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
|
|
|
}
|
2019-12-17 03:33:55 +08:00
|
|
|
for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
|
|
|
|
if (const Symbol * specific{FindBoundOp(oprName, passIndex)}) {
|
|
|
|
proc = specific;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
if (proc) {
|
2020-02-19 07:20:28 +08:00
|
|
|
ActualArguments actualsCopy{actuals_};
|
|
|
|
actualsCopy[1]->Parenthesize();
|
|
|
|
return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
|
2019-12-17 03:33:55 +08:00
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
|
|
|
|
2020-01-11 06:09:39 +08:00
|
|
|
void ArgumentAnalyzer::Dump(std::ostream &os) {
|
|
|
|
os << "source_: " << source_.ToString() << " fatalErrors_ = " << fatalErrors_
|
|
|
|
<< '\n';
|
|
|
|
for (const auto &actual : actuals_) {
|
|
|
|
if (!actual.has_value()) {
|
|
|
|
os << "- error\n";
|
|
|
|
} else if (const Symbol * symbol{actual->GetAssumedTypeDummy()}) {
|
|
|
|
os << "- assumed type: " << symbol->name().ToString() << '\n';
|
|
|
|
} else if (const Expr<SomeType> *expr{actual->UnwrapExpr()}) {
|
|
|
|
expr->AsFortran(os << "- expr: ") << '\n';
|
|
|
|
} else {
|
|
|
|
DIE("bad ActualArgument");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
|
2019-10-23 00:31:33 +08:00
|
|
|
const parser::Expr &expr) {
|
2019-11-03 00:56:46 +08:00
|
|
|
source_.ExtendToCover(expr.source);
|
2019-10-23 00:31:33 +08:00
|
|
|
if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
|
2020-01-11 06:09:39 +08:00
|
|
|
expr.typedExpr.reset(new GenericExprWrapper{});
|
|
|
|
if (allowAssumedType_) {
|
|
|
|
return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
|
|
|
|
} else {
|
|
|
|
context_.SayAt(expr.source,
|
|
|
|
"TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2019-10-23 00:31:33 +08:00
|
|
|
} else if (MaybeExpr argExpr{context_.Analyze(expr)}) {
|
2020-01-04 02:38:51 +08:00
|
|
|
return ActualArgument{context_.Fold(std::move(*argExpr))};
|
2019-10-23 00:31:33 +08:00
|
|
|
} else {
|
|
|
|
return std::nullopt;
|
|
|
|
}
|
2018-10-25 20:55:23 +08:00
|
|
|
}
|
2018-08-08 03:34:09 +08:00
|
|
|
|
2019-11-03 00:56:46 +08:00
|
|
|
bool ArgumentAnalyzer::AreConformable() const {
|
|
|
|
CHECK(!fatalErrors_ && actuals_.size() == 2);
|
|
|
|
return evaluate::AreConformable(*actuals_[0], *actuals_[1]);
|
|
|
|
}
|
|
|
|
|
2019-12-17 03:33:55 +08:00
|
|
|
// Look for a type-bound operator in the type of arg number passIndex.
|
|
|
|
const Symbol *ArgumentAnalyzer::FindBoundOp(
|
|
|
|
parser::CharBlock oprName, int passIndex) {
|
|
|
|
const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
|
|
|
|
if (!type || !type->scope()) {
|
|
|
|
return nullptr;
|
|
|
|
}
|
2020-01-03 01:55:03 +08:00
|
|
|
const Symbol *symbol{type->scope()->FindComponent(oprName)};
|
2019-12-17 03:33:55 +08:00
|
|
|
if (!symbol) {
|
|
|
|
return nullptr;
|
|
|
|
}
|
|
|
|
sawDefinedOp_ = symbol;
|
2019-12-24 09:12:53 +08:00
|
|
|
ExpressionAnalyzer::AdjustActuals adjustment{
|
|
|
|
[&](const Symbol &proc, ActualArguments &) {
|
2019-12-17 03:33:55 +08:00
|
|
|
return passIndex == GetPassIndex(proc);
|
2019-12-24 09:12:53 +08:00
|
|
|
}};
|
|
|
|
const Symbol *result{context_.ResolveGeneric(*symbol, actuals_, adjustment)};
|
|
|
|
if (!result) {
|
|
|
|
context_.EmitGenericResolutionError(*symbol);
|
|
|
|
}
|
|
|
|
return result;
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
std::optional<DynamicType> ArgumentAnalyzer::GetType(std::size_t i) const {
|
|
|
|
return i < actuals_.size() ? actuals_[i].value().GetType() : std::nullopt;
|
|
|
|
}
|
2019-12-03 00:55:44 +08:00
|
|
|
int ArgumentAnalyzer::GetRank(std::size_t i) const {
|
|
|
|
return i < actuals_.size() ? actuals_[i].value().Rank() : 0;
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
|
|
|
|
// Report error resolving opr when there is a user-defined one available
|
2019-11-23 08:46:11 +08:00
|
|
|
void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {
|
|
|
|
std::string type0{TypeAsFortran(0)};
|
2019-11-03 00:56:46 +08:00
|
|
|
auto rank0{actuals_[0]->Rank()};
|
|
|
|
if (actuals_.size() == 1) {
|
|
|
|
if (rank0 > 0) {
|
2019-11-23 08:46:11 +08:00
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
2019-11-03 00:56:46 +08:00
|
|
|
"rank %d array of %s"_err_en_US,
|
2019-11-23 08:46:11 +08:00
|
|
|
opr, rank0, type0);
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-11-23 08:46:11 +08:00
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
2019-11-03 00:56:46 +08:00
|
|
|
"operand type %s"_err_en_US,
|
2019-11-23 08:46:11 +08:00
|
|
|
opr, type0);
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
} else {
|
2019-11-23 08:46:11 +08:00
|
|
|
std::string type1{TypeAsFortran(1)};
|
2019-11-03 00:56:46 +08:00
|
|
|
auto rank1{actuals_[1]->Rank()};
|
|
|
|
if (rank0 > 0 && rank1 > 0 && rank0 != rank1) {
|
2019-11-23 08:46:11 +08:00
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
2019-11-03 00:56:46 +08:00
|
|
|
"rank %d array of %s and rank %d array of %s"_err_en_US,
|
2019-11-23 08:46:11 +08:00
|
|
|
opr, rank0, type0, rank1, type1);
|
|
|
|
} else if (isAssignment && rank0 != rank1) {
|
|
|
|
if (rank0 == 0) {
|
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
|
|
|
"scalar %s and rank %d array of %s"_err_en_US,
|
|
|
|
opr, type0, rank1, type1);
|
|
|
|
} else {
|
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
|
|
|
"rank %d array of %s and scalar %s"_err_en_US,
|
|
|
|
opr, rank0, type0, type1);
|
|
|
|
}
|
2019-11-03 00:56:46 +08:00
|
|
|
} else {
|
2019-11-23 08:46:11 +08:00
|
|
|
context_.Say("No intrinsic or user-defined %s matches "
|
2019-11-03 00:56:46 +08:00
|
|
|
"operand types %s and %s"_err_en_US,
|
2019-11-23 08:46:11 +08:00
|
|
|
opr, type0, type1);
|
2019-11-03 00:56:46 +08:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) {
|
|
|
|
if (std::optional<DynamicType> type{GetType(i)}) {
|
|
|
|
return type->category() == TypeCategory::Derived
|
|
|
|
? "TYPE("s + type->AsFortran() + ')'
|
|
|
|
: type->category() == TypeCategory::Character
|
|
|
|
? "CHARACTER(KIND="s + std::to_string(type->kind()) + ')'
|
|
|
|
: ToUpperCase(type->AsFortran());
|
|
|
|
} else {
|
|
|
|
return "untyped";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
bool ArgumentAnalyzer::AnyUntypedOperand() {
|
|
|
|
for (const auto &actual : actuals_) {
|
2019-11-10 01:29:31 +08:00
|
|
|
if (!actual.value().GetType()) {
|
2019-11-03 00:56:46 +08:00
|
|
|
return true;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return false;
|
|
|
|
}
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
} // namespace Fortran::evaluate
|
|
|
|
|
2018-09-01 04:28:21 +08:00
|
|
|
namespace Fortran::semantics {
|
2019-03-06 08:52:50 +08:00
|
|
|
evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
|
|
|
|
SemanticsContext &context, common::TypeCategory category,
|
|
|
|
const std::optional<parser::KindSelector> &selector) {
|
2019-03-08 06:46:31 +08:00
|
|
|
evaluate::ExpressionAnalyzer analyzer{context};
|
2019-12-12 07:06:24 +08:00
|
|
|
auto restorer{
|
2019-08-21 20:33:03 +08:00
|
|
|
analyzer.GetContextualMessages().SetLocation(context.location().value())};
|
2019-03-08 06:46:31 +08:00
|
|
|
return analyzer.AnalyzeKindSelector(category, selector);
|
2019-03-06 08:52:50 +08:00
|
|
|
}
|
2019-04-13 02:43:03 +08:00
|
|
|
|
2019-09-14 03:32:43 +08:00
|
|
|
void AnalyzeCallStmt(SemanticsContext &context, const parser::CallStmt &call) {
|
|
|
|
evaluate::ExpressionAnalyzer{context}.Analyze(call);
|
|
|
|
}
|
|
|
|
|
2019-12-18 07:59:25 +08:00
|
|
|
const evaluate::Assignment *AnalyzeAssignmentStmt(
|
2019-11-23 08:46:11 +08:00
|
|
|
SemanticsContext &context, const parser::AssignmentStmt &stmt) {
|
2019-12-18 07:59:25 +08:00
|
|
|
return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
|
2019-11-23 08:46:11 +08:00
|
|
|
}
|
2020-01-04 02:38:51 +08:00
|
|
|
const evaluate::Assignment *AnalyzePointerAssignmentStmt(
|
|
|
|
SemanticsContext &context, const parser::PointerAssignmentStmt &stmt) {
|
|
|
|
return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
|
|
|
|
}
|
2019-11-23 08:46:11 +08:00
|
|
|
|
2019-09-05 03:45:08 +08:00
|
|
|
ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
|
|
|
|
|
2019-04-12 08:22:16 +08:00
|
|
|
bool ExprChecker::Walk(const parser::Program &program) {
|
|
|
|
parser::Walk(program, *this);
|
|
|
|
return !context_.AnyFatalError();
|
2019-03-09 04:55:57 +08:00
|
|
|
}
|
2018-10-25 20:55:23 +08:00
|
|
|
}
|