maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Eliminating old default type declarations 

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

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

@ -264,19 +264,17 @@ SameKindExprs<CAT, 2> AsSameKindExprs(
using ConvertRealOperandsResult = using ConvertRealOperandsResult =
std::optional<SameKindExprs<TypeCategory::Real, 2>>; std::optional<SameKindExprs<TypeCategory::Real, 2>>;
ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &, ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&, Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
int defaultRealKind = DefaultReal::kind);
// Per F'2018 R718, if both components are INTEGER, they are both converted // Per F'2018 R718, if both components are INTEGER, they are both converted
// to default REAL and the result is default COMPLEX. Otherwise, the // 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 // kind of the result is the kind of most precise REAL component, and the other
// component is converted if necessary to its type. // component is converted if necessary to its type.
std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &, std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&, Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
int defaultRealKind = DefaultReal::kind);
std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &, std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
int defaultRealKind = DefaultReal::kind); int defaultRealKind);
template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) { template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
using Ty = TypeOf<A>; using Ty = TypeOf<A>;
@ -292,8 +290,8 @@ template<template<typename> class OPR, typename SPECIFIC>
Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) { Expr<SPECIFIC> Combine(Expr<SPECIFIC> &&x, Expr<SPECIFIC> &&y) {
static_assert(SPECIFIC::isSpecificIntrinsicType); static_assert(SPECIFIC::isSpecificIntrinsicType);
if constexpr (SPECIFIC::category == TypeCategory::Complex && if constexpr (SPECIFIC::category == TypeCategory::Complex &&
(std::is_same_v<OPR<DefaultReal>, Add<DefaultReal>> || (std::is_same_v<OPR<LargestReal>, Add<LargestReal>> ||
std::is_same_v<OPR<DefaultReal>, Subtract<DefaultReal>>)) { std::is_same_v<OPR<LargestReal>, Subtract<LargestReal>>)) {
static constexpr int kind{SPECIFIC::kind}; static constexpr int kind{SPECIFIC::kind};
using Part = Type<TypeCategory::Real, kind>; using Part = Type<TypeCategory::Real, kind>;
return AsExpr(ComplexConstructor<kind>{ return AsExpr(ComplexConstructor<kind>{
@ -328,19 +326,24 @@ Expr<SomeKind<CAT>> PromoteAndCombine(
// typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER // typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
// powers. // powers.
template<template<typename> class OPR> template<template<typename> class OPR>
std::optional<Expr<SomeType>> NumericOperation( std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&); Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Power>( 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>( 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>( 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>( 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>( 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( std::optional<Expr<SomeType>> Negation(
parser::ContextualMessages &, Expr<SomeType> &&); 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> template<TypeCategory CATEGORY, typename T>
using SameKind = Type<CATEGORY, std::decay_t<T>::kind>; using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
// Convenience type aliases: // TODO: Eliminate this type!
// Default REAL just simply has to be IEEE-754 single precision today. using DefaultInteger = Type<TypeCategory::Integer, 4>;
// 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>;
using SubscriptInteger = Type<TypeCategory::Integer, 8>; using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using LogicalResult = Type<TypeCategory::Logical, 1>; 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 { class IntrinsicTypeDefaultKinds {
public: public:
// TODO: Support compile-time options to default reals, ints, or both to
// KIND=8
IntrinsicTypeDefaultKinds(); IntrinsicTypeDefaultKinds();
int subscriptIntegerKind() const { return subscriptIntegerKind_; } int subscriptIntegerKind() const { return subscriptIntegerKind_; }
int doublePrecisionKind() const { return doublePrecisionKind_; } int doublePrecisionKind() const { return doublePrecisionKind_; }
@ -33,11 +35,16 @@ public:
int GetDefaultKind(TypeCategory) const; int GetDefaultKind(TypeCategory) const;
private: 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 defaultIntegerKind_{4};
int subscriptIntegerKind_{8}; int subscriptIntegerKind_{8}; // for large arrays
int defaultRealKind_{defaultIntegerKind_}; int defaultRealKind_{defaultIntegerKind_};
int doublePrecisionKind_{2 * defaultRealKind_}; int doublePrecisionKind_{2 * defaultRealKind_};
int quadPrecisionKind_{2 * doublePrecisionKind_}; int quadPrecisionKind_{2 * doublePrecisionKind_}; // TODO: x86-64: 10
int defaultCharacterKind_{1}; int defaultCharacterKind_{1};
int defaultLogicalKind_{defaultIntegerKind_}; int defaultLogicalKind_{defaultIntegerKind_};
}; };

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

@ -1037,7 +1037,8 @@ MaybeExpr BinaryOperationHelper(ExprAnalyzer &ea, const PARSED &x) {
leftRank, rightRank); leftRank, rightRank);
} }
return NumericOperation<OPR>(ea.context.messages, 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; return std::nullopt;
} }

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

@ -503,7 +503,8 @@ Scope *ModFileReader::Read(
} else { } else {
parentScope = ancestor; 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)}; const auto &it{parentScope->find(name)};
if (it == parentScope->end()) { if (it == parentScope->end()) {
return nullptr; return nullptr;

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

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

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

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

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

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

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

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

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

@ -15,6 +15,7 @@
#ifndef FORTRAN_SEMANTICS_SEMANTICS_H_ #ifndef FORTRAN_SEMANTICS_SEMANTICS_H_
#define FORTRAN_SEMANTICS_SEMANTICS_H_ #define FORTRAN_SEMANTICS_SEMANTICS_H_
#include "default-kinds.h"
#include "scope.h" #include "scope.h"
#include "../parser/message.h" #include "../parser/message.h"
#include <iostream> #include <iostream>
@ -29,6 +30,8 @@ namespace Fortran::semantics {
class Semantics { class Semantics {
public: public:
explicit Semantics(const IntrinsicTypeDefaultKinds &dftKinds)
: defaultKinds_{dftKinds} {}
const parser::Messages &messages() const { return messages_; } const parser::Messages &messages() const { return messages_; }
Semantics &set_searchDirectories(const std::vector<std::string> &); Semantics &set_searchDirectories(const std::vector<std::string> &);
Semantics &set_moduleDirectory(const std::string &); Semantics &set_moduleDirectory(const std::string &);
@ -37,6 +40,7 @@ public:
void DumpSymbols(std::ostream &); void DumpSymbols(std::ostream &);
private: private:
const IntrinsicTypeDefaultKinds &defaultKinds_;
Scope globalScope_; Scope globalScope_;
std::vector<std::string> directories_{"."s}; std::vector<std::string> directories_{"."s};
std::string moduleDirectory_{"."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) IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind)
: category_{category}, kind_{kind ? kind : GetDefaultKind(category)} { : category_{category}, kind_{kind} {
CHECK(category != TypeCategory::Derived); CHECK(category != TypeCategory::Derived);
} CHECK(kind > 0);
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;
}
} }
std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) { std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) {

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

@ -89,7 +89,7 @@ private:
class IntrinsicTypeSpec { class IntrinsicTypeSpec {
public: public:
IntrinsicTypeSpec(TypeCategory, int kind = 0); IntrinsicTypeSpec(TypeCategory, int kind);
const TypeCategory category() const { return category_; } const TypeCategory category() const { return category_; }
const int kind() const { return kind_; } const int kind() const { return kind_; }
bool operator==(const IntrinsicTypeSpec &x) const { bool operator==(const IntrinsicTypeSpec &x) const {
@ -97,8 +97,6 @@ public:
} }
bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); } bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); }
static int GetDefaultKind(TypeCategory category);
private: private:
TypeCategory category_; TypeCategory category_;
int kind_; 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"); 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_searchDirectories(options.searchDirectories);
semantics.set_moduleDirectory(driver.moduleDirectory); semantics.set_moduleDirectory(driver.moduleDirectory);
if (!anyFiles) { if (!anyFiles) {