diff options
Diffstat (limited to 'flang/lib')
32 files changed, 971 insertions, 176 deletions
diff --git a/flang/lib/Decimal/binary-to-decimal.cpp b/flang/lib/Decimal/binary-to-decimal.cpp index af233d586941..68ee345b8935 100644 --- a/flang/lib/Decimal/binary-to-decimal.cpp +++ b/flang/lib/Decimal/binary-to-decimal.cpp @@ -350,13 +350,20 @@ ConversionToDecimalResult ConvertDoubleToDecimal(char *buffer, std::size_t size, rounding, Fortran::decimal::BinaryFloatingPointNumber<53>(x)); } -#if __x86_64__ && !defined(_MSC_VER) +#if LONG_DOUBLE == 80 ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, long double x) { return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits, rounding, Fortran::decimal::BinaryFloatingPointNumber<64>(x)); } +#elif LONG_DOUBLE == 128 +ConversionToDecimalResult ConvertLongDoubleToDecimal(char *buffer, + std::size_t size, enum DecimalConversionFlags flags, int digits, + enum FortranRounding rounding, long double x) { + return Fortran::decimal::ConvertToDecimal(buffer, size, flags, digits, + rounding, Fortran::decimal::BinaryFloatingPointNumber<113>(x)); +} #endif } diff --git a/flang/lib/Decimal/decimal-to-binary.cpp b/flang/lib/Decimal/decimal-to-binary.cpp index 5e927e93b3bb..d6e30bed84c7 100644 --- a/flang/lib/Decimal/decimal-to-binary.cpp +++ b/flang/lib/Decimal/decimal-to-binary.cpp @@ -454,7 +454,6 @@ enum ConversionResultFlags ConvertDecimalToDouble( reinterpret_cast<const void *>(&result.binary), sizeof *d); return result.flags; } -#if __x86_64__ && !defined(_MSC_VER) enum ConversionResultFlags ConvertDecimalToLongDouble( const char **p, long double *ld, enum FortranRounding rounding) { auto result{Fortran::decimal::ConvertToBinary<64>(*p, rounding)}; @@ -462,6 +461,5 @@ enum ConversionResultFlags ConvertDecimalToLongDouble( reinterpret_cast<const void *>(&result.binary), sizeof *ld); return result.flags; } -#endif } } // namespace Fortran::decimal diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 2e061f0fe3fe..418d16105365 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -39,7 +39,7 @@ public: return semantics::IsKindTypeParameter(inq.parameter()); } bool operator()(const semantics::Symbol &symbol) const { - const auto &ultimate{symbol.GetUltimate()}; + const auto &ultimate{GetAssociationRoot(symbol)}; return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) || IsInitialProcedureTarget(ultimate); } @@ -180,21 +180,19 @@ public: return false; } bool operator()(const semantics::Symbol &symbol) { + // This function checks only base symbols, not components. const Symbol &ultimate{symbol.GetUltimate()}; - if (IsAllocatable(ultimate)) { - if (messages_) { - messages_->Say( - "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US, - ultimate.name()); - emittedMessage_ = true; - } - return false; - } else if (ultimate.Corank() > 0) { - if (messages_) { - messages_->Say( - "An initial data target may not be a reference to a coarray '%s'"_err_en_US, - ultimate.name()); - emittedMessage_ = true; + if (const auto *assoc{ + ultimate.detailsIf<semantics::AssocEntityDetails>()}) { + if (const auto &expr{assoc->expr()}) { + if (IsVariable(*expr)) { + return (*this)(*expr); + } else if (messages_) { + messages_->Say( + "An initial data target may not be an associated expression ('%s')"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } } return false; } else if (!ultimate.attrs().test(semantics::Attr::TARGET)) { @@ -213,8 +211,9 @@ public: emittedMessage_ = true; } return false; + } else { + return CheckVarOrComponent(ultimate); } - return true; } bool operator()(const StaticDataObject &) const { return false; } bool operator()(const TypeParamInquiry &) const { return false; } @@ -233,6 +232,9 @@ public: x.u); } bool operator()(const CoarrayRef &) const { return false; } + bool operator()(const Component &x) { + return CheckVarOrComponent(x.GetLastSymbol()) && (*this)(x.base()); + } bool operator()(const Substring &x) const { return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) && (*this)(x.parent()); @@ -258,6 +260,28 @@ public: bool operator()(const Relational<SomeType> &) const { return false; } private: + bool CheckVarOrComponent(const semantics::Symbol &symbol) { + const Symbol &ultimate{symbol.GetUltimate()}; + if (IsAllocatable(ultimate)) { + if (messages_) { + messages_->Say( + "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } + return false; + } else if (ultimate.Corank() > 0) { + if (messages_) { + messages_->Say( + "An initial data target may not be a reference to a coarray '%s'"_err_en_US, + ultimate.name()); + emittedMessage_ = true; + } + return false; + } + return true; + } + parser::ContextualMessages *messages_; bool emittedMessage_{false}; }; @@ -440,8 +464,11 @@ public: Result operator()(const semantics::Symbol &symbol) const { const auto &ultimate{symbol.GetUltimate()}; - if (semantics::IsNamedConstant(ultimate) || ultimate.owner().IsModule() || - ultimate.owner().IsSubmodule()) { + if (const auto *assoc{ + ultimate.detailsIf<semantics::AssocEntityDetails>()}) { + return (*this)(assoc->expr()); + } else if (semantics::IsNamedConstant(ultimate) || + ultimate.owner().IsModule() || ultimate.owner().IsSubmodule()) { return std::nullopt; } else if (scope_.IsDerivedType() && IsVariableName(ultimate)) { // C750, C754 @@ -584,16 +611,19 @@ public: using Base::operator(); Result operator()(const semantics::Symbol &symbol) const { - if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) || - symbol.Rank() == 0) { + const auto &ultimate{symbol.GetUltimate()}; + if (ultimate.attrs().test(semantics::Attr::CONTIGUOUS) || + ultimate.Rank() == 0) { return true; - } else if (semantics::IsPointer(symbol)) { + } else if (semantics::IsPointer(ultimate)) { return false; } else if (const auto *details{ - symbol.detailsIf<semantics::ObjectEntityDetails>()}) { + ultimate.detailsIf<semantics::ObjectEntityDetails>()}) { // N.B. ALLOCATABLEs are deferred shape, not assumed, and // are obviously contiguous. return !details->IsAssumedShape() && !details->IsAssumedRank(); + } else if (auto assoc{Base::operator()(ultimate)}) { + return assoc; } else { return false; } diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index eea7b6ee7a95..8f18a0605b2e 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -579,7 +579,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( if (auto p{GetInt64Arg(args[0])}) { return Expr<T>{SelectedIntKind(*p)}; } - } else if (name == "selected_real_kind") { + } else if (name == "selected_real_kind" || + name == "__builtin_ieee_selected_real_kind") { if (auto p{GetInt64ArgOr(args[0], 0)}) { if (auto r{GetInt64ArgOr(args[1], 0)}) { if (auto radix{GetInt64ArgOr(args[2], 2)}) { @@ -658,24 +659,43 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( // Substitute a bare type parameter reference with its value if it has one now Expr<TypeParamInquiry::Result> FoldOperation( FoldingContext &context, TypeParamInquiry &&inquiry) { - if (!inquiry.base()) { + std::optional<NamedEntity> base{inquiry.base()}; + parser::CharBlock parameterName{inquiry.parameter().name()}; + if (base) { + // Handling "designator%typeParam". Get the value of the type parameter + // from the instantiation of the base + if (const semantics::DeclTypeSpec * + declType{base->GetLastSymbol().GetType()}) { + if (const semantics::ParamValue * + paramValue{ + declType->derivedTypeSpec().FindParameter(parameterName)}) { + const semantics::MaybeIntExpr ¶mExpr{paramValue->GetExplicit()}; + if (paramExpr && IsConstantExpr(*paramExpr)) { + Expr<SomeInteger> intExpr{*paramExpr}; + return Fold(context, + ConvertToType<TypeParamInquiry::Result>(std::move(intExpr))); + } + } + } + } else { // A "bare" type parameter: replace with its value, if that's now known. if (const auto *pdt{context.pdtInstance()}) { if (const semantics::Scope * scope{context.pdtInstance()->scope()}) { - auto iter{scope->find(inquiry.parameter().name())}; + auto iter{scope->find(parameterName)}; if (iter != scope->end()) { const Symbol &symbol{*iter->second}; const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()}; - if (details && details->init() && - (details->attr() == common::TypeParamAttr::Kind || - IsConstantExpr(*details->init()))) { - Expr<SomeInteger> expr{*details->init()}; - return Fold(context, - ConvertToType<TypeParamInquiry::Result>(std::move(expr))); + if (details) { + const semantics::MaybeIntExpr &initExpr{details->init()}; + if (initExpr && IsConstantExpr(*initExpr)) { + Expr<SomeInteger> expr{*initExpr}; + return Fold(context, + ConvertToType<TypeParamInquiry::Result>(std::move(expr))); + } } } } - if (const auto *value{pdt->FindParameter(inquiry.parameter().name())}) { + if (const auto *value{pdt->FindParameter(parameterName)}) { if (value->isExplicit()) { return Fold(context, AsExpr(ConvertToType<TypeParamInquiry::Result>( diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp index 64e4bd8c8bd9..455b3c2605c3 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -106,6 +106,10 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction( } } } + } else if (name == "logical") { + if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) { + return Fold(context, ConvertToType<T>(std::move(*expr))); + } } else if (name == "merge") { return FoldMerge<T>(context, std::move(funcRef)); } else if (name == "__builtin_ieee_support_datatype" || diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index df3671a919b5..f7cfaa3e6dff 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/flang/lib/Evaluate/formatting.cpp @@ -614,7 +614,7 @@ llvm::raw_ostream &BaseObject::AsFortran(llvm::raw_ostream &o) const { llvm::raw_ostream &TypeParamInquiry::AsFortran(llvm::raw_ostream &o) const { if (base_) { - return base_->AsFortran(o) << '%'; + base_.value().AsFortran(o) << '%'; } return EmitVar(o, parameter_); } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 8636c9ed3d77..26889a6e21d4 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -772,6 +772,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"back", AnyLogical, Rank::elemental, Optionality::optional}, DefaultingKIND}, KINDInt}, + {"__builtin_ieee_selected_real_kind", // alias for selected_real_kind + {{"p", AnyInt, Rank::scalar}, + {"r", AnyInt, Rank::scalar, Optionality::optional}, + {"radix", AnyInt, Rank::scalar, Optionality::optional}}, + DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction}, {"__builtin_ieee_support_datatype", {{"x", AnyReal, Rank::elemental, Optionality::optional}}, DefaultLogical}, diff --git a/flang/lib/Frontend/CompilerInstance.cpp b/flang/lib/Frontend/CompilerInstance.cpp index 6c6b0b7335a9..c3e538911d41 100644 --- a/flang/lib/Frontend/CompilerInstance.cpp +++ b/flang/lib/Frontend/CompilerInstance.cpp @@ -112,7 +112,7 @@ std::unique_ptr<llvm::raw_pwrite_stream> CompilerInstance::CreateOutputFile( if (!os) { osFile = outputFilePath; os.reset(new llvm::raw_fd_ostream(osFile, error, - (binary ? llvm::sys::fs::OF_None : llvm::sys::fs::OF_Text))); + (binary ? llvm::sys::fs::OF_None : llvm::sys::fs::OF_TextWithCRLF))); if (error) return nullptr; } @@ -142,7 +142,6 @@ bool CompilerInstance::ExecuteAction(FrontendAction &act) { // Set some sane defaults for the frontend. invoc.SetDefaultFortranOpts(); - invoc.setDefaultPredefinitions(); // Update the fortran options based on user-based input. invoc.setFortranOpts(); // Set the encoding to read all input files in based on user input. diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp index d2318d3d683d..d1203c7912d0 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -21,6 +21,8 @@ #include "llvm/Option/Arg.h" #include "llvm/Option/ArgList.h" #include "llvm/Option/OptTable.h" +#include "llvm/Support/FileSystem.h" +#include "llvm/Support/FileUtilities.h" #include "llvm/Support/Process.h" #include "llvm/Support/raw_ostream.h" #include <memory> @@ -92,6 +94,9 @@ static void setUpFrontendBasedOnAction(FrontendOptions &opts) { if (opts.programAction_ == DebugDumpParsingLog) opts.instrumentedParse_ = true; + + if (opts.programAction_ == DebugDumpProvenance) + opts.needProvenanceRangeToCharBlockMappings_ = true; } static InputKind ParseFrontendArgs(FrontendOptions &opts, @@ -122,6 +127,9 @@ static InputKind ParseFrontendArgs(FrontendOptions &opts, case clang::driver::options::OPT_fdebug_unparse: opts.programAction_ = DebugUnparse; break; + case clang::driver::options::OPT_fdebug_unparse_no_sema: + opts.programAction_ = DebugUnparseNoSema; + break; case clang::driver::options::OPT_fdebug_unparse_with_symbols: opts.programAction_ = DebugUnparseWithSymbols; break; @@ -131,6 +139,9 @@ static InputKind ParseFrontendArgs(FrontendOptions &opts, case clang::driver::options::OPT_fdebug_dump_parse_tree: opts.programAction_ = DebugDumpParseTree; break; + case clang::driver::options::OPT_fdebug_dump_parse_tree_no_sema: + opts.programAction_ = DebugDumpParseTreeNoSema; + break; case clang::driver::options::OPT_fdebug_dump_provenance: opts.programAction_ = DebugDumpProvenance; break; @@ -285,6 +296,16 @@ static InputKind ParseFrontendArgs(FrontendOptions &opts, return dashX; } +// Generate the path to look for intrinsic modules +static std::string getIntrinsicDir() { + // TODO: Find a system independent API + llvm::SmallString<128> driverPath; + driverPath.assign(llvm::sys::fs::getMainExecutable(nullptr, nullptr)); + llvm::sys::path::remove_filename(driverPath); + driverPath.append("/../include/flang/"); + return std::string(driverPath); +} + /// Parses all preprocessor input arguments and populates the preprocessor /// options accordingly. /// @@ -305,6 +326,20 @@ static void parsePreprocessorArgs( // Add the ordered list of -I's. for (const auto *currentArg : args.filtered(clang::driver::options::OPT_I)) opts.searchDirectoriesFromDashI.emplace_back(currentArg->getValue()); + + // Prepend the ordered list of -intrinsic-modules-path + // to the default location to search. + for (const auto *currentArg : + args.filtered(clang::driver::options::OPT_fintrinsic_modules_path)) + opts.searchDirectoriesFromIntrModPath.emplace_back(currentArg->getValue()); + + // -cpp/-nocpp + if (const auto *currentArg = args.getLastArg( + clang::driver::options::OPT_cpp, clang::driver::options::OPT_nocpp)) + opts.macrosFlag_ = + (currentArg->getOption().matches(clang::driver::options::OPT_cpp)) + ? PPMacrosFlag::Include + : PPMacrosFlag::Exclude; } /// Parses all semantic related arguments and populates the variables @@ -332,6 +367,26 @@ static void parseSemaArgs(CompilerInvocation &res, llvm::opt::ArgList &args, } } +/// Parses all diagnostics related arguments and populates the variables +/// options accordingly. +static void parseDiagArgs(CompilerInvocation &res, llvm::opt::ArgList &args, + clang::DiagnosticsEngine &diags) { + // -Werror option + // TODO: Currently throws a Diagnostic for anything other than -W<error>, + // this has to change when other -W<opt>'s are supported. + if (args.hasArg(clang::driver::options::OPT_W_Joined)) { + if (args.getLastArgValue(clang::driver::options::OPT_W_Joined) + .equals("error")) { + res.SetWarnAsErr(true); + } else { + const unsigned diagID = + diags.getCustomDiagID(clang::DiagnosticsEngine::Error, + "Only `-Werror` is supported currently."); + diags.Report(diagID); + } + } +} + /// Parses all Dialect related arguments and populates the variables /// options accordingly. static void parseDialectArgs(CompilerInvocation &res, llvm::opt::ArgList &args, @@ -371,6 +426,26 @@ static void parseDialectArgs(CompilerInvocation &res, llvm::opt::ArgList &args, res.frontendOpts().features_.Enable( Fortran::common::LanguageFeature::OpenMP); } + + // -pedantic + if (args.hasArg(clang::driver::options::OPT_pedantic)) { + res.set_EnableConformanceChecks(); + } + // -std=f2018 (currently this implies -pedantic) + // TODO: Set proper options when more fortran standards + // are supported. + if (args.hasArg(clang::driver::options::OPT_std_EQ)) { + auto standard = args.getLastArgValue(clang::driver::options::OPT_std_EQ); + // We only allow f2018 as the given standard + if (standard.equals("f2018")) { + res.set_EnableConformanceChecks(); + } else { + const unsigned diagID = + diags.getCustomDiagID(clang::DiagnosticsEngine::Error, + "Only -std=f2018 is allowed currently."); + diags.Report(diagID); + } + } return; } @@ -407,17 +482,15 @@ bool CompilerInvocation::CreateFromArgs(CompilerInvocation &res, parseSemaArgs(res, args, diags); // Parse dialect arguments parseDialectArgs(res, args, diags); + // Parse diagnostic arguments + parseDiagArgs(res, args, diags); return success; } -/// Collect the macro definitions provided by the given preprocessor -/// options into the parser options. -/// -/// \param [in] ppOpts The preprocessor options -/// \param [out] opts The fortran options -static void collectMacroDefinitions( - const PreprocessorOptions &ppOpts, Fortran::parser::Options &opts) { +void CompilerInvocation::collectMacroDefinitions() { + auto &ppOpts = this->preprocessorOpts(); + for (unsigned i = 0, n = ppOpts.macros.size(); i != n; ++i) { llvm::StringRef macro = ppOpts.macros[i].first; bool isUndef = ppOpts.macros[i].second; @@ -428,7 +501,7 @@ static void collectMacroDefinitions( // For an #undef'd macro, we only care about the name. if (isUndef) { - opts.predefinitions.emplace_back( + parserOpts_.predefinitions.emplace_back( macroName.str(), std::optional<std::string>{}); continue; } @@ -441,7 +514,7 @@ static void collectMacroDefinitions( llvm::StringRef::size_type End = macroBody.find_first_of("\n\r"); macroBody = macroBody.substr(0, End); } - opts.predefinitions.emplace_back( + parserOpts_.predefinitions.emplace_back( macroName, std::optional<std::string>(macroBody.str())); } } @@ -497,13 +570,21 @@ void CompilerInvocation::setFortranOpts() { fortranOptions.features = frontendOptions.features_; fortranOptions.encoding = frontendOptions.encoding_; - collectMacroDefinitions(preprocessorOptions, fortranOptions); - + // Adding search directories specified by -I fortranOptions.searchDirectories.insert( fortranOptions.searchDirectories.end(), preprocessorOptions.searchDirectoriesFromDashI.begin(), preprocessorOptions.searchDirectoriesFromDashI.end()); + // Add the ordered list of -intrinsic-modules-path + fortranOptions.searchDirectories.insert( + fortranOptions.searchDirectories.end(), + preprocessorOptions.searchDirectoriesFromIntrModPath.begin(), + preprocessorOptions.searchDirectoriesFromIntrModPath.end()); + + // Add the default intrinsic module directory at the end + fortranOptions.searchDirectories.emplace_back(getIntrinsicDir()); + // Add the directory supplied through -J/-module-dir to the list of search // directories if (moduleDirJ.compare(".") != 0) @@ -511,6 +592,13 @@ void CompilerInvocation::setFortranOpts() { if (frontendOptions.instrumentedParse_) fortranOptions.instrumentedParse = true; + + if (frontendOptions.needProvenanceRangeToCharBlockMappings_) + fortranOptions.needProvenanceRangeToCharBlockMappings = true; + + if (enableConformanceChecks()) { + fortranOptions.features.WarnOnAllNonstandard(); + } } void CompilerInvocation::setSemanticsOpts( @@ -521,5 +609,7 @@ void CompilerInvocation::setSemanticsOpts( defaultKinds(), fortranOptions.features, allCookedSources); semanticsContext_->set_moduleDirectory(moduleDir()) - .set_searchDirectories(fortranOptions.searchDirectories); + .set_searchDirectories(fortranOptions.searchDirectories) + .set_warnOnNonstandardUsage(enableConformanceChecks()) + .set_warningsAreErrors(warnAsErr()); } diff --git a/flang/lib/Frontend/FrontendAction.cpp b/flang/lib/Frontend/FrontendAction.cpp index 650fd2999bed..23e4ca3f3306 100644 --- a/flang/lib/Frontend/FrontendAction.cpp +++ b/flang/lib/Frontend/FrontendAction.cpp @@ -67,6 +67,25 @@ bool FrontendAction::BeginSourceFile( return false; } + auto &invoc = ci.invocation(); + + // Include command-line and predefined preprocessor macros. Use either: + // * `-cpp/-nocpp`, or + // * the file extension (if the user didn't express any preference) + // to decide whether to include them or not. + if ((invoc.preprocessorOpts().macrosFlag_ == PPMacrosFlag::Include) || + (invoc.preprocessorOpts().macrosFlag_ == PPMacrosFlag::Unknown && + currentInput().MustBePreprocessed())) { + invoc.setDefaultPredefinitions(); + invoc.collectMacroDefinitions(); + } + + // Decide between fixed and free form (if the user didn't express any + // preference, use the file extension to decide) + if (invoc.frontendOpts().fortranForm_ == FortranForm::Unknown) { + invoc.fortranOpts().isFixedForm = currentInput().IsFixedForm(); + } + if (!BeginSourceFileAction(ci)) { BeginSourceFileCleanUp(*this, ci); return false; diff --git a/flang/lib/Frontend/FrontendActions.cpp b/flang/lib/Frontend/FrontendActions.cpp index 1871a35444db..00b46c90dfd1 100644 --- a/flang/lib/Frontend/FrontendActions.cpp +++ b/flang/lib/Frontend/FrontendActions.cpp @@ -10,6 +10,7 @@ #include "flang/Common/default-kinds.h" #include "flang/Frontend/CompilerInstance.h" #include "flang/Frontend/FrontendOptions.h" +#include "flang/Frontend/PreprocessorOptions.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/parsing.h" @@ -45,26 +46,16 @@ bool reportFatalSemanticErrors(const Fortran::semantics::Semantics &semantics, bool PrescanAction::BeginSourceFileAction(CompilerInstance &c1) { CompilerInstance &ci = this->instance(); - std::string currentInputPath{GetCurrentFileOrBufferName()}; - Fortran::parser::Options parserOptions = ci.invocation().fortranOpts(); - if (ci.invocation().frontendOpts().fortranForm_ == FortranForm::Unknown) { - // Switch between fixed and free form format based on the input file - // extension. - // - // Ideally we should have all Fortran options set before entering this - // method (i.e. before processing any specific input files). However, we - // can't decide between fixed and free form based on the file extension - // earlier than this. - parserOptions.isFixedForm = currentInput().IsFixedForm(); - } // Prescan. In case of failure, report and return. ci.parsing().Prescan(currentInputPath, parserOptions); - if (ci.parsing().messages().AnyFatalError()) { + if (!ci.parsing().messages().empty() && + (ci.invocation().warnAsErr() || + ci.parsing().messages().AnyFatalError())) { const unsigned diagID = ci.diagnostics().getCustomDiagID( clang::DiagnosticsEngine::Error, "Could not scan %0"); ci.diagnostics().Report(diagID) << GetCurrentFileOrBufferName(); @@ -76,7 +67,7 @@ bool PrescanAction::BeginSourceFileAction(CompilerInstance &c1) { return true; } -bool PrescanAndSemaAction::BeginSourceFileAction(CompilerInstance &c1) { +bool PrescanAndParseAction::BeginSourceFileAction(CompilerInstance &c1) { CompilerInstance &ci = this->instance(); std::string currentInputPath{GetCurrentFileOrBufferName()}; @@ -122,6 +113,46 @@ bool PrescanAndSemaAction::BeginSourceFileAction(CompilerInstance &c1) { // Report the diagnostics from parsing ci.parsing().messages().Emit(llvm::errs(), ci.allCookedSources()); + return true; +} + +bool PrescanAndSemaAction::BeginSourceFileAction(CompilerInstance &c1) { + CompilerInstance &ci = this->instance(); + std::string currentInputPath{GetCurrentFileOrBufferName()}; + Fortran::parser::Options parserOptions = ci.invocation().fortranOpts(); + + // Prescan. In case of failure, report and return. + ci.parsing().Prescan(currentInputPath, parserOptions); + + if (!ci.parsing().messages().empty() && + (ci.invocation().warnAsErr() || + ci.parsing().messages().AnyFatalError())) { + const unsigned diagID = ci.diagnostics().getCustomDiagID( + clang::DiagnosticsEngine::Error, "Could not scan %0"); + ci.diagnostics().Report(diagID) << GetCurrentFileOrBufferName(); + ci.parsing().messages().Emit(llvm::errs(), ci.allCookedSources()); + + return false; + } + + // Parse. In case of failure, report and return. + ci.parsing().Parse(llvm::outs()); + + if (!ci.parsing().messages().empty() && + (ci.invocation().warnAsErr() || + ci.parsing().messages().AnyFatalError())) { + unsigned diagID = ci.diagnostics().getCustomDiagID( + clang::DiagnosticsEngine::Error, "Could not parse %0"); + ci.diagnostics().Report(diagID) << GetCurrentFileOrBufferName(); + + ci.parsing().messages().Emit( + llvm::errs(), this->instance().allCookedSources()); + return false; + } + + // Report the diagnostics from parsing + ci.parsing().messages().Emit(llvm::errs(), ci.allCookedSources()); + auto &parseTree{*ci.parsing().parseTree()}; // Prepare semantics @@ -135,6 +166,7 @@ bool PrescanAndSemaAction::BeginSourceFileAction(CompilerInstance &c1) { // Report the diagnostics from the semantic checks semantics.EmitMessages(ci.semaOutputStream()); + return true; } @@ -209,6 +241,19 @@ void ParseSyntaxOnlyAction::ExecuteAction() { GetCurrentFileOrBufferName()); } +void DebugUnparseNoSemaAction::ExecuteAction() { + auto &parseTree{instance().parsing().parseTree()}; + + Fortran::parser::AnalyzedObjectsAsFortran asFortran = + Fortran::frontend::getBasicAsFortran(); + + // TODO: Options should come from CompilerInvocation + Unparse(llvm::outs(), *parseTree, + /*encoding=*/Fortran::parser::Encoding::UTF_8, + /*capitalizeKeywords=*/true, /*backslashEscapes=*/false, + /*preStatement=*/nullptr, &asFortran); +} + void DebugUnparseAction::ExecuteAction() { auto &parseTree{instance().parsing().parseTree()}; Fortran::parser::AnalyzedObjectsAsFortran asFortran = @@ -246,6 +291,15 @@ void DebugDumpSymbolsAction::ExecuteAction() { semantics, this->instance().diagnostics(), GetCurrentFileOrBufferName()); } +void DebugDumpParseTreeNoSemaAction::ExecuteAction() { + auto &parseTree{instance().parsing().parseTree()}; + Fortran::parser::AnalyzedObjectsAsFortran asFortran = + Fortran::frontend::getBasicAsFortran(); + + // Dump parse tree + Fortran::parser::DumpTree(llvm::outs(), parseTree, &asFortran); +} + void DebugDumpParseTreeAction::ExecuteAction() { auto &parseTree{instance().parsing().parseTree()}; Fortran::parser::AnalyzedObjectsAsFortran asFortran = @@ -264,7 +318,9 @@ void DebugMeasureParseTreeAction::ExecuteAction() { // Parse. In case of failure, report and return. ci.parsing().Parse(llvm::outs()); - if (ci.parsing().messages().AnyFatalError()) { + if (!ci.parsing().messages().empty() && + (ci.invocation().warnAsErr() || + ci.parsing().messages().AnyFatalError())) { unsigned diagID = ci.diagnostics().getCustomDiagID( clang::DiagnosticsEngine::Error, "Could not parse %0"); ci.diagnostics().Report(diagID) << GetCurrentFileOrBufferName(); diff --git a/flang/lib/Frontend/FrontendOptions.cpp b/flang/lib/Frontend/FrontendOptions.cpp index a43cac3bb1cb..94fff8799177 100644 --- a/flang/lib/Frontend/FrontendOptions.cpp +++ b/flang/lib/Frontend/FrontendOptions.cpp @@ -13,17 +13,23 @@ using namespace Fortran::frontend; bool Fortran::frontend::isFixedFormSuffix(llvm::StringRef suffix) { // Note: Keep this list in-sync with flang/test/lit.cfg.py - return suffix == "f" || suffix == "F" || suffix == "ff" || suffix == "for" || - suffix == "FOR" || suffix == "fpp" || suffix == "FPP"; + return suffix == "f77" || suffix == "f" || suffix == "F" || suffix == "ff" || + suffix == "for" || suffix == "FOR" || suffix == "fpp" || suffix == "FPP"; } bool Fortran::frontend::isFreeFormSuffix(llvm::StringRef suffix) { // Note: Keep this list in-sync with flang/test/lit.cfg.py // TODO: Add Cuda Fortan files (i.e. `*.cuf` and `*.CUF`). - return suffix == "f77" || suffix == "f90" || suffix == "F90" || - suffix == "ff90" || suffix == "f95" || suffix == "F95" || - suffix == "ff95" || suffix == "f03" || suffix == "F03" || - suffix == "f08" || suffix == "F08" || suffix == "f18" || suffix == "F18"; + return suffix == "f90" || suffix == "F90" || suffix == "ff90" || + suffix == "f95" || suffix == "F95" || suffix == "ff95" || + suffix == "f03" || suffix == "F03" || suffix == "f08" || + suffix == "F08" || suffix == "f18" || suffix == "F18"; +} + +bool Fortran::frontend::mustBePreprocessed(llvm::StringRef suffix) { + return suffix == "F" || suffix == "FOR" || suffix == "fpp" || + suffix == "FPP" || suffix == "F90" || suffix == "F95" || + suffix == "F03" || suffix == "F08" || suffix == "F18"; } // TODO: This is a copy of `asFortran` from f18.cpp and is added here for diff --git a/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp b/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp index 2a08e388a9d8..462de5241f3e 100644 --- a/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp +++ b/flang/lib/FrontendTool/ExecuteCompilerInvocation.cpp @@ -40,6 +40,9 @@ static std::unique_ptr<FrontendAction> CreateFrontendBaseAction( case DebugUnparse: return std::make_unique<DebugUnparseAction>(); break; + case DebugUnparseNoSema: + return std::make_unique<DebugUnparseNoSemaAction>(); + break; case DebugUnparseWithSymbols: return std::make_unique<DebugUnparseWithSymbolsAction>(); break; @@ -49,6 +52,9 @@ static std::unique_ptr<FrontendAction> CreateFrontendBaseAction( case DebugDumpParseTree: return std::make_unique<DebugDumpParseTreeAction>(); break; + case DebugDumpParseTreeNoSema: + return std::make_unique<DebugDumpParseTreeNoSemaAction>(); + break; case DebugDumpProvenance: return std::make_unique<DebugDumpProvenanceAction>(); break; diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp index b590fc932441..07d9e63e0423 100644 --- a/flang/lib/Lower/Mangler.cpp +++ b/flang/lib/Lower/Mangler.cpp @@ -8,6 +8,7 @@ #include "flang/Lower/Mangler.h" #include "flang/Common/reference.h" +#include "flang/Lower/Todo.h" #include "flang/Lower/Utils.h" #include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -65,8 +66,8 @@ findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) { // Mangle the name of `symbol` to make it unique within FIR's symbol table using // the FIR name mangler, `mangler` std::string -Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, - const Fortran::semantics::Symbol &symbol) { +Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol, + bool keepExternalInScope) { // Resolve host and module association before mangling const auto &ultimateSymbol = symbol.GetUltimate(); auto symbolName = toStringRef(ultimateSymbol.name()); @@ -74,12 +75,14 @@ Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, return std::visit( Fortran::common::visitors{ [&](const Fortran::semantics::MainProgramDetails &) { - return uniquer.doProgramEntry().str(); + return fir::NameUniquer::doProgramEntry().str(); }, [&](const Fortran::semantics::SubprogramDetails &) { // Mangle external procedure without any scope prefix. - if (Fortran::semantics::IsExternal(ultimateSymbol)) - return uniquer.doProcedure(llvm::None, llvm::None, symbolName); + if (!keepExternalInScope && + Fortran::semantics::IsExternal(ultimateSymbol)) + return fir::NameUniquer::doProcedure(llvm::None, llvm::None, + symbolName); // Separate module subprograms must be mangled according to the // scope where they were declared (the symbol we have is the // definition). @@ -87,35 +90,69 @@ Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer, if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol)) interface = mpIface; auto modNames = moduleNames(*interface); - return uniquer.doProcedure(modNames, hostName(*interface), - symbolName); + return fir::NameUniquer::doProcedure(modNames, hostName(*interface), + symbolName); }, [&](const Fortran::semantics::ProcEntityDetails &) { // Mangle procedure pointers and dummy procedures as variables if (Fortran::semantics::IsPointer(ultimateSymbol) || Fortran::semantics::IsDummy(ultimateSymbol)) - return uniquer.doVariable(moduleNames(ultimateSymbol), - hostName(ultimateSymbol), symbolName); + return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol), + hostName(ultimateSymbol), + symbolName); // Otherwise, this is an external procedure, even if it does not // have an explicit EXTERNAL attribute. Mangle it without any // prefix. - return uniquer.doProcedure(llvm::None, llvm::None, symbolName); + return fir::NameUniquer::doProcedure(llvm::None, llvm::None, + symbolName); }, [&](const Fortran::semantics::ObjectEntityDetails &) { auto modNames = moduleNames(ultimateSymbol); auto optHost = hostName(ultimateSymbol); if (Fortran::semantics::IsNamedConstant(ultimateSymbol)) - return uniquer.doConstant(modNames, optHost, symbolName); - return uniquer.doVariable(modNames, optHost, symbolName); + return fir::NameUniquer::doConstant(modNames, optHost, + symbolName); + return fir::NameUniquer::doVariable(modNames, optHost, symbolName); }, - [](const auto &) -> std::string { - assert(false); - return {}; + [&](const Fortran::semantics::CommonBlockDetails &) { + return fir::NameUniquer::doCommonBlock(symbolName); }, + [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string { + // Derived type mangling must used mangleName(DerivedTypeSpec&) so + // that kind type parameter values can be mangled. + llvm::report_fatal_error( + "only derived type instances can be mangled"); + }, + [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); }, }, ultimateSymbol.details()); } +std::string Fortran::lower::mangle::mangleName( + const Fortran::semantics::DerivedTypeSpec &derivedType) { + // Resolve host and module association before mangling + const auto &ultimateSymbol = derivedType.typeSymbol().GetUltimate(); + auto symbolName = toStringRef(ultimateSymbol.name()); + auto modNames = moduleNames(ultimateSymbol); + auto optHost = hostName(ultimateSymbol); + llvm::SmallVector<std::int64_t> kinds; + for (const auto ¶m : + Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) { + const auto ¶mDetails = + param->get<Fortran::semantics::TypeParamDetails>(); + if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) { + const auto *paramValue = derivedType.FindParameter(param->name()); + assert(paramValue && "derived type kind parameter value not found"); + auto paramExpr = paramValue->GetExplicit(); + assert(paramExpr && "derived type kind param not explicit"); + auto init = Fortran::evaluate::ToInt64(paramValue->GetExplicit()); + assert(init && "derived type kind param is not constant"); + kinds.emplace_back(*init); + } + } + return fir::NameUniquer::doType(modNames, optHost, symbolName, kinds); +} + std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) { auto result = fir::NameUniquer::deconstruct(name); return result.second.name; diff --git a/flang/lib/Optimizer/CMakeLists.txt b/flang/lib/Optimizer/CMakeLists.txt index 0a7286339e2e..b83d6a079db6 100644 --- a/flang/lib/Optimizer/CMakeLists.txt +++ b/flang/lib/Optimizer/CMakeLists.txt @@ -10,11 +10,16 @@ add_flang_library(FIROptimizer Support/InternalNames.cpp Support/KindMapping.cpp + CodeGen/CGOps.cpp + CodeGen/PreCGRewrite.cpp + Transforms/Inliner.cpp DEPENDS FIROpsIncGen + FIROptCodeGenPassIncGen FIROptTransformsPassIncGen + CGOpsIncGen ${dialect_libs} LINK_LIBS diff --git a/flang/lib/Optimizer/CodeGen/CGOps.cpp b/flang/lib/Optimizer/CodeGen/CGOps.cpp new file mode 100644 index 000000000000..527066ec5ccd --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/CGOps.cpp @@ -0,0 +1,64 @@ +//===-- CGOps.cpp -- FIR codegen operations -------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "CGOps.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" + +/// FIR codegen dialect constructor. +fir::FIRCodeGenDialect::FIRCodeGenDialect(mlir::MLIRContext *ctx) + : mlir::Dialect("fircg", ctx, mlir::TypeID::get<FIRCodeGenDialect>()) { + addOperations< +#define GET_OP_LIST +#include "flang/Optimizer/CodeGen/CGOps.cpp.inc" + >(); +} + +// anchor the class vtable to this compilation unit +fir::FIRCodeGenDialect::~FIRCodeGenDialect() { + // do nothing +} + +#define GET_OP_CLASSES +#include "flang/Optimizer/CodeGen/CGOps.cpp.inc" + +unsigned fir::cg::XEmboxOp::getOutRank() { + if (slice().empty()) + return getRank(); + auto outRank = fir::SliceOp::getOutputRank(slice()); + assert(outRank >= 1); + return outRank; +} + +unsigned fir::cg::XReboxOp::getOutRank() { + if (auto seqTy = + fir::dyn_cast_ptrOrBoxEleTy(getType()).dyn_cast<fir::SequenceType>()) + return seqTy.getDimension(); + return 0; +} + +unsigned fir::cg::XReboxOp::getRank() { + if (auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(box().getType()) + .dyn_cast<fir::SequenceType>()) + return seqTy.getDimension(); + return 0; +} + +unsigned fir::cg::XArrayCoorOp::getRank() { + auto memrefTy = memref().getType(); + if (memrefTy.isa<fir::BoxType>()) + if (auto seqty = + fir::dyn_cast_ptrOrBoxEleTy(memrefTy).dyn_cast<fir::SequenceType>()) + return seqty.getDimension(); + return shape().size(); +} diff --git a/flang/lib/Optimizer/CodeGen/CGOps.h b/flang/lib/Optimizer/CodeGen/CGOps.h new file mode 100644 index 000000000000..f5f552c63376 --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/CGOps.h @@ -0,0 +1,24 @@ +//===-- CGOps.h -------------------------------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_CODEGEN_CGOPS_H +#define OPTIMIZER_CODEGEN_CGOPS_H + +#include "flang/Optimizer/Dialect/FIRType.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +using namespace mlir; + +#define GET_OP_CLASSES +#include "flang/Optimizer/CodeGen/CGOps.h.inc" + +#endif diff --git a/flang/lib/Optimizer/CodeGen/PassDetail.h b/flang/lib/Optimizer/CodeGen/PassDetail.h new file mode 100644 index 000000000000..f7030131beff --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/PassDetail.h @@ -0,0 +1,26 @@ +//===- PassDetail.h - Optimizer code gen Pass class details -----*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef OPTMIZER_CODEGEN_PASSDETAIL_H +#define OPTMIZER_CODEGEN_PASSDETAIL_H + +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/OpenMP/OpenMPDialect.h" +#include "mlir/IR/BuiltinDialect.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassRegistry.h" + +namespace fir { + +#define GEN_PASS_CLASSES +#include "flang/Optimizer/CodeGen/CGPasses.h.inc" + +} // namespace fir + +#endif // OPTMIZER_CODEGEN_PASSDETAIL_H diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp new file mode 100644 index 000000000000..37c6e43cb7ac --- /dev/null +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -0,0 +1,263 @@ +//===-- PreCGRewrite.cpp --------------------------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "CGOps.h" +#include "PassDetail.h" +#include "flang/Optimizer/CodeGen/CodeGen.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Optimizer/Support/FIRContext.h" +#include "mlir/Transforms/DialectConversion.h" +#include "llvm/ADT/STLExtras.h" + +//===----------------------------------------------------------------------===// +// Codegen rewrite: rewriting of subgraphs of ops +//===----------------------------------------------------------------------===// + +using namespace fir; + +#define DEBUG_TYPE "flang-codegen-rewrite" + +static void populateShape(llvm::SmallVectorImpl<mlir::Value> &vec, + ShapeOp shape) { + vec.append(shape.extents().begin(), shape.extents().end()); +} + +// Operands of fir.shape_shift split into two vectors. +static void populateShapeAndShift(llvm::SmallVectorImpl<mlir::Value> &shapeVec, + llvm::SmallVectorImpl<mlir::Value> &shiftVec, + ShapeShiftOp shift) { + auto endIter = shift.pairs().end(); + for (auto i = shift.pairs().begin(); i != endIter;) { + shiftVec.push_back(*i++); + shapeVec.push_back(*i++); + } +} + +static void populateShift(llvm::SmallVectorImpl<mlir::Value> &vec, + ShiftOp shift) { + vec.append(shift.origins().begin(), shift.origins().end()); +} + +namespace { + +/// Convert fir.embox to the extended form where necessary. +/// +/// The embox operation can take arguments that specify multidimensional array +/// properties at runtime. These properties may be shared between distinct +/// objects that have the same properties. Before we lower these small DAGs to +/// LLVM-IR, we gather all the information into a single extended operation. For +/// example, +/// ``` +/// %1 = fir.shape_shift %4, %5 : (index, index) -> !fir.shapeshift<1> +/// %2 = fir.slice %6, %7, %8 : (index, index, index) -> !fir.slice<1> +/// %3 = fir.embox %0 (%1) [%2] : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xi32>> +/// ``` +/// can be rewritten as +/// ``` +/// %1 = fircg.ext_embox %0(%5) origin %4[%6, %7, %8] : (!fir.ref<!fir.array<?xi32>>, index, index, index, index, index) -> !fir.box<!fir.array<?xi32>> +/// ``` +class EmboxConversion : public mlir::OpRewritePattern<EmboxOp> { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(EmboxOp embox, + mlir::PatternRewriter &rewriter) const override { + auto shapeVal = embox.getShape(); + // If the embox does not include a shape, then do not convert it + if (shapeVal) + return rewriteDynamicShape(embox, rewriter, shapeVal); + if (auto boxTy = embox.getType().dyn_cast<BoxType>()) + if (auto seqTy = boxTy.getEleTy().dyn_cast<SequenceType>()) + if (seqTy.hasConstantShape()) + return rewriteStaticShape(embox, rewriter, seqTy); + return mlir::failure(); + } + + mlir::LogicalResult rewriteStaticShape(EmboxOp embox, + mlir::PatternRewriter &rewriter, + SequenceType seqTy) const { + auto loc = embox.getLoc(); + llvm::SmallVector<mlir::Value> shapeOpers; + auto idxTy = rewriter.getIndexType(); + for (auto ext : seqTy.getShape()) { + auto iAttr = rewriter.getIndexAttr(ext); + auto extVal = rewriter.create<mlir::ConstantOp>(loc, idxTy, iAttr); + shapeOpers.push_back(extVal); + } + auto xbox = rewriter.create<cg::XEmboxOp>( + loc, embox.getType(), embox.memref(), shapeOpers, llvm::None, + llvm::None, llvm::None, embox.lenParams()); + LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); + rewriter.replaceOp(embox, xbox.getOperation()->getResults()); + return mlir::success(); + } + + mlir::LogicalResult rewriteDynamicShape(EmboxOp embox, + mlir::PatternRewriter &rewriter, + mlir::Value shapeVal) const { + auto loc = embox.getLoc(); + auto shapeOp = dyn_cast<ShapeOp>(shapeVal.getDefiningOp()); + llvm::SmallVector<mlir::Value> shapeOpers; + llvm::SmallVector<mlir::Value> shiftOpers; + if (shapeOp) { + populateShape(shapeOpers, shapeOp); + } else { + auto shiftOp = dyn_cast<ShapeShiftOp>(shapeVal.getDefiningOp()); + assert(shiftOp && "shape is neither fir.shape nor fir.shape_shift"); + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + } + llvm::SmallVector<mlir::Value> sliceOpers; + llvm::SmallVector<mlir::Value> subcompOpers; + if (auto s = embox.getSlice()) + if (auto sliceOp = dyn_cast_or_null<SliceOp>(s.getDefiningOp())) { + sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); + subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); + } + auto xbox = rewriter.create<cg::XEmboxOp>( + loc, embox.getType(), embox.memref(), shapeOpers, shiftOpers, + sliceOpers, subcompOpers, embox.lenParams()); + LLVM_DEBUG(llvm::dbgs() << "rewriting " << embox << " to " << xbox << '\n'); + rewriter.replaceOp(embox, xbox.getOperation()->getResults()); + return mlir::success(); + } +}; + +/// Convert fir.rebox to the extended form where necessary. +/// +/// For example, +/// ``` +/// %5 = fir.rebox %3(%1) : (!fir.box<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>> +/// ``` +/// converted to +/// ``` +/// %5 = fircg.ext_rebox %3(%13) origin %12 : (!fir.box<!fir.array<?xi32>>, index, index) -> !fir.box<!fir.array<?xi32>> +/// ``` +class ReboxConversion : public mlir::OpRewritePattern<ReboxOp> { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(ReboxOp rebox, + mlir::PatternRewriter &rewriter) const override { + auto loc = rebox.getLoc(); + llvm::SmallVector<mlir::Value> shapeOpers; + llvm::SmallVector<mlir::Value> shiftOpers; + if (auto shapeVal = rebox.shape()) { + if (auto shapeOp = dyn_cast<ShapeOp>(shapeVal.getDefiningOp())) + populateShape(shapeOpers, shapeOp); + else if (auto shiftOp = dyn_cast<ShapeShiftOp>(shapeVal.getDefiningOp())) + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + else if (auto shiftOp = dyn_cast<ShiftOp>(shapeVal.getDefiningOp())) + populateShift(shiftOpers, shiftOp); + else + return mlir::failure(); + } + llvm::SmallVector<mlir::Value> sliceOpers; + llvm::SmallVector<mlir::Value> subcompOpers; + if (auto s = rebox.slice()) + if (auto sliceOp = dyn_cast_or_null<SliceOp>(s.getDefiningOp())) { + sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); + subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); + } + + auto xRebox = rewriter.create<cg::XReboxOp>( + loc, rebox.getType(), rebox.box(), shapeOpers, shiftOpers, sliceOpers, + subcompOpers); + LLVM_DEBUG(llvm::dbgs() + << "rewriting " << rebox << " to " << xRebox << '\n'); + rewriter.replaceOp(rebox, xRebox.getOperation()->getResults()); + return mlir::success(); + } +}; + +/// Convert all fir.array_coor to the extended form. +/// +/// For example, +/// ``` +/// %4 = fir.array_coor %addr (%1) [%2] %0 : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>, !fir.slice<1>, index) -> !fir.ref<i32> +/// ``` +/// converted to +/// ``` +/// %40 = fircg.ext_array_coor %addr(%9) origin %8[%4, %5, %6<%39> : (!fir.ref<!fir.array<?xi32>>, index, index, index, index, index, index) -> !fir.ref<i32> +/// ``` +class ArrayCoorConversion : public mlir::OpRewritePattern<ArrayCoorOp> { +public: + using OpRewritePattern::OpRewritePattern; + + mlir::LogicalResult + matchAndRewrite(ArrayCoorOp arrCoor, + mlir::PatternRewriter &rewriter) const override { + auto loc = arrCoor.getLoc(); + llvm::SmallVector<mlir::Value> shapeOpers; + llvm::SmallVector<mlir::Value> shiftOpers; + if (auto shapeVal = arrCoor.shape()) { + if (auto shapeOp = dyn_cast<ShapeOp>(shapeVal.getDefiningOp())) + populateShape(shapeOpers, shapeOp); + else if (auto shiftOp = dyn_cast<ShapeShiftOp>(shapeVal.getDefiningOp())) + populateShapeAndShift(shapeOpers, shiftOpers, shiftOp); + else if (auto shiftOp = dyn_cast<ShiftOp>(shapeVal.getDefiningOp())) + populateShift(shiftOpers, shiftOp); + else + return mlir::failure(); + } + llvm::SmallVector<mlir::Value> sliceOpers; + llvm::SmallVector<mlir::Value> subcompOpers; + if (auto s = arrCoor.slice()) + if (auto sliceOp = dyn_cast_or_null<SliceOp>(s.getDefiningOp())) { + sliceOpers.append(sliceOp.triples().begin(), sliceOp.triples().end()); + subcompOpers.append(sliceOp.fields().begin(), sliceOp.fields().end()); + } + auto xArrCoor = rewriter.create<cg::XArrayCoorOp>( + loc, arrCoor.getType(), arrCoor.memref(), shapeOpers, shiftOpers, + sliceOpers, subcompOpers, arrCoor.indices(), arrCoor.lenParams()); + LLVM_DEBUG(llvm::dbgs() + << "rewriting " << arrCoor << " to " << xArrCoor << '\n'); + rewriter.replaceOp(arrCoor, xArrCoor.getOperation()->getResults()); + return mlir::success(); + } +}; + +class CodeGenRewrite : public CodeGenRewriteBase<CodeGenRewrite> { +public: + void runOnOperation() override final { + auto op = getOperation(); + auto &context = getContext(); + mlir::OpBuilder rewriter(&context); + mlir::ConversionTarget target(context); + target.addLegalDialect<FIROpsDialect, FIRCodeGenDialect, + mlir::StandardOpsDialect>(); + target.addIllegalOp<ArrayCoorOp>(); + target.addIllegalOp<ReboxOp>(); + target.addDynamicallyLegalOp<EmboxOp>([](EmboxOp embox) { + return !(embox.getShape() || + embox.getType().cast<BoxType>().getEleTy().isa<SequenceType>()); + }); + mlir::OwningRewritePatternList patterns(&context); + patterns.insert<EmboxConversion, ArrayCoorConversion, ReboxConversion>( + &context); + if (mlir::failed( + mlir::applyPartialConversion(op, target, std::move(patterns)))) { + mlir::emitError(mlir::UnknownLoc::get(&context), + "error in running the pre-codegen conversions"); + signalPassFailure(); + } + } +}; + +} // namespace + +std::unique_ptr<mlir::Pass> fir::createFirCodeGenRewritePass() { + return std::make_unique<CodeGenRewrite>(); +} diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp index 6d2d78d5825f..38390d801134 100644 --- a/flang/lib/Optimizer/Dialect/FIROps.cpp +++ b/flang/lib/Optimizer/Dialect/FIROps.cpp @@ -697,7 +697,7 @@ static bool isOne(mlir::Value v) { return checkIsIntegerConstant(v, 1); } template <typename FltOp, typename CpxOp> struct UndoComplexPattern : public mlir::RewritePattern { UndoComplexPattern(mlir::MLIRContext *ctx) - : mlir::RewritePattern("fir.insert_value", {}, 2, ctx) {} + : mlir::RewritePattern("fir.insert_value", 2, ctx) {} mlir::LogicalResult matchAndRewrite(mlir::Operation *op, diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 4bab4b16149d..9e7c07b9c55f 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -1,4 +1,3 @@ - add_flang_library(FortranSemantics assignment.cpp attr.cpp diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp index fccda8ce55a9..7dd0a7a273b9 100644 --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -66,10 +66,11 @@ public: : IsInBlankCommon(symbol) ? "Blank COMMON object" : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure" // remaining checks don't apply to components - : !isFirstSymbol ? nullptr - : IsHostAssociated(symbol, scope) ? "Host-associated object" - : IsUseAssociated(symbol, scope) ? "USE-associated object" - : nullptr}) { + : !isFirstSymbol ? nullptr + : IsHostAssociated(symbol, scope) ? "Host-associated object" + : IsUseAssociated(symbol, scope) ? "USE-associated object" + : symbol.has<AssocEntityDetails>() ? "Construct association" + : nullptr}) { context_.Say(source_, "%s '%s' must not be initialized in a DATA statement"_err_en_US, whyNot, symbol.name()); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 0dad3c6e8d9b..0b28a3188e5d 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -19,6 +19,8 @@ #include "flang/Semantics/tools.h" #include "flang/Semantics/type.h" #include <algorithm> +#include <map> +#include <string> namespace Fortran::semantics { @@ -100,6 +102,7 @@ private: } } bool IsResultOkToDiffer(const FunctionResult &); + void CheckBindCName(const Symbol &); SemanticsContext &context_; evaluate::FoldingContext &foldingContext_{context_.foldingContext()}; @@ -112,6 +115,8 @@ private: // Cache of calls to Procedure::Characterize(Symbol) std::map<SymbolRef, std::optional<Procedure>, SymbolAddressCompare> characterizeCache_; + // Collection of symbols with BIND(C) names + std::map<std::string, SymbolRef> bindC_; }; class DistinguishabilityHelper { @@ -195,6 +200,7 @@ void CheckHelper::Check(const Symbol &symbol) { if (symbol.attrs().test(Attr::VOLATILE)) { CheckVolatile(symbol, derived); } + CheckBindCName(symbol); if (isDone) { return; // following checks do not apply } @@ -1654,6 +1660,35 @@ void CheckHelper::CheckGenericOps(const Scope &scope) { helper.Check(scope); } +static const std::string *DefinesBindCName(const Symbol &symbol) { + const auto *subp{symbol.detailsIf<SubprogramDetails>()}; + if ((subp && !subp->isInterface()) || symbol.has<ObjectEntityDetails>()) { + // Symbol defines data or entry point + return symbol.GetBindName(); + } else { + return nullptr; + } +} + +// Check that BIND(C) names are distinct +void CheckHelper::CheckBindCName(const Symbol &symbol) { + if (const std::string * name{DefinesBindCName(symbol)}) { + auto pair{bindC_.emplace(*name, symbol)}; + if (!pair.second) { + const Symbol &other{*pair.first->second}; + if (DefinesBindCName(other) && !context_.HasError(other)) { + if (auto *msg{messages_.Say( + "Two symbols have the same BIND(C) name '%s'"_err_en_US, + *name)}) { + msg->Attach(other.name(), "Conflicting symbol"_en_US); + } + context_.SetError(symbol); + context_.SetError(other); + } + } + } +} + void SubprogramMatchHelper::Check( const Symbol &symbol1, const Symbol &symbol2) { const auto details1{symbol1.get<SubprogramDetails>()}; @@ -1687,24 +1722,23 @@ void SubprogramMatchHelper::Check( : "Module subprogram '%s' does not have NON_RECURSIVE prefix but " "the corresponding interface body does"_err_en_US); } - MaybeExpr bindName1{details1.bindName()}; - MaybeExpr bindName2{details2.bindName()}; - if (bindName1.has_value() != bindName2.has_value()) { + const std::string *bindName1{details1.bindName()}; + const std::string *bindName2{details2.bindName()}; + if (!bindName1 && !bindName2) { + // OK - neither has a binding label + } else if (!bindName1) { Say(symbol1, symbol2, - bindName1.has_value() - ? "Module subprogram '%s' has a binding label but the corresponding" - " interface body does not"_err_en_US - : "Module subprogram '%s' does not have a binding label but the" - " corresponding interface body does"_err_en_US); - } else if (bindName1) { - std::string string1{bindName1->AsFortran()}; - std::string string2{bindName2->AsFortran()}; - if (string1 != string2) { - Say(symbol1, symbol2, - "Module subprogram '%s' has binding label %s but the corresponding" - " interface body has %s"_err_en_US, - string1, string2); - } + "Module subprogram '%s' does not have a binding label but the" + " corresponding interface body does"_err_en_US); + } else if (!bindName2) { + Say(symbol1, symbol2, + "Module subprogram '%s' has a binding label but the" + " corresponding interface body does not"_err_en_US); + } else if (*bindName1 != *bindName2) { + Say(symbol1, symbol2, + "Module subprogram '%s' has binding label '%s' but the corresponding" + " interface body has '%s'"_err_en_US, + *details1.bindName(), *details2.bindName()); } const Procedure *proc1{checkHelper.Characterize(symbol1)}; const Procedure *proc2{checkHelper.Characterize(symbol2)}; diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 3ed86132cbea..dcb70015d5d8 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -127,11 +127,52 @@ private: std::map<std::string, std::int64_t> labelNamesandLevels_; }; +bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { + // Definition of close nesting: + // + // `A region nested inside another region with no parallel region nested + // between them` + // + // Examples: + // non-parallel construct 1 + // non-parallel construct 2 + // parallel construct + // construct 3 + // In the above example, construct 3 is NOT closely nested inside construct 1 + // or 2 + // + // non-parallel construct 1 + // non-parallel construct 2 + // construct 3 + // In the above example, construct 3 is closely nested inside BOTH construct 1 + // and 2 + // + // Algorithm: + // Starting from the parent context, Check in a bottom-up fashion, each level + // of the context stack. If we have a match for one of the (supplied) + // violating directives, `close nesting` is satisfied. If no match is there in + // the entire stack, `close nesting` is not satisfied. If at any level, a + // `parallel` region is found, `close nesting` is not satisfied. + + if (CurrentDirectiveIsNested()) { + int index = dirContext_.size() - 2; + while (index != -1) { + if (set.test(dirContext_[index].directive)) { + return true; + } else if (llvm::omp::parallelSet.test(dirContext_[index].directive)) { + return false; + } + index--; + } + } + return false; +} + bool OmpStructureChecker::HasInvalidWorksharingNesting( const parser::CharBlock &source, const OmpDirectiveSet &set) { // set contains all the invalid closely nested directives // for the given directive (`source` here) - if (CurrentDirectiveIsNested() && set.test(GetContextParent().directive)) { + if (IsCloselyNestedRegion(set)) { context_.Say(source, "A worksharing region may not be closely nested inside a " "worksharing, explicit task, taskloop, critical, ordered, atomic, or " @@ -729,6 +770,9 @@ CHECK_SIMPLE_CLAUSE(UseDeviceAddr, OMPC_use_device_addr) CHECK_SIMPLE_CLAUSE(Write, OMPC_write) CHECK_SIMPLE_CLAUSE(Init, OMPC_init) CHECK_SIMPLE_CLAUSE(Use, OMPC_use) +CHECK_SIMPLE_CLAUSE(Novariants, OMPC_novariants) +CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) +CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator) CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 0d11f72b5bc8..66a8c99cbcd6 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -166,7 +166,7 @@ public: private: bool HasInvalidWorksharingNesting( const parser::CharBlock &, const OmpDirectiveSet &); - + bool IsCloselyNestedRegion(const OmpDirectiveSet &set); // specific clause related bool ScheduleModifierHasType(const parser::OmpScheduleClause &, const parser::OmpScheduleModifierType::ModType &); diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 0b36de464129..b826221be643 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -2217,8 +2217,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef, return std::nullopt; } const semantics::DeclTypeSpec &type{ - semantics::FindOrInstantiateDerivedType( - scope, std::move(dtSpec), context_)}; + semantics::FindOrInstantiateDerivedType(scope, std::move(dtSpec))}; auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)}; *structureConstructor = mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec()); diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 1e2a5c6728b7..005342007302 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -54,8 +54,8 @@ static void PutEntity( static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &); static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &); static void PutBound(llvm::raw_ostream &, const Bound &); -static llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs, - const MaybeExpr & = std::nullopt, std::string before = ","s, +llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs, + const std::string * = nullptr, std::string before = ","s, std::string after = ""s); static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr); @@ -346,7 +346,7 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) { if (isInterface) { os << (isAbstract ? "abstract " : "") << "interface\n"; } - PutAttrs(os, prefixAttrs, std::nullopt, ""s, " "s); + PutAttrs(os, prefixAttrs, nullptr, ""s, " "s); os << (details.isFunction() ? "function " : "subroutine "); os << symbol.name() << '('; int n = 0; @@ -561,6 +561,9 @@ void PutObjectEntity(llvm::raw_ostream &os, const Symbol &symbol) { void PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) { if (symbol.attrs().test(Attr::INTRINSIC)) { os << "intrinsic::" << symbol.name() << '\n'; + if (symbol.attrs().test(Attr::PRIVATE)) { + os << "private::" << symbol.name() << '\n'; + } return; } const auto &details{symbol.get<ProcEntityDetails>()}; @@ -636,26 +639,18 @@ void PutBound(llvm::raw_ostream &os, const Bound &x) { void PutEntity(llvm::raw_ostream &os, const Symbol &symbol, std::function<void()> writeType, Attrs attrs) { writeType(); - MaybeExpr bindName; - std::visit(common::visitors{ - [&](const SubprogramDetails &x) { bindName = x.bindName(); }, - [&](const ObjectEntityDetails &x) { bindName = x.bindName(); }, - [&](const ProcEntityDetails &x) { bindName = x.bindName(); }, - [&](const auto &) {}, - }, - symbol.details()); - PutAttrs(os, attrs, bindName); + PutAttrs(os, attrs, symbol.GetBindName()); os << "::" << symbol.name(); } // Put out each attribute to os, surrounded by `before` and `after` and // mapped to lower case. llvm::raw_ostream &PutAttrs(llvm::raw_ostream &os, Attrs attrs, - const MaybeExpr &bindName, std::string before, std::string after) { + const std::string *bindName, std::string before, std::string after) { attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL if (bindName) { - bindName->AsFortran(os << before << "bind(c, name=") << ')' << after; + os << before << "bind(c, name=\"" << *bindName << "\")" << after; attrs.set(Attr::BIND_C, false); } for (std::size_t i{0}; i < Attr_enumSize; ++i) { diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 2d1d513c427e..a62b7c36fe61 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -681,7 +681,9 @@ public: bool isAbstract() const; protected: - GenericDetails &GetGenericDetails(); + Symbol &GetGenericSymbol() { + return DEREF(genericInfo_.top().symbol); + } // Add to generic the symbol for the subprogram with the same name void CheckGenericProcedures(Symbol &); @@ -1528,19 +1530,26 @@ bool AttrsVisitor::SetPassNameOn(Symbol &symbol) { } bool AttrsVisitor::SetBindNameOn(Symbol &symbol) { - if (!bindName_) { + if (!attrs_ || !attrs_->test(Attr::BIND_C)) { return false; } - std::visit( - common::visitors{ - [&](EntityDetails &x) { x.set_bindName(std::move(bindName_)); }, - [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, - [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, - [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); }, - [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); }, - [](auto &) { common::die("unexpected bind name"); }, - }, - symbol.details()); + std::optional<std::string> label{evaluate::GetScalarConstantValue< + evaluate::Type<TypeCategory::Character, 1>>(bindName_)}; + // 18.9.2(2): discard leading and trailing blanks, ignore if all blank + if (label) { + auto first{label->find_first_not_of(" ")}; + auto last{label->find_last_not_of(" ")}; + if (first == std::string::npos) { + Say(currStmtSource().value(), "Blank binding label ignored"_en_US); + label.reset(); + } else { + label = label->substr(first, last - first + 1); + } + } + if (!label) { + label = parser::ToLowerCaseLetters(symbol.name().ToString()); + } + symbol.SetBindName(std::move(*label)); return true; } @@ -2228,7 +2237,7 @@ const DeclTypeSpec *ScopeHandler::GetImplicitType( if (const DerivedTypeSpec * derived{type->AsDerived()}) { // Resolve any forward-referenced derived type; a quick no-op else. auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)}; - instantiatable.Instantiate(currScope(), context()); + instantiatable.Instantiate(currScope()); } } return type; @@ -2674,9 +2683,6 @@ bool InterfaceVisitor::isGeneric() const { bool InterfaceVisitor::isAbstract() const { return !genericInfo_.empty() && GetGenericInfo().isAbstract; } -GenericDetails &InterfaceVisitor::GetGenericDetails() { - return GetGenericInfo().symbol->get<GenericDetails>(); -} void InterfaceVisitor::AddSpecificProcs( const std::list<parser::Name> &names, ProcedureKind kind) { @@ -2878,7 +2884,9 @@ void SubprogramVisitor::Post(const parser::ImplicitPart &) { if (funcInfo_.parsedType) { messageHandler().set_currStmtSource(funcInfo_.source); if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) { - funcInfo_.resultSymbol->SetType(*type); + if (!context().HasError(funcInfo_.resultSymbol)) { + funcInfo_.resultSymbol->SetType(*type); + } } } funcInfo_ = {}; @@ -2938,11 +2946,16 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { funcResultName = &name; } // add function result to function scope - EntityDetails funcResultDetails; - funcResultDetails.set_funcResult(true); - funcInfo_.resultSymbol = - &MakeSymbol(*funcResultName, std::move(funcResultDetails)); - details.set_result(*funcInfo_.resultSymbol); + if (details.isFunction()) { + CHECK(context().HasError(currScope().symbol())); + } else { + // add function result to function scope + EntityDetails funcResultDetails; + funcResultDetails.set_funcResult(true); + funcInfo_.resultSymbol = + &MakeSymbol(*funcResultName, std::move(funcResultDetails)); + details.set_result(*funcInfo_.resultSymbol); + } // C1560. if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) { @@ -3216,7 +3229,13 @@ Symbol &SubprogramVisitor::PushSubprogramScope( MakeExternal(*symbol); } if (isGeneric()) { - GetGenericDetails().AddSpecificProc(*symbol, name.source); + Symbol &genericSymbol{GetGenericSymbol()}; + if (genericSymbol.has<GenericDetails>()) { + genericSymbol.get<GenericDetails>().AddSpecificProc( + *symbol, name.source); + } else { + CHECK(context().HasError(genericSymbol)); + } } set_inheritFromParent(false); } @@ -3912,7 +3931,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) { } else { auto restorer{ GetFoldingContext().messages().SetLocation(currStmtSource().value())}; - derived.Instantiate(currScope(), context()); + derived.Instantiate(currScope()); } SetDeclTypeSpec(type); } @@ -6808,7 +6827,7 @@ void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) { void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) { CHECK(scope.IsDerivedType() && !scope.symbol()); if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) { - spec->Instantiate(currScope(), context()); + spec->Instantiate(currScope()); const Symbol &origTypeSymbol{spec->typeSymbol()}; if (const Scope * origTypeScope{origTypeSymbol.scope()}) { CHECK(origTypeScope->IsDerivedType() && diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp index 4faec3bd00cd..c6f73e583d6d 100644 --- a/flang/lib/Semantics/scope.cpp +++ b/flang/lib/Semantics/scope.cpp @@ -408,7 +408,7 @@ void Scope::InstantiateDerivedTypes() { for (DeclTypeSpec &type : declTypeSpecs_) { if (type.category() == DeclTypeSpec::TypeDerived || type.category() == DeclTypeSpec::ClassDerived) { - type.derivedTypeSpec().Instantiate(*this, context_); + type.derivedTypeSpec().Instantiate(*this); } } } diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index edd2c84218c1..7d439df75c2e 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -14,6 +14,7 @@ #include "flang/Semantics/tools.h" #include "llvm/Support/raw_ostream.h" #include <string> +#include <type_traits> namespace Fortran::semantics { @@ -84,7 +85,7 @@ void ModuleDetails::set_scope(const Scope *scope) { llvm::raw_ostream &operator<<( llvm::raw_ostream &os, const SubprogramDetails &x) { DumpBool(os, "isInterface", x.isInterface_); - DumpExpr(os, "bindName", x.bindName_); + DumpOptional(os, "bindName", x.bindName()); if (x.result_) { DumpType(os << " result:", x.result()); os << x.result_->name(); @@ -290,6 +291,33 @@ void Symbol::SetType(const DeclTypeSpec &type) { details_); } +template <typename T> +constexpr bool HasBindName{std::is_convertible_v<T, const WithBindName *>}; + +const std::string *Symbol::GetBindName() const { + return std::visit( + [&](auto &x) -> const std::string * { + if constexpr (HasBindName<decltype(&x)>) { + return x.bindName(); + } else { + return nullptr; + } + }, + details_); +} + +void Symbol::SetBindName(std::string &&name) { + std::visit( + [&](auto &x) { + if constexpr (HasBindName<decltype(&x)>) { + x.set_bindName(std::move(name)); + } else { + DIE("bind name not allowed on this kind of symbol"); + } + }, + details_); +} + bool Symbol::IsFuncResult() const { return std::visit( common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); }, @@ -331,7 +359,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) { if (x.type()) { os << " type: " << *x.type(); } - DumpExpr(os, "bindName", x.bindName_); + DumpOptional(os, "bindName", x.bindName()); return os; } @@ -361,7 +389,7 @@ llvm::raw_ostream &operator<<( } else { DumpType(os, x.interface_.type()); } - DumpExpr(os, "bindName", x.bindName()); + DumpOptional(os, "bindName", x.bindName()); DumpOptional(os, "passName", x.passName()); if (x.init()) { if (const Symbol * target{*x.init()}) { @@ -448,6 +476,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { DumpSymbolVector(os, x.objects()); }, [&](const CommonBlockDetails &x) { + DumpOptional(os, "bindName", x.bindName()); if (x.alignment()) { os << " alignment=" << x.alignment(); } diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 256a5cc1d317..68db3e186a99 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1053,10 +1053,9 @@ SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) { return result; } -const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope, - DerivedTypeSpec &&spec, SemanticsContext &semanticsContext, - DeclTypeSpec::Category category) { - spec.EvaluateParameters(semanticsContext); +const DeclTypeSpec &FindOrInstantiateDerivedType( + Scope &scope, DerivedTypeSpec &&spec, DeclTypeSpec::Category category) { + spec.EvaluateParameters(scope.context()); if (const DeclTypeSpec * type{scope.FindInstantiatedDerivedType(spec, category)}) { return *type; @@ -1064,7 +1063,7 @@ const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope, // Create a new instantiation of this parameterized derived type // for this particular distinct set of actual parameter values. DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))}; - type.derivedTypeSpec().Instantiate(scope, semanticsContext); + type.derivedTypeSpec().Instantiate(scope); return type; } diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 741b25332297..40b434b7b86e 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -191,33 +191,42 @@ ParamValue *DerivedTypeSpec::FindParameter(SourceName target) { class InstantiateHelper { public: - InstantiateHelper(SemanticsContext &context, Scope &scope) - : context_{context}, scope_{scope} {} + InstantiateHelper(Scope &scope) : scope_{scope} {} // Instantiate components from fromScope into scope_ void InstantiateComponents(const Scope &); private: + SemanticsContext &context() const { return scope_.context(); } evaluate::FoldingContext &foldingContext() { - return context_.foldingContext(); + return context().foldingContext(); } template <typename T> T Fold(T &&expr) { return evaluate::Fold(foldingContext(), std::move(expr)); } void InstantiateComponent(const Symbol &); const DeclTypeSpec *InstantiateType(const Symbol &); - const DeclTypeSpec &InstantiateIntrinsicType(const DeclTypeSpec &); + const DeclTypeSpec &InstantiateIntrinsicType( + SourceName, const DeclTypeSpec &); DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool); - SemanticsContext &context_; Scope &scope_; }; -void DerivedTypeSpec::Instantiate( - Scope &containingScope, SemanticsContext &context) { +static int PlumbPDTInstantiationDepth(const Scope *scope) { + int depth{0}; + while (scope->IsParameterizedDerivedTypeInstantiation()) { + ++depth; + scope = &scope->parent(); + } + return depth; +} + +void DerivedTypeSpec::Instantiate(Scope &containingScope) { if (instantiated_) { return; } instantiated_ = true; + auto &context{containingScope.context()}; auto &foldingContext{context.foldingContext()}; if (IsForwardReferenced()) { foldingContext.messages().Say(typeSymbol_.name(), @@ -235,7 +244,7 @@ void DerivedTypeSpec::Instantiate( if (DerivedTypeSpec * derived{type->AsDerived()}) { if (!(derived->IsForwardReferenced() && IsAllocatableOrPointer(symbol))) { - derived->Instantiate(containingScope, context); + derived->Instantiate(containingScope); } } } @@ -252,6 +261,9 @@ void DerivedTypeSpec::Instantiate( ComputeOffsets(context, const_cast<Scope &>(typeScope)); return; } + // New PDT instantiation. Create a new scope and populate it + // with components that have been specialized for this set of + // parameters. Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)}; newScope.set_derivedTypeSpec(*this); ReplaceScope(newScope); @@ -301,14 +313,19 @@ void DerivedTypeSpec::Instantiate( // type's scope into the new instance. newScope.AddSourceRange(typeScope.sourceRange()); auto restorer2{foldingContext.messages().SetContext(contextMessage)}; - InstantiateHelper{context, newScope}.InstantiateComponents(typeScope); + if (PlumbPDTInstantiationDepth(&containingScope) > 100) { + foldingContext.messages().Say( + "Too many recursive parameterized derived type instantiations"_err_en_US); + } else { + InstantiateHelper{newScope}.InstantiateComponents(typeScope); + } } void InstantiateHelper::InstantiateComponents(const Scope &fromScope) { for (const auto &pair : fromScope) { InstantiateComponent(*pair.second); } - ComputeOffsets(context_, scope_); + ComputeOffsets(context(), scope_); } void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) { @@ -362,9 +379,9 @@ const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) { } else if (const DerivedTypeSpec * spec{type->AsDerived()}) { return &FindOrInstantiateDerivedType(scope_, CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)), - context_, type->category()); + type->category()); } else if (type->AsIntrinsic()) { - return &InstantiateIntrinsicType(*type); + return &InstantiateIntrinsicType(symbol.name(), *type); } else if (type->category() == DeclTypeSpec::ClassStar) { return type; } else { @@ -374,7 +391,7 @@ const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) { // Apply type parameter values to an intrinsic type spec. const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( - const DeclTypeSpec &spec) { + SourceName symbolName, const DeclTypeSpec &spec) { const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())}; if (evaluate::ToInt64(intrinsic.kind())) { return spec; // KIND is already a known constant @@ -382,12 +399,12 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType( // The expression was not originally constant, but now it must be so // in the context of a parameterized derived type instantiation. KindExpr copy{Fold(common::Clone(intrinsic.kind()))}; - int kind{context_.GetDefaultKind(intrinsic.category())}; + int kind{context().GetDefaultKind(intrinsic.category())}; if (auto value{evaluate::ToInt64(copy)}) { if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) { kind = *value; } else { - foldingContext().messages().Say( + foldingContext().messages().Say(symbolName, "KIND parameter value (%jd) of intrinsic type %s " "did not resolve to a supported value"_err_en_US, *value, |