| //===-- 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 |