squiid/llvm
1
0
Fork 0
Code Issues Pull requests Activity

[flang] Better name resolution for intrinsics

Browse source 
Original-commit: flang-compiler/f18@31fd9c82e9
Reviewed-on: https://github.com/flang-compiler/f18/pull/561
This commit is contained in:
peter klausler 2019-07-11 11:34:01 -07:00
parent eb97418b2d
commit 20dd13e492
6 changed files with 39 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
flang/lib/evaluate/characteristics.cc
View file

@ -371,6 +371,10 @@ std::optional<Procedure> Procedure::Characterize(
},
[&](const semantics::ProcEntityDetails &proc)
-> std::optional<Procedure> {
if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
return intrinsics.IsUnrestrictedSpecificIntrinsicFunction(
symbol.name().ToString());
}
const semantics::ProcInterface &interface{proc.interface()};
if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
auto characterized{Characterize(*interfaceSymbol, intrinsics)};
@ -403,21 +407,11 @@ std::optional<Procedure> Procedure::Characterize(
[&](const semantics::ProcBindingDetails &binding) {
return Characterize(binding.symbol(), intrinsics);
},
[&](const semantics::MiscDetails &misc) -> std::optional<Procedure> {
if (misc.kind() ==
semantics::MiscDetails::Kind::SpecificIntrinsic) {
return intrinsics.IsUnrestrictedSpecificIntrinsicFunction(
symbol.name().ToString());
} else {
return std::nullopt;
}
},
[](const semantics::GenericDetails &) -> std::optional<Procedure> {
return std::nullopt;
},
[](const semantics::GenericBindingDetails &) -> std::optional<Procedure> {
return std::nullopt;
},
[](const semantics::GenericBindingDetails &)
-> std::optional<Procedure> { return std::nullopt; },
[](const auto &) -> std::optional<Procedure> { CRASH_NO_CASE; },
},
symbol.details());

8
flang/lib/semantics/expression.cc
View file

