From 7026445c07928b3d583fe81c86a1c055c65cda26 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 21 May 2019 10:24:30 -0700 Subject: [PATCH] [flang] Address review comments from Jean (thanks!) Original-commit: flang-compiler/f18@5183c6196e36fa361d1f18717d741c2fe36a31df Reviewed-on: https://github.com/flang-compiler/f18/pull/466 --- flang/lib/evaluate/fold.cc | 6 ++-- flang/lib/evaluate/formatting.cc | 62 ++++++++++++++++++++++++++++++++++---- flang/lib/evaluate/intrinsics.cc | 2 +- flang/lib/evaluate/tools.h | 43 ++++++++++++++++++++++++++ flang/lib/evaluate/type.cc | 63 --------------------------------------- flang/lib/semantics/expression.cc | 35 ++-------------------- flang/lib/semantics/type.cc | 10 +++---- 7 files changed, 111 insertions(+), 110 deletions(-) diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index d7fffc8..04bc338 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -916,16 +916,16 @@ std::optional> ApplySubscripts(parser::ContextualMessages &messages, } ++k; } - CHECK(!increment || elements == 0); - CHECK(k == resultShape.size()); if (at[j] < 1 || at[j] > shape[j]) { messages.Say("Subscript value (%jd) is out of range in reference " "to a constant array value"_err_en_US, static_cast(at[j])); return std::nullopt; } - values.emplace_back(array.At(at)); } + values.emplace_back(array.At(at)); + CHECK(!increment || elements == 0); + CHECK(k == resultShape.size()); } if constexpr (T::category == TypeCategory::Character) { return Constant{array.LEN(), std::move(values), std::move(resultShape)}; diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc index 758cef7..5eb0c29 100644 --- a/flang/lib/evaluate/formatting.cc +++ b/flang/lib/evaluate/formatting.cc @@ -391,18 +391,70 @@ std::ostream &StructureConstructor::AsFortran(std::ostream &o) const { return o << ')'; } +std::string DynamicType::AsFortran() const { + if (derived_ != nullptr) { + CHECK(category_ == TypeCategory::Derived); + return (isPolymorphic_ ? "CLASS("s : "TYPE("s) + + DerivedTypeSpecAsFortran(*derived_) + ')'; + } else if (charLength_ != nullptr) { + std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="}; + if (charLength_->isAssumed()) { + result += '*'; + } else if (charLength_->isDeferred()) { + result += ':'; + } else if (const auto &length{charLength_->GetExplicit()}) { + std::stringstream ss; + length->AsFortran(ss); + result += ss.str(); + } + return result + ')'; + } else if (isPolymorphic_) { + return "CLASS(*)"; + } else if (kind_ == 0) { + return "(typeless intrinsic function argument)"; + } else { + return EnumToString(category_) + '(' + std::to_string(kind_) + ')'; + } +} + +std::string DynamicType::AsFortran(std::string &&charLenExpr) const { + if (!charLenExpr.empty() && category_ == TypeCategory::Character) { + return "CHARACTER(KIND=" + std::to_string(kind_) + + ",LEN=" + std::move(charLenExpr) + ')'; + } else { + return AsFortran(); + } +} + +std::string SomeDerived::AsFortran() const { + if (IsUnlimitedPolymorphic()) { + return "CLASS(*)"; + } else { + return "TYPE("s + DerivedTypeSpecAsFortran(derivedTypeSpec()) + ')'; + } +} + std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &spec) { - std::stringstream ss; - ss << spec.typeSymbol().name().ToString(); - if (!spec.parameters().empty()) { + if (spec.HasActualParameters()) { + std::stringstream ss; + ss << spec.typeSymbol().name().ToString(); char ch{'('}; for (const auto &[name, value] : spec.parameters()) { - value.GetExplicit()->AsFortran(ss << ch << name.ToString() << '='); + ss << ch << name.ToString() << '='; ch = ','; + if (value.isAssumed()) { + ss << '*'; + } else if (value.isDeferred()) { + ss << ':'; + } else { + value.GetExplicit()->AsFortran(ss); + } } ss << ')'; + return ss.str(); + } else { + return spec.typeSymbol().name().ToString(); } - return ss.str(); } std::ostream &EmitVar(std::ostream &o, const Symbol &symbol) { diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 1957d0c..bd242c9 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -1424,7 +1424,7 @@ std::optional IntrinsicProcTable::Implementation::Probe( bool ok{false}; if (const auto &arg{specificCall->arguments[0]}) { if (const auto *expr{arg->GetExpr()}) { - if (const Symbol * symbol{GetLastSymbol(*expr)}) { + if (const Symbol * symbol{IsWholeSymbolDataRef(*expr)}) { ok = symbol->attrs().test(semantics::Attr::OPTIONAL); } } diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h index f98742e..cf10aa2 100644 --- a/flang/lib/evaluate/tools.h +++ b/flang/lib/evaluate/tools.h @@ -179,6 +179,49 @@ template A *UnwrapExpr(std::optional &x) { } } +// If an expression simply wraps a DataRef, extract and return it. +template +common::IfNoLvalue, A> ExtractDataRef(const A &) { + return std::nullopt; // default base casec +} + +template +std::optional ExtractDataRef(const Designator &d) { + return std::visit( + [](const auto &x) -> std::optional { + if constexpr (common::HasMember) { + return DataRef{x}; + } + return std::nullopt; + }, + d.u); +} + +template +std::optional ExtractDataRef(const Expr &expr) { + return std::visit([](const auto &x) { return ExtractDataRef(x); }, expr.u); +} + +template +std::optional ExtractDataRef(const std::optional &x) { + if (x.has_value()) { + return ExtractDataRef(*x); + } else { + return std::nullopt; + } +} + +// If an expression is simply a whole symbol data designator, +// extract and return that symbol, else null. +template const Symbol *IsWholeSymbolDataRef(const A &x) { + if (auto dataRef{ExtractDataRef(x)}) { + if (const Symbol **p{std::get_if(&dataRef->u)}) { + return *p; + } + } + return nullptr; +} + // Creation of conversion expressions can be done to either a known // specific intrinsic type with ConvertToType(x) or by converting // one arbitrary expression to the type of another with ConvertTo(to, from). diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 739be6e..4578385 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -173,61 +173,6 @@ std::optional DynamicType::From(const semantics::Symbol &symbol) { return From(symbol.GetType()); // Symbol -> DeclTypeSpec -> DynamicType } -std::string DynamicType::AsFortran() const { - if (derived_ != nullptr) { - CHECK(category_ == TypeCategory::Derived); - std::string result{isPolymorphic_ ? "CLASS("s : "TYPE("s}; - result += derived_->typeSymbol().name().ToString(); - if (derived_->HasActualParameters()) { - char ch{'('}; - for (const auto &[name, value] : derived_->parameters()) { - result += ch; - ch = ','; - result += name.ToString() + '='; - if (value.isAssumed()) { - result += '*'; - } else if (value.isDeferred()) { - result += ':'; - } else if (const auto &intExpr{value.GetExplicit()}) { - std::stringstream ss; - intExpr->AsFortran(ss); - result += ss.str(); - } - } - result += ')'; - } - return result + ')'; - - } else if (charLength_ != nullptr) { - std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="}; - if (charLength_->isAssumed()) { - result += '*'; - } else if (charLength_->isDeferred()) { - result += ':'; - } else if (const auto &length{charLength_->GetExplicit()}) { - std::stringstream ss; - length->AsFortran(ss); - result += ss.str(); - } - return result + ')'; - } else if (isPolymorphic_) { - return "CLASS(*)"; - } else if (kind_ == 0) { - return "(typeless intrinsic function argument)"; - } else { - return EnumToString(category_) + '(' + std::to_string(kind_) + ')'; - } -} - -std::string DynamicType::AsFortran(std::string &&charLenExpr) const { - if (!charLenExpr.empty() && category_ == TypeCategory::Character) { - return "CHARACTER(KIND=" + std::to_string(kind_) + - ",LEN=" + std::move(charLenExpr) + ')'; - } else { - return AsFortran(); - } -} - DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const { switch (category_) { case TypeCategory::Integer: @@ -274,12 +219,4 @@ bool SomeKind::operator==( const SomeKind &that) const { return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_); } - -std::string SomeDerived::AsFortran() const { - if (IsUnlimitedPolymorphic()) { - return "CLASS(*)"; - } else { - return "TYPE("s + DerivedTypeSpecAsFortran(derivedTypeSpec()) + ')'; - } -} } diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 1c7689a..c5dd39a 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -27,16 +27,15 @@ #include "../parser/parse-tree.h" #include #include -#include // TODO pmk rm #include #include -#define DUMP_ON_FAILURE 1 // pmk +// #define DUMP_ON_FAILURE 1 +// #define CRASH_ON_FAILURE #if DUMP_ON_FAILURE #include "../parser/dump-parse-tree.h" #include #endif -// #define CRASH_ON_FAILURE // Typedef for optional generic expressions (ubiquitous in this file) using MaybeExpr = @@ -49,36 +48,6 @@ namespace Fortran::evaluate { using common::TypeCategory; -// If an expression simply wraps a DataRef, extract and return it. -template -common::IfNoLvalue, A> ExtractDataRef(A &&) { - return std::nullopt; -} - -template std::optional ExtractDataRef(Designator &&d) { - return std::visit( - [](auto &&x) -> std::optional { - if constexpr (common::HasMember) { - return {DataRef{std::move(x)}}; - } - return std::nullopt; - }, - std::move(d.u)); -} - -template std::optional ExtractDataRef(Expr &&expr) { - return std::visit( - [](auto &&x) { return ExtractDataRef(std::move(x)); }, std::move(expr.u)); -} - -template -std::optional ExtractDataRef(std::optional &&x) { - if (x.has_value()) { - return ExtractDataRef(std::move(*x)); - } - return std::nullopt; -} - struct DynamicTypeWithLength : public DynamicType { explicit DynamicTypeWithLength(const DynamicType &t) : DynamicType{t} {} std::optional> LEN() const; diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index 59550c4..09da44c 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -96,12 +96,12 @@ void DerivedTypeSpec::ProcessParameterExpressions( MaybeIntExpr expr; ParamValue *paramValue{FindParameter(name)}; if (paramValue != nullptr) { - if (!paramValue->isExplicit()) { - continue; // Deferred type parameter + if (paramValue->isExplicit()) { + expr = paramValue->GetExplicit(); + } else { + continue; // deferred or assumed parameter: don't use default value } - expr = paramValue->GetExplicit(); - } - if (!expr.has_value()) { + } else { expr = evaluate::Fold(foldingContext, common::Clone(details.init())); } if (expr.has_value()) { -- 2.7.4