From 6acfa11fdaedff16a0e5ca021aa6b34d3c29915c Mon Sep 17 00:00:00 2001 From: peter klausler Date: Mon, 4 Mar 2019 10:13:12 -0800 Subject: [PATCH] [flang] Add lib/semantics/tools.{h,cc} Original-commit: flang-compiler/f18@c9823da20746313005ee017413f8207a720a10b0 Reviewed-on: https://github.com/flang-compiler/f18/pull/311 Tree-same-pre-rewrite: false --- flang/lib/semantics/tools.cc | 212 +++++++++++++++++++++++++++++++++++++++++++ flang/lib/semantics/tools.h | 74 +++++++++++++++ 2 files changed, 286 insertions(+) create mode 100644 flang/lib/semantics/tools.cc create mode 100644 flang/lib/semantics/tools.h diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc new file mode 100644 index 0000000..90d539b1 --- /dev/null +++ b/flang/lib/semantics/tools.cc @@ -0,0 +1,212 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "tools.h" +#include "scope.h" +#include "../evaluate/variable.h" +#include +#include +#include + +namespace Fortran::semantics { + +static const Symbol *FindCommonBlockInScope( + const Scope &scope, const Symbol &object) { + for (const auto &pair : scope.commonBlocks()) { + const Symbol &block{*pair.second}; + if (IsCommonBlockContaining(block, object)) { + return █ + } + } + return nullptr; +} + +const Symbol *FindCommonBlockContaining(const Symbol &object) { + for (const Scope *scope{&object.owner()}; + scope->kind() != Scope::Kind::Global; scope = &scope->parent()) { + if (const Symbol * block{FindCommonBlockInScope(*scope, object)}) { + return block; + } + } + return nullptr; +} + +const Scope *FindProgramUnitContaining(const Scope &start) { + const Scope *scope{&start}; + while (scope != nullptr) { + switch (scope->kind()) { + case Scope::Kind::Module: + case Scope::Kind::MainProgram: + case Scope::Kind::Subprogram: return scope; + case Scope::Kind::Global: + case Scope::Kind::System: return nullptr; + case Scope::Kind::DerivedType: + case Scope::Kind::Block: + case Scope::Kind::Forall: + case Scope::Kind::ImpliedDos: scope = &scope->parent(); + } + } + return nullptr; +} + +const Scope *FindProgramUnitContaining(const Symbol &symbol) { + return FindProgramUnitContaining(symbol.owner()); +} + +const Scope *FindPureFunctionContaining(const Scope *scope) { + scope = FindProgramUnitContaining(*scope); + while (scope != nullptr) { + if (IsPureFunction(*scope)) { + return scope; + } + scope = FindProgramUnitContaining(scope->parent()); + } + return nullptr; +} + +bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) { + const auto &objects{block.get().objects()}; + auto found{std::find(objects.begin(), objects.end(), &object)}; + return found != objects.end(); +} + +bool IsUseAssociated(const Symbol &symbol, const Scope &scope) { + const Scope *owner{FindProgramUnitContaining(symbol.GetUltimate().owner())}; + return owner != nullptr && owner->kind() == Scope::Kind::Module && + owner != FindProgramUnitContaining(scope); +} + +bool IsAncestor(const Scope *maybeAncestor, const Scope &maybeDescendent) { + if (maybeAncestor == nullptr) { + return false; + } + const Scope *scope{&maybeDescendent}; + while (scope->kind() != Scope::Kind::Global) { + scope = &scope->parent(); + if (scope == maybeAncestor) { + return true; + } + } + return false; +} + +bool IsHostAssociated(const Symbol &symbol, const Scope &scope) { + return IsAncestor(FindProgramUnitContaining(symbol), scope); +} + +bool IsDummy(const Symbol &symbol) { + if (const auto *details{symbol.detailsIf()}) { + return details->isDummy(); + } else if (const auto *details{symbol.detailsIf()}) { + return details->isDummy(); + } else { + return false; + } +} + +bool IsPointerDummy(const Symbol &symbol) { + return symbol.attrs().test(Attr::POINTER) && IsDummy(symbol); +} + +bool IsFunction(const Symbol &symbol) { + if (const auto *procDetails{symbol.detailsIf()}) { + return procDetails->interface().type() != nullptr || + (procDetails->interface().symbol() != nullptr && + IsFunction(*procDetails->interface().symbol())); + } else if (const auto *subprogram{symbol.detailsIf()}) { + return subprogram->isFunction(); + } else { + return false; + } +} + +bool IsPureFunction(const Symbol &symbol) { + return symbol.attrs().test(Attr::PURE) && IsFunction(symbol); +} + +bool IsPureFunction(const Scope &scope) { + if (const Symbol * symbol{scope.GetSymbol()}) { + return IsPureFunction(*symbol); + } else { + return false; + } +} + +static bool HasPointerComponent( + const Scope &scope, std::set &visited) { + if (scope.kind() != Scope::Kind::DerivedType) { + return false; + } + if (!visited.insert(&scope).second) { + return false; + } + for (const auto &pair : scope) { + const Symbol &symbol{*pair.second}; + if (symbol.attrs().test(Attr::POINTER)) { + return true; + } + if (const auto *details{symbol.detailsIf()}) { + if (const DeclTypeSpec * type{details->type()}) { + if (const DerivedTypeSpec * derived{type->AsDerived()}) { + if (const Scope * nested{derived->scope()}) { + if (HasPointerComponent(*nested, visited)) { + return true; + } + } + } + } + } + } + return false; +} + +bool HasPointerComponent(const Scope &scope) { + std::set visited; + return HasPointerComponent(scope, visited); +} + +bool HasPointerComponent(const DerivedTypeSpec &derived) { + if (const Scope * scope{derived.scope()}) { + return HasPointerComponent(*scope); + } else { + return false; + } +} + +bool HasPointerComponent(const DeclTypeSpec &type) { + if (const DerivedTypeSpec * derived{type.AsDerived()}) { + return HasPointerComponent(*derived); + } else { + return false; + } +} + +bool HasPointerComponent(const DeclTypeSpec *type) { + return type != nullptr && HasPointerComponent(*type); +} + +bool IsOrHasPointerComponent(const Symbol &symbol) { + return symbol.attrs().test(Attr::POINTER) || + HasPointerComponent(symbol.GetType()); +} + +// C1594 specifies several ways by which an object might be globally visible. +bool IsExternallyVisibleObject(const Symbol &object, const Scope &scope) { + return IsUseAssociated(object, scope) || IsHostAssociated(object, scope) || + (IsPureFunction(scope) && IsPointerDummy(object)) || + (object.attrs().test(Attr::INTENT_IN) && IsDummy(object)) || + FindCommonBlockContaining(object) != nullptr; + // TODO: Storage association with any object for which this predicate holds +} +} diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h new file mode 100644 index 0000000..f9b04bb --- /dev/null +++ b/flang/lib/semantics/tools.h @@ -0,0 +1,74 @@ +// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#ifndef FORTRAN_SEMANTICS_TOOLS_H_ +#define FORTRAN_SEMANTICS_TOOLS_H_ + +// Simple predicates and look-up functions that are best defined +// canonically for use in semantic checking. + +#include "scope.h" +#include "symbol.h" +#include "type.h" +#include "../evaluate/variable.h" + +namespace Fortran::semantics { + +const Symbol *FindCommonBlockContaining(const Symbol &object); +const Scope *FindProgramUnitContaining(const Scope &); +const Scope *FindProgramUnitContaining(const Symbol &); +const Scope *FindPureFunctionContaining(const Scope *); + +bool IsCommonBlockContaining(const Symbol &block, const Symbol &object); +bool IsAncestor(const Scope *maybeAncestor, const Scope &maybeDescendent); +bool IsUseAssociated(const Symbol *, const Scope &); +bool IsHostAssociated(const Symbol &, const Scope &); +bool IsDummy(const Symbol &); +bool IsPointerDummy(const Symbol &); +bool IsFunction(const Symbol &); +bool IsPureFunction(const Symbol &); +bool IsPureFunction(const Scope &); +bool HasPointerComponent(const Scope &); +bool HasPointerComponent(const DerivedTypeSpec &); +bool HasPointerComponent(const DeclTypeSpec &); +bool IsOrHasPointerComponent(const Symbol &); + +// Determines whether an object might be visible outside a +// PURE function (C1594) +bool IsExternallyVisibleObject(const Symbol &, const Scope &); + +template bool IsExternallyVisibleObject(const A &, const Scope &) { + return false; // default base case +} + +template +bool IsExternallyVisibleObject( + const evaluate::Designator &designator, const Scope &scope) { + if (const Symbol * symbol{designator.GetBaseObject().symbol()}) { + return IsExternallyVisibleObject(*symbol, scope); + } else { + // Coindexed values are visible even if their image-local objects are not. + return std::holds_alternative(designator.u); + } +} + +template +bool IsExternallyVisibleObject( + const evaluate::Expr &expr, const Scope &scope) { + return std::visit( + [&](const auto &x) { return IsExternallyVisibleObject(x, scope); }, + expr.u); +} +} +#endif // FORTRAN_SEMANTICS_TOOLS_H_ -- 2.7.4