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

[flang] Eliminating old default type declarations

Browse source 
Original-commit: flang-compiler/f18@10e4a3385a
Reviewed-on: https://github.com/flang-compiler/f18/pull/213
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2018-10-15 17:11:24 -07:00
parent bf339f8d47
commit d2f36b9d76
14 changed files with 162 additions and 110 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

88
flang/lib/evaluate/tools.cc
View file

@ -160,34 +160,35 @@ Expr<SomeReal> GetComplexPart(const Expr<SomeComplex> &z, bool isImaginary) {
template<template<typename> class OPR, TypeCategory RCAT>
std::optional<Expr<SomeType>> MixedComplexLeft(
parser::ContextualMessages &messages, Expr<SomeComplex> &&zx,
Expr<SomeKind<RCAT>> &&iry) {
Expr<SomeKind<RCAT>> &&iry, int defaultRealKind) {
Expr<SomeReal> zr{GetComplexPart(zx, false)};
Expr<SomeReal> zi{GetComplexPart(zx, true)};
if constexpr (std::is_same_v<OPR<DefaultReal>, Add<DefaultReal>> ||
std::is_same_v<OPR<DefaultReal>, Subtract<DefaultReal>>) {
if constexpr (std::is_same_v<OPR<LargestReal>, Add<LargestReal>> ||
std::is_same_v<OPR<LargestReal>, Subtract<LargestReal>>) {
// (a,b) + x -> (a+x, b)
// (a,b) - x -> (a-x, b)
if (std::optional<Expr<SomeType>> rr{NumericOperation<OPR>(messages,
AsGenericExpr(std::move(zr)), AsGenericExpr(std::move(iry)))}) {
return Package(ConstructComplex(
messages, std::move(*rr), AsGenericExpr(std::move(zi))));
if (std::optional<Expr<SomeType>> rr{
NumericOperation<OPR>(messages, AsGenericExpr(std::move(zr)),
AsGenericExpr(std::move(iry)), defaultRealKind)}) {
return Package(ConstructComplex(messages, std::move(*rr),
AsGenericExpr(std::move(zi)), defaultRealKind));
}
} else if constexpr (std::is_same_v<OPR<DefaultReal>,
Multiply<DefaultReal>> ||
std::is_same_v<OPR<DefaultReal>, Divide<DefaultReal>>) {
} else if constexpr (std::is_same_v<OPR<LargestReal>,
Multiply<LargestReal>> ||
std::is_same_v<OPR<LargestReal>, Divide<LargestReal>>) {
// (a,b) * x -> (a*x, b*x)
// (a,b) / x -> (a/x, b/x)
auto copy{iry};
auto rr{NumericOperation<Multiply>(
messages, AsGenericExpr(std::move(zr)), AsGenericExpr(std::move(iry)))};
auto rr{NumericOperation<Multiply>(messages, AsGenericExpr(std::move(zr)),
AsGenericExpr(std::move(iry)), defaultRealKind)};
auto ri{NumericOperation<Multiply>(messages, AsGenericExpr(std::move(zi)),
AsGenericExpr(std::move(copy)))};
AsGenericExpr(std::move(copy)), defaultRealKind)};
if (auto parts{common::AllPresent(std::move(rr), std::move(ri))}) {
return Package(ConstructComplex(messages, std::move(std::get<0>(*parts)),
std::move(std::get<1>(*parts))));
std::move(std::get<1>(*parts)), defaultRealKind));
}
} else if constexpr (RCAT == TypeCategory::Integer &&
std::is_same_v<OPR<DefaultReal>, Power<DefaultReal>>) {
std::is_same_v<OPR<LargestReal>, Power<LargestReal>>) {
// COMPLEX**INTEGER is a special case that doesn't convert the exponent.
static_assert(RCAT == TypeCategory::Integer);
return Package(std::visit(
@ -213,21 +214,23 @@ std::optional<Expr<SomeType>> MixedComplexLeft(
template<template<typename> class OPR, TypeCategory LCAT>
std::optional<Expr<SomeType>> MixedComplexRight(
parser::ContextualMessages &messages, Expr<SomeKind<LCAT>> &&irx,
Expr<SomeComplex> &&zy) {
if constexpr (std::is_same_v<OPR<DefaultReal>, Add<DefaultReal>> ||
std::is_same_v<OPR<DefaultReal>, Multiply<DefaultReal>>) {
Expr<SomeComplex> &&zy, int defaultRealKind) {
if constexpr (std::is_same_v<OPR<LargestReal>, Add<LargestReal>> ||
std::is_same_v<OPR<LargestReal>, Multiply<LargestReal>>) {
// x + (a,b) -> (a,b) + x -> (a+x, b)
// x * (a,b) -> (a,b) * x -> (a*x, b*x)
return MixedComplexLeft<Add, LCAT>(messages, std::move(zy), std::move(irx));
} else if constexpr (std::is_same_v<OPR<DefaultReal>,
Subtract<DefaultReal>>) {
return MixedComplexLeft<Add, LCAT>(
messages, std::move(zy), std::move(irx), defaultRealKind);
} else if constexpr (std::is_same_v<OPR<LargestReal>,
Subtract<LargestReal>>) {
// x - (a,b) -> (x-a, -b)
Expr<SomeReal> zr{GetComplexPart(zy, false)};
Expr<SomeReal> zi{GetComplexPart(zy, true)};
if (std::optional<Expr<SomeType>> rr{NumericOperation<Subtract>(messages,
AsGenericExpr(std::move(irx)), AsGenericExpr(std::move(zr)))}) {
return Package(ConstructComplex(
messages, std::move(*rr), AsGenericExpr(-std::move(zi))));
if (std::optional<Expr<SomeType>> rr{
NumericOperation<Subtract>(messages, AsGenericExpr(std::move(irx)),
AsGenericExpr(std::move(zr)), defaultRealKind)}) {
return Package(ConstructComplex(messages, std::move(*rr),
AsGenericExpr(-std::move(zi)), defaultRealKind));
}
} else {
// x / (a,b) -> (x,0) / (a,b)
@ -243,7 +246,7 @@ std::optional<Expr<SomeType>> MixedComplexRight(
template<template<typename> class OPR>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &messages, Expr<SomeType> &&x,
Expr<SomeType> &&y) {
Expr<SomeType> &&y, int defaultRealKind) {
return std::visit(
common::visitors{[](Expr<SomeInteger> &&ix, Expr<SomeInteger> &&iy) {
return Package(
@ -275,36 +278,38 @@ std::optional<Expr<SomeType>> NumericOperation(
},
[&](Expr<SomeComplex> &&zx, Expr<SomeInteger> &&zy) {
return MixedComplexLeft<OPR>(
messages, std::move(zx), std::move(zy));
messages, std::move(zx), std::move(zy), defaultRealKind);
},
[&](Expr<SomeComplex> &&zx, Expr<SomeReal> &&zy) {
return MixedComplexLeft<OPR>(
messages, std::move(zx), std::move(zy));
messages, std::move(zx), std::move(zy), defaultRealKind);
},
[&](Expr<SomeInteger> &&zx, Expr<SomeComplex> &&zy) {
return MixedComplexRight<OPR>(
messages, std::move(zx), std::move(zy));
messages, std::move(zx), std::move(zy), defaultRealKind);
},
[&](Expr<SomeReal> &&zx, Expr<SomeComplex> &&zy) {
return MixedComplexRight<OPR>(
messages, std::move(zx), std::move(zy));
messages, std::move(zx), std::move(zy), defaultRealKind);
},
// Operations with one typeless operand
[&](BOZLiteralConstant &&bx, Expr<SomeInteger> &&iy) {
return NumericOperation<OPR>(messages,
AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y));
AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](BOZLiteralConstant &&bx, Expr<SomeReal> &&ry) {
return NumericOperation<OPR>(messages,
AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y));
AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](Expr<SomeInteger> &&ix, BOZLiteralConstant &&by) {
return NumericOperation<OPR>(messages, std::move(x),
AsGenericExpr(ConvertTo(ix, std::move(by))));
AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind);
},
[&](Expr<SomeReal> &&rx, BOZLiteralConstant &&by) {
return NumericOperation<OPR>(messages, std::move(x),
AsGenericExpr(ConvertTo(rx, std::move(by))));
AsGenericExpr(ConvertTo(rx, std::move(by))), defaultRealKind);
},
// Default case
[&](auto &&, auto &&) {
@ -316,15 +321,20 @@ std::optional<Expr<SomeType>> NumericOperation(
}
template std::optional<Expr<SomeType>> NumericOperation<Power>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Divide>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Add>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
std::optional<Expr<SomeType>> Negation(
parser::ContextualMessages &messages, Expr<SomeType> &&x) {

31
flang/lib/evaluate/tools.h
View file

@ -264,19 +264,17 @@ SameKindExprs<CAT, 2> AsSameKindExprs(
using ConvertRealOperandsResult =
std::optional<SameKindExprs<TypeCategory::Real, 2>>;
ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind = DefaultReal::kind);
Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
// Per F'2018 R718, if both components are INTEGER, they are both converted
// to default REAL and the result is default COMPLEX. Otherwise, the
// kind of the result is the kind of most precise REAL component, and the other
// component is converted if necessary to its type.
std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind = DefaultReal::kind);
Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
int defaultRealKind = DefaultReal::kind);
int defaultRealKind);
template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
using Ty = TypeOf<A>;
@ -292,8 +290,8 @@ template<template<typename> class OPR, typename SPECIFIC>
Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) {
static_assert(SPECIFIC::isSpecificIntrinsicType);
if constexpr (SPECIFIC::category == TypeCategory::Complex &&
(std::is_same_v<OPR<DefaultReal>, Add<DefaultReal>> ||
std::is_same_v<OPR<DefaultReal>, Subtract<DefaultReal>>)) {
(std::is_same_v<OPR<LargestReal>, Add<LargestReal>> ||
std::is_same_v<OPR<LargestReal>, Subtract<LargestReal>>)) {
static constexpr int kind{SPECIFIC::kind};
using Part = Type<TypeCategory::Real, kind>;
return AsExpr(ComplexConstructor<kind>{
@ -328,19 +326,24 @@ Expr<SomeKind<CAT>> PromoteAndCombine(
// typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
// powers.
template<template<typename> class OPR>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Add>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Subtract>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
std::optional<Expr<SomeType>> Negation(
parser::ContextualMessages &, Expr<SomeType> &&);

17
flang/lib/evaluate/type.h
View file

@ -164,21 +164,8 @@ template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
template<TypeCategory CATEGORY, typename T>
using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
// Convenience type aliases:
// Default REAL just simply has to be IEEE-754 single precision today.
// It occupies one numeric storage unit by definition. The default INTEGER
// and default LOGICAL intrinsic types also have to occupy one numeric
// storage unit, so their kinds are also forced. Default COMPLEX must always
// comprise two default REAL components.
// TODO: Support compile-time options to default reals, ints, or both to KIND=8
using DefaultReal = Type<TypeCategory::Real, 4>;
using DefaultDoublePrecision = Type<TypeCategory::Real, 2 * DefaultReal::kind>;
using DefaultInteger = Type<TypeCategory::Integer, DefaultReal::kind>;
using IntrinsicTypeParameterType = DefaultInteger;
using DefaultComplex = SameKind<TypeCategory::Complex, DefaultReal>;
using DefaultLogical = Type<TypeCategory::Logical, DefaultInteger::kind>;
using DefaultCharacter = Type<TypeCategory::Character, 1>;
// TODO: Eliminate this type!
using DefaultInteger = Type<TypeCategory::Integer, 4>;
using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using LogicalResult = Type<TypeCategory::Logical, 1>;

11
flang/lib/semantics/default-kinds.h
View file

@ -26,6 +26,8 @@ using Fortran::common::TypeCategory;
class IntrinsicTypeDefaultKinds {
public:
// TODO: Support compile-time options to default reals, ints, or both to
// KIND=8
IntrinsicTypeDefaultKinds();
int subscriptIntegerKind() const { return subscriptIntegerKind_; }
int doublePrecisionKind() const { return doublePrecisionKind_; }
@ -33,11 +35,16 @@ public:
int GetDefaultKind(TypeCategory) const;
private:
// Default REAL just simply has to be IEEE-754 single precision today.
// It occupies one numeric storage unit by definition. The default INTEGER
// and default LOGICAL intrinsic types also have to occupy one numeric
// storage unit, so their kinds are also forced. Default COMPLEX must always
// comprise two default REAL components.
int defaultIntegerKind_{4};
int subscriptIntegerKind_{8};
int subscriptIntegerKind_{8}; // for large arrays
int defaultRealKind_{defaultIntegerKind_};
int doublePrecisionKind_{2 * defaultRealKind_};
int quadPrecisionKind_{2 * doublePrecisionKind_};
int quadPrecisionKind_{2 * doublePrecisionKind_}; // TODO: x86-64: 10
int defaultCharacterKind_{1};
int defaultLogicalKind_{defaultIntegerKind_};
};

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

@ -1037,7 +1037,8 @@ MaybeExpr BinaryOperationHelper(ExprAnalyzer &ea, const PARSED &x) {
leftRank, rightRank);
}
return NumericOperation<OPR>(ea.context.messages,
std::move(std::get<0>(*both)), std::move(std::get<1>(*both)));
std::move(std::get<0>(*both)), std::move(std::get<1>(*both)),
ea.defaults.GetDefaultKind(TypeCategory::Real));
}
return std::nullopt;
}

3
flang/lib/semantics/mod-file.cc
View file

@ -503,7 +503,8 @@ Scope *ModFileReader::Read(
} else {
parentScope = ancestor;
}
ResolveNames(errors_, *parentScope, *parseTree, directories_);
// TODO: Check that default kinds of intrinsic types match?
ResolveNames(errors_, *parentScope, *parseTree, directories_, defaultKinds_);
const auto &it{parentScope->find(name)};
if (it == parentScope->end()) {
return nullptr;

7
flang/lib/semantics/mod-file.h
View file

@ -16,6 +16,7 @@
#define FORTRAN_SEMANTICS_MOD_FILE_H_
#include "attr.h"
#include "default-kinds.h"
#include "resolve-names.h"
#include "../parser/message.h"
#include <set>
@ -69,8 +70,9 @@ private:
class ModFileReader {
public:
// directories specifies where to search for module files
ModFileReader(const std::vector<std::string> &directories)
: directories_{directories} {}
ModFileReader(const std::vector<std::string> &directories,
const IntrinsicTypeDefaultKinds &defaultKinds)
: directories_{directories}, defaultKinds_{defaultKinds} {}
// Find and read the module file for a module or submodule.
// If ancestor is specified, look for a submodule of that module.
// Return the Scope for that module/submodule or nullptr on error.
@ -81,6 +83,7 @@ public:
private:
std::vector<std::string> directories_;
parser::Messages errors_;
const IntrinsicTypeDefaultKinds defaultKinds_;
std::optional<std::string> FindModFile(
const SourceName &, const std::string &);

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

@ -14,6 +14,7 @@
#include "resolve-names.h"
#include "attr.h"
#include "default-kinds.h"
#include "mod-file.h"
#include "rewrite-parse-tree.h"
#include "scope.h"
@ -43,10 +44,14 @@ static GenericSpec MapGenericSpec(const parser::GenericSpec &);
// When inheritFromParent is set, defaults come from the parent rules.
class ImplicitRules {
public:
ImplicitRules(MessageHandler &messages)
: messages_{messages}, inheritFromParent_{false} {}
ImplicitRules(std::unique_ptr<ImplicitRules> &&parent)
: messages_{parent->messages_}, inheritFromParent_{true} {
ImplicitRules(
MessageHandler &messages, const IntrinsicTypeDefaultKinds &defaultKinds)
: messages_{messages}, inheritFromParent_{false}, defaultKinds_{
defaultKinds} {}
ImplicitRules(std::unique_ptr<ImplicitRules> &&parent,
const IntrinsicTypeDefaultKinds &defaultKinds)
: messages_{parent->messages_}, inheritFromParent_{true},
defaultKinds_{defaultKinds} {
parent_.swap(parent);
}
std::unique_ptr<ImplicitRules> &&parent() { return std::move(parent_); }
@ -71,6 +76,7 @@ private:
bool inheritFromParent_; // look in parent if not specified here
// map initial character of identifier to nullptr or its default type
std::map<char, const DeclTypeSpec> map_;
const IntrinsicTypeDefaultKinds &defaultKinds_;
friend std::ostream &operator<<(std::ostream &, const ImplicitRules &);
friend void ShowImplicitRule(std::ostream &, const ImplicitRules &, char);
@ -143,6 +149,8 @@ protected:
// Find and create types from declaration-type-spec nodes.
class DeclTypeSpecVisitor : public AttrsVisitor {
public:
explicit DeclTypeSpecVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: defaultKinds_{defaultKinds} {}
using AttrsVisitor::Post;
using AttrsVisitor::Pre;
bool Pre(const parser::IntegerTypeSpec &);
@ -163,6 +171,10 @@ public:
bool Pre(const parser::TypeGuardStmt &);
void Post(const parser::TypeGuardStmt &);
const IntrinsicTypeDefaultKinds &defaultKinds() const {
return defaultKinds_;
}
protected:
std::unique_ptr<DeclTypeSpec> &GetDeclTypeSpec();
void BeginDeclTypeSpec();
@ -175,6 +187,7 @@ private:
std::unique_ptr<DeclTypeSpec> declTypeSpec_;
DerivedTypeSpec *derivedTypeSpec_{nullptr};
std::unique_ptr<ParamValue> typeParamValue_;
const IntrinsicTypeDefaultKinds &defaultKinds_;
void MakeIntrinsic(TypeCategory, int);
void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec);
@ -229,6 +242,8 @@ private:
// Visit ImplicitStmt and related parse tree nodes and updates implicit rules.
class ImplicitRulesVisitor : public DeclTypeSpecVisitor, public MessageHandler {
public:
explicit ImplicitRulesVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: DeclTypeSpecVisitor{defaultKinds} {}
using DeclTypeSpecVisitor::Post;
using DeclTypeSpecVisitor::Pre;
using MessageHandler::Post;
@ -257,7 +272,7 @@ protected:
private:
// implicit rules in effect for current scope
std::unique_ptr<ImplicitRules> implicitRules_{
std::make_unique<ImplicitRules>(*this)};
std::make_unique<ImplicitRules>(*this, defaultKinds())};
const SourceName *prevImplicit_{nullptr};
const SourceName *prevImplicitNone_{nullptr};
const SourceName *prevImplicitNoneType_{nullptr};
@ -305,6 +320,9 @@ private:
// Manage a stack of Scopes
class ScopeHandler : public ImplicitRulesVisitor {
public:
explicit ScopeHandler(const IntrinsicTypeDefaultKinds &defaultKinds)
: ImplicitRulesVisitor(defaultKinds) {}
Scope &currScope() { return *currScope_; }
// The enclosing scope, skipping blocks and derived types.
Scope &InclusiveScope();
@ -397,6 +415,9 @@ private:
class ModuleVisitor : public virtual ScopeHandler {
public:
explicit ModuleVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds} {}
bool Pre(const parser::Module &);
void Post(const parser::Module &);
bool Pre(const parser::Submodule &);
@ -436,6 +457,9 @@ private:
class InterfaceVisitor : public virtual ScopeHandler {
public:
explicit InterfaceVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds} {}
bool Pre(const parser::InterfaceStmt &);
void Post(const parser::InterfaceStmt &);
void Post(const parser::EndInterfaceStmt &);
@ -465,8 +489,11 @@ private:
void ResolveSpecificsInGeneric(Symbol &generic);
};
class SubprogramVisitor : public InterfaceVisitor {
class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
public:
explicit SubprogramVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds}, InterfaceVisitor{defaultKinds} {}
bool HandleStmtFunction(const parser::StmtFunctionStmt &);
void Post(const parser::StmtFunctionStmt &);
bool Pre(const parser::SubroutineStmt &);
@ -502,6 +529,9 @@ private:
class DeclarationVisitor : public ArraySpecVisitor,
public virtual ScopeHandler {
public:
explicit DeclarationVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds} {}
using ArraySpecVisitor::Post;
using ArraySpecVisitor::Pre;
@ -635,6 +665,9 @@ private:
// Check that construct names don't conflict with other names.
class ConstructNamesVisitor : public virtual ScopeHandler {
public:
explicit ConstructNamesVisitor(const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds} {}
// Definitions of construct names
bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); }
bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); }
@ -684,7 +717,8 @@ private:
};
// Walk the parse tree and resolve names to symbols.
class ResolveNamesVisitor : public ModuleVisitor,
class ResolveNamesVisitor : public virtual ScopeHandler,
public ModuleVisitor,
public SubprogramVisitor,
public DeclarationVisitor,
public ConstructNamesVisitor {
@ -704,7 +738,13 @@ public:
using SubprogramVisitor::Post;
using SubprogramVisitor::Pre;
ResolveNamesVisitor(Scope &rootScope) { PushScope(rootScope); }
ResolveNamesVisitor(
Scope &rootScope, const IntrinsicTypeDefaultKinds &defaultKinds)
: ScopeHandler{defaultKinds}, ModuleVisitor{defaultKinds},
SubprogramVisitor{defaultKinds}, DeclarationVisitor{defaultKinds},
ConstructNamesVisitor{defaultKinds} {
PushScope(rootScope);
}
// Default action for a parse tree node is to visit children.
template<typename T> bool Pre(const T &) { return true; }
@ -781,9 +821,11 @@ std::optional<const DeclTypeSpec> ImplicitRules::GetType(char ch) const {
} else if (inheritFromParent_) {
return parent_->GetType(ch);
} else if (ch >= 'i' && ch <= 'n') {
return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Integer}};
return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Integer,
defaultKinds_.GetDefaultKind(TypeCategory::Integer)}};
} else if (ch >= 'a' && ch <= 'z') {
return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Real}};
return DeclTypeSpec{IntrinsicTypeSpec{
TypeCategory::Real, defaultKinds_.GetDefaultKind(TypeCategory::Real)}};
} else {
return std::nullopt;
}
@ -960,17 +1002,18 @@ bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Complex &x) {
}
bool DeclTypeSpecVisitor::Pre(
const parser::IntrinsicTypeSpec::DoublePrecision &) {
MakeIntrinsic(TypeCategory::Real,
2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Real));
MakeIntrinsic(TypeCategory::Real, defaultKinds().doublePrecisionKind());
return false;
}
bool DeclTypeSpecVisitor::Pre(
const parser::IntrinsicTypeSpec::DoubleComplex &) {
MakeIntrinsic(TypeCategory::Complex,
2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Complex));
MakeIntrinsic(TypeCategory::Complex, defaultKinds().doublePrecisionKind());
return false;
}
void DeclTypeSpecVisitor::MakeIntrinsic(TypeCategory category, int kind) {
if (kind == 0) {
kind = defaultKinds_.GetDefaultKind(category);
}
SetDeclTypeSpec(DeclTypeSpec{IntrinsicTypeSpec{category, kind}});
}
@ -1103,7 +1146,8 @@ void ImplicitRulesVisitor::Post(const parser::ImplicitSpec &) {
}
void ImplicitRulesVisitor::PushScope() {
implicitRules_ = std::make_unique<ImplicitRules>(std::move(implicitRules_));
implicitRules_ = std::make_unique<ImplicitRules>(
std::move(implicitRules_), defaultKinds());
prevImplicit_ = nullptr;
prevImplicitNone_ = nullptr;
prevImplicitNoneType_ = nullptr;
@ -1527,7 +1571,7 @@ Symbol &ModuleVisitor::BeginModule(const SourceName &name, bool isSubmodule,
// May have to read a .mod file to find it.
// If an error occurs, report it and return nullptr.
Scope *ModuleVisitor::FindModule(const SourceName &name, Scope *ancestor) {
ModFileReader reader{searchDirectories_};
ModFileReader reader{searchDirectories_, defaultKinds()};
auto *scope{reader.Read(GlobalScope(), name, ancestor)};
if (!scope) {
Annex(std::move(reader.errors()));
@ -3053,8 +3097,9 @@ void ResolveNamesVisitor::Post(const parser::Program &) {
void ResolveNames(parser::Messages &messages, Scope &rootScope,
const parser::Program &program,
const std::vector<std::string> &searchDirectories) {
ResolveNamesVisitor visitor{rootScope};
const std::vector<std::string> &searchDirectories,
const IntrinsicTypeDefaultKinds &defaultKinds) {
ResolveNamesVisitor visitor{rootScope, defaultKinds};
for (auto &dir : searchDirectories) {
visitor.add_searchDirectory(dir);
}

3
flang/lib/semantics/resolve-names.h
View file

@ -27,9 +27,10 @@ struct Program;
namespace Fortran::semantics {
class Scope;
class IntrinsicTypeDefaultKinds;
void ResolveNames(parser::Messages &, Scope &, const parser::Program &,
const std::vector<std::string> &);
const std::vector<std::string> &, const IntrinsicTypeDefaultKinds &);
void DumpSymbols(std::ostream &);
} // namespace Fortran::semantics

2
flang/lib/semantics/semantics.cc
View file

@ -45,7 +45,7 @@ bool Semantics::Perform(parser::Program &program) {
if (AnyFatalError()) {
return false;
}
ResolveNames(messages_, globalScope_, program, directories_);
ResolveNames(messages_, globalScope_, program, directories_, defaultKinds_);
if (AnyFatalError()) {
return false;
}

4
flang/lib/semantics/semantics.h
View file

@ -15,6 +15,7 @@
#ifndef FORTRAN_SEMANTICS_SEMANTICS_H_
#define FORTRAN_SEMANTICS_SEMANTICS_H_
#include "default-kinds.h"
#include "scope.h"
#include "../parser/message.h"
#include <iostream>
@ -29,6 +30,8 @@ namespace Fortran::semantics {
class Semantics {
public:
explicit Semantics(const IntrinsicTypeDefaultKinds &dftKinds)
: defaultKinds_{dftKinds} {}
const parser::Messages &messages() const { return messages_; }
Semantics &set_searchDirectories(const std::vector<std::string> &);
Semantics &set_moduleDirectory(const std::string &);
@ -37,6 +40,7 @@ public:
void DumpSymbols(std::ostream &);
private:
const IntrinsicTypeDefaultKinds &defaultKinds_;
Scope globalScope_;
std::vector<std::string> directories_{"."s};
std::string moduleDirectory_{"."s};

14
flang/lib/semantics/type.cc
View file

@ -80,19 +80,9 @@ std::ostream &operator<<(std::ostream &o, const ShapeSpec &x) {
}
IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind)
: category_{category}, kind_{kind ? kind : GetDefaultKind(category)} {
: category_{category}, kind_{kind} {
CHECK(category != TypeCategory::Derived);
}
int IntrinsicTypeSpec::GetDefaultKind(TypeCategory category) {
switch (category) {
case TypeCategory::Character: return evaluate::DefaultCharacter::kind;
case TypeCategory::Integer: return evaluate::DefaultInteger::kind;
case TypeCategory::Logical: return evaluate::DefaultLogical::kind;
case TypeCategory::Complex:
case TypeCategory::Real: return evaluate::DefaultReal::kind;
default: CRASH_NO_CASE;
}
CHECK(kind > 0);
}
std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) {

4
flang/lib/semantics/type.h
View file

@ -89,7 +89,7 @@ private:
class IntrinsicTypeSpec {
public:
IntrinsicTypeSpec(TypeCategory, int kind = 0);
IntrinsicTypeSpec(TypeCategory, int kind);
const TypeCategory category() const { return category_; }
const int kind() const { return kind_; }
bool operator==(const IntrinsicTypeSpec &x) const {
@ -97,8 +97,6 @@ public:
}
bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); }
static int GetDefaultKind(TypeCategory category);
private:
TypeCategory category_;
int kind_;

4
flang/tools/f18/f18.cc
View file

@ -498,7 +498,9 @@ int main(int argc, char *const argv[]) {
driver.pgf90Args.push_back("-Mbackslash");
}
Fortran::semantics::Semantics semantics;
// TODO: Configure these kinds based on command line settings
Fortran::semantics::IntrinsicTypeDefaultKinds defaultKinds;
Fortran::semantics::Semantics semantics{defaultKinds};
semantics.set_searchDirectories(options.searchDirectories);
semantics.set_moduleDirectory(driver.moduleDirectory);
if (!anyFiles) {