blob: 8ad0f5ab27d8bfd8149c1375ab86a1b97f53a313 [file] [log] [blame]
//===-- lib/Semantics/resolve-names.cpp -----------------------------------===//
// 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
//
//===----------------------------------------------------------------------===//
#include "resolve-names.h"
#include "assignment.h"
#include "mod-file.h"
#include "pointer-assignment.h"
#include "program-tree.h"
#include "resolve-directives.h"
#include "resolve-names-utils.h"
#include "rewrite-parse-tree.h"
#include "flang/Common/Fortran.h"
#include "flang/Common/default-kinds.h"
#include "flang/Common/indirection.h"
#include "flang/Common/restorer.h"
#include "flang/Evaluate/characteristics.h"
#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/common.h"
#include "flang/Evaluate/fold-designator.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/intrinsics.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
#include "flang/Semantics/attr.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/scope.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include "flang/Semantics/type.h"
#include "llvm/Support/raw_ostream.h"
#include <list>
#include <map>
#include <set>
#include <stack>
namespace Fortran::semantics {
using namespace parser::literals;
template <typename T> using Indirection = common::Indirection<T>;
using Message = parser::Message;
using Messages = parser::Messages;
using MessageFixedText = parser::MessageFixedText;
using MessageFormattedText = parser::MessageFormattedText;
class ResolveNamesVisitor;
// ImplicitRules maps initial character of identifier to the DeclTypeSpec
// representing the implicit type; std::nullopt if none.
// It also records the presence of IMPLICIT NONE statements.
// When inheritFromParent is set, defaults come from the parent rules.
class ImplicitRules {
public:
ImplicitRules(SemanticsContext &context, ImplicitRules *parent)
: parent_{parent}, context_{context} {
inheritFromParent_ = parent != nullptr;
}
bool isImplicitNoneType() const;
bool isImplicitNoneExternal() const;
void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
// Get the implicit type for this name. May be null.
const DeclTypeSpec *GetType(
SourceName, bool respectImplicitNone = true) const;
// Record the implicit type for the range of characters [fromLetter,
// toLetter].
void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
parser::Location toLetter);
private:
static char Incr(char ch);
ImplicitRules *parent_;
SemanticsContext &context_;
bool inheritFromParent_{false}; // look in parent if not specified here
bool isImplicitNoneType_{
context_.IsEnabled(common::LanguageFeature::ImplicitNoneTypeAlways)};
bool isImplicitNoneExternal_{false};
// map_ contains the mapping between letters and types that were defined
// by the IMPLICIT statements of the related scope. It does not contain
// the default Fortran mappings nor the mapping defined in parents.
std::map<char, common::Reference<const DeclTypeSpec>> map_;
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const ImplicitRules &);
friend void ShowImplicitRule(
llvm::raw_ostream &, const ImplicitRules &, char);
};
// scope -> implicit rules for that scope
using ImplicitRulesMap = std::map<const Scope *, ImplicitRules>;
// Track statement source locations and save messages.
class MessageHandler {
public:
MessageHandler() { DIE("MessageHandler: default-constructed"); }
explicit MessageHandler(SemanticsContext &c) : context_{&c} {}
Messages &messages() { return context_->messages(); };
const std::optional<SourceName> &currStmtSource() {
return context_->location();
}
void set_currStmtSource(const std::optional<SourceName> &source) {
context_->set_location(source);
}
// Emit a message associated with the current statement source.
Message &Say(MessageFixedText &&);
Message &Say(MessageFormattedText &&);
// Emit a message about a SourceName
Message &Say(const SourceName &, MessageFixedText &&);
// Emit a formatted message associated with a source location.
template <typename... A>
Message &Say(const SourceName &source, MessageFixedText &&msg, A &&...args) {
return context_->Say(source, std::move(msg), std::forward<A>(args)...);
}
private:
SemanticsContext *context_;
};
// Inheritance graph for the parse tree visitation classes that follow:
// BaseVisitor
// + AttrsVisitor
// | + DeclTypeSpecVisitor
// | + ImplicitRulesVisitor
// | + ScopeHandler -----------+--+
// | + ModuleVisitor ========|==+
// | + InterfaceVisitor | |
// | +-+ SubprogramVisitor ==|==+
// + ArraySpecVisitor | |
// + DeclarationVisitor <--------+ |
// + ConstructVisitor |
// + ResolveNamesVisitor <------+
class BaseVisitor {
public:
BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
BaseVisitor(
SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)
: implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {
}
template <typename T> void Walk(const T &);
MessageHandler &messageHandler() { return messageHandler_; }
const std::optional<SourceName> &currStmtSource() {
return context_->location();
}
SemanticsContext &context() const { return *context_; }
evaluate::FoldingContext &GetFoldingContext() const {
return context_->foldingContext();
}
bool IsIntrinsic(
const SourceName &name, std::optional<Symbol::Flag> flag) const {
if (!flag) {
return context_->intrinsics().IsIntrinsic(name.ToString());
} else if (flag == Symbol::Flag::Function) {
return context_->intrinsics().IsIntrinsicFunction(name.ToString());
} else if (flag == Symbol::Flag::Subroutine) {
return context_->intrinsics().IsIntrinsicSubroutine(name.ToString());
} else {
DIE("expected Subroutine or Function flag");
}
}
// Make a placeholder symbol for a Name that otherwise wouldn't have one.
// It is not in any scope and always has MiscDetails.
void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
return evaluate::Fold(GetFoldingContext(), std::move(expr));
}
template <typename T> MaybeExpr EvaluateExpr(const T &expr) {
return FoldExpr(AnalyzeExpr(*context_, expr));
}
template <typename T>
MaybeExpr EvaluateNonPointerInitializer(
const Symbol &symbol, const T &expr, parser::CharBlock source) {
if (!context().HasError(symbol)) {
if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
auto restorer{GetFoldingContext().messages().SetLocation(source)};
return evaluate::NonPointerInitializationExpr(
symbol, std::move(*maybeExpr), GetFoldingContext());
}
}
return std::nullopt;
}
template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
return semantics::EvaluateIntExpr(*context_, expr);
}
template <typename T>
MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
std::move(*maybeIntExpr)));
} else {
return std::nullopt;
}
}
template <typename... A> Message &Say(A &&...args) {
return messageHandler_.Say(std::forward<A>(args)...);
}
template <typename... A>
Message &Say(
const parser::Name &name, MessageFixedText &&text, const A &...args) {
return messageHandler_.Say(name.source, std::move(text), args...);
}
protected:
ImplicitRulesMap *implicitRulesMap_{nullptr};
private:
ResolveNamesVisitor *this_;
SemanticsContext *context_;
MessageHandler messageHandler_;
};
// Provide Post methods to collect attributes into a member variable.
class AttrsVisitor : public virtual BaseVisitor {
public:
bool BeginAttrs(); // always returns true
Attrs GetAttrs();
Attrs EndAttrs();
bool SetPassNameOn(Symbol &);
void SetBindNameOn(Symbol &);
void Post(const parser::LanguageBindingSpec &);
bool Pre(const parser::IntentSpec &);
bool Pre(const parser::Pass &);
bool CheckAndSet(Attr);
// Simple case: encountering CLASSNAME causes ATTRNAME to be set.
#define HANDLE_ATTR_CLASS(CLASSNAME, ATTRNAME) \
bool Pre(const parser::CLASSNAME &) { \
CheckAndSet(Attr::ATTRNAME); \
return false; \
}
HANDLE_ATTR_CLASS(PrefixSpec::Elemental, ELEMENTAL)
HANDLE_ATTR_CLASS(PrefixSpec::Impure, IMPURE)
HANDLE_ATTR_CLASS(PrefixSpec::Module, MODULE)
HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
HANDLE_ATTR_CLASS(Abstract, ABSTRACT)
HANDLE_ATTR_CLASS(Allocatable, ALLOCATABLE)
HANDLE_ATTR_CLASS(Asynchronous, ASYNCHRONOUS)
HANDLE_ATTR_CLASS(Contiguous, CONTIGUOUS)
HANDLE_ATTR_CLASS(External, EXTERNAL)
HANDLE_ATTR_CLASS(Intrinsic, INTRINSIC)
HANDLE_ATTR_CLASS(NoPass, NOPASS)
HANDLE_ATTR_CLASS(Optional, OPTIONAL)
HANDLE_ATTR_CLASS(Parameter, PARAMETER)
HANDLE_ATTR_CLASS(Pointer, POINTER)
HANDLE_ATTR_CLASS(Protected, PROTECTED)
HANDLE_ATTR_CLASS(Save, SAVE)
HANDLE_ATTR_CLASS(Target, TARGET)
HANDLE_ATTR_CLASS(Value, VALUE)
HANDLE_ATTR_CLASS(Volatile, VOLATILE)
#undef HANDLE_ATTR_CLASS
protected:
std::optional<Attrs> attrs_;
Attr AccessSpecToAttr(const parser::AccessSpec &x) {
switch (x.v) {
case parser::AccessSpec::Kind::Public:
return Attr::PUBLIC;
case parser::AccessSpec::Kind::Private:
return Attr::PRIVATE;
}
llvm_unreachable("Switch covers all cases"); // suppress g++ warning
}
Attr IntentSpecToAttr(const parser::IntentSpec &x) {
switch (x.v) {
case parser::IntentSpec::Intent::In:
return Attr::INTENT_IN;
case parser::IntentSpec::Intent::Out:
return Attr::INTENT_OUT;
case parser::IntentSpec::Intent::InOut:
return Attr::INTENT_INOUT;
}
llvm_unreachable("Switch covers all cases"); // suppress g++ warning
}
private:
bool IsDuplicateAttr(Attr);
bool HaveAttrConflict(Attr, Attr, Attr);
bool IsConflictingAttr(Attr);
MaybeExpr bindName_; // from BIND(C, NAME="...")
std::optional<SourceName> passName_; // from PASS(...)
};
// Find and create types from declaration-type-spec nodes.
class DeclTypeSpecVisitor : public AttrsVisitor {
public:
using AttrsVisitor::Post;
using AttrsVisitor::Pre;
void Post(const parser::IntrinsicTypeSpec::DoublePrecision &);
void Post(const parser::IntrinsicTypeSpec::DoubleComplex &);
void Post(const parser::DeclarationTypeSpec::ClassStar &);
void Post(const parser::DeclarationTypeSpec::TypeStar &);
bool Pre(const parser::TypeGuardStmt &);
void Post(const parser::TypeGuardStmt &);
void Post(const parser::TypeSpec &);
protected:
struct State {
bool expectDeclTypeSpec{false}; // should see decl-type-spec only when true
const DeclTypeSpec *declTypeSpec{nullptr};
struct {
DerivedTypeSpec *type{nullptr};
DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
} derived;
bool allowForwardReferenceToDerivedType{false};
};
bool allowForwardReferenceToDerivedType() const {
return state_.allowForwardReferenceToDerivedType;
}
void set_allowForwardReferenceToDerivedType(bool yes) {
state_.allowForwardReferenceToDerivedType = yes;
}
// Walk the parse tree of a type spec and return the DeclTypeSpec for it.
template <typename T>
const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
auto restorer{common::ScopedSet(state_, State{})};
set_allowForwardReferenceToDerivedType(allowForward);
BeginDeclTypeSpec();
Walk(x);
const auto *type{GetDeclTypeSpec()};
EndDeclTypeSpec();
return type;
}
const DeclTypeSpec *GetDeclTypeSpec();
void BeginDeclTypeSpec();
void EndDeclTypeSpec();
void SetDeclTypeSpec(const DeclTypeSpec &);
void SetDeclTypeSpecCategory(DeclTypeSpec::Category);
DeclTypeSpec::Category GetDeclTypeSpecCategory() const {
return state_.derived.category;
}
KindExpr GetKindParamExpr(
TypeCategory, const std::optional<parser::KindSelector> &);
void CheckForAbstractType(const Symbol &typeSymbol);
private:
State state_;
void MakeNumericType(TypeCategory, int kind);
};
// Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
public:
using DeclTypeSpecVisitor::Post;
using DeclTypeSpecVisitor::Pre;
using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
void Post(const parser::ParameterStmt &);
bool Pre(const parser::ImplicitStmt &);
bool Pre(const parser::LetterSpec &);
bool Pre(const parser::ImplicitSpec &);
void Post(const parser::ImplicitSpec &);
const DeclTypeSpec *GetType(
SourceName name, bool respectImplicitNoneType = true) {
return implicitRules_->GetType(name, respectImplicitNoneType);
}
bool isImplicitNoneType() const {
return implicitRules_->isImplicitNoneType();
}
bool isImplicitNoneType(const Scope &scope) const {
return implicitRulesMap_->at(&scope).isImplicitNoneType();
}
bool isImplicitNoneExternal() const {
return implicitRules_->isImplicitNoneExternal();
}
void set_inheritFromParent(bool x) {
implicitRules_->set_inheritFromParent(x);
}
protected:
void BeginScope(const Scope &);
void SetScope(const Scope &);
private:
// implicit rules in effect for current scope
ImplicitRules *implicitRules_{nullptr};
std::optional<SourceName> prevImplicit_;
std::optional<SourceName> prevImplicitNone_;
std::optional<SourceName> prevImplicitNoneType_;
std::optional<SourceName> prevParameterStmt_;
bool HandleImplicitNone(const std::list<ImplicitNoneNameSpec> &nameSpecs);
};
// Track array specifications. They can occur in AttrSpec, EntityDecl,
// ObjectDecl, DimensionStmt, CommonBlockObject, or BasedPointerStmt.
// 1. INTEGER, DIMENSION(10) :: x
// 2. INTEGER :: x(10)
// 3. ALLOCATABLE :: x(:)
// 4. DIMENSION :: x(10)
// 5. COMMON x(10)
// 6. BasedPointerStmt
class ArraySpecVisitor : public virtual BaseVisitor {
public:
void Post(const parser::ArraySpec &);
void Post(const parser::ComponentArraySpec &);
void Post(const parser::CoarraySpec &);
void Post(const parser::AttrSpec &) { PostAttrSpec(); }
void Post(const parser::ComponentAttrSpec &) { PostAttrSpec(); }
protected:
const ArraySpec &arraySpec();
void set_arraySpec(const ArraySpec arraySpec) { arraySpec_ = arraySpec; }
const ArraySpec &coarraySpec();
void BeginArraySpec();
void EndArraySpec();
void ClearArraySpec() { arraySpec_.clear(); }
void ClearCoarraySpec() { coarraySpec_.clear(); }
private:
// arraySpec_/coarraySpec_ are populated from any ArraySpec/CoarraySpec
ArraySpec arraySpec_;
ArraySpec coarraySpec_;
// When an ArraySpec is under an AttrSpec or ComponentAttrSpec, it is moved
// into attrArraySpec_
ArraySpec attrArraySpec_;
ArraySpec attrCoarraySpec_;
void PostAttrSpec();
};
// Manage a stack of Scopes
class ScopeHandler : public ImplicitRulesVisitor {
public:
using ImplicitRulesVisitor::Post;
using ImplicitRulesVisitor::Pre;
Scope &currScope() { return DEREF(currScope_); }
// The enclosing host procedure if current scope is in an internal procedure
Scope *GetHostProcedure();
// The innermost enclosing program unit scope, ignoring BLOCK and other
// construct scopes.
Scope &InclusiveScope();
// The enclosing scope, skipping derived types.
Scope &NonDerivedTypeScope();
// Create a new scope and push it on the scope stack.
void PushScope(Scope::Kind kind, Symbol *symbol);
void PushScope(Scope &scope);
void PopScope();
void SetScope(Scope &);
template <typename T> bool Pre(const parser::Statement<T> &x) {
messageHandler().set_currStmtSource(x.source);
currScope_->AddSourceRange(x.source);
return true;
}
template <typename T> void Post(const parser::Statement<T> &) {
messageHandler().set_currStmtSource(std::nullopt);
}
// Special messages: already declared; referencing symbol's declaration;
// about a type; two names & locations
void SayAlreadyDeclared(const parser::Name &, Symbol &);
void SayAlreadyDeclared(const SourceName &, Symbol &);
void SayAlreadyDeclared(const SourceName &, const SourceName &);
void SayWithReason(
const parser::Name &, Symbol &, MessageFixedText &&, MessageFixedText &&);
void SayWithDecl(const parser::Name &, Symbol &, MessageFixedText &&);
void SayLocalMustBeVariable(const parser::Name &, Symbol &);
void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
MessageFixedText &&);
void Say2(
const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
void Say2(
const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
// Search for symbol by name in current, parent derived type, and
// containing scopes
Symbol *FindSymbol(const parser::Name &);
Symbol *FindSymbol(const Scope &, const parser::Name &);
// Search for name only in scope, not in enclosing scopes.
Symbol *FindInScope(const Scope &, const parser::Name &);
Symbol *FindInScope(const Scope &, const SourceName &);
template <typename T> Symbol *FindInScope(const T &name) {
return FindInScope(currScope(), name);
}
// Search for name in a derived type scope and its parents.
Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
Symbol *FindInTypeOrParents(const parser::Name &);
void EraseSymbol(const parser::Name &);
void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
// Make a new symbol with the name and attrs of an existing one
Symbol &CopySymbol(const SourceName &, const Symbol &);
// Make symbols in the current or named scope
Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
Symbol &MakeHostAssocSymbol(const parser::Name &, const Symbol &);
template <typename D>
common::IfNoLvalue<Symbol &, D> MakeSymbol(
const parser::Name &name, D &&details) {
return MakeSymbol(name, Attrs{}, std::move(details));
}
template <typename D>
common::IfNoLvalue<Symbol &, D> MakeSymbol(
const parser::Name &name, const Attrs &attrs, D &&details) {
return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
}
template <typename D>
common::IfNoLvalue<Symbol &, D> MakeSymbol(
const SourceName &name, const Attrs &attrs, D &&details) {
// Note: don't use FindSymbol here. If this is a derived type scope,
// we want to detect whether the name is already declared as a component.
auto *symbol{FindInScope(name)};
if (!symbol) {
symbol = &MakeSymbol(name, attrs);
symbol->set_details(std::move(details));
return *symbol;
}
if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
if (auto *d{symbol->detailsIf<GenericDetails>()}) {
if (!d->specific()) {
// derived type with same name as a generic
auto *derivedType{d->derivedType()};
if (!derivedType) {
derivedType =
&currScope().MakeSymbol(name, attrs, std::move(details));
d->set_derivedType(*derivedType);
} else {
SayAlreadyDeclared(name, *derivedType);
}
return *derivedType;
}
}
}
if (symbol->CanReplaceDetails(details)) {
// update the existing symbol
symbol->attrs() |= attrs;
if constexpr (std::is_same_v<SubprogramDetails, D>) {
// Dummy argument defined by explicit interface
details.set_isDummy(IsDummy(*symbol));
}
symbol->set_details(std::move(details));
return *symbol;
} else if constexpr (std::is_same_v<UnknownDetails, D>) {
symbol->attrs() |= attrs;
return *symbol;
} else {
if (!CheckPossibleBadForwardRef(*symbol)) {
SayAlreadyDeclared(name, *symbol);
}
// replace the old symbol with a new one with correct details
EraseSymbol(*symbol);
auto &result{MakeSymbol(name, attrs, std::move(details))};
context().SetError(result);
return result;
}
}
void MakeExternal(Symbol &);
protected:
// Apply the implicit type rules to this symbol.
void ApplyImplicitRules(Symbol &, bool allowForwardReference = false);
bool ImplicitlyTypeForwardRef(Symbol &);
void AcquireIntrinsicProcedureFlags(Symbol &);
const DeclTypeSpec *GetImplicitType(
Symbol &, bool respectImplicitNoneType = true);
bool ConvertToObjectEntity(Symbol &);
bool ConvertToProcEntity(Symbol &);
const DeclTypeSpec &MakeNumericType(
TypeCategory, const std::optional<parser::KindSelector> &);
const DeclTypeSpec &MakeLogicalType(
const std::optional<parser::KindSelector> &);
void NotePossibleBadForwardRef(const parser::Name &);
std::optional<SourceName> HadForwardRef(const Symbol &) const;
bool CheckPossibleBadForwardRef(const Symbol &);
bool inExecutionPart_{false};
bool inSpecificationPart_{false};
bool inEquivalenceStmt_{false};
// Some information is collected from a specification part for deferred
// processing in DeclarationPartVisitor functions (e.g., CheckSaveStmts())
// that are called by ResolveNamesVisitor::FinishSpecificationPart(). Since
// specification parts can nest (e.g., INTERFACE bodies), the collected
// information that is not contained in the scope needs to be packaged
// and restorable.
struct SpecificationPartState {
std::set<SourceName> forwardRefs;
// Collect equivalence sets and process at end of specification part
std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets;
// Names of all common block objects in the scope
std::set<SourceName> commonBlockObjects;
// Info about about SAVE statements and attributes in current scope
struct {
std::optional<SourceName> saveAll; // "SAVE" without entity list
std::set<SourceName> entities; // names of entities with save attr
std::set<SourceName> commons; // names of common blocks with save attr
} saveInfo;
} specPartState_;
private:
Scope *currScope_{nullptr};
};
class ModuleVisitor : public virtual ScopeHandler {
public:
bool Pre(const parser::AccessStmt &);
bool Pre(const parser::Only &);
bool Pre(const parser::Rename::Names &);
bool Pre(const parser::Rename::Operators &);
bool Pre(const parser::UseStmt &);
void Post(const parser::UseStmt &);
void BeginModule(const parser::Name &, bool isSubmodule);
bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
void ApplyDefaultAccess();
void AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
void ClearUseRenames() { useRenames_.clear(); }
void ClearUseOnly() { useOnly_.clear(); }
private:
// The default access spec for this module.
Attr defaultAccess_{Attr::PUBLIC};
// The location of the last AccessStmt without access-ids, if any.
std::optional<SourceName> prevAccessStmt_;
// The scope of the module during a UseStmt
Scope *useModuleScope_{nullptr};
// Names that have appeared in a rename clause of a USE statement
std::set<std::pair<SourceName, Scope *>> useRenames_;
// Names that have appeared in an ONLY clause of a USE statement
std::set<std::pair<SourceName, Scope *>> useOnly_;
Symbol &SetAccess(const SourceName &, Attr attr, Symbol * = nullptr);
// A rename in a USE statement: local => use
struct SymbolRename {
Symbol *local{nullptr};
Symbol *use{nullptr};
};
// Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
void DoAddUse(const SourceName &, const SourceName &, Symbol &localSymbol,
const Symbol &useSymbol);
void AddUse(const GenericSpecInfo &);
// If appropriate, erase a previously USE-associated symbol
void EraseRenamedSymbol(const Symbol &);
// Record a name appearing in a USE rename clause
void AddUseRename(const SourceName &name) {
useRenames_.emplace(std::make_pair(name, useModuleScope_));
}
bool IsUseRenamed(const SourceName &name) const {
return useRenames_.find({name, useModuleScope_}) != useRenames_.end();
}
// Record a name appearing in a USE ONLY clause
void AddUseOnly(const SourceName &name) {
useOnly_.emplace(std::make_pair(name, useModuleScope_));
}
bool IsUseOnly(const SourceName &name) const {
return useOnly_.find({name, useModuleScope_}) != useOnly_.end();
}
Scope *FindModule(const parser::Name &, Scope *ancestor = nullptr);
};
class InterfaceVisitor : public virtual ScopeHandler {
public:
bool Pre(const parser::InterfaceStmt &);
void Post(const parser::InterfaceStmt &);
void Post(const parser::EndInterfaceStmt &);
bool Pre(const parser::GenericSpec &);
bool Pre(const parser::ProcedureStmt &);
bool Pre(const parser::GenericStmt &);
void Post(const parser::GenericStmt &);
bool inInterfaceBlock() const;
bool isGeneric() const;
bool isAbstract() const;
protected:
Symbol &GetGenericSymbol() {
return DEREF(genericInfo_.top().symbol);
}
// Add to generic the symbol for the subprogram with the same name
void CheckGenericProcedures(Symbol &);
private:
// A new GenericInfo is pushed for each interface block and generic stmt
struct GenericInfo {
GenericInfo(bool isInterface, bool isAbstract = false)
: isInterface{isInterface}, isAbstract{isAbstract} {}
bool isInterface; // in interface block
bool isAbstract; // in abstract interface block
Symbol *symbol{nullptr}; // the generic symbol being defined
};
std::stack<GenericInfo> genericInfo_;
const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); }
void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; }
using ProcedureKind = parser::ProcedureStmt::Kind;
// mapping of generic to its specific proc names and kinds
std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>
specificProcs_;
void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
void ResolveSpecificsInGeneric(Symbol &generic);
};
class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
public:
bool HandleStmtFunction(const parser::StmtFunctionStmt &);
bool Pre(const parser::SubroutineStmt &);
void Post(const parser::SubroutineStmt &);
bool Pre(const parser::FunctionStmt &);
void Post(const parser::FunctionStmt &);
bool Pre(const parser::EntryStmt &);
void Post(const parser::EntryStmt &);
bool Pre(const parser::InterfaceBody::Subroutine &);
void Post(const parser::InterfaceBody::Subroutine &);
bool Pre(const parser::InterfaceBody::Function &);
void Post(const parser::InterfaceBody::Function &);
bool Pre(const parser::Suffix &);
bool Pre(const parser::PrefixSpec &);
void Post(const parser::ImplicitPart &);
bool BeginSubprogram(
const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
bool BeginMpSubprogram(const parser::Name &);
void PushBlockDataScope(const parser::Name &);
void EndSubprogram();
protected:
// Set when we see a stmt function that is really an array element assignment
bool badStmtFuncFound_{false};
private:
// Info about the current function: parse tree of the type in the PrefixSpec;
// name and symbol of the function result from the Suffix; source location.
struct {
const parser::DeclarationTypeSpec *parsedType{nullptr};
const parser::Name *resultName{nullptr};
Symbol *resultSymbol{nullptr};
std::optional<SourceName> source;
} funcInfo_;
// Edits an existing symbol created for earlier calls to a subprogram or ENTRY
// so that it can be replaced by a later definition.
bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
void CheckExtantProc(const parser::Name &, Symbol::Flag);
// Create a subprogram symbol in the current scope and push a new scope.
Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
Symbol *GetSpecificFromGeneric(const parser::Name &);
SubprogramDetails &PostSubprogramStmt(const parser::Name &);
};
class DeclarationVisitor : public ArraySpecVisitor,
public virtual ScopeHandler {
public:
using ArraySpecVisitor::Post;
using ScopeHandler::Post;
using ScopeHandler::Pre;
bool Pre(const parser::Initialization &);
void Post(const parser::EntityDecl &);
void Post(const parser::ObjectDecl &);
void Post(const parser::PointerDecl &);
bool Pre(const parser::BindStmt &) { return BeginAttrs(); }
void Post(const parser::BindStmt &) { EndAttrs(); }
bool Pre(const parser::BindEntity &);
bool Pre(const parser::OldParameterStmt &);
bool Pre(const parser::NamedConstantDef &);
bool Pre(const parser::NamedConstant &);
void Post(const parser::EnumDef &);
bool Pre(const parser::Enumerator &);
bool Pre(const parser::AccessSpec &);
bool Pre(const parser::AsynchronousStmt &);
bool Pre(const parser::ContiguousStmt &);
bool Pre(const parser::ExternalStmt &);
bool Pre(const parser::IntentStmt &);
bool Pre(const parser::IntrinsicStmt &);
bool Pre(const parser::OptionalStmt &);
bool Pre(const parser::ProtectedStmt &);
bool Pre(const parser::ValueStmt &);
bool Pre(const parser::VolatileStmt &);
bool Pre(const parser::AllocatableStmt &) {
objectDeclAttr_ = Attr::ALLOCATABLE;
return true;
}
void Post(const parser::AllocatableStmt &) { objectDeclAttr_ = std::nullopt; }
bool Pre(const parser::TargetStmt &) {
objectDeclAttr_ = Attr::TARGET;
return true;
}
void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
void Post(const parser::DimensionStmt::Declaration &);
void Post(const parser::CodimensionDecl &);
bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
void Post(const parser::TypeDeclarationStmt &);
void Post(const parser::IntegerTypeSpec &);
void Post(const parser::IntrinsicTypeSpec::Real &);
void Post(const parser::IntrinsicTypeSpec::Complex &);
void Post(const parser::IntrinsicTypeSpec::Logical &);
void Post(const parser::IntrinsicTypeSpec::Character &);
void Post(const parser::CharSelector::LengthAndKind &);
void Post(const parser::CharLength &);
void Post(const parser::LengthSelector &);
bool Pre(const parser::KindParam &);
bool Pre(const parser::DeclarationTypeSpec::Type &);
void Post(const parser::DeclarationTypeSpec::Type &);
bool Pre(const parser::DeclarationTypeSpec::Class &);
void Post(const parser::DeclarationTypeSpec::Class &);
bool Pre(const parser::DeclarationTypeSpec::Record &);
void Post(const parser::DerivedTypeSpec &);
bool Pre(const parser::DerivedTypeDef &);
bool Pre(const parser::DerivedTypeStmt &);
void Post(const parser::DerivedTypeStmt &);
bool Pre(const parser::TypeParamDefStmt &) { return BeginDecl(); }
void Post(const parser::TypeParamDefStmt &);
bool Pre(const parser::TypeAttrSpec::Extends &);
bool Pre(const parser::PrivateStmt &);
bool Pre(const parser::SequenceStmt &);
bool Pre(const parser::ComponentDefStmt &) { return BeginDecl(); }
void Post(const parser::ComponentDefStmt &) { EndDecl(); }
void Post(const parser::ComponentDecl &);
bool Pre(const parser::ProcedureDeclarationStmt &);
void Post(const parser::ProcedureDeclarationStmt &);
bool Pre(const parser::DataComponentDefStmt &); // returns false
bool Pre(const parser::ProcComponentDefStmt &);
void Post(const parser::ProcComponentDefStmt &);
bool Pre(const parser::ProcPointerInit &);
void Post(const parser::ProcInterface &);
void Post(const parser::ProcDecl &);
bool Pre(const parser::TypeBoundProcedurePart &);
void Post(const parser::TypeBoundProcedurePart &);
void Post(const parser::ContainsStmt &);
bool Pre(const parser::TypeBoundProcBinding &) { return BeginAttrs(); }
void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
void Post(const parser::FinalProcedureStmt &);
bool Pre(const parser::TypeBoundGenericStmt &);
bool Pre(const parser::AllocateStmt &);
void Post(const parser::AllocateStmt &);
bool Pre(const parser::StructureConstructor &);
bool Pre(const parser::NamelistStmt::Group &);
bool Pre(const parser::IoControlSpec &);
bool Pre(const parser::CommonStmt::Block &);
bool Pre(const parser::CommonBlockObject &);
void Post(const parser::CommonBlockObject &);
bool Pre(const parser::EquivalenceStmt &);
bool Pre(const parser::SaveStmt &);
bool Pre(const parser::BasedPointerStmt &);
void PointerInitialization(
const parser::Name &, const parser::InitialDataTarget &);
void PointerInitialization(
const parser::Name &, const parser::ProcPointerInit &);
void NonPointerInitialization(
const parser::Name &, const parser::ConstantExpr &);
void CheckExplicitInterface(const parser::Name &);
void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
const parser::Name *ResolveDesignator(const parser::Designator &);
protected:
bool BeginDecl();
void EndDecl();
Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
// Make sure that there's an entity in an enclosing scope called Name
Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
// Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
// it comes from the entity in the containing scope, or implicit rules.
// Return pointer to the new symbol, or nullptr on error.
Symbol *DeclareLocalEntity(const parser::Name &);
// Declare a statement entity (i.e., an implied DO loop index for
// a DATA statement or an array constructor). If there isn't an explict
// type specified, implicit rules apply. Return pointer to the new symbol,
// or nullptr on error.
Symbol *DeclareStatementEntity(const parser::DoVariable &,
const std::optional<parser::IntegerTypeSpec> &);
Symbol &MakeCommonBlockSymbol(const parser::Name &);
Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
bool CheckUseError(const parser::Name &);
void CheckAccessibility(const SourceName &, bool, Symbol &);
void CheckCommonBlocks();
void CheckSaveStmts();
void CheckEquivalenceSets();
bool CheckNotInBlock(const char *);
bool NameIsKnownOrIntrinsic(const parser::Name &);
// Each of these returns a pointer to a resolved Name (i.e. with symbol)
// or nullptr in case of error.
const parser::Name *ResolveStructureComponent(
const parser::StructureComponent &);
const parser::Name *ResolveDataRef(const parser::DataRef &);
const parser::Name *ResolveName(const parser::Name &);
bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol);
Symbol *NoteInterfaceName(const parser::Name &);
bool IsUplevelReference(const Symbol &);
std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(
const parser::DoVariable &name) {
std::optional<SourceName> result{checkIndexUseInOwnBounds_};
checkIndexUseInOwnBounds_ = name.thing.thing.source;
return result;
}
void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {
checkIndexUseInOwnBounds_ = restore;
}
private:
// The attribute corresponding to the statement containing an ObjectDecl
std::optional<Attr> objectDeclAttr_;
// Info about current character type while walking DeclTypeSpec.
// Also captures any "*length" specifier on an individual declaration.
struct {
std::optional<ParamValue> length;
std::optional<KindExpr> kind;
} charInfo_;
// Info about current derived type while walking DerivedTypeDef
struct {
const parser::Name *extends{nullptr}; // EXTENDS(name)
bool privateComps{false}; // components are private by default
bool privateBindings{false}; // bindings are private by default
bool sawContains{false}; // currently processing bindings
bool sequence{false}; // is a sequence type
const Symbol *type{nullptr}; // derived type being defined
} derivedTypeInfo_;
// In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
// the interface name, if any.
const parser::Name *interfaceName_{nullptr};
// Map type-bound generic to binding names of its specific bindings
std::multimap<Symbol *, const parser::Name *> genericBindings_;
// Info about current ENUM
struct EnumeratorState {
// Enum value must hold inside a C_INT (7.6.2).
std::optional<int> value{0};
} enumerationState_;
// Set for OldParameterStmt processing
bool inOldStyleParameterStmt_{false};
// Set when walking DATA & array constructor implied DO loop bounds
// to warn about use of the implied DO intex therein.
std::optional<SourceName> checkIndexUseInOwnBounds_;
bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
Symbol &HandleAttributeStmt(Attr, const parser::Name &);
Symbol &DeclareUnknownEntity(const parser::Name &, Attrs);
Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &);
void SetType(const parser::Name &, const DeclTypeSpec &);
std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
std::optional<DerivedTypeSpec> ResolveExtendsType(
const parser::Name &, const parser::Name *);
Symbol *MakeTypeSymbol(const SourceName &, Details &&);
Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
ParamValue GetParamValue(
const parser::TypeParamValue &, common::TypeParamAttr attr);
void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
Attrs HandleSaveName(const SourceName &, Attrs);
void AddSaveName(std::set<SourceName> &, const SourceName &);
void SetSaveAttr(Symbol &);
bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
void Initialization(const parser::Name &, const parser::Initialization &,
bool inComponentDecl);
bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
bool CheckForHostAssociatedImplicit(const parser::Name &);
// Declare an object or procedure entity.
// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
template <typename T>
Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
Symbol &symbol{MakeSymbol(name, attrs)};
if (context().HasError(symbol) || symbol.has<T>()) {
return symbol; // OK or error already reported
} else if (symbol.has<UnknownDetails>()) {
symbol.set_details(T{});
return symbol;
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
symbol.set_details(T{std::move(*details)});
return symbol;
} else if (std::is_same_v<EntityDetails, T> &&
(symbol.has<ObjectEntityDetails>() ||
symbol.has<ProcEntityDetails>())) {
return symbol; // OK
} else if (auto *details{symbol.detailsIf<UseDetails>()}) {
Say(name.source,
"'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
name.source, GetUsedModule(*details).name());
} else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
if (details->kind() == SubprogramKind::Module) {
Say2(name,
"Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
symbol, "Module procedure definition"_en_US);
} else if (details->kind() == SubprogramKind::Internal) {
Say2(name,
"Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
symbol, "Internal procedure definition"_en_US);
} else {
DIE("unexpected kind");
}
} else if (std::is_same_v<ObjectEntityDetails, T> &&
symbol.has<ProcEntityDetails>()) {
SayWithDecl(
name, symbol, "'%s' is already declared as a procedure"_err_en_US);
} else if (std::is_same_v<ProcEntityDetails, T> &&
symbol.has<ObjectEntityDetails>()) {
if (InCommonBlock(symbol)) {
SayWithDecl(name, symbol,
"'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
} else {
SayWithDecl(
name, symbol, "'%s' is already declared as an object"_err_en_US);
}
} else if (!CheckPossibleBadForwardRef(symbol)) {
SayAlreadyDeclared(name, symbol);
}
context().SetError(symbol);
return symbol;
}
bool HasCycle(const Symbol &, const ProcInterface &);
};
// Resolve construct entities and statement entities.
// Check that construct names don't conflict with other names.
class ConstructVisitor : public virtual DeclarationVisitor {
public:
bool Pre(const parser::ConcurrentHeader &);
bool Pre(const parser::LocalitySpec::Local &);
bool Pre(const parser::LocalitySpec::LocalInit &);
bool Pre(const parser::LocalitySpec::Shared &);
bool Pre(const parser::AcSpec &);
bool Pre(const parser::AcImpliedDo &);
bool Pre(const parser::DataImpliedDo &);
bool Pre(const parser::DataIDoObject &);
bool Pre(const parser::DataStmtObject &);
bool Pre(const parser::DataStmtValue &);
bool Pre(const parser::DoConstruct &);
void Post(const parser::DoConstruct &);
bool Pre(const parser::ForallConstruct &);
void Post(const parser::ForallConstruct &);
bool Pre(const parser::ForallStmt &);
void Post(const parser::ForallStmt &);
bool Pre(const parser::BlockStmt &);
bool Pre(const parser::EndBlockStmt &);
void Post(const parser::Selector &);
void Post(const parser::AssociateStmt &);
void Post(const parser::EndAssociateStmt &);
bool Pre(const parser::Association &);
void Post(const parser::SelectTypeStmt &);
void Post(const parser::SelectRankStmt &);
bool Pre(const parser::SelectTypeConstruct &);
void Post(const parser::SelectTypeConstruct &);
bool Pre(const parser::SelectTypeConstruct::TypeCase &);
void Post(const parser::SelectTypeConstruct::TypeCase &);
// Creates Block scopes with neither symbol name nor symbol details.
bool Pre(const parser::SelectRankConstruct::RankCase &);
void Post(const parser::SelectRankConstruct::RankCase &);
void Post(const parser::TypeGuardStmt::Guard &);
void Post(const parser::SelectRankCaseStmt::Rank &);
bool Pre(const parser::ChangeTeamStmt &);
void Post(const parser::EndChangeTeamStmt &);
void Post(const parser::CoarrayAssociation &);
// Definitions of construct names
bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::LabelDoStmt &) {
return false; // error recovery
}
bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::SelectRankConstruct &);
void Post(const parser::SelectRankConstruct &);
bool Pre(const parser::SelectRankStmt &x) {
return CheckDef(std::get<0>(x.t));
}
bool Pre(const parser::SelectTypeStmt &x) {
return CheckDef(std::get<0>(x.t));
}
// References to construct names
void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); }
void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); }
void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); }
void Post(const parser::EndForallStmt &x) { CheckRef(x.v); }
void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); }
void Post(const parser::EndDoStmt &x) { CheckRef(x.v); }
void Post(const parser::ElseIfStmt &x) { CheckRef(x.t); }
void Post(const parser::ElseStmt &x) { CheckRef(x.v); }
void Post(const parser::EndIfStmt &x) { CheckRef(x.v); }
void Post(const parser::CaseStmt &x) { CheckRef(x.t); }
void Post(const parser::EndSelectStmt &x) { CheckRef(x.v); }
void Post(const parser::SelectRankCaseStmt &x) { CheckRef(x.t); }
void Post(const parser::TypeGuardStmt &x) { CheckRef(x.t); }
void Post(const parser::CycleStmt &x) { CheckRef(x.v); }
void Post(const parser::ExitStmt &x) { CheckRef(x.v); }
private:
// R1105 selector -> expr | variable
// expr is set in either case unless there were errors
struct Selector {
Selector() {}
Selector(const SourceName &source, MaybeExpr &&expr)
: source{source}, expr{std::move(expr)} {}
operator bool() const { return expr.has_value(); }
parser::CharBlock source;
MaybeExpr expr;
};
// association -> [associate-name =>] selector
struct Association {
const parser::Name *name{nullptr};
Selector selector;
};
std::vector<Association> associationStack_;
Association *currentAssociation_{nullptr};
template <typename T> bool CheckDef(const T &t) {
return CheckDef(std::get<std::optional<parser::Name>>(t));
}
template <typename T> void CheckRef(const T &t) {
CheckRef(std::get<std::optional<parser::Name>>(t));
}
bool CheckDef(const std::optional<parser::Name> &);
void CheckRef(const std::optional<parser::Name> &);
const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
const DeclTypeSpec &ToDeclTypeSpec(
evaluate::DynamicType &&, MaybeSubscriptIntExpr &&length);
Symbol *MakeAssocEntity();
void SetTypeFromAssociation(Symbol &);
void SetAttrsFromAssociation(Symbol &);
Selector ResolveSelector(const parser::Selector &);
void ResolveIndexName(const parser::ConcurrentControl &control);
void SetCurrentAssociation(std::size_t n);
Association &GetCurrentAssociation();
void PushAssociation();
void PopAssociation(std::size_t count = 1);
};
// Create scopes for OpenACC constructs
class AccVisitor : public virtual DeclarationVisitor {
public:
void AddAccSourceRange(const parser::CharBlock &);
static bool NeedsScope(const parser::OpenACCBlockConstruct &);
bool Pre(const parser::OpenACCBlockConstruct &);
void Post(const parser::OpenACCBlockConstruct &);
bool Pre(const parser::AccBeginBlockDirective &x) {
AddAccSourceRange(x.source);
return true;
}
void Post(const parser::AccBeginBlockDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::AccEndBlockDirective &x) {
AddAccSourceRange(x.source);
return true;
}
void Post(const parser::AccEndBlockDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::AccBeginLoopDirective &x) {
AddAccSourceRange(x.source);
return true;
}
void Post(const parser::AccBeginLoopDirective &x) {
messageHandler().set_currStmtSource(std::nullopt);
}
};
bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) {
const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
const auto &beginDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
switch (beginDir.v) {
case llvm::acc::Directive::ACCD_data:
case llvm::acc::Directive::ACCD_host_data:
case llvm::acc::Directive::ACCD_kernels:
case llvm::acc::Directive::ACCD_parallel:
case llvm::acc::Directive::ACCD_serial:
return true;
default:
return false;
}
}
void AccVisitor::AddAccSourceRange(const parser::CharBlock &source) {
messageHandler().set_currStmtSource(source);
currScope().AddSourceRange(source);
}
bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
if (NeedsScope(x)) {
PushScope(Scope::Kind::Block, nullptr);
}
return true;
}
void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) {
if (NeedsScope(x)) {
PopScope();
}
}
// Create scopes for OpenMP constructs
class OmpVisitor : public virtual DeclarationVisitor {
public:
void AddOmpSourceRange(const parser::CharBlock &);
static bool NeedsScope(const parser::OpenMPBlockConstruct &);
bool Pre(const parser::OpenMPBlockConstruct &);
void Post(const parser::OpenMPBlockConstruct &);
bool Pre(const parser::OmpBeginBlockDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpBeginBlockDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OmpEndBlockDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpEndBlockDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OpenMPLoopConstruct &) {
PushScope(Scope::Kind::Block, nullptr);
return true;
}
void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
bool Pre(const parser::OmpBeginLoopDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpBeginLoopDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OmpEndLoopDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpEndLoopDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OpenMPSectionsConstruct &) {
PushScope(Scope::Kind::Block, nullptr);
return true;
}
void Post(const parser::OpenMPSectionsConstruct &) { PopScope(); }
bool Pre(const parser::OmpBeginSectionsDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpBeginSectionsDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
bool Pre(const parser::OmpEndSectionsDirective &x) {
AddOmpSourceRange(x.source);
return true;
}
void Post(const parser::OmpEndSectionsDirective &) {
messageHandler().set_currStmtSource(std::nullopt);
}
};
bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
switch (beginDir.v) {
case llvm::omp::Directive::OMPD_target_data:
case llvm::omp::Directive::OMPD_master:
case llvm::omp::Directive::OMPD_ordered:
case llvm::omp::Directive::OMPD_taskgroup:
return false;
default:
return true;
}
}
void OmpVisitor::AddOmpSourceRange(const parser::CharBlock &source) {
messageHandler().set_currStmtSource(source);
currScope().AddSourceRange(source);
}
bool OmpVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
if (NeedsScope(x)) {
PushScope(Scope::Kind::Block, nullptr);
}
return true;
}
void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
if (NeedsScope(x)) {
PopScope();
}
}
// Walk the parse tree and resolve names to symbols.
class ResolveNamesVisitor : public virtual ScopeHandler,
public ModuleVisitor,
public SubprogramVisitor,
public ConstructVisitor,
public OmpVisitor,
public AccVisitor {
public:
using AccVisitor::Post;
using AccVisitor::Pre;
using ArraySpecVisitor::Post;
using ConstructVisitor::Post;
using ConstructVisitor::Pre;
using DeclarationVisitor::Post;
using DeclarationVisitor::Pre;
using ImplicitRulesVisitor::Post;
using ImplicitRulesVisitor::Pre;
using InterfaceVisitor::Post;
using InterfaceVisitor::Pre;
using ModuleVisitor::Post;
using ModuleVisitor::Pre;
using OmpVisitor::Post;
using OmpVisitor::Pre;
using ScopeHandler::Post;
using ScopeHandler::Pre;
using SubprogramVisitor::Post;
using SubprogramVisitor::Pre;
ResolveNamesVisitor(SemanticsContext &context, ImplicitRulesMap &rules)
: BaseVisitor{context, *this, rules} {
PushScope(context.globalScope());
}
// Default action for a parse tree node is to visit children.
template <typename T> bool Pre(const T &) { return true; }
template <typename T> void Post(const T &) {}
bool Pre(const parser::SpecificationPart &);
void Post(const parser::Program &);
bool Pre(const parser::ImplicitStmt &);
void Post(const parser::PointerObject &);
void Post(const parser::AllocateObject &);
bool Pre(const parser::PointerAssignmentStmt &);
void Post(const parser::Designator &);
template <typename A, typename B>
void Post(const parser::LoopBounds<A, B> &x) {
ResolveName(*parser::Unwrap<parser::Name>(x.name));
}
void Post(const parser::ProcComponentRef &);
bool Pre(const parser::FunctionReference &);
bool Pre(const parser::CallStmt &);
bool Pre(const parser::ImportStmt &);
void Post(const parser::TypeGuardStmt &);
bool Pre(const parser::StmtFunctionStmt &);
bool Pre(const parser::DefinedOpName &);
bool Pre(const parser::ProgramUnit &);
void Post(const parser::AssignStmt &);
void Post(const parser::AssignedGotoStmt &);
// These nodes should never be reached: they are handled in ProgramUnit
bool Pre(const parser::MainProgram &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::FunctionSubprogram &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::SubroutineSubprogram &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::SeparateModuleSubprogram &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::Module &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::Submodule &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
bool Pre(const parser::BlockData &) {
llvm_unreachable("This node is handled in ProgramUnit");
}
void NoteExecutablePartCall(Symbol::Flag, const parser::Call &);
friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
private:
// Kind of procedure we are expecting to see in a ProcedureDesignator
std::optional<Symbol::Flag> expectedProcFlag_;
std::optional<SourceName> prevImportStmt_;
void PreSpecificationConstruct(const parser::SpecificationConstruct &);
void CreateCommonBlockSymbols(const parser::CommonStmt &);
void CreateGeneric(const parser::GenericSpec &);
void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
void CheckImports();
void CheckImport(const SourceName &, const SourceName &);
void HandleCall(Symbol::Flag, const parser::Call &);
void HandleProcedureName(Symbol::Flag, const parser::Name &);
bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
void ResolveSpecificationParts(ProgramTree &);
void AddSubpNames(ProgramTree &);
bool BeginScopeForNode(const ProgramTree &);
void FinishSpecificationParts(const ProgramTree &);
void FinishDerivedTypeInstantiation(Scope &);
void ResolveExecutionParts(const ProgramTree &);
};
// ImplicitRules implementation
bool ImplicitRules::isImplicitNoneType() const {
if (isImplicitNoneType_) {
return true;
} else if (map_.empty() && inheritFromParent_) {
return parent_->isImplicitNoneType();
} else {
return false; // default if not specified
}
}
bool ImplicitRules::isImplicitNoneExternal() const {
if (isImplicitNoneExternal_) {
return true;
} else if (inheritFromParent_) {
return parent_->isImplicitNoneExternal();
} else {
return false; // default if not specified
}
}
const DeclTypeSpec *ImplicitRules::GetType(
SourceName name, bool respectImplicitNoneType) const {
char ch{name.begin()[0]};
if (isImplicitNoneType_ && respectImplicitNoneType) {
return nullptr;
} else if (auto it{map_.find(ch)}; it != map_.end()) {
return &*it->second;
} else if (inheritFromParent_) {
return parent_->GetType(name, respectImplicitNoneType);
} else if (ch >= 'i' && ch <= 'n') {
return &context_.MakeNumericType(TypeCategory::Integer);
} else if (ch >= 'a' && ch <= 'z') {
return &context_.MakeNumericType(TypeCategory::Real);
} else {
return nullptr;
}
}
void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
parser::Location fromLetter, parser::Location toLetter) {
for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
auto res{map_.emplace(ch, type)};
if (!res.second) {
context_.Say(parser::CharBlock{fromLetter},
"More than one implicit type specified for '%c'"_err_en_US, ch);
}
if (ch == *toLetter) {
break;
}
}
}
// Return the next char after ch in a way that works for ASCII or EBCDIC.
// Return '\0' for the char after 'z'.
char ImplicitRules::Incr(char ch) {
switch (ch) {
case 'i':
return 'j';
case 'r':
return 's';
case 'z':
return '\0';
default:
return ch + 1;
}
}
llvm::raw_ostream &operator<<(
llvm::raw_ostream &o, const ImplicitRules &implicitRules) {
o << "ImplicitRules:\n";
for (char ch = 'a'; ch; ch = ImplicitRules::Incr(ch)) {
ShowImplicitRule(o, implicitRules, ch);
}
ShowImplicitRule(o, implicitRules, '_');
ShowImplicitRule(o, implicitRules, '$');
ShowImplicitRule(o, implicitRules, '@');
return o;
}
void ShowImplicitRule(
llvm::raw_ostream &o, const ImplicitRules &implicitRules, char ch) {
auto it{implicitRules.map_.find(ch)};
if (it != implicitRules.map_.end()) {
o << " " << ch << ": " << *it->second << '\n';
}
}
template <typename T> void BaseVisitor::Walk(const T &x) {
parser::Walk(x, *this_);
}
void BaseVisitor::MakePlaceholder(
const parser::Name &name, MiscDetails::Kind kind) {
if (!name.symbol) {
name.symbol = &context_->globalScope().MakeSymbol(
name.source, Attrs{}, MiscDetails{kind});
}
}
// AttrsVisitor implementation
bool AttrsVisitor::BeginAttrs() {
CHECK(!attrs_);
attrs_ = std::make_optional<Attrs>();
return true;
}
Attrs AttrsVisitor::GetAttrs() {
CHECK(attrs_);
return *attrs_;
}
Attrs AttrsVisitor::EndAttrs() {
Attrs result{GetAttrs()};
attrs_.reset();
passName_ = std::nullopt;
bindName_.reset();
return result;
}
bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
if (!passName_) {
return false;
}
std::visit(common::visitors{
[&](ProcEntityDetails &x) { x.set_passName(*passName_); },
[&](ProcBindingDetails &x) { x.set_passName(*passName_); },
[](auto &) { common::die("unexpected pass name"); },
},
symbol.details());
return true;
}
void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
if (!attrs_ || !attrs_->test(Attr::BIND_C)) {
return;
}
std::optional<std::string> label{
evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
// 18.9.2(2): discard leading and trailing blanks, ignore if all blank
if (label) {
auto first{label->find_first_not_of(" ")};
if (first == std::string::npos) {
// Empty NAME= means no binding at all (18.10.2p2)
Say(currStmtSource().value(), "Blank binding label ignored"_en_US);
return;
}
auto last{label->find_last_not_of(" ")};
label = label->substr(first, last - first + 1);
} else {
label = parser::ToLowerCaseLetters(symbol.name().ToString());
}
symbol.SetBindName(std::move(*label));
}
void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
CHECK(attrs_);
if (CheckAndSet(Attr::BIND_C)) {
if (x.v) {
bindName_ = EvaluateExpr(*x.v);
}
}
}
bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
CHECK(attrs_);
CheckAndSet(IntentSpecToAttr(x));
return false;
}
bool AttrsVisitor::Pre(const parser::Pass &x) {
if (CheckAndSet(Attr::PASS)) {
if (x.v) {
passName_ = x.v->source;
MakePlaceholder(*x.v, MiscDetails::Kind::PassName);
}
}
return false;
}
// C730, C743, C755, C778, C1543 say no attribute or prefix repetitions
bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
if (attrs_->test(attrName)) {
Say(currStmtSource().value(),
"Attribute '%s' cannot be used more than once"_en_US,
AttrToString(attrName));
return true;
}
return false;
}
// See if attrName violates a constraint cause by a conflict. attr1 and attr2
// name attributes that cannot be used on the same declaration
bool AttrsVisitor::HaveAttrConflict(Attr attrName, Attr attr1, Attr attr2) {
if ((attrName == attr1 && attrs_->test(attr2)) ||
(attrName == attr2 && attrs_->test(attr1))) {
Say(currStmtSource().value(),
"Attributes '%s' and '%s' conflict with each other"_err_en_US,
AttrToString(attr1), AttrToString(attr2));
return true;
}
return false;
}
// C759, C1543
bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
return HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_INOUT) ||
HaveAttrConflict(attrName, Attr::INTENT_IN, Attr::INTENT_OUT) ||
HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE);
}
bool AttrsVisitor::CheckAndSet(Attr attrName) {
CHECK(attrs_);
if (IsConflictingAttr(attrName) || IsDuplicateAttr(attrName)) {
return false;
}
attrs_->set(attrName);
return true;
}
// DeclTypeSpecVisitor implementation
const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() {
return state_.declTypeSpec;
}
void DeclTypeSpecVisitor::BeginDeclTypeSpec() {
CHECK(!state_.expectDeclTypeSpec);
CHECK(!state_.declTypeSpec);
state_.expectDeclTypeSpec = true;
}
void DeclTypeSpecVisitor::EndDeclTypeSpec() {
CHECK(state_.expectDeclTypeSpec);
state_ = {};
}
void DeclTypeSpecVisitor::SetDeclTypeSpecCategory(
DeclTypeSpec::Category category) {
CHECK(state_.expectDeclTypeSpec);
state_.derived.category = category;
}
bool DeclTypeSpecVisitor::Pre(const parser::TypeGuardStmt &) {
BeginDeclTypeSpec();
return true;
}
void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
EndDeclTypeSpec();
}
void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
// Record the resolved DeclTypeSpec in the parse tree for use by
// expression semantics if the DeclTypeSpec is a valid TypeSpec.
// The grammar ensures that it's an intrinsic or derived type spec,
// not TYPE(*) or CLASS(*) or CLASS(T).
if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
switch (spec->category()) {
case DeclTypeSpec::Numeric:
case DeclTypeSpec::Logical:
case DeclTypeSpec::Character:
typeSpec.declTypeSpec = spec;
break;
case DeclTypeSpec::TypeDerived:
if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
CheckForAbstractType(derived->typeSymbol()); // C703
typeSpec.declTypeSpec = spec;
}
break;
default:
CRASH_NO_CASE;
}
}
}
void DeclTypeSpecVisitor::Post(
const parser::IntrinsicTypeSpec::DoublePrecision &) {
MakeNumericType(TypeCategory::Real, context().doublePrecisionKind());
}
void DeclTypeSpecVisitor::Post(
const parser::IntrinsicTypeSpec::DoubleComplex &) {
MakeNumericType(TypeCategory::Complex, context().doublePrecisionKind());
}
void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) {
SetDeclTypeSpec(context().MakeNumericType(category, kind));
}
void DeclTypeSpecVisitor::CheckForAbstractType(const Symbol &typeSymbol) {
if (typeSymbol.attrs().test(Attr::ABSTRACT)) {
Say("ABSTRACT derived type may not be used here"_err_en_US);
}
}
void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) {
SetDeclTypeSpec(context().globalScope().MakeClassStarType());
}
void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) {
SetDeclTypeSpec(context().globalScope().MakeTypeStarType());
}
// Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet)
// and save it in state_.declTypeSpec.
void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) {
CHECK(state_.expectDeclTypeSpec);
CHECK(!state_.declTypeSpec);
state_.declTypeSpec = &declTypeSpec;
}
KindExpr DeclTypeSpecVisitor::GetKindParamExpr(
TypeCategory category, const std::optional<parser::KindSelector> &kind) {
return AnalyzeKindSelector(context(), category, kind);
}
// MessageHandler implementation
Message &MessageHandler::Say(MessageFixedText &&msg) {
return context_->Say(currStmtSource().value(), std::move(msg));
}
Message &MessageHandler::Say(MessageFormattedText &&msg) {
return context_->Say(currStmtSource().value(), std::move(msg));
}
Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) {
return Say(name, std::move(msg), name);
}
// ImplicitRulesVisitor implementation
void ImplicitRulesVisitor::Post(const parser::ParameterStmt &) {
prevParameterStmt_ = currStmtSource();
}
bool ImplicitRulesVisitor::Pre(const parser::ImplicitStmt &x) {
bool result{
std::visit(common::visitors{
[&](const std::list<ImplicitNoneNameSpec> &y) {
return HandleImplicitNone(y);
},
[&](const std::list<parser::ImplicitSpec> &) {
if (prevImplicitNoneType_) {
Say("IMPLICIT statement after IMPLICIT NONE or "
"IMPLICIT NONE(TYPE) statement"_err_en_US);
return false;
}
implicitRules_->set_isImplicitNoneType(false);
return true;
},
},
x.u)};
prevImplicit_ = currStmtSource();
return result;
}
bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
auto loLoc{std::get<parser::Location>(x.t)};
auto hiLoc{loLoc};
if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
hiLoc = *hiLocOpt;
if (*hiLoc < *loLoc) {
Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
std::string(hiLoc, 1), std::string(loLoc, 1));
return false;
}
}
implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
return false;
}
bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
BeginDeclTypeSpec();
set_allowForwardReferenceToDerivedType(true);
return true;
}
void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
EndDeclTypeSpec();
}
void ImplicitRulesVisitor::SetScope(const Scope &scope) {
implicitRules_ = &DEREF(implicitRulesMap_).at(&scope);
prevImplicit_ = std::nullopt;
prevImplicitNone_ = std::nullopt;
prevImplicitNoneType_ = std::nullopt;
prevParameterStmt_ = std::nullopt;
}
void ImplicitRulesVisitor::BeginScope(const Scope &scope) {
// find or create implicit rules for this scope
DEREF(implicitRulesMap_).try_emplace(&scope, context(), implicitRules_);
SetScope(scope);
}
// TODO: for all of these errors, reference previous statement too
bool ImplicitRulesVisitor::HandleImplicitNone(
const std::list<ImplicitNoneNameSpec> &nameSpecs) {
if (prevImplicitNone_) {
Say("More than one IMPLICIT NONE statement"_err_en_US);
Say(*prevImplicitNone_, "Previous IMPLICIT NONE statement"_en_US);
return false;
}
if (prevParameterStmt_) {
Say("IMPLICIT NONE statement after PARAMETER statement"_err_en_US);
return false;
}
prevImplicitNone_ = currStmtSource();
bool implicitNoneTypeNever{
context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
if (nameSpecs.empty()) {
if (!implicitNoneTypeNever) {
prevImplicitNoneType_ = currStmtSource();
implicitRules_->set_isImplicitNoneType(true);
if (prevImplicit_) {
Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
return false;
}
}
} else {
int sawType{0};
int sawExternal{0};
for (const auto noneSpec : nameSpecs) {
switch (noneSpec) {
case ImplicitNoneNameSpec::External:
implicitRules_->set_isImplicitNoneExternal(true);
++sawExternal;
break;
case ImplicitNoneNameSpec::Type:
if (!implicitNoneTypeNever) {
prevImplicitNoneType_ = currStmtSource();
implicitRules_->set_isImplicitNoneType(true);
if (prevImplicit_) {
Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
return false;
}
++sawType;
}
break;
}
}
if (sawType > 1) {
Say("TYPE specified more than once in IMPLICIT NONE statement"_err_en_US);
return false;
}
if (sawExternal > 1) {
Say("EXTERNAL specified more than once in IMPLICIT NONE statement"_err_en_US);
return false;
}
}
return true;
}
// ArraySpecVisitor implementation
void ArraySpecVisitor::Post(const parser::ArraySpec &x) {
CHECK(arraySpec_.empty());
arraySpec_ = AnalyzeArraySpec(context(), x);
}
void ArraySpecVisitor::Post(const parser::ComponentArraySpec &x) {
CHECK(arraySpec_.empty());
arraySpec_ = AnalyzeArraySpec(context(), x);
}
void ArraySpecVisitor::Post(const parser::CoarraySpec &x) {
CHECK(coarraySpec_.empty());
coarraySpec_ = AnalyzeCoarraySpec(context(), x);
}
const ArraySpec &ArraySpecVisitor::arraySpec() {
return !arraySpec_.empty() ? arraySpec_ : attrArraySpec_;
}
const ArraySpec &ArraySpecVisitor::coarraySpec() {
return !coarraySpec_.empty() ? coarraySpec_ : attrCoarraySpec_;
}
void ArraySpecVisitor::BeginArraySpec() {
CHECK(arraySpec_.empty());
CHECK(coarraySpec_.empty());
CHECK(attrArraySpec_.empty());
CHECK(attrCoarraySpec_.empty());
}
void ArraySpecVisitor::EndArraySpec() {
CHECK(arraySpec_.empty());
CHECK(coarraySpec_.empty());
attrArraySpec_.clear();
attrCoarraySpec_.clear();
}
void ArraySpecVisitor::PostAttrSpec() {
// Save dimension/codimension from attrs so we can process array/coarray-spec
// on the entity-decl
if (!arraySpec_.empty()) {
if (attrArraySpec_.empty()) {
attrArraySpec_ = arraySpec_;
arraySpec_.clear();
} else {
Say(currStmtSource().value(),
"Attribute 'DIMENSION' cannot be used more than once"_err_en_US);
}
}
if (!coarraySpec_.empty()) {
if (attrCoarraySpec_.empty()) {
attrCoarraySpec_ = coarraySpec_;
coarraySpec_.clear();
} else {
Say(currStmtSource().value(),
"Attribute 'CODIMENSION' cannot be used more than once"_err_en_US);
}
}
}
// ScopeHandler implementation
void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
SayAlreadyDeclared(name.source, prev);
}
void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
if (context().HasError(prev)) {
// don't report another error about prev
} else {
if (const auto *details{prev.detailsIf<UseDetails>()}) {
Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
.Attach(details->location(),
"It is use-associated with '%s' in module '%s'"_err_en_US,
details->symbol().name(), GetUsedModule(*details).name());
} else {
SayAlreadyDeclared(name, prev.name());
}
context().SetError(prev);
}
}
void ScopeHandler::SayAlreadyDeclared(
const SourceName &name1, const SourceName &name2) {
if (name1.begin() < name2.begin()) {
SayAlreadyDeclared(name2, name1);
} else {
Say(name1, "'%s' is already declared in this scoping unit"_err_en_US)
.Attach(name2, "Previous declaration of '%s'"_en_US, name2);
}
}
void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
MessageFixedText &&msg1, MessageFixedText &&msg2) {
Say2(name, std::move(msg1), symbol, std::move(msg2));
context().SetError(symbol, msg1.isFatal());
}
void ScopeHandler::SayWithDecl(
const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
SayWithReason(name, symbol, std::move(msg),
symbol.test(Symbol::Flag::Implicit) ? "Implicit declaration of '%s'"_en_US
: "Declaration of '%s'"_en_US);
}
void ScopeHandler::SayLocalMustBeVariable(
const parser::Name &name, Symbol &symbol) {
SayWithDecl(name, symbol,
"The name '%s' must be a variable to appear"
" in a locality-spec"_err_en_US);
}
void ScopeHandler::SayDerivedType(
const SourceName &name, MessageFixedText &&msg, const Scope &type) {
const Symbol &typeSymbol{DEREF(type.GetSymbol())};
Say(name, std::move(msg), name, typeSymbol.name())
.Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
typeSymbol.name());
}
void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
const SourceName &name2, MessageFixedText &&msg2) {
Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
}
void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
Symbol &symbol, MessageFixedText &&msg2) {
Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
context().SetError(symbol, msg1.isFatal());
}
void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
Symbol &symbol, MessageFixedText &&msg2) {
Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
context().SetError(symbol, msg1.isFatal());
}
// This is essentially GetProgramUnitContaining(), but it can return
// a mutable Scope &, it ignores statement functions, and it fails
// gracefully for error recovery (returning the original Scope).
template <typename T> static T &GetInclusiveScope(T &scope) {
for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
switch (s->kind()) {
case Scope::Kind::Module:
case Scope::Kind::MainProgram:
case Scope::Kind::Subprogram:
case Scope::Kind::BlockData:
if (!s->IsStmtFunction()) {
return *s;
}
break;
default:;
}
}
return scope;
}
Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); }
Scope *ScopeHandler::GetHostProcedure() {
Scope &parent{InclusiveScope().parent()};
switch (parent.kind()) {
case Scope::Kind::Subprogram:
return &parent;
case Scope::Kind::MainProgram:
return &parent;
default:
return nullptr;
}
}
Scope &ScopeHandler::NonDerivedTypeScope() {
return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
}
void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
PushScope(currScope().MakeScope(kind, symbol));
}
void ScopeHandler::PushScope(Scope &scope) {
currScope_ = &scope;
auto kind{currScope_->kind()};
if (kind != Scope::Kind::Block) {
BeginScope(scope);
}
// The name of a module or submodule cannot be "used" in its scope,
// as we read 19.3.1(2), so we allow the name to be used as a local
// identifier in the module or submodule too. Same with programs
// (14.1(3)) and BLOCK DATA.
if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
if (auto *symbol{scope.symbol()}) {
// Create a dummy symbol so we can't create another one with the same
// name. It might already be there if we previously pushed the scope.
if (!FindInScope(scope, symbol->name())) {
auto &newSymbol{MakeSymbol(symbol->name())};
if (kind == Scope::Kind::Subprogram) {
// Allow for recursive references. If this symbol is a function
// without an explicit RESULT(), this new symbol will be discarded
// and replaced with an object of the same name.
newSymbol.set_details(HostAssocDetails{*symbol});
} else {
newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
}
}
}
}
}
void ScopeHandler::PopScope() {
// Entities that are not yet classified as objects or procedures are now
// assumed to be objects.
// TODO: Statement functions
for (auto &pair : currScope()) {
ConvertToObjectEntity(*pair.second);
}
SetScope(currScope_->parent());
}
void ScopeHandler::SetScope(Scope &scope) {
currScope_ = &scope;
ImplicitRulesVisitor::SetScope(InclusiveScope());
}
Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
return FindSymbol(currScope(), name);
}
Symbol *ScopeHandler::FindSymbol(const Scope &scope, const parser::Name &name) {
if (scope.IsDerivedType()) {
if (Symbol * symbol{scope.FindComponent(name.source)}) {
if (!symbol->has<ProcBindingDetails>() &&
!symbol->test(Symbol::Flag::ParentComp)) {
return Resolve(name, symbol);
}
}
return FindSymbol(scope.parent(), name);
} else {
// In EQUIVALENCE statements only resolve names in the local scope, see
// 19.5.1.4, paragraph 2, item (10)
return Resolve(name,
inEquivalenceStmt_ ? FindInScope(scope, name)
: scope.FindSymbol(name.source));
}
}
Symbol &ScopeHandler::MakeSymbol(
Scope &scope, const SourceName &name, Attrs attrs) {
if (Symbol * symbol{FindInScope(scope, name)}) {
symbol->attrs() |= attrs;
return *symbol;
} else {
const auto pair{scope.try_emplace(name, attrs, UnknownDetails{})};
CHECK(pair.second); // name was not found, so must be able to add
return *pair.first->second;
}
}
Symbol &ScopeHandler::MakeSymbol(const SourceName &name, Attrs attrs) {
return MakeSymbol(currScope(), name, attrs);
}
Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
return Resolve(name, MakeSymbol(name.source, attrs));
}
Symbol &ScopeHandler::MakeHostAssocSymbol(
const parser::Name &name, const Symbol &hostSymbol) {
Symbol &symbol{*NonDerivedTypeScope()
.try_emplace(name.source, HostAssocDetails{hostSymbol})
.first->second};
name.symbol = &symbol;
symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
symbol.flags() = hostSymbol.flags();
return symbol;
}
Symbol &ScopeHandler::CopySymbol(const SourceName &name, const Symbol &symbol) {
CHECK(!FindInScope(name));
return MakeSymbol(currScope(), name, symbol.attrs());
}
// Look for name only in scope, not in enclosing scopes.
Symbol *ScopeHandler::FindInScope(
const Scope &scope, const parser::Name &name) {
return Resolve(name, FindInScope(scope, name.source));
}
Symbol *ScopeHandler::FindInScope(const Scope &scope, const SourceName &name) {
// all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
for (const std::string &n : GetAllNames(context(), name)) {
auto it{scope.find(SourceName{n})};
if (it != scope.end()) {
return &*it->second;
}
}
return nullptr;
}
// Find a component or type parameter by name in a derived type or its parents.
Symbol *ScopeHandler::FindInTypeOrParents(
const Scope &scope, const parser::Name &name) {
return Resolve(name, scope.FindComponent(name.source));
}
Symbol *ScopeHandler::FindInTypeOrParents(const parser::Name &name) {
return FindInTypeOrParents(currScope(), name);
}
void ScopeHandler::EraseSymbol(const parser::Name &name) {
currScope().erase(name.source);
name.symbol = nullptr;
}
static bool NeedsType(const Symbol &symbol) {
return !symbol.GetType() &&
std::visit(common::visitors{
[](const EntityDetails &) { return true; },
[](const ObjectEntityDetails &) { return true; },
[](const AssocEntityDetails &) { return true; },
[&](const ProcEntityDetails &p) {
return symbol.test(Symbol::Flag::Function) &&
!symbol.attrs().test(Attr::INTRINSIC) &&
!p.interface().type() && !p.interface().symbol();
},
[](const auto &) { return false; },
},
symbol.details());
}
void ScopeHandler::ApplyImplicitRules(
Symbol &symbol, bool allowForwardReference) {
if (context().HasError(symbol) || !NeedsType(symbol)) {
return;
}
if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
symbol.set(Symbol::Flag::Implicit);
symbol.SetType(*type);
return;
}
if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
std::optional<Symbol::Flag> functionOrSubroutineFlag;
if (symbol.test(Symbol::Flag::Function)) {
functionOrSubroutineFlag = Symbol::Flag::Function;
} else if (symbol.test(Symbol::Flag::Subroutine)) {
functionOrSubroutineFlag = Symbol::Flag::Subroutine;
}
if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
// type will be determined in expression semantics
AcquireIntrinsicProcedureFlags(symbol);
return;
}
}
if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
return;
}
if (!context().HasError(symbol)) {
Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
context().SetError(symbol);
}
}
// Extension: Allow forward references to scalar integer dummy arguments
// to appear in specification expressions under IMPLICIT NONE(TYPE) when
// what would otherwise have been their implicit type is default INTEGER.
bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
if (!inSpecificationPart_ || context().HasError(symbol) || !IsDummy(symbol) ||
symbol.Rank() != 0 ||
!context().languageFeatures().IsEnabled(
common::LanguageFeature::ForwardRefDummyImplicitNone)) {
return false;
}
const DeclTypeSpec *type{
GetImplicitType(symbol, false /*ignore IMPLICIT NONE*/)};
if (!type || !type->IsNumeric(TypeCategory::Integer)) {
return false;
}
auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
return false;
}
if (!ConvertToObjectEntity(symbol)) {
return false;
}
// TODO: check no INTENT(OUT)?
if (context().languageFeatures().ShouldWarn(
common::LanguageFeature::ForwardRefDummyImplicitNone)) {
Say(symbol.name(),
"Dummy argument '%s' was used without being explicitly typed"_en_US,
symbol.name());
}
symbol.set(Symbol::Flag::Implicit);
symbol.SetType(*type);
return true;
}
// Ensure that the symbol for an intrinsic procedure is marked with
// the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as
// appropriate.
void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
symbol.attrs().set(Attr::INTRINSIC);
switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {
case evaluate::IntrinsicClass::elementalFunction:
case evaluate::IntrinsicClass::elementalSubroutine:
symbol.attrs().set(Attr::ELEMENTAL);
symbol.attrs().set(Attr::PURE);
break;
case evaluate::IntrinsicClass::impureSubroutine:
break;
default:
symbol.attrs().set(Attr::PURE);
}
}
const DeclTypeSpec *ScopeHandler::GetImplicitType(
Symbol &symbol, bool respectImplicitNoneType) {
const Scope *scope{&symbol.owner()};
if (scope->IsGlobal()) {
scope = &currScope();
}
scope = &GetInclusiveScope(*scope);
const auto *type{implicitRulesMap_->at(scope).GetType(
symbol.name(), respectImplicitNoneType)};
if (type) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
// Resolve any forward-referenced derived type; a quick no-op else.
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(currScope());
}
}
return type;
}
// Convert symbol to be a ObjectEntity or return false if it can't be.
bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
if (symbol.has<ObjectEntityDetails>()) {
// nothing to do
} else if (symbol.has<UnknownDetails>()) {
symbol.set_details(ObjectEntityDetails{});
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
symbol.set_details(ObjectEntityDetails{std::move(*details)});
} else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
return useDetails->symbol().has<ObjectEntityDetails>();
} else {
return false;
}
return true;
}
// Convert symbol to be a ProcEntity or return false if it can't be.
bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
if (symbol.has<ProcEntityDetails>()) {
// nothing to do
} else if (symbol.has<UnknownDetails>()) {
symbol.set_details(ProcEntityDetails{});
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
symbol.set_details(ProcEntityDetails{std::move(*details)});
if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
CHECK(!symbol.test(Symbol::Flag::Subroutine));
symbol.set(Symbol::Flag::Function);
}
} else {
return false;
}
return true;
}
const DeclTypeSpec &ScopeHandler::MakeNumericType(
TypeCategory category, const std::optional<parser::KindSelector> &kind) {
KindExpr value{GetKindParamExpr(category, kind)};
if (auto known{evaluate::ToInt64(value)}) {
return context().MakeNumericType(category, static_cast<int>(*known));
} else {
return currScope_->MakeNumericType(category, std::move(value));
}
}
const DeclTypeSpec &ScopeHandler::MakeLogicalType(
const std::optional<parser::KindSelector> &kind) {
KindExpr value{GetKindParamExpr(TypeCategory::Logical, kind)};
if (auto known{evaluate::ToInt64(value)}) {
return context().MakeLogicalType(static_cast<int>(*known));
} else {
return currScope_->MakeLogicalType(std::move(value));
}
}
void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
if (inSpecificationPart_ && name.symbol) {
auto kind{currScope().kind()};
if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
kind == Scope::Kind::Block) {
bool isHostAssociated{&name.symbol->owner() == &currScope()
? name.symbol->has<HostAssocDetails>()
: name.symbol->owner().Contains(currScope())};
if (isHostAssociated) {
specPartState_.forwardRefs.insert(name.source);
}
}
}
}
std::optional<SourceName> ScopeHandler::HadForwardRef(
const Symbol &symbol) const {
auto iter{specPartState_.forwardRefs.find(symbol.name())};
if (iter != specPartState_.forwardRefs.end()) {
return *iter;
}
return std::nullopt;
}
bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
if (!context().HasError(symbol)) {
if (auto fwdRef{HadForwardRef(symbol)}) {
const Symbol *outer{symbol.owner().FindSymbol(symbol.name())};
if (outer && symbol.has<UseDetails>() &&
&symbol.GetUltimate() == &outer->GetUltimate()) {
// e.g. IMPORT of host's USE association
return false;
}
Say(*fwdRef,
"Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
*fwdRef)
.Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
context().SetError(symbol);
return true;
}
if (IsDummy(symbol) && isImplicitNoneType() &&
symbol.test(Symbol::Flag::Implicit) && !context().HasError(symbol)) {
// Dummy was implicitly typed despite IMPLICIT NONE(TYPE) in
// ApplyImplicitRules() due to use in a specification expression,
// and no explicit type declaration appeared later.
Say(symbol.name(),
"No explicit type declared for dummy argument '%s'"_err_en_US);
context().SetError(symbol);
return true;
}
}
return false;
}
void ScopeHandler::MakeExternal(Symbol &symbol) {
if (!symbol.attrs().test(Attr::EXTERNAL)) {
symbol.attrs().set(Attr::EXTERNAL);
if (symbol.attrs().test(Attr::INTRINSIC)) { // C840
Say(symbol.name(),
"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
symbol.name());
}
}
}
// ModuleVisitor implementation
bool ModuleVisitor::Pre(const parser::Only &x) {
std::visit(common::visitors{
[&](const Indirection<parser::GenericSpec> &generic) {
GenericSpecInfo genericSpecInfo{generic.value()};
AddUseOnly(genericSpecInfo.symbolName());
AddUse(genericSpecInfo);
},
[&](const parser::Name &name) {
AddUseOnly(name.source);
Resolve(name, AddUse(name.source, name.source).use);
},
[&](const parser::Rename &rename) { Walk(rename); },
},
x.u);
return false;
}
bool ModuleVisitor::Pre(const parser::Rename::Names &x) {
const auto &localName{std::get<0>(x.t)};
const auto &useName{std::get<1>(x.t)};
AddUseRename(useName.source);
SymbolRename rename{AddUse(localName.source, useName.source)};
if (rename.use) {
EraseRenamedSymbol(*rename.use);
}
Resolve(useName, rename.use);
Resolve(localName, rename.local);
return false;
}
bool ModuleVisitor::Pre(const parser::Rename::Operators &x) {
const parser::DefinedOpName &local{std::get<0>(x.t)};
const parser::DefinedOpName &use{std::get<1>(x.t)};
GenericSpecInfo localInfo{local};
GenericSpecInfo useInfo{use};
if (IsIntrinsicOperator(context(), local.v.source)) {
Say(local.v,
"Intrinsic operator '%s' may not be used as a defined operator"_err_en_US);
} else if (IsLogicalConstant(context(), local.v.source)) {
Say(local.v,
"Logical constant '%s' may not be used as a defined operator"_err_en_US);
} else {
SymbolRename rename{AddUse(localInfo.symbolName(), useInfo.symbolName())};
if (rename.use) {
EraseRenamedSymbol(*rename.use);
}
useInfo.Resolve(rename.use);
localInfo.Resolve(rename.local);
}
return false;
}
// Set useModuleScope_ to the Scope of the module being used.
bool ModuleVisitor::Pre(const parser::UseStmt &x) {
useModuleScope_ = FindModule(x.moduleName);
if (!useModuleScope_) {
return false;
}
// use the name from this source file
useModuleScope_->symbol()->ReplaceName(x.moduleName.source);
return true;
}
void ModuleVisitor::Post(const parser::UseStmt &x) {
if (const auto *list{std::get_if<std::list<parser::Rename>>(&x.u)}) {
// Not a use-only: collect the names that were used in renames,
// then add a use for each public name that was not renamed.
std::set<SourceName> useNames;
for (const auto &rename : *list) {
std::visit(common::visitors{
[&](const parser::Rename::Names &names) {
useNames.insert(std::get<1>(names.t).source);
},
[&](const parser::Rename::Operators &ops) {
useNames.insert(std::get<1>(ops.t).v.source);
},
},
rename.u);
}
for (const auto &[name, symbol] : *useModuleScope_) {
if (symbol->attrs().test(Attr::PUBLIC) && !IsUseRenamed(symbol->name()) &&
(!symbol->attrs().test(Attr::INTRINSIC) ||
symbol->has<UseDetails>()) &&
!symbol->has<MiscDetails>() && useNames.count(name) == 0) {
SourceName location{x.moduleName.source};
if