[flang] Extract IntrinsicTypeDefaultKinds, move it into semantics

Original-commit: flang-compiler/f18@dd819b4727
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 15:28:47 -07:00
parent afd3d6bc50
commit bf339f8d47
11 changed files with 127 additions and 62 deletions

View File

@ -18,6 +18,7 @@
#include "../common/enum-set.h"
#include "../common/fortran.h"
#include "../common/idioms.h"
#include "../semantics/default-kinds.h"
#include <map>
#include <ostream>
#include <sstream>
@ -194,7 +195,7 @@ struct IntrinsicInterface {
TypePattern result;
Rank rank{Rank::elemental};
std::optional<SpecificIntrinsic> Match(const CallCharacteristics &,
const IntrinsicTypeDefaultKinds &,
const semantics::IntrinsicTypeDefaultKinds &,
parser::ContextualMessages &messages) const;
std::ostream &Dump(std::ostream &) const;
};
@ -737,7 +738,8 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
// Intrinsic interface matching against the arguments of a particular
// procedure reference.
std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
const CallCharacteristics &call, const IntrinsicTypeDefaultKinds &defaults,
const CallCharacteristics &call,
const semantics::IntrinsicTypeDefaultKinds &defaults,
parser::ContextualMessages &messages) const {
// Attempt to construct a 1-1 correspondence between the dummy arguments in
// a particular intrinsic procedure's generic interface and the actual
@ -823,19 +825,19 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
argOk = false;
break;
case KindCode::defaultIntegerKind:
argOk = type->kind == defaults.defaultIntegerKind;
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Integer);
break;
case KindCode::defaultRealKind:
argOk = type->kind == defaults.defaultRealKind;
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Real);
break;
case KindCode::doublePrecision:
argOk = type->kind == defaults.defaultDoublePrecisionKind;
argOk = type->kind == defaults.doublePrecisionKind();
break;
case KindCode::defaultCharKind:
argOk = type->kind == defaults.defaultCharacterKind;
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Character);
break;
case KindCode::defaultLogicalKind:
argOk = type->kind == defaults.defaultLogicalKind;
argOk = type->kind == defaults.GetDefaultKind(TypeCategory::Logical);
break;
case KindCode::any: argOk = true; break;
case KindCode::kindArg:
@ -961,27 +963,27 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
case KindCode::defaultIntegerKind:
CHECK(result.categorySet == IntType);
CHECK(resultType.category == TypeCategory::Integer);
resultType.kind = defaults.defaultIntegerKind;
resultType.kind = defaults.GetDefaultKind(TypeCategory::Integer);
break;
case KindCode::defaultRealKind:
CHECK(result.categorySet == CategorySet{resultType.category});
CHECK(FloatingType.test(resultType.category));
resultType.kind = defaults.defaultRealKind;
resultType.kind = defaults.GetDefaultKind(TypeCategory::Real);
break;
case KindCode::doublePrecision:
CHECK(result.categorySet == RealType);
CHECK(resultType.category == TypeCategory::Real);
resultType.kind = defaults.defaultDoublePrecisionKind;
resultType.kind = defaults.doublePrecisionKind();
break;
case KindCode::defaultCharKind:
CHECK(result.categorySet == CharType);
CHECK(resultType.category == TypeCategory::Character);
resultType.kind = defaults.defaultCharacterKind;
resultType.kind = defaults.GetDefaultKind(TypeCategory::Character);
break;
case KindCode::defaultLogicalKind:
CHECK(result.categorySet == LogicalType);
CHECK(resultType.category == TypeCategory::Logical);
resultType.kind = defaults.defaultLogicalKind;
resultType.kind = defaults.GetDefaultKind(TypeCategory::Logical);
break;
case KindCode::same:
CHECK(sameArg != nullptr);
@ -1018,7 +1020,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
} else {
CHECK(
kindDummyArg->optionality == Optionality::defaultsToDefaultForResult);
resultType.kind = defaults.DefaultKind(resultType.category);
resultType.kind = defaults.GetDefaultKind(resultType.category);
}
break;
case KindCode::likeMultiply:
@ -1085,7 +1087,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
}
struct IntrinsicProcTable::Implementation {
explicit Implementation(const IntrinsicTypeDefaultKinds &dfts)
explicit Implementation(const semantics::IntrinsicTypeDefaultKinds &dfts)
: defaults{dfts} {
for (const IntrinsicInterface &f : genericIntrinsicFunction) {
genericFuncs.insert(std::make_pair(std::string{f.name}, &f));
@ -1098,7 +1100,7 @@ struct IntrinsicProcTable::Implementation {
std::optional<SpecificIntrinsic> Probe(
const CallCharacteristics &, parser::ContextualMessages *) const;
IntrinsicTypeDefaultKinds defaults;
semantics::IntrinsicTypeDefaultKinds defaults;
std::multimap<std::string, const IntrinsicInterface *> genericFuncs;
std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs;
std::ostream &Dump(std::ostream &) const;
@ -1176,7 +1178,7 @@ IntrinsicProcTable::~IntrinsicProcTable() {
}
IntrinsicProcTable IntrinsicProcTable::Configure(
const IntrinsicTypeDefaultKinds &defaults) {
const semantics::IntrinsicTypeDefaultKinds &defaults) {
IntrinsicProcTable result;
result.impl_ = new IntrinsicProcTable::Implementation(defaults);
return result;

View File

@ -19,6 +19,7 @@
#include "type.h"
#include "../common/idioms.h"
#include "../parser/message.h"
#include "../semantics/default-kinds.h"
#include <memory>
#include <optional>
#include <ostream>
@ -58,7 +59,8 @@ private:
public:
~IntrinsicProcTable();
static IntrinsicProcTable Configure(const IntrinsicTypeDefaultKinds &);
static IntrinsicProcTable Configure(
const semantics::IntrinsicTypeDefaultKinds &);
std::optional<SpecificIntrinsic> Probe(const CallCharacteristics &,
parser::ContextualMessages *messages = nullptr) const;
std::ostream &Dump(std::ostream &) const;

View File

@ -88,17 +88,6 @@ DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
return *this;
}
int IntrinsicTypeDefaultKinds::DefaultKind(TypeCategory category) const {
switch (category) {
case TypeCategory::Integer: return defaultIntegerKind;
case TypeCategory::Real:
case TypeCategory::Complex: return defaultRealKind;
case TypeCategory::Character: return defaultCharacterKind;
case TypeCategory::Logical: return defaultLogicalKind;
default: CRASH_NO_CASE; return 0;
}
}
std::string SomeDerived::Dump() const {
return "TYPE("s + spec().name().ToString() + ')';
}

View File

@ -180,16 +180,6 @@ using DefaultComplex = SameKind<TypeCategory::Complex, DefaultReal>;
using DefaultLogical = Type<TypeCategory::Logical, DefaultInteger::kind>;
using DefaultCharacter = Type<TypeCategory::Character, 1>;
struct IntrinsicTypeDefaultKinds {
int defaultIntegerKind{evaluate::DefaultInteger::kind};
int defaultRealKind{evaluate::DefaultReal::kind};
int defaultDoublePrecisionKind{evaluate::DefaultDoublePrecision::kind};
int defaultQuadPrecisionKind{evaluate::DefaultDoublePrecision::kind};
int defaultCharacterKind{evaluate::DefaultCharacter::kind};
int defaultLogicalKind{evaluate::DefaultLogical::kind};
int DefaultKind(TypeCategory) const;
};
using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using LogicalResult = Type<TypeCategory::Logical, 1>;
using LargestReal = Type<TypeCategory::Real, 16>;

View File

@ -16,6 +16,7 @@
add_library(FortranSemantics
attr.cc
canonicalize-do.cc
default-kinds.cc
expression.cc
mod-file.cc
resolve-labels.cc

View File

@ -0,0 +1,32 @@
// Copyright (c) 2018, 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 "default-kinds.h"
#include "../common/idioms.h"
namespace Fortran::semantics {
IntrinsicTypeDefaultKinds::IntrinsicTypeDefaultKinds() {}
int IntrinsicTypeDefaultKinds::GetDefaultKind(TypeCategory category) const {
switch (category) {
case TypeCategory::Integer: return defaultIntegerKind_;
case TypeCategory::Real:
case TypeCategory::Complex: return defaultRealKind_;
case TypeCategory::Character: return defaultCharacterKind_;
case TypeCategory::Logical: return defaultLogicalKind_;
default: CRASH_NO_CASE; return 0;
}
}
} // namespace Fortran::semantics

View File

@ -0,0 +1,46 @@
// Copyright (c) 2018, 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_DEFAULT_KINDS_H_
#define FORTRAN_DEFAULT_KINDS_H_
#include "../common/fortran.h"
// Represent the default values of the kind parameters of the
// various intrinsic types. These can be configured by means of
// the compiler command line.
namespace Fortran::semantics {
using Fortran::common::TypeCategory;
class IntrinsicTypeDefaultKinds {
public:
IntrinsicTypeDefaultKinds();
int subscriptIntegerKind() const { return subscriptIntegerKind_; }
int doublePrecisionKind() const { return doublePrecisionKind_; }
int quadPrecisionKind() const { return quadPrecisionKind_; }
int GetDefaultKind(TypeCategory) const;
private:
int defaultIntegerKind_{4};
int subscriptIntegerKind_{8};
int defaultRealKind_{defaultIntegerKind_};
int doublePrecisionKind_{2 * defaultRealKind_};
int quadPrecisionKind_{2 * doublePrecisionKind_};
int defaultCharacterKind_{1};
int defaultLogicalKind_{defaultIntegerKind_};
};
} // namespace Fortran::semantics
#endif // FORTRAN_DEFAULT_KINDS_H_

View File

@ -105,7 +105,8 @@ std::optional<DataRef> ExtractDataRef(std::optional<A> &&x) {
// member function that converts parse trees into (usually) generic
// expressions.
struct ExprAnalyzer {
ExprAnalyzer(FoldingContext &ctx, const IntrinsicTypeDefaultKinds &dfts,
ExprAnalyzer(FoldingContext &ctx,
const semantics::IntrinsicTypeDefaultKinds &dfts,
const IntrinsicProcTable &procs)
: context{ctx}, defaults{dfts}, intrinsics{procs} {}
@ -184,7 +185,7 @@ struct ExprAnalyzer {
const parser::ProcedureDesignator &, const std::vector<ActualArgument> &);
FoldingContext context;
const IntrinsicTypeDefaultKinds &defaults;
const semantics::IntrinsicTypeDefaultKinds &defaults;
const IntrinsicProcTable &intrinsics;
};
@ -313,7 +314,7 @@ int ExprAnalyzer::Analyze(const std::optional<parser::KindParam> &kindParam,
template<typename PARSED>
MaybeExpr IntLiteralConstant(ExprAnalyzer &ea, const PARSED &x) {
int kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
ea.defaults.defaultIntegerKind)};
ea.defaults.GetDefaultKind(TypeCategory::Integer))};
auto value{std::get<0>(x.t)}; // std::(u)int64_t
auto result{common::SearchDynamicTypes(
TypeKindVisitor<TypeCategory::Integer, Constant, std::int64_t>{
@ -375,15 +376,15 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
// letter used in an exponent part (e.g., the 'E' in "6.02214E+23")
// should agree. In the absence of an explicit kind parameter, any exponent
// letter determines the kind. Otherwise, defaults apply.
int defaultKind{defaults.defaultRealKind};
int defaultKind{defaults.GetDefaultKind(TypeCategory::Real)};
const char *end{x.real.source.end()};
std::optional<int> letterKind;
for (const char *p{x.real.source.begin()}; p < end; ++p) {
if (parser::IsLetter(*p)) {
switch (*p) {
case 'e': letterKind = defaults.defaultRealKind; break;
case 'd': letterKind = defaults.defaultDoublePrecisionKind; break;
case 'q': letterKind = defaults.defaultQuadPrecisionKind; break;
case 'e': letterKind = defaults.GetDefaultKind(TypeCategory::Real); break;
case 'd': letterKind = defaults.doublePrecisionKind(); break;
case 'q': letterKind = defaults.quadPrecisionKind(); break;
default: ctxMsgs.Say("unknown exponent letter '%c'"_err_en_US, *p);
}
break;
@ -424,9 +425,9 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::ComplexPart &x) {
}
MaybeExpr ExprAnalyzer::Analyze(const parser::ComplexLiteralConstant &z) {
return AsMaybeExpr(
ConstructComplex(context.messages, Analyze(std::get<0>(z.t)),
Analyze(std::get<1>(z.t)), defaults.defaultRealKind));
return AsMaybeExpr(ConstructComplex(context.messages,
Analyze(std::get<0>(z.t)), Analyze(std::get<1>(z.t)),
defaults.GetDefaultKind(TypeCategory::Real)));
}
MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
@ -443,7 +444,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
MaybeExpr ExprAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
auto kind{Analyze(std::get<std::optional<parser::KindParam>>(x.t),
defaults.defaultLogicalKind)};
defaults.GetDefaultKind(TypeCategory::Logical))};
bool value{std::get<bool>(x.t)};
auto result{common::SearchDynamicTypes(
TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
@ -457,7 +458,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::LogicalLiteralConstant &x) {
MaybeExpr ExprAnalyzer::Analyze(const parser::HollerithLiteralConstant &x) {
return common::SearchDynamicTypes(
TypeKindVisitor<TypeCategory::Character, Constant, std::string>{
defaults.defaultCharacterKind, x.v});
defaults.GetDefaultKind(TypeCategory::Character), x.v});
}
MaybeExpr ExprAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
@ -1064,7 +1065,8 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Subtract &x) {
MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::ComplexConstructor &x) {
return AsMaybeExpr(ConstructComplex(context.messages,
AnalyzeHelper(*this, *std::get<0>(x.t)),
AnalyzeHelper(*this, *std::get<1>(x.t)), defaults.defaultRealKind));
AnalyzeHelper(*this, *std::get<1>(x.t)),
defaults.GetDefaultKind(TypeCategory::Real)));
}
MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Concat &x) {
@ -1215,7 +1217,7 @@ void ExprAnalyzer::CheckUnsubscriptedComponent(const Component &component) {
namespace Fortran::semantics {
evaluate::MaybeExpr AnalyzeExpr(evaluate::FoldingContext &context,
const evaluate::IntrinsicTypeDefaultKinds &defaults,
const IntrinsicTypeDefaultKinds &defaults,
const evaluate::IntrinsicProcTable &intrinsics, const parser::Expr &expr) {
return evaluate::ExprAnalyzer{context, defaults, intrinsics}.Analyze(expr);
}
@ -1223,7 +1225,7 @@ evaluate::MaybeExpr AnalyzeExpr(evaluate::FoldingContext &context,
class Mutator {
public:
Mutator(evaluate::FoldingContext &context,
const evaluate::IntrinsicTypeDefaultKinds &defaults,
const IntrinsicTypeDefaultKinds &defaults,
const evaluate::IntrinsicProcTable &intrinsics)
: context_{context}, defaults_{defaults}, intrinsics_{intrinsics} {}
@ -1247,13 +1249,13 @@ public:
private:
evaluate::FoldingContext &context_;
const evaluate::IntrinsicTypeDefaultKinds &defaults_;
const IntrinsicTypeDefaultKinds &defaults_;
const evaluate::IntrinsicProcTable &intrinsics_;
};
void AnalyzeExpressions(parser::Program &program,
evaluate::FoldingContext &context,
const evaluate::IntrinsicTypeDefaultKinds &defaults,
const IntrinsicTypeDefaultKinds &defaults,
const evaluate::IntrinsicProcTable &intrinsics) {
Mutator mutator{context, defaults, intrinsics};
parser::Walk(program, mutator);

View File

@ -15,6 +15,7 @@
#ifndef FORTRAN_SEMANTICS_EXPRESSION_H_
#define FORTRAN_SEMANTICS_EXPRESSION_H_
#include "default-kinds.h"
#include "../evaluate/expression.h"
#include "../evaluate/type.h"
#include "../parser/parse-tree.h"
@ -26,14 +27,13 @@ using MaybeExpr = std::optional<evaluate::Expr<evaluate::SomeType>>;
// Semantic analysis of one expression.
std::optional<evaluate::Expr<evaluate::SomeType>> AnalyzeExpr(
evaluate::FoldingContext &, const evaluate::IntrinsicTypeDefaultKinds &,
evaluate::FoldingContext &, const IntrinsicTypeDefaultKinds &,
const parser::Expr &);
// Semantic analysis of all expressions in a parse tree, which is
// decorated with typed representations for top-level expressions.
void AnalyzeExpressions(parser::Program &, evaluate::FoldingContext &,
const evaluate::IntrinsicTypeDefaultKinds &,
const evaluate::IntrinsicProcTable &);
const IntrinsicTypeDefaultKinds &, const evaluate::IntrinsicProcTable &);
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_EXPRESSION_H_

View File

@ -148,9 +148,9 @@ template<typename... As> Arguments Args(As &&... xs) {
}
void TestIntrinsics() {
IntrinsicTypeDefaultKinds defaults;
MATCH(4, defaults.defaultIntegerKind);
MATCH(4, defaults.defaultRealKind);
semantics::IntrinsicTypeDefaultKinds defaults;
MATCH(4, defaults.GetDefaultKind(TypeCategory::Integer));
MATCH(4, defaults.GetDefaultKind(TypeCategory::Real));
IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)};
table.Dump(std::cout);

View File

@ -22,6 +22,7 @@
#include "../../lib/parser/parsing.h"
#include "../../lib/parser/provenance.h"
#include "../../lib/parser/unparse.h"
#include "../../lib/semantics/default-kinds.h"
#include "../../lib/semantics/dump-parse-tree.h"
#include "../../lib/semantics/expression.h"
#include "../../lib/semantics/semantics.h"
@ -219,7 +220,7 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
Fortran::parser::Messages messages;
Fortran::parser::ContextualMessages contextualMessages{whole, &messages};
Fortran::evaluate::FoldingContext context{contextualMessages};
Fortran::evaluate::IntrinsicTypeDefaultKinds defaults;
Fortran::semantics::IntrinsicTypeDefaultKinds defaults;
auto intrinsics{
Fortran::evaluate::IntrinsicProcTable::Configure(defaults)};
Fortran::semantics::AnalyzeExpressions(