@ -1449,17 +1449,15 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
return std::nullopt;
}
const Symbol &symbol{n.symbol->GetUltimate()};
if (!symbol.HasExplicitInterface() ||
(symbol.has<semantics::MiscDetails>() &&
symbol.get<semantics::MiscDetails>().kind() ==
semantics::MiscDetails::Kind::SpecificIntrinsic)) {
// Might be an intrinsic.
if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(CallCharacteristics{n.source},
arguments, GetFoldingContext())}) {
return CalleeAndArguments{ProcedureDesignator{std::move(
specificCall->specificIntrinsic)},
std::move(specificCall->arguments)};
} else {
return std::nullopt;
}
}
if (symbol.HasExplicitInterface()) {

37
flang/lib/semantics/resolve-names.cc
View file

@ -1697,6 +1697,7 @@ static bool NeedsType(const Symbol &symbol) {
[](const AssocEntityDetails &) { return true; },
[&](const ProcEntityDetails &p) {
return symbol.test(Symbol::Flag::Function) &&
!symbol.attrs().test(Attr::INTRINSIC) &&
p.interface().type() == nullptr &&
p.interface().symbol() == nullptr;
},
@ -1708,8 +1709,10 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
if (NeedsType(symbol)) {
if (isImplicitNoneType()) {
if (symbol.has<ProcEntityDetails>() &&
!symbol.attrs().test(Attr::EXTERNAL) &&
context().intrinsics().IsIntrinsic(symbol.name().ToString())) {
// type will be determined in expression semantics
symbol.attrs().set(Attr::INTRINSIC);
} else {
Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
}
@ -3716,13 +3719,9 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
.has_value()) {
// Unrestricted specific intrinsic function names (e.g., "cos")
// are acceptable as procedure interfaces.
Scope *scope{&currScope()};
while (scope->kind() == Scope::Kind::DerivedType) {
scope = &scope->parent();
}
Symbol &symbol{MakeSymbol(*scope, name.source, Attrs{Attr::INTRINSIC})};
symbol.set_details(MiscDetails{MiscDetails::Kind::SpecificIntrinsic});
CHECK(symbol.HasExplicitInterface());
Symbol &symbol{
MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
symbol.set_details(ProcEntityDetails{});
Resolve(name, symbol);
return true;
} else {
@ -4751,20 +4750,26 @@ void ResolveNamesVisitor::HandleProcedureName(
CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
auto *symbol{FindSymbol(name)};
if (symbol == nullptr) {
symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
Attrs attrs;
if (context().intrinsics().IsIntrinsic(name.source.ToString())) {
attrs.set(Attr::INTRINSIC);
}
symbol = &MakeSymbol(context().globalScope(), name.source, attrs);
Resolve(name, *symbol);
if (symbol->has<ModuleDetails>()) {
SayWithDecl(name, *symbol,
"Use of '%s' as a procedure conflicts with its declaration"_err_en_US);
return;
}
if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
Say(name,
"'%s' is an external procedure without the EXTERNAL"
" attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
return;
if (!symbol->attrs().test(Attr::INTRINSIC)) {
if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
Say(name,
"'%s' is an external procedure without the EXTERNAL"
" attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
return;
}
MakeExternal(*symbol);
}
MakeExternal(*symbol);
if (!symbol->has<ProcEntityDetails>()) {
ConvertToProcEntity(*symbol);
}
@ -4779,9 +4784,7 @@ void ResolveNamesVisitor::HandleProcedureName(
if (!SetProcFlag(name, *symbol, flag)) {
return; // reported error
}
if (symbol->has<SubprogramNameDetails>() || symbol->has<GenericDetails>() ||
symbol->has<DerivedTypeDetails>() || symbol->has<SubprogramDetails>() ||
symbol->has<ProcEntityDetails>() ||
if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
symbol->has<ObjectEntityDetails>()) {
// these are all valid as procedure-designators
} else if (symbol->test(Symbol::Flag::Implicit)) {

11
flang/lib/semantics/symbol.h
View file

@ -326,8 +326,8 @@ class FinalProcDetails {};
class MiscDetails {
public:
ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe,
ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName,
SpecificIntrinsic);
ComplexPartIm, KindParamInquiry, LenParamInquiry,
SelectTypeAssociateName);
MiscDetails(Kind kind) : kind_{kind} {}
Kind kind() const { return kind_; }
@ -540,13 +540,12 @@ public:
common::visitors{
[](const SubprogramDetails &) { return true; },
[](const SubprogramNameDetails &) { return true; },
[](const ProcEntityDetails &x) { return x.HasExplicitInterface(); },
[&](const ProcEntityDetails &x) {
return attrs_.test(Attr::INTRINSIC) || x.HasExplicitInterface();
},
[](const UseDetails &x) {
return x.symbol().HasExplicitInterface();
},
[](const MiscDetails &x) {
return x.kind() == MiscDetails::Kind::SpecificIntrinsic;
},
[](const auto &) { return false; },
},
details_);

8
flang/test/semantics/procinterface01.f90
View file

@ -66,13 +66,13 @@ module module1
!DEF: /module1/derived1/p5 NOPASS, POINTER ProcEntity COMPLEX(4)
!DEF: /module1/nested4 PUBLIC Subprogram COMPLEX(4)
procedure(complex), pointer, nopass :: p5 => nested4
!DEF: /module1/sin INTRINSIC, PUBLIC ProcEntity
!DEF: /module1/derived1/p6 NOPASS, POINTER ProcEntity
!REF: /module1/nested1
! NOTE: sin is not dumped as a DEF here because specific
! intrinsic functions are represented with MiscDetails
! and those are omitted from dumping.
procedure(sin), pointer, nopass :: p6 => nested1
!REF: /module1/sin
!DEF: /module1/derived1/p7 NOPASS, POINTER ProcEntity
!DEF: /module1/cos INTRINSIC, PUBLIC ProcEntity
procedure(sin), pointer, nopass :: p7 => cos
!REF: /module1/tan
!DEF: /module1/derived1/p8 NOPASS, POINTER ProcEntity CHARACTER(1_4,1)
@ -118,7 +118,7 @@ contains
!REF: /module1/nested4/x
real, intent(in) :: x
!DEF: /module1/nested4/nested4 ObjectEntity COMPLEX(4)
!DEF: /cmplx EXTERNAL (implicit) ProcEntity REAL(4)
!DEF: /cmplx INTRINSIC ProcEntity
!REF: /module1/nested4/x
nested4 = cmplx(x+4., 6.)
end function nested4

2
flang/test/semantics/symbol13.f90
View file

@ -23,7 +23,7 @@ character*1 function f1(x1, x2)
!REF: /f1/n
!REF: /f1/x1
!REF: /f1/x2
!DEF: /len EXTERNAL (implicit) ProcEntity INTEGER(4)
!DEF: /len INTRINSIC ProcEntity
character*(n), intent(in) :: x1, x2*(len(x1)+1)
!DEF: /f1/t DerivedType
type :: t