[llvm-branch-commits] [flang] [flang] Plugin directives for the loop that follows them (PR #228758)
Valentin Churavy via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Sat Oct 3 12:34:13 PDT 2026
https://github.com/vchuravy created https://github.com/llvm/llvm-project/pull/228758
Follow-up on #228757 to also attach plugin directives to loops.
:robot:
A plugin can register a directive whose subject is the DO or DO WHILE loop that follows it (PluginDirectiveSubject::Loop), as !DIR$ UNROLL is for its loop:
!DIR$ prefix keyword(var, ...) [name(value)]...
- Syntax: a trailing name(value) is the same as a name=value argument, and an argument may be a (signed) real literal, for the new PluginDirectiveArgKind::Real (a real or integer literal).
- Semantics: the positional arguments of a loop directive are variables or COMMON blocks, at least PluginDirectiveSpec::minPositional of them. The directive must come directly before a DO or DO WHILE loop (other directives may be in between), or it is an error; a directive after the last declaration goes with the loop that starts the execution part.
- Lowering: the variables are evaluated in front of the loop (a variable as its address, or its descriptor if it has one, an allocatable or pointer as its target's at that point; a COMMON block as its storage), and the start of the loop body gets a marker fir.call @__flang_directive.<prefix>.<keyword>(%var...) {fir.directive = {prefix = ..., keyword = ..., args = {...}}} with the other arguments as for fir.directives. The plugin's passes replace it with what the directive stands for; nothing defines the callee. For every form of DO loop, structured or not.
The example plugin registers `example converge(var, ... [, tol=real]) [max_iters(n)]`; the tests check its marker calls for a structured DO and an unstructured DO WHILE loop, with !DIR$ and the sentinel, and its errors.
Assisted-by: Claude Code (Opus 5.5)
>From 03e1255700c0d1f00c6ef00d2e5d9525899e3169 Mon Sep 17 00:00:00 2001
From: Valentin Churavy <v.churavy at gmail.com>
Date: Sat, 3 Oct 2026 21:22:31 +0200
Subject: [PATCH] [flang] Plugin directives for the loop that follows them
A plugin can register a directive whose subject is the DO or DO WHILE loop
that follows it (PluginDirectiveSubject::Loop), as !DIR$ UNROLL is for its
loop:
!DIR$ prefix keyword(var, ...) [name(value)]...
- Syntax: a trailing name(value) is the same as a name=value argument, and
an argument may be a (signed) real literal, for the new
PluginDirectiveArgKind::Real (a real or integer literal).
- Semantics: the positional arguments of a loop directive are variables or
COMMON blocks, at least PluginDirectiveSpec::minPositional of them. The
directive must come directly before a DO or DO WHILE loop (other
directives may be in between), or it is an error; a directive after the
last declaration goes with the loop that starts the execution part.
- Lowering: the variables are evaluated in front of the loop (a variable as
its address, or its descriptor if it has one, an allocatable or pointer
as its target's at that point; a COMMON block as its storage), and the
start of the loop body gets a marker
fir.call @__flang_directive.<prefix>.<keyword>(%var...)
{fir.directive = {prefix = ..., keyword = ..., args = {...}}}
with the other arguments as for fir.directives. The plugin's passes
replace it with what the directive stands for; nothing defines the
callee. For every form of DO loop, structured or not.
The example plugin registers `example converge(var, ... [, tol=real])
[max_iters(n)]`; the tests check its marker calls for a structured DO and
an unstructured DO WHILE loop, with !DIR$ and the sentinel, and its errors.
Assisted-by: Claude Code (Opus 5.5)
Co-Authored-By: Claude Opus 5.5 <noreply at anthropic.com>
---
.../DirectivesPlugin/DirectivesPlugin.cpp | 15 +-
flang/include/flang/Parser/parse-tree.h | 8 +-
.../include/flang/Support/PluginDirectives.h | 25 +-
flang/lib/Lower/Bridge.cpp | 392 +++++++++++++-----
flang/lib/Parser/Fortran-parsers.cpp | 30 +-
flang/lib/Parser/unparse.cpp | 1 +
.../lib/Semantics/canonicalize-directives.cpp | 124 +++++-
flang/lib/Semantics/mod-file.cpp | 18 +
flang/lib/Semantics/resolve-names.cpp | 217 ++++++----
.../Examples/plugin-directives-errors.f90 | 2 +
.../plugin-directives-loop-errors.f90 | 31 ++
.../test/Examples/plugin-directives-loop.f90 | 36 ++
.../test/Examples/plugin-directives-parse.f90 | 4 +-
13 files changed, 702 insertions(+), 201 deletions(-)
create mode 100644 flang/test/Examples/plugin-directives-loop-errors.f90
create mode 100644 flang/test/Examples/plugin-directives-loop.f90
diff --git a/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp b/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
index 464d7a397415d..33dc3ca32d24f 100644
--- a/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
+++ b/flang/examples/DirectivesPlugin/DirectivesPlugin.cpp
@@ -13,17 +13,21 @@
// !DIR$ EXAMPLE CALLBACK([proc,] HANDLER=proc [, PRIORITY=n] [, TAG=str])
// !DIR$ EXAMPLE WATCH(var [, BY=var])
// !DIR$ EXAMPLE NOTE([proc-or-var,] TEXT=str)
+// !DIR$ EXAMPLE CONVERGE(var [, var]... [, TOL=real]) [MAX_ITERS(n)]
//
// which may also be spelled with the plugin's own comment sentinel, e.g.
// `!$EXAMPLE NOTE(TEXT="...")`, a comment for other compilers.
//
-// Each one becomes an entry of the `fir.directives` attribute of the
-// func.func or fir.global of its subject, for a pass of the plugin to act on;
+// Each one but CONVERGE becomes an entry of the `fir.directives` attribute of
+// the func.func or fir.global of its subject. CONVERGE applies to the DO or
+// DO WHILE loop that follows it: its variables are passed to a marker call
+// at the start of the loop body. A pass of the plugin would act on them;
// this one defines no pass.
//
//===----------------------------------------------------------------------===//
#include "flang/Support/PluginDirectives.h"
+#include <utility>
using namespace Fortran::common;
@@ -44,6 +48,13 @@ namespace {
// A remark on a procedure or a variable.
registerPluginDirective({"example", "note", PluginDirectiveSubject::Any,
{{"text", PluginDirectiveArgKind::String, /*required=*/true}}});
+ // The loop that follows iterates the variables until they converge.
+ PluginDirectiveSpec converge{"example", "converge",
+ PluginDirectiveSubject::Loop,
+ {{"tol", PluginDirectiveArgKind::Real},
+ {"max_iters", PluginDirectiveArgKind::Integer}}};
+ converge.minPositional = 1;
+ registerPluginDirective(std::move(converge));
// !$example ... is !DIR$ example ...
registerPluginDirectiveSentinel("example");
return true;
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index c1cad361289e6..9483c8bda5a90 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3487,15 +3487,17 @@ struct CompilerDirective {
EMPTY_CLASS(IVDep);
EMPTY_CLASS(Simd);
EMPTY_CLASS(Unrecognized);
- // !DIR$ prefix keyword [( arg [, arg]... )] for a prefix registered by a
- // plugin (see flang/Support/PluginDirectives.h).
+ // !DIR$ prefix keyword [( arg [, arg]... )] [name(value)]... for a prefix
+ // registered by a plugin (see flang/Support/PluginDirectives.h). A trailing
+ // name(value) is an Arg with that keyword.
struct Plugin {
// A COMMON block named in an argument, /name/.
WRAPPER_CLASS(CommonBlock, Name);
struct Arg {
TUPLE_CLASS_BOILERPLATE(Arg);
std::tuple<std::optional<Name>,
- std::variant<Name, CommonBlock, std::uint64_t, std::string>>
+ std::variant<Name, CommonBlock, std::uint64_t,
+ SignedRealLiteralConstant, std::string>>
t;
};
TUPLE_CLASS_BOILERPLATE(Plugin);
diff --git a/flang/include/flang/Support/PluginDirectives.h b/flang/include/flang/Support/PluginDirectives.h
index cff6b344f8a95..82f0942268fa1 100644
--- a/flang/include/flang/Support/PluginDirectives.h
+++ b/flang/include/flang/Support/PluginDirectives.h
@@ -8,8 +8,11 @@
//
// Compiler directives defined by plugins:
//
-// !DIR$ prefix keyword [ ( arg [, arg]... ) ]
-// arg -> [ name = ] value, value -> name | integer | character-literal
+// !DIR$ prefix keyword [ ( arg [, arg]... ) ] [ name ( value ) ]...
+// arg -> [ name = ] value
+// value -> name | /common-block/ | integer | [sign] real | character-literal
+//
+// A trailing `name(value)` is the same as a `name=value` argument.
//
// A plugin loaded with `flang -fc1 -load` registers the directives it defines
// from a static initializer. The parser accepts the form above only for a
@@ -18,6 +21,18 @@
// directive to its subject (a procedure or a variable) as an MLIR attribute,
// for the plugin's own passes to interpret.
//
+// A directive whose subject is a loop goes in the execution part, in front of
+// a DO or DO WHILE loop, as !DIR$ UNROLL does. Its positional arguments are
+// variables (or COMMON blocks). Lowering evaluates them in front of the loop
+// (an allocatable or pointer as its descriptor then) and passes them to a
+// marker call at the start of the loop body:
+//
+// fir.call @__flang_directive.prefix.keyword(%var...)
+// {fir.directive = {prefix = "...", keyword = "...", args = {...}}}
+//
+// whose `args` are the other arguments, as for `fir.directives`. The plugin's
+// passes replace the call, which nothing defines, with what it stands for.
+//
// A plugin may also register a comment sentinel for its prefix, so that
//
// !$prefix keyword [ ( arg [, arg]... ) ]
@@ -40,6 +55,7 @@ enum class PluginDirectiveArgKind {
Procedure, ///< A name resolving to a procedure.
Variable, ///< A name resolving to a variable.
Integer, ///< An integer literal.
+ Real, ///< A real or integer literal, possibly signed.
String, ///< A character literal, or a name taken as its spelling.
};
@@ -59,6 +75,9 @@ enum class PluginDirectiveSubject {
Variable,
/// Either, as for Procedure.
Any,
+ /// The DO or DO WHILE loop that follows the directive. The positional
+ /// arguments are variables or COMMON blocks.
+ Loop,
};
struct PluginDirectiveSpec {
@@ -67,6 +86,8 @@ struct PluginDirectiveSpec {
PluginDirectiveSubject subject{PluginDirectiveSubject::Procedure};
/// The arguments after the (optional) positional subject.
std::vector<PluginDirectiveArg> args;
+ /// For a Loop directive, the least number of positional arguments.
+ unsigned minPositional{0};
};
/// Register a directive. Call from a static initializer in a plugin.
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index b8f23da2964c8..a9ae93b5f4159 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -12,6 +12,7 @@
#include "flang/Lower/Bridge.h"
+#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/CUDA.h"
@@ -66,6 +67,7 @@
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
#include "flang/Support/Flags.h"
+#include "flang/Support/PluginDirectives.h"
#include "flang/Support/Version.h"
#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
#include "mlir/Dialect/SCF/IR/SCF.h"
@@ -692,53 +694,146 @@ class FirConverter : public Fortran::lower::AbstractConverter {
finalizeOpenMPLowering(globalOmpRequiresSymbols);
}
- /// Attach the directives defined by plugins to the operations of their
- /// subjects in this module (a func.func for a procedure, a fir.global for a
- /// variable), as a `fir.directives` array of dictionaries:
+ /// What semantics lets a plugin directive refer to: a subprogram or an
+ /// external procedure, a variable, or a COMMON block. Nothing else has an
+ /// operation (or even a mangled name).
+ static bool
+ isPluginDirectiveReferable(const Fortran::semantics::Symbol &sym) {
+ if (Fortran::semantics::IsProcedure(sym)) {
+ return !sym.has<Fortran::semantics::GenericDetails>() &&
+ !Fortran::semantics::IsDummy(sym) &&
+ !Fortran::semantics::IsProcedurePointer(sym) &&
+ !Fortran::semantics::IsStmtFunction(sym) &&
+ !sym.attrs().test(Fortran::semantics::Attr::INTRINSIC);
+ }
+ return sym.has<Fortran::semantics::ObjectEntityDetails>() ||
+ sym.has<Fortran::semantics::CommonBlockDetails>();
+ }
+
+ /// The operation of a procedure or variable that a plugin directive names,
+ /// declared if need be (as a reference to it would): procedures, and
+ /// variables of modules, which may be another module's.
+ mlir::Operation *
+ getOrDeclarePluginDirectiveSymbol(const Fortran::semantics::Symbol &sym) {
+ if (!isPluginDirectiveReferable(sym)) {
+ return nullptr;
+ }
+ mlir::ModuleOp module{getModuleOp()};
+ if (mlir::Operation *op{module.lookupSymbol(mangleName(sym))}) {
+ return op;
+ }
+ if (Fortran::semantics::IsProcedure(sym)) {
+ return Fortran::lower::getOrDeclareFunction(
+ Fortran::evaluate::ProcedureDesignator{sym}, *this)
+ .getOperation();
+ }
+ if (sym.has<Fortran::semantics::ObjectEntityDetails>() &&
+ sym.owner().IsModule()) {
+ return Fortran::lower::declareModuleVariable(*this, sym).getOperation();
+ }
+ return nullptr;
+ }
+
+ /// A real literal argument of a plugin directive, as a float attribute of
+ /// its kind.
+ mlir::Attribute genPluginDirectiveRealAttr(
+ const Fortran::parser::SignedRealLiteralConstant &x) {
+ Fortran::evaluate::ExpressionAnalyzer ea{bridge.getSemanticsContext()};
+ Fortran::semantics::MaybeExpr expr{ea.Analyze(x)};
+ if (!expr)
+ return {};
+ *expr = Fortran::evaluate::Fold(
+ bridge.getSemanticsContext().foldingContext(), std::move(*expr));
+ const auto *real{
+ std::get_if<Fortran::evaluate::Expr<Fortran::evaluate::SomeReal>>(
+ &expr->u)};
+ if (!real)
+ return {};
+ return Fortran::common::visit(
+ [&](const auto &kindExpr) -> mlir::Attribute {
+ using T = typename std::decay_t<decltype(kindExpr)>::Result;
+ std::optional<Fortran::evaluate::Scalar<T>> value{
+ Fortran::evaluate::GetScalarConstantValue<T>(kindExpr)};
+ if (!value)
+ return {};
+ llvm::APFloat f{builder->getKindMap().getFloatSemantics(T::kind),
+ value->DumpHexadecimal()};
+ return mlir::FloatAttr::get(builder->getRealType(T::kind), f);
+ },
+ real->u);
+ }
+
+ /// A directive defined by a plugin as a dictionary attribute:
/// {prefix = "enzyme", keyword = "custom_rule",
/// args = {reverse = @_QMmPrev, ...}}
- /// Procedure and variable arguments are symbol references, declaring the
- /// procedure or module variable if this module does not yet; the plugin's
- /// passes give them a meaning.
- void lowerPluginDirectives() {
+ /// The arguments are its keyword arguments. Procedure and variable
+ /// arguments are symbol references, declaring the procedure or module
+ /// variable if this module does not yet; the plugin's passes give them a
+ /// meaning.
+ mlir::DictionaryAttr
+ genPluginDirectiveAttr(const Fortran::parser::CompilerDirective &directive) {
mlir::ModuleOp module{getModuleOp()};
mlir::MLIRContext *ctx{module.getContext()};
- // What semantics lets a directive refer to: a subprogram or an external
- // procedure, a variable, or a COMMON block. Nothing else has an operation
- // (or even a mangled name).
- auto isReferable{[](const Fortran::semantics::Symbol &sym) {
- if (Fortran::semantics::IsProcedure(sym)) {
- return !sym.has<Fortran::semantics::GenericDetails>() &&
- !Fortran::semantics::IsDummy(sym) &&
- !Fortran::semantics::IsProcedurePointer(sym) &&
- !Fortran::semantics::IsStmtFunction(sym) &&
- !sym.attrs().test(Fortran::semantics::Attr::INTRINSIC);
- }
- return sym.has<Fortran::semantics::ObjectEntityDetails>() ||
- sym.has<Fortran::semantics::CommonBlockDetails>();
- }};
- // The operation of a procedure or variable, declared if need be (as a
- // reference to it would): procedures, and variables of modules, which
- // may be another module's.
- auto getOrDeclare{[&](const Fortran::semantics::Symbol &sym)
- -> mlir::Operation * {
- if (!isReferable(sym)) {
- return nullptr;
- }
- if (mlir::Operation *op{module.lookupSymbol(mangleName(sym))}) {
- return op;
+ const auto &[prefix, keyword, args]{
+ std::get<Fortran::parser::CompilerDirective::Plugin>(directive.u).t};
+ llvm::SmallVector<mlir::NamedAttribute> argAttrs;
+ for (const Fortran::parser::CompilerDirective::Plugin::Arg &arg : args) {
+ const auto &argKeyword{std::get<0>(arg.t)};
+ if (!argKeyword) {
+ continue; // the subject, or the variables of a loop directive
}
- if (Fortran::semantics::IsProcedure(sym)) {
- return Fortran::lower::getOrDeclareFunction(
- Fortran::evaluate::ProcedureDesignator{sym}, *this)
- .getOperation();
- }
- if (sym.has<Fortran::semantics::ObjectEntityDetails>() &&
- sym.owner().IsModule()) {
- return Fortran::lower::declareModuleVariable(*this, sym).getOperation();
- }
- return nullptr;
- }};
+ mlir::Attribute value{Fortran::common::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::parser::Name &n) -> mlir::Attribute {
+ if (!n.symbol) {
+ return mlir::StringAttr::get(ctx, n.ToString());
+ }
+ mlir::Operation *op{
+ getOrDeclarePluginDirectiveSymbol(n.symbol->GetUltimate())};
+ if (!op) {
+ return mlir::StringAttr::get(ctx, n.ToString());
+ }
+ return mlir::FlatSymbolRefAttr::get(
+ mlir::SymbolTable::getSymbolName(op));
+ },
+ [&](const Fortran::parser::CompilerDirective::Plugin::CommonBlock
+ &c) -> mlir::Attribute {
+ std::string name{c.v.symbol ? mangleName(*c.v.symbol)
+ : c.v.ToString()};
+ if (!module.lookupSymbol(name)) {
+ return mlir::StringAttr::get(ctx, c.v.ToString());
+ }
+ return mlir::FlatSymbolRefAttr::get(ctx, name);
+ },
+ [&](std::uint64_t n) -> mlir::Attribute {
+ return builder->getI64IntegerAttr(n);
+ },
+ [&](const Fortran::parser::SignedRealLiteralConstant &r)
+ -> mlir::Attribute { return genPluginDirectiveRealAttr(r); },
+ [&](const std::string &str) -> mlir::Attribute {
+ return mlir::StringAttr::get(ctx, str);
+ },
+ },
+ std::get<1>(arg.t))};
+ if (value)
+ argAttrs.push_back(
+ builder->getNamedAttr(argKeyword->ToString(), value));
+ }
+ return builder->getDictionaryAttr({
+ builder->getNamedAttr("prefix",
+ builder->getStringAttr(prefix.ToString())),
+ builder->getNamedAttr("keyword",
+ builder->getStringAttr(keyword.ToString())),
+ builder->getNamedAttr("args", builder->getDictionaryAttr(argAttrs)),
+ });
+ }
+
+ /// Attach the directives defined by plugins to the operations of their
+ /// subjects in this module (a func.func for a procedure, a fir.global for a
+ /// variable), as a `fir.directives` array of the dictionaries of
+ /// genPluginDirectiveAttr.
+ void lowerPluginDirectives() {
+ mlir::ModuleOp module{getModuleOp()};
for (const auto &[subject, directive, fromModFile] :
bridge.getSemanticsContext().GetPluginDirectives()) {
const Fortran::semantics::Symbol &ultimate{subject->GetUltimate()};
@@ -748,69 +843,131 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// those it uses.
mlir::Operation *target{nullptr};
if (!fromModFile)
- target = getOrDeclare(ultimate);
- else if (isReferable(ultimate))
+ target = getOrDeclarePluginDirectiveSymbol(ultimate);
+ else if (isPluginDirectiveReferable(ultimate))
target = module.lookupSymbol(mangleName(ultimate));
if (!target) {
continue; // neither defined nor referenced here
}
- const auto &[prefix, keyword, args]{
- std::get<Fortran::parser::CompilerDirective::Plugin>(directive->u).t};
- llvm::SmallVector<mlir::NamedAttribute> argAttrs;
- for (const Fortran::parser::CompilerDirective::Plugin::Arg &arg : args) {
- const auto &argKeyword{std::get<0>(arg.t)};
- if (!argKeyword) {
- continue; // the subject
- }
- mlir::Attribute value{Fortran::common::visit(
- Fortran::common::visitors{
- [&](const Fortran::parser::Name &n) -> mlir::Attribute {
- if (!n.symbol) {
- return mlir::StringAttr::get(ctx, n.ToString());
- }
- mlir::Operation *op{getOrDeclare(n.symbol->GetUltimate())};
- if (!op) {
- return mlir::StringAttr::get(ctx, n.ToString());
- }
- return mlir::FlatSymbolRefAttr::get(
- mlir::SymbolTable::getSymbolName(op));
- },
- [&](const Fortran::parser::CompilerDirective::Plugin::
- CommonBlock &c) -> mlir::Attribute {
- std::string name{c.v.symbol ? mangleName(*c.v.symbol)
- : c.v.ToString()};
- if (!module.lookupSymbol(name)) {
- return mlir::StringAttr::get(ctx, c.v.ToString());
- }
- return mlir::FlatSymbolRefAttr::get(ctx, name);
- },
- [&](std::uint64_t n) -> mlir::Attribute {
- return builder->getI64IntegerAttr(n);
- },
- [&](const std::string &str) -> mlir::Attribute {
- return mlir::StringAttr::get(ctx, str);
- },
- },
- std::get<1>(arg.t))};
- argAttrs.push_back(
- builder->getNamedAttr(argKeyword->ToString(), value));
- }
- mlir::Attribute entry{builder->getDictionaryAttr({
- builder->getNamedAttr("prefix",
- builder->getStringAttr(prefix.ToString())),
- builder->getNamedAttr("keyword",
- builder->getStringAttr(keyword.ToString())),
- builder->getNamedAttr("args", builder->getDictionaryAttr(argAttrs)),
- })};
llvm::SmallVector<mlir::Attribute> entries;
if (auto existing{
target->getAttrOfType<mlir::ArrayAttr>("fir.directives")})
entries.append(existing.begin(), existing.end());
- entries.push_back(entry);
+ entries.push_back(genPluginDirectiveAttr(*directive));
target->setAttr("fir.directives", builder->getArrayAttr(entries));
}
}
+ /// A directive defined by a plugin for the loop that follows it, with its
+ /// variables evaluated in front of the loop.
+ struct PluginLoopDirective {
+ const Fortran::parser::CompilerDirective *directive;
+ llvm::SmallVector<mlir::Value> operands;
+ };
+ using PluginLoopDirectives = llvm::SmallVector<PluginLoopDirective, 1>;
+
+ static bool
+ isPluginLoopDirective(const Fortran::parser::CompilerDirective &dir) {
+ const auto *plugin{
+ std::get_if<Fortran::parser::CompilerDirective::Plugin>(&dir.u)};
+ if (!plugin)
+ return false;
+ const auto &[prefix, keyword, args]{plugin->t};
+ const Fortran::common::PluginDirectiveSpec *spec{
+ Fortran::common::lookupPluginDirective(prefix.ToString(),
+ keyword.ToString())};
+ return spec &&
+ spec->subject == Fortran::common::PluginDirectiveSubject::Loop;
+ }
+
+ /// Evaluate the variables of the plugin directives among the directives of
+ /// a loop, at the insertion point in front of it: a variable as its
+ /// address, or its descriptor if it has one (an allocatable or pointer as
+ /// its target's, as it is in front of the loop); a COMMON block as the
+ /// address of its storage.
+ PluginLoopDirectives genPluginLoopDirectiveOperands(
+ llvm::ArrayRef<const Fortran::parser::CompilerDirective *> dirs) {
+ PluginLoopDirectives result;
+ for (const Fortran::parser::CompilerDirective *dir : dirs) {
+ if (!isPluginLoopDirective(*dir))
+ continue;
+ mlir::Location loc = genLocation(dir->source);
+ PluginLoopDirective &directive = result.emplace_back();
+ directive.directive = dir;
+ for (const Fortran::parser::CompilerDirective::Plugin::Arg &arg :
+ std::get<2>(
+ std::get<Fortran::parser::CompilerDirective::Plugin>(dir->u)
+ .t)) {
+ if (std::get<0>(arg.t))
+ continue; // a keyword argument
+ const auto &value{std::get<1>(arg.t)};
+ if (const auto *name{std::get_if<Fortran::parser::Name>(&value)}) {
+ std::optional<Fortran::lower::SomeExpr> expr{
+ Fortran::evaluate::AsGenericExpr(*name->symbol)};
+ assert(expr && "plugin directive variable is not a designator");
+ Fortran::lower::StatementContext stmtCtx;
+ hlfir::Entity var{Fortran::lower::convertExprToHLFIR(
+ loc, *this, *expr, localSymbols, stmtCtx)};
+ var = hlfir::derefPointersAndAllocatables(loc, *builder, var);
+ stmtCtx.finalizeAndReset();
+ directive.operands.push_back(var.getBase());
+ } else if (const auto *common{std::get_if<
+ Fortran::parser::CompilerDirective::Plugin::CommonBlock>(
+ &value)}) {
+ fir::GlobalOp global{
+ builder->getNamedGlobal(mangleName(*common->v.symbol))};
+ assert(global && "plugin directive COMMON block is not lowered");
+ directive.operands.push_back(fir::AddrOfOp::create(
+ *builder, loc, fir::ReferenceType::get(global.getType()),
+ global.getSymbol()));
+ }
+ }
+ }
+ return result;
+ }
+
+ /// At the start of a loop body, the markers of the plugin directives of the
+ /// loop: calls of `__flang_directive.<prefix>.<keyword>`, which nothing
+ /// defines, with the variables evaluated in front of the loop and the
+ /// directive as their `fir.directive` attribute. The plugin's passes replace
+ /// them.
+ void genPluginLoopDirectiveMarkers(PluginLoopDirectives &directives) {
+ for (PluginLoopDirective &directive : directives) {
+ mlir::Location loc = genLocation(directive.directive->source);
+ const auto &[prefix, keyword,
+ args]{std::get<Fortran::parser::CompilerDirective::Plugin>(
+ directive.directive->u)
+ .t};
+ llvm::SmallVector<mlir::Type> types;
+ for (mlir::Value v : directive.operands)
+ types.push_back(v.getType());
+ mlir::FunctionType ty{
+ mlir::FunctionType::get(builder->getContext(), types, {})};
+ std::string base{"__flang_directive." + prefix.ToString() + "." +
+ keyword.ToString()};
+ std::string name{base};
+ mlir::func::FuncOp callee;
+ for (unsigned n{1};; ++n) {
+ callee = builder->getNamedFunction(name);
+ if (!callee) {
+ callee = builder->createFunction(loc, name, ty);
+ break;
+ }
+ if (callee.getFunctionType() == ty)
+ break;
+ name = base + "." + std::to_string(n); // other variables' types
+ }
+ auto call{fir::CallOp::create(*builder, loc, callee, directive.operands)};
+ call->setAttr("fir.directive",
+ genPluginDirectiveAttr(*directive.directive));
+ }
+ directives.clear();
+ }
+
+ /// Plugin loop directive markers for the evaluation that starts the body
+ /// of an unstructured loop, emitted once its block is started.
+ PluginLoopDirectives *pendingPluginLoopDirectives = nullptr;
+
/// Declare a function.
void declareFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
CHECK(builder && "declareFunction called with uninitialized builder");
@@ -1929,7 +2086,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void
genDoWhileAsSCFWhile(const Fortran::parser::ScalarLogicalExpr &whileCondition,
Fortran::lower::pft::Evaluation &doConstructEval,
- Fortran::lower::pft::Evaluation &doStmtEval) {
+ Fortran::lower::pft::Evaluation &doStmtEval,
+ PluginLoopDirectives &pluginLoopDirectives) {
mlir::Location loc = toLocation();
auto scfWhile =
@@ -1952,6 +2110,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Block *afterBlock =
builder->createBlock(&scfWhile.getAfter(), scfWhile.getAfter().end());
builder->setInsertionPointToStart(afterBlock);
+ genPluginLoopDirectiveMarkers(pluginLoopDirectives);
// Lower nested evaluations excluding the loop control statement (the
// NonLabelDoStmt) and the EndDoStmt.
@@ -2862,8 +3021,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// same context flag, same region, same blocks. They may be branch targets
/// from outside the loop, so their blocks have to stay in the enclosing
/// region. Only what lies strictly between them goes inside the wrap.
- void genLoopBodyEvaluations(Fortran::lower::pft::Evaluation &eval,
- bool unstructuredContext) {
+ void
+ genLoopBodyEvaluations(Fortran::lower::pft::Evaluation &eval,
+ bool unstructuredContext,
+ PluginLoopDirectives *pluginLoopDirectives = nullptr) {
Fortran::lower::pft::EvaluationList &list = eval.getNestedEvaluations();
auto iter = list.begin();
auto end = std::prev(list.end());
@@ -2878,6 +3039,14 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Block *savedEndDoBlock = nullptr;
mlir::scf::ExecuteRegionOp wrapOp =
wrapUnstructuredBody(eval, yieldBlock, savedEndDoBlock);
+ // The markers of plugin loop directives start the body: here, or in the
+ // block the first evaluation of an unstructured body starts.
+ if (pluginLoopDirectives && !pluginLoopDirectives->empty()) {
+ if (unstructuredContext || wrapOp)
+ pendingPluginLoopDirectives = pluginLoopDirectives;
+ else
+ genPluginLoopDirectiveMarkers(*pluginLoopDirectives);
+ }
for (; iter != end; ++iter)
genFIR(*iter, unstructuredContext || wrapOp);
closeUnstructuredBodyWrap(wrapOp, eval, yieldBlock, savedEndDoBlock);
@@ -3023,6 +3192,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
headerBlock = createNextBeginBlock();
};
+ // The plugin directives of the loop: their variables are evaluated in
+ // front of the loop, for markers at the start of its body.
+ PluginLoopDirectives pluginLoopDirectives;
+ auto genPluginLoopDirectivesInFront = [&]() {
+ pluginLoopDirectives = genPluginLoopDirectiveOperands(doStmtEval.dirs);
+ };
+
IncrementLoopNestInfo incrementLoopNestInfo;
const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr;
bool infiniteLoop = !loopControl.has_value();
@@ -3031,6 +3207,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Infinite loops are never wrappable; maybeWrapAndRecalc is a no-op here,
// but call it for uniformity so wrapOp stays null.
maybeWrapAndRecalc();
+ genPluginLoopDirectivesInFront();
startBlock(headerBlock);
} else if ((whileCondition =
std::get_if<Fortran::parser::ScalarLogicalExpr>(
@@ -3041,13 +3218,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// PFT branch analysis), allowing the loop to exit only when the condition
// becomes false.
if (!unstructuredContext) {
- genDoWhileAsSCFWhile(*whileCondition, eval, doStmtEval);
+ genPluginLoopDirectivesInFront();
+ genDoWhileAsSCFWhile(*whileCondition, eval, doStmtEval,
+ pluginLoopDirectives);
return;
}
assert(unstructuredContext && "while loop must be unstructured");
maybeStartBlock(preheaderBlock); // no block or empty block
maybeWrapAndRecalc();
+ genPluginLoopDirectivesInFront();
startBlock(headerBlock);
genConditionalBranch(*whileCondition, bodyBlock, exitBlock);
} else if (const auto *bounds =
@@ -3105,14 +3285,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
localSymbols.pushScope();
// Increment loop begin code. (Infinite/while code was already generated.)
- if (!infiniteLoop && !whileCondition)
+ if (!infiniteLoop && !whileCondition) {
+ genPluginLoopDirectivesInFront();
genFIRIncrementLoopBegin(incrementLoopNestInfo, doStmtEval.dirs);
+ }
// The loop control is structured, but the body may hold raw branching
// confined to it. Wrap the body, leaving the loop control outside, so the
// structured loop op's single-block region stays well formed.
// Loop body code.
- genLoopBodyEvaluations(eval, unstructuredContext);
+ genLoopBodyEvaluations(eval, unstructuredContext, &pluginLoopDirectives);
auto iter = std::prev(eval.getNestedEvaluations().end());
// An EndDoStmt in unstructured code may start a new block.
@@ -3120,6 +3302,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
assert(endDoEval.getIf<Fortran::parser::EndDoStmt>() && "no enddo stmt");
if (unstructuredContext)
maybeStartBlock(endDoEval.block);
+ // An empty body did not take the markers of plugin loop directives.
+ if (pendingPluginLoopDirectives == &pluginLoopDirectives)
+ pendingPluginLoopDirectives = nullptr;
+ genPluginLoopDirectiveMarkers(pluginLoopDirectives);
// Loop end code.
if (infiniteLoop || whileCondition)
@@ -3917,6 +4103,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
[&](const Fortran::parser::CompilerDirective::Simd &) {
attachDirectiveToLoop(dir, &eval);
},
+ [&](const Fortran::parser::CompilerDirective::Plugin &) {
+ if (isPluginLoopDirective(dir))
+ attachDirectiveToLoop(dir, &eval);
+ },
[&](const auto &) {}},
dir.u);
}
@@ -6411,6 +6601,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured()
? eval.getFirstNestedEvaluation().block
: eval.block);
+ if (PluginLoopDirectives *pending = pendingPluginLoopDirectives) {
+ pendingPluginLoopDirectives = nullptr;
+ genPluginLoopDirectiveMarkers(*pending);
+ }
if (eval.skipNextLowering) {
eval.skipNextLowering = false;
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 931bdb2c8a034..2cc7f423d715d 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -1427,18 +1427,28 @@ struct PluginDirectivePrefix {
return std::nullopt;
}
};
+using PluginDirectiveValue =
+ std::variant<Name, CompilerDirective::Plugin::CommonBlock, std::uint64_t,
+ SignedRealLiteralConstant, std::string>;
+// A real literal before an integer, which would match its leading digits.
constexpr auto pluginDirectiveValue{
- construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
- std::uint64_t, std::string>>(
+ construct<PluginDirectiveValue>(
construct<CompilerDirective::Plugin::CommonBlock>("/" >> name / "/")) ||
- construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
- std::uint64_t, std::string>>(name) ||
- construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
- std::uint64_t, std::string>>(digitString64) ||
- construct<std::variant<Name, CompilerDirective::Plugin::CommonBlock,
- std::uint64_t, std::string>>(space >> charLiteralConstantWithoutKind)};
+ construct<PluginDirectiveValue>(name) ||
+ construct<PluginDirectiveValue>(signedRealLiteralConstant) ||
+ construct<PluginDirectiveValue>(digitString64) ||
+ construct<PluginDirectiveValue>(space >> charLiteralConstantWithoutKind)};
constexpr auto pluginDirectiveArg{construct<CompilerDirective::Plugin::Arg>(
maybe(name / "="_tok), pluginDirectiveValue)};
+// name(value) after the parenthesized arguments, the same as name=value.
+constexpr auto pluginDirectiveClause{construct<CompilerDirective::Plugin::Arg>(
+ construct<std::optional<Name>>(name), parenthesized(pluginDirectiveValue))};
+static std::list<CompilerDirective::Plugin::Arg> AppendPluginDirectiveClauses(
+ std::list<CompilerDirective::Plugin::Arg> &&args,
+ std::list<CompilerDirective::Plugin::Arg> &&clauses) {
+ args.splice(args.end(), clauses);
+ return std::move(args);
+}
// The arguments of a directive defined by a plugin. Once its prefix is
// recognized, the directive is the plugin's: arguments that do not parse are
// an error, not an unrecognized directive to ignore.
@@ -1447,7 +1457,9 @@ struct PluginDirectiveArgs {
constexpr PluginDirectiveArgs() {}
std::optional<resultType> Parse(ParseState &state) const {
static constexpr auto args{
- defaulted(parenthesized(optionalList(pluginDirectiveArg))) /
+ applyFunction(AppendPluginDirectiveClauses,
+ defaulted(parenthesized(optionalList(pluginDirectiveArg))),
+ many(pluginDirectiveClause)) /
lookAhead(endOfStmt)};
const char *start{state.GetLocation()};
ParseState backtrack{state};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 72e245ab66be0..093cf6db9b4a5 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1972,6 +1972,7 @@ class UnparseVisitor {
Put('/');
},
[&](std::uint64_t n) { Put(std::to_string(n)); },
+ [&](const SignedRealLiteralConstant &r) { Walk(r); },
[&](const std::string &str) { PutNormalized(str); },
},
std::get<1>(x.t));
diff --git a/flang/lib/Semantics/canonicalize-directives.cpp b/flang/lib/Semantics/canonicalize-directives.cpp
index 43405ba71db10..0aa50bddc208c 100644
--- a/flang/lib/Semantics/canonicalize-directives.cpp
+++ b/flang/lib/Semantics/canonicalize-directives.cpp
@@ -9,6 +9,7 @@
#include "canonicalize-directives.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Semantics/tools.h"
+#include "flang/Support/PluginDirectives.h"
namespace Fortran::semantics {
@@ -30,6 +31,35 @@ class CanonicalizationOfDirectives {
void Post(parser::SpecificationPart &spec);
bool Pre(parser::ExecutionPart &x);
+ // A directive defined by a plugin for the loop that follows it, after the
+ // declarations, is a declaration construct: move it to the start of the
+ // execution part, where it is checked like the others.
+ bool Pre(parser::MainProgram &x) {
+ MovePluginLoopDirectives(std::get<parser::SpecificationPart>(x.t),
+ std::get<parser::ExecutionPart>(x.t).v);
+ return true;
+ }
+ bool Pre(parser::FunctionSubprogram &x) {
+ MovePluginLoopDirectives(std::get<parser::SpecificationPart>(x.t),
+ std::get<parser::ExecutionPart>(x.t).v);
+ return true;
+ }
+ bool Pre(parser::SubroutineSubprogram &x) {
+ MovePluginLoopDirectives(std::get<parser::SpecificationPart>(x.t),
+ std::get<parser::ExecutionPart>(x.t).v);
+ return true;
+ }
+ bool Pre(parser::SeparateModuleSubprogram &x) {
+ MovePluginLoopDirectives(std::get<parser::SpecificationPart>(x.t),
+ std::get<parser::ExecutionPart>(x.t).v);
+ return true;
+ }
+ bool Pre(parser::BlockConstruct &x) {
+ MovePluginLoopDirectives(std::get<parser::BlockSpecificationPart>(x.t).v,
+ std::get<parser::Block>(x.t));
+ return true;
+ }
+
// Ensure that directives associated with constructs appear accompanying the
// construct.
void Post(parser::Block &block);
@@ -38,6 +68,13 @@ class CanonicalizationOfDirectives {
// Ensure that loop directives appear immediately before a loop.
void CheckLoopDirective(parser::CompilerDirective &dir, parser::Block &block,
std::list<parser::ExecutionPartConstruct>::iterator it);
+ // Ensure that a directive a plugin defines for a loop appears immediately
+ // before a DO or DO WHILE loop.
+ void CheckPluginLoopDirective(parser::CompilerDirective &dir,
+ parser::Block &block,
+ std::list<parser::ExecutionPartConstruct>::iterator it);
+ void MovePluginLoopDirectives(
+ parser::SpecificationPart &spec, parser::Block &block);
parser::Messages &messages_;
@@ -53,9 +90,21 @@ bool CanonicalizeDirectives(
return !messages.AnyFatalError();
}
+// A directive defined by a plugin whose subject is the loop that follows it.
+static bool IsPluginLoopDirective(const parser::CompilerDirective &dir) {
+ if (const auto *plugin{
+ std::get_if<parser::CompilerDirective::Plugin>(&dir.u)}) {
+ const auto &[prefix, keyword, args]{plugin->t};
+ const common::PluginDirectiveSpec *spec{
+ common::lookupPluginDirective(prefix.ToString(), keyword.ToString())};
+ return spec && spec->subject == common::PluginDirectiveSubject::Loop;
+ }
+ return false;
+}
+
static bool IsExecutionDirective(const parser::CompilerDirective &dir) {
- return std::holds_alternative<parser::CompilerDirective::VectorAlways>(
- dir.u) ||
+ return IsPluginLoopDirective(dir) ||
+ std::holds_alternative<parser::CompilerDirective::VectorAlways>(dir.u) ||
std::holds_alternative<parser::CompilerDirective::VectorLength>(dir.u) ||
std::holds_alternative<parser::CompilerDirective::Unroll>(dir.u) ||
std::holds_alternative<parser::CompilerDirective::UnrollAndJam>(dir.u) ||
@@ -71,6 +120,39 @@ static bool IsExecutionDirective(const parser::CompilerDirective &dir) {
std::holds_alternative<parser::CompilerDirective::Simd>(dir.u);
}
+// The directive of a declaration construct, if it is one.
+static common::Indirection<parser::CompilerDirective> *GetCompilerDirective(
+ parser::DeclarationConstruct &x) {
+ if (auto *spec{std::get_if<parser::SpecificationConstruct>(&x.u)}) {
+ return std::get_if<common::Indirection<parser::CompilerDirective>>(
+ &spec->u);
+ }
+ return nullptr;
+}
+
+void CanonicalizationOfDirectives::MovePluginLoopDirectives(
+ parser::SpecificationPart &spec, parser::Block &block) {
+ auto &decls{std::get<std::list<parser::DeclarationConstruct>>(spec.t)};
+ // The directives after the last declaration.
+ auto it{decls.end()};
+ while (it != decls.begin() && GetCompilerDirective(*std::prev(it))) {
+ --it;
+ }
+ auto first{block.begin()};
+ while (it != decls.end()) {
+ common::Indirection<parser::CompilerDirective> *dir{
+ GetCompilerDirective(*it)};
+ if (IsPluginLoopDirective(dir->value())) {
+ block.insert(first,
+ parser::ExecutionPartConstruct{
+ parser::ExecutableConstruct{std::move(*dir)}});
+ it = decls.erase(it);
+ } else {
+ ++it;
+ }
+ }
+}
+
void CanonicalizationOfDirectives::Post(parser::SpecificationPart &spec) {
auto &list{
std::get<std::list<common::Indirection<parser::CompilerDirective>>>(
@@ -83,6 +165,20 @@ void CanonicalizationOfDirectives::Post(parser::SpecificationPart &spec) {
++it;
}
}
+ // A directive for a loop that is still among the declarations has no loop
+ // to follow: other declarations do, or the scope has no execution part.
+ for (parser::DeclarationConstruct &decl :
+ std::get<std::list<parser::DeclarationConstruct>>(spec.t)) {
+ if (auto *dir{GetCompilerDirective(decl)};
+ dir && IsPluginLoopDirective(dir->value())) {
+ const auto &[prefix, keyword, args]{
+ std::get<parser::CompilerDirective::Plugin>(dir->value().u).t};
+ messages_.Say(dir->value().source,
+ "A DO or DO WHILE loop must follow the '%s %s' directive"_err_en_US,
+ parser::ToUpperCaseLetters(prefix.ToString()),
+ parser::ToUpperCaseLetters(keyword.ToString()));
+ }
+ }
}
bool CanonicalizationOfDirectives::Pre(parser::ExecutionPart &x) {
@@ -117,6 +213,25 @@ void CanonicalizationOfDirectives::CheckLoopDirective(
}
}
+void CanonicalizationOfDirectives::CheckPluginLoopDirective(
+ parser::CompilerDirective &dir, parser::Block &block,
+ std::list<parser::ExecutionPartConstruct>::iterator it) {
+ // Skip over this and other compiler directives
+ while (it != block.end() && parser::Unwrap<parser::CompilerDirective>(*it)) {
+ ++it;
+ }
+ const parser::DoConstruct *loop{
+ it == block.end() ? nullptr : parser::Unwrap<parser::DoConstruct>(*it)};
+ if (!loop || loop->IsDoConcurrent()) {
+ const auto &[prefix, keyword, args]{
+ std::get<parser::CompilerDirective::Plugin>(dir.u).t};
+ messages_.Say(dir.source,
+ "A DO or DO WHILE loop must follow the '%s %s' directive"_err_en_US,
+ parser::ToUpperCaseLetters(prefix.ToString()),
+ parser::ToUpperCaseLetters(keyword.ToString()));
+ }
+}
+
void CanonicalizationOfDirectives::Post(parser::Block &block) {
for (auto it{block.begin()}; it != block.end(); ++it) {
if (auto *dir{parser::Unwrap<parser::CompilerDirective>(*it)}) {
@@ -148,6 +263,11 @@ void CanonicalizationOfDirectives::Post(parser::Block &block) {
[&](parser::CompilerDirective::Simd &) {
CheckLoopDirective(*dir, block, it);
},
+ [&](parser::CompilerDirective::Plugin &) {
+ if (IsPluginLoopDirective(*dir)) {
+ CheckPluginLoopDirective(*dir, block, it);
+ }
+ },
[&](auto &) {}},
dir->u);
}
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index a3856061ea90a..adbe8ffd17c51 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -447,6 +447,24 @@ static void PutPluginDirectives(
line << '/' << c.v.ToString() << '/';
},
[&](std::uint64_t n) { line << n; },
+ [&](const parser::SignedRealLiteralConstant &r) {
+ const auto &[sign, real]{r.t};
+ const auto &[value, kind]{real.t};
+ if (sign) {
+ line << (*sign == parser::Sign::Negative ? '-' : '+');
+ }
+ line << value.source.ToString();
+ if (kind) {
+ common::visit(
+ common::visitors{
+ [&](std::uint64_t k) { line << '_' << k; },
+ [&](const auto &named) {
+ line << '_' << named.thing.thing.thing.ToString();
+ },
+ },
+ kind->u);
+ }
+ },
[&](const std::string &str) {
line << parser::QuoteCharacterLiteral(str);
},
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d1e0dbccc7f8d..d7a3a56727476 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -11558,104 +11558,147 @@ void ResolveNamesVisitor::ResolvePluginDirective(
return symbol;
}};
- // The subject: a leading positional name, or the enclosing subprogram.
- std::optional<common::PluginDirectiveArgKind> subjectKind;
- if (spec->subject == common::PluginDirectiveSubject::Procedure) {
- subjectKind = common::PluginDirectiveArgKind::Procedure;
- } else if (spec->subject == common::PluginDirectiveSubject::Variable) {
- subjectKind = common::PluginDirectiveArgKind::Variable;
- }
auto it{args.begin()};
- const Symbol *subject{nullptr};
- const parser::Name *subjectNamePtr{nullptr};
- if (it != args.end() && !std::get<0>(it->t)) {
- const auto &value{std::get<1>(it->t)};
- if (const auto *name{std::get_if<parser::Name>(&value)}) {
- subjectNamePtr = name;
- subject = resolve(*name, subjectKind);
- } else if (const auto *common{
- std::get_if<parser::CompilerDirective::Plugin::CommonBlock>(
- &value)}) {
- subjectNamePtr = &common->v;
- subject = resolveCommon(common->v);
- } else {
- Say(x.source,
- "The subject of a '%s %s' directive must be a name or a COMMON block"_err_en_US,
- prefix.ToString(), keyword.ToString());
- return;
+ std::vector<const Symbol *> subjects;
+ bool ok{true};
+ if (spec->subject == common::PluginDirectiveSubject::Loop) {
+ // The variables of a directive for the loop that follows it, in front of
+ // its other arguments; lowering passes them to the plugin.
+ unsigned count{0};
+ for (; it != args.end() && !std::get<0>(it->t); ++it, ++count) {
+ const auto &value{std::get<1>(it->t)};
+ if (const auto *name{std::get_if<parser::Name>(&value)}) {
+ if (const Symbol *symbol{
+ resolve(*name, common::PluginDirectiveArgKind::Variable)}) {
+ // In a specification part, a variable declared only by a type
+ // declaration statement is still an entity.
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (!IsVariableName(*symbol) &&
+ !(ultimate.has<EntityDetails>() && !isProcedure(ultimate) &&
+ !IsNamedConstant(ultimate))) {
+ Say(*name, "'%s' is not a variable"_err_en_US);
+ ok = false;
+ }
+ } else {
+ ok = false;
+ }
+ } else if (const auto *common{std::get_if<
+ parser::CompilerDirective::Plugin::CommonBlock>(&value)}) {
+ ok &= resolveCommon(common->v) != nullptr;
+ } else {
+ Say(x.source,
+ "The variables of a '%s %s' directive must be names or COMMON blocks"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ ok = false;
+ }
}
- if (!subject) {
- return;
+ if (count < spec->minPositional) {
+ Say(x.source,
+ "A '%s %s' directive needs at least %d variable(s)"_err_en_US,
+ prefix.ToString(), keyword.ToString(),
+ static_cast<int>(spec->minPositional));
+ ok = false;
}
- ++it;
- } else if (spec->subject != common::PluginDirectiveSubject::Variable) {
- const Symbol *scopeSymbol{currScope().symbol()};
- if (scopeSymbol && scopeSymbol->has<SubprogramDetails>()) {
- subject = scopeSymbol;
+ } else {
+ // The subject: a leading positional name, or the enclosing subprogram.
+ std::optional<common::PluginDirectiveArgKind> subjectKind;
+ if (spec->subject == common::PluginDirectiveSubject::Procedure) {
+ subjectKind = common::PluginDirectiveArgKind::Procedure;
+ } else if (spec->subject == common::PluginDirectiveSubject::Variable) {
+ subjectKind = common::PluginDirectiveArgKind::Variable;
+ }
+ const Symbol *subject{nullptr};
+ const parser::Name *subjectNamePtr{nullptr};
+ if (it != args.end() && !std::get<0>(it->t)) {
+ const auto &value{std::get<1>(it->t)};
+ if (const auto *name{std::get_if<parser::Name>(&value)}) {
+ subjectNamePtr = name;
+ subject = resolve(*name, subjectKind);
+ } else if (const auto *common{std::get_if<
+ parser::CompilerDirective::Plugin::CommonBlock>(&value)}) {
+ subjectNamePtr = &common->v;
+ subject = resolveCommon(common->v);
+ } else {
+ Say(x.source,
+ "The subject of a '%s %s' directive must be a name or a COMMON block"_err_en_US,
+ prefix.ToString(), keyword.ToString());
+ return;
+ }
+ if (!subject) {
+ return;
+ }
+ ++it;
+ } else if (spec->subject != common::PluginDirectiveSubject::Variable) {
+ const Symbol *scopeSymbol{currScope().symbol()};
+ if (scopeSymbol && scopeSymbol->has<SubprogramDetails>()) {
+ subject = scopeSymbol;
+ }
}
- }
- if (!subject) {
- Say(x.source,
- "A '%s %s' directive must name what it applies to, or appear in a subprogram"_err_en_US,
- prefix.ToString(), keyword.ToString());
- return;
- }
- const parser::Name &subjectName{subjectNamePtr ? *subjectNamePtr : keyword};
- if (subject->has<CommonBlockDetails>()) {
- if (subjectKind == common::PluginDirectiveArgKind::Procedure) {
- Say(subjectName, "'%s' is not a procedure"_err_en_US);
+ if (!subject) {
+ Say(x.source,
+ "A '%s %s' directive must name what it applies to, or appear in a subprogram"_err_en_US,
+ prefix.ToString(), keyword.ToString());
return;
}
- } else if (!checkKind(subjectName, subject, subjectKind)) {
- return;
- }
- // A generic interface stands for all of its specific procedures, also
- // private ones and those of other modules, which a directive elsewhere
- // could not name. Not for a directive with procedure arguments, which
- // each specific procedure would need its own of.
- // A name of the host (e.g. a procedure's own name, in it) is host
- // associated; the directive is on the host's symbol, which a module file
- // declares.
- while (const auto *host{subject->detailsIf<HostAssocDetails>()}) {
- subject = &host->symbol();
- }
- std::vector<const Symbol *> subjects{subject};
- if (const auto *generic{subject->GetUltimate().detailsIf<GenericDetails>()}) {
- bool takesProcedures{false};
- for (const common::PluginDirectiveArg &a : spec->args) {
- takesProcedures |= a.kind == common::PluginDirectiveArgKind::Procedure;
- }
- if (takesProcedures) {
- Say(subjectName.source,
- "'%s' is a generic interface; a '%s %s' directive must name one of its specific procedures"_err_en_US,
- subjectName.ToString(), prefix.ToString(), keyword.ToString());
+ const parser::Name &subjectName{subjectNamePtr ? *subjectNamePtr : keyword};
+ if (subject->has<CommonBlockDetails>()) {
+ if (subjectKind == common::PluginDirectiveArgKind::Procedure) {
+ Say(subjectName, "'%s' is not a procedure"_err_en_US);
+ return;
+ }
+ } else if (!checkKind(subjectName, subject, subjectKind)) {
return;
}
- subjects.clear();
- for (const Symbol &specific : generic->specificProcs()) {
- subjects.push_back(&specific);
- }
- if (const Symbol *specific{generic->specific()}; specific &&
- std::find(subjects.begin(), subjects.end(), specific) ==
- subjects.end()) {
- subjects.push_back(specific);
- }
- if (subjects.empty()) {
- Say(subjectName.source,
- "Generic interface '%s' has no specific procedures"_err_en_US,
- subjectName.ToString());
- return;
+ // A name of the host (e.g. a procedure's own name, in it) is host
+ // associated; the directive is on the host's symbol, which a module file
+ // declares.
+ while (const auto *host{subject->detailsIf<HostAssocDetails>()}) {
+ subject = &host->symbol();
+ }
+ // A generic interface stands for all of its specific procedures, also
+ // private ones and those of other modules, which a directive elsewhere
+ // could not name. Not for a directive with procedure arguments, which
+ // each specific procedure would need its own of.
+ subjects.push_back(subject);
+ if (const auto *generic{
+ subject->GetUltimate().detailsIf<GenericDetails>()}) {
+ bool takesProcedures{false};
+ for (const common::PluginDirectiveArg &a : spec->args) {
+ takesProcedures |= a.kind == common::PluginDirectiveArgKind::Procedure;
+ }
+ if (takesProcedures) {
+ Say(subjectName.source,
+ "'%s' is a generic interface; a '%s %s' directive must name one of its specific procedures"_err_en_US,
+ subjectName.ToString(), prefix.ToString(), keyword.ToString());
+ return;
+ }
+ subjects.clear();
+ for (const Symbol &specific : generic->specificProcs()) {
+ subjects.push_back(&specific);
+ }
+ if (const Symbol *specific{generic->specific()}; specific &&
+ std::find(subjects.begin(), subjects.end(), specific) ==
+ subjects.end()) {
+ subjects.push_back(specific);
+ }
+ if (subjects.empty()) {
+ Say(subjectName.source,
+ "Generic interface '%s' has no specific procedures"_err_en_US,
+ subjectName.ToString());
+ return;
+ }
}
}
// The other arguments are keyword arguments.
std::set<std::string> seen;
- bool ok{true};
for (; it != args.end(); ++it) {
const auto &maybeKeyword{std::get<0>(it->t)};
if (!maybeKeyword) {
Say(x.source,
- "Only the first argument of a '%s %s' directive may be positional"_err_en_US,
+ spec->subject == common::PluginDirectiveSubject::Loop
+ ? "The variables of a '%s %s' directive must come before its other arguments"_err_en_US
+ : "Only the first argument of a '%s %s' directive may be positional"_err_en_US,
prefix.ToString(), keyword.ToString());
ok = false;
continue;
@@ -11712,8 +11755,18 @@ void ResolveNamesVisitor::ResolvePluginDirective(
ok = false;
}
break;
+ case common::PluginDirectiveArgKind::Real:
+ if (!std::holds_alternative<std::uint64_t>(value) &&
+ !std::holds_alternative<parser::SignedRealLiteralConstant>(value)) {
+ Say(maybeKeyword->source,
+ "Argument '%s' must be a real or integer literal"_err_en_US,
+ argName);
+ ok = false;
+ }
+ break;
case common::PluginDirectiveArgKind::String:
- if (std::holds_alternative<std::uint64_t>(value)) {
+ if (std::holds_alternative<std::uint64_t>(value) ||
+ std::holds_alternative<parser::SignedRealLiteralConstant>(value)) {
Say(maybeKeyword->source,
"Argument '%s' must be a character literal or a name"_err_en_US,
argName);
diff --git a/flang/test/Examples/plugin-directives-errors.f90 b/flang/test/Examples/plugin-directives-errors.f90
index dc60722045e52..ce5d0cffae6c3 100644
--- a/flang/test/Examples/plugin-directives-errors.f90
+++ b/flang/test/Examples/plugin-directives-errors.f90
@@ -37,6 +37,8 @@ subroutine s(dummy, pp)
!dir$ example watch(x, priority=1)
! CHECK: error: Argument 'priority' must be an integer
!dir$ example callback(handler=s, priority=high)
+ ! CHECK: error: Argument 'priority' must be an integer
+ !dir$ example callback(handler=s, priority=1.5)
! CHECK: error: Argument 'handler' appears more than once
!dir$ example callback(handler=s, handler=s)
! CHECK: error: Only the first argument of a 'example callback' directive may be positional
diff --git a/flang/test/Examples/plugin-directives-loop-errors.f90 b/flang/test/Examples/plugin-directives-loop-errors.f90
new file mode 100644
index 0000000000000..bb496df1af21c
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-loop-errors.f90
@@ -0,0 +1,31 @@
+! Check the errors in the directives of a plugin loaded with `flang -fc1 -load`
+! for the loop that follows them.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: not %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -fsyntax-only %s 2>&1 | FileCheck %s
+
+subroutine s(x)
+ real :: x
+ integer :: i
+ ! CHECK: error: A 'example converge' directive needs at least 1 variable(s)
+ !dir$ example converge(tol=1.0)
+ do i = 1, 2
+ end do
+ ! CHECK: error: 's' is not a variable
+ !dir$ example converge(s)
+ do i = 1, 2
+ end do
+ ! CHECK: error: Argument 'max_iters' must be an integer
+ !dir$ example converge(x) max_iters(1.5)
+ do i = 1, 2
+ end do
+ ! CHECK: error: The variables of a 'example converge' directive must come before its other arguments
+ !dir$ example converge(x, tol=1.0, x)
+ do i = 1, 2
+ end do
+ !dir$ example converge(x)
+ x = 1.
+end
diff --git a/flang/test/Examples/plugin-directives-loop.f90 b/flang/test/Examples/plugin-directives-loop.f90
new file mode 100644
index 0000000000000..40832764215ee
--- /dev/null
+++ b/flang/test/Examples/plugin-directives-loop.f90
@@ -0,0 +1,36 @@
+! Check that a directive of a plugin loaded with `flang -fc1 -load` for the
+! loop that follows it becomes a marker call at the start of the loop body.
+
+! REQUIRES: plugins, examples
+! XFAIL: system-aix
+
+! RUN: rm -rf %t && mkdir -p %t
+! RUN: %flang_fc1 -load %llvmshlibdir/flangDirectivesPlugin%pluginext \
+! RUN: -emit-hlfir -module-dir %t -o - %s | FileCheck %s
+
+module m_loop
+ real :: u(10)
+ common /blk/ w
+ real :: w
+contains
+ subroutine iterate(n, v)
+ integer :: n, i
+ real :: v(n)
+ real, allocatable :: a(:)
+ logical :: converged
+ allocate(a(n))
+ !dir$ example converge(u, v, tol=1.e-6) max_iters(100)
+ do i = 1, 100
+ u = u * 0.5
+ end do
+ !$example converge(a, /blk/, tol=-0.5)
+ do while (.not. converged)
+ converged = .true.
+ end do
+ end
+end
+
+! CHECK-LABEL: func.func @_QMm_loopPiterate(
+! CHECK: fir.do_loop
+! CHECK: fir.call @__flang_directive.example.converge({{.*}}) fastmath<contract> {fir.directive = {args = {max_iters = 100 : i64, tol = {{.*}} : f32}, keyword = "converge", prefix = "example"}}
+! CHECK: fir.call @__flang_directive.example.converge{{(\.[0-9]+)?}}({{.*}}) fastmath<contract> {fir.directive = {args = {tol = -5.000000e-01 : f32}, keyword = "converge", prefix = "example"}}
diff --git a/flang/test/Examples/plugin-directives-parse.f90 b/flang/test/Examples/plugin-directives-parse.f90
index a3e76240f4156..7757ea32963e3 100644
--- a/flang/test/Examples/plugin-directives-parse.f90
+++ b/flang/test/Examples/plugin-directives-parse.f90
@@ -10,9 +10,9 @@
subroutine s
! CHECK: error: malformed argument list of a directive defined by a plugin
- !dir$ example callback(handler=s, priority=1.5)
+ !dir$ example callback(handler=s, priority=1+2)
! CHECK: error: malformed argument list of a directive defined by a plugin
- !dir$ example callback(handler=s, priority=-1)
+ !dir$ example callback(handler=s, priority=*)
! CHECK: error: malformed argument list of a directive defined by a plugin
!dir$ example callback(handler=s) trailing
! CHECK-NOT: Unrecognized compiler directive
More information about the llvm-branch-commits
mailing list