Select Case constructs with character selector expressions #685
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -17,6 +17,7 @@ | |
| #include "flang/Lower/Allocatable.h" | ||
| #include "flang/Lower/CallInterface.h" | ||
| #include "flang/Lower/CharacterExpr.h" | ||
| #include "flang/Lower/CharacterRuntime.h" | ||
| #include "flang/Lower/Coarray.h" | ||
| #include "flang/Lower/ConvertExpr.h" | ||
| #include "flang/Lower/ConvertType.h" | ||
|
|
@@ -395,6 +396,14 @@ class FirConverter : public Fortran::lower::AbstractConverter { | |
| return cat == Fortran::common::TypeCategory::Derived; | ||
| } | ||
|
|
||
| /// Insert a new block before \p block. Leave the insertion point unchanged. | ||
| mlir::Block *insertBlock(mlir::Block *block) { | ||
| auto insertPt = builder->saveInsertionPoint(); | ||
| auto newBlock = builder->createBlock(block); | ||
| builder->restoreInsertionPoint(insertPt); | ||
| return newBlock; | ||
| } | ||
|
|
||
| mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval, | ||
| Fortran::parser::Label label) { | ||
| const auto &labelEvaluationMap = | ||
|
|
@@ -791,10 +800,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { | |
| // exit block of the immediately enclosed dimension. | ||
| auto createNextExitBlock = [&]() { | ||
| // Create unstructured loop exit blocks, outermost to innermost. | ||
| return exitBlock = insertBlock(exitBlock); | ||
| }; | ||
| auto isInnermost = &info == &incrementLoopNestInfo.back(); | ||
| auto isOutermost = &info == &incrementLoopNestInfo.front(); | ||
|
|
@@ -1130,36 +1136,53 @@ class FirConverter : public Fortran::lower::AbstractConverter { | |
| builder->restoreInsertionPoint(insertPt); | ||
| } | ||
|
|
||
| /// Generate FIR for a SELECT CASE statement. | ||
| /// The type may be CHARACTER, INTEGER, or LOGICAL. | ||
| void genFIR(const Fortran::parser::SelectCaseStmt &stmt) { | ||
| auto &eval = getEval(); | ||
| auto *context = builder->getContext(); | ||
| auto loc = toLocation(); | ||
| Fortran::lower::StatementContext stmtCtx; | ||
| const auto *expr = Fortran::semantics::GetExpr( | ||
| std::get<Fortran::parser::Scalar<Fortran::parser::Expr>>(stmt.t)); | ||
| bool isCharSelector = isCharacterCategory(expr->GetType()->category()); | ||
| bool isLogicalSelector = isLogicalCategory(expr->GetType()->category()); | ||
|
There was a problem hiding this comment. I think we have moved to using the FIR type for these tests. @jeanPerier ? There was a problem hiding this comment. In general yes, when there is a There was a problem hiding this comment. Right, that was the motivation for doing it this way. |
||
| auto charValue = [&](const Fortran::lower::SomeExpr *expr) { | ||
| fir::ExtendedValue exv = genExprAddr(*expr, stmtCtx, &loc); | ||
| return exv.match( | ||
| [&](const fir::CharBoxValue &cbv) { | ||
| return Fortran::lower::CharacterExprHelper{*builder, loc} | ||
| .createEmboxChar(cbv.getAddr(), cbv.getLen()); | ||
| }, | ||
| [&](auto) { | ||
| fir::emitFatalError(loc, "not a character"); | ||
| return mlir::Value{}; | ||
| }); | ||
| }; | ||
| mlir::Value selector; | ||
| if (isCharSelector) { | ||
| selector = charValue(expr); | ||
| } else { | ||
| selector = createFIRExpr(loc, expr, stmtCtx); | ||
| if (isLogicalSelector) | ||
| selector = builder->createConvert(loc, builder->getI1Type(), selector); | ||
| } | ||
| auto selectType = selector.getType(); | ||
| llvm::SmallVector<mlir::Attribute> attrList; | ||
| llvm::SmallVector<mlir::Value> valueList; | ||
| llvm::SmallVector<mlir::Block *> blockList; | ||
| auto *defaultBlock = eval.parentConstruct->constructExit->block; | ||
| using CaseValue = Fortran::parser::Scalar<Fortran::parser::ConstantExpr>; | ||
| auto addValue = [&](const CaseValue &caseValue) { | ||
| const auto *expr = Fortran::semantics::GetExpr(caseValue.thing); | ||
| if (isCharSelector) | ||
| valueList.push_back(charValue(expr)); | ||
| else if (isLogicalSelector) | ||
| valueList.push_back(builder->createConvert( | ||
| loc, selectType, createFIRExpr(toLocation(), expr, stmtCtx))); | ||
| else | ||
| valueList.push_back(builder->createIntegerConstant( | ||
| loc, selectType, *Fortran::evaluate::ToInt64(*expr))); | ||
| }; | ||
| for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e; | ||
| e = e->controlSuccessor) { | ||
|
|
@@ -1197,13 +1220,65 @@ class FirConverter : public Fortran::lower::AbstractConverter { | |
| } | ||
| } | ||
| // Skip a logical default block that can never be referenced. | ||
| if (isLogicalSelector && attrList.size() == 2) | ||
| defaultBlock = eval.parentConstruct->constructExit->block; | ||
| attrList.push_back(mlir::UnitAttr::get(context)); | ||
| blockList.push_back(defaultBlock); | ||
| stmtCtx.finalize(); | ||
|
|
||
| // Generate a fir::SelectCaseOp. | ||
| // Explicit branch code is better for the LOGICAL type. The CHARACTER type | ||
| // does not yet have downstream support, and also uses explicit branch code. | ||
| // The -no-structured-fir option can be used to force generation of INTEGER | ||
| // type branch code. | ||
| if (!isLogicalSelector && !isCharSelector && eval.lowerAsStructured()) { | ||
| builder->create<fir::SelectCaseOp>(loc, selector, attrList, valueList, | ||
| blockList); | ||
| return; | ||
| } | ||
|
|
||
| // Generate a sequence of case value comparisons and branches. | ||
| auto caseValue = valueList.begin(); | ||
| auto caseBlock = blockList.begin(); | ||
| for (auto attr : attrList) { | ||
| if (attr.isa<mlir::UnitAttr>()) { | ||
| genFIRBranch(*caseBlock++); | ||
| break; | ||
| } | ||
| auto genCond = [&](mlir::Value rhs, | ||
| mlir::CmpIPredicate pred) -> mlir::Value { | ||
| if (!isCharSelector) | ||
| return builder->create<mlir::CmpIOp>(loc, pred, selector, rhs); | ||
| Fortran::lower::CharacterExprHelper charHelper{*builder, loc}; | ||
| auto [lhsAddr, lhsLen] = charHelper.createUnboxChar(selector); | ||
| auto [rhsAddr, rhsLen] = charHelper.createUnboxChar(rhs); | ||
| return Fortran::lower::genRawCharCompare(*builder, loc, pred, lhsAddr, | ||
| lhsLen, rhsAddr, rhsLen); | ||
| }; | ||
| auto *newBlock = insertBlock(*caseBlock); | ||
| if (attr.isa<fir::ClosedIntervalAttr>()) { | ||
| auto *newBlock2 = insertBlock(*caseBlock); | ||
| auto cond = genCond(*caseValue++, mlir::CmpIPredicate::sge); | ||
| genFIRConditionalBranch(cond, newBlock, newBlock2); | ||
| builder->setInsertionPointToEnd(newBlock); | ||
| auto cond2 = genCond(*caseValue++, mlir::CmpIPredicate::sle); | ||
| genFIRConditionalBranch(cond2, *caseBlock++, newBlock2); | ||
| builder->setInsertionPointToEnd(newBlock2); | ||
| continue; | ||
| } | ||
| mlir::CmpIPredicate pred; | ||
| if (attr.isa<fir::PointIntervalAttr>()) | ||
| pred = mlir::CmpIPredicate::eq; | ||
| else if (attr.isa<fir::LowerBoundAttr>()) | ||
| pred = mlir::CmpIPredicate::sge; | ||
| else if (attr.isa<fir::UpperBoundAttr>()) | ||
| pred = mlir::CmpIPredicate::sle; | ||
| auto cond = genCond(*caseValue++, pred); | ||
| genFIRConditionalBranch(cond, *caseBlock++, newBlock); | ||
| builder->setInsertionPointToEnd(newBlock); | ||
| } | ||
| assert(caseValue == valueList.end() && caseBlock == blockList.end() && | ||
| "select case list mismatch"); | ||
| } | ||
|
|
||
| void genFIR(const Fortran::parser::AssociateConstruct &) { | ||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Why not use mlir's splitBlock function?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
mlir functions
splitBlockand (one overload of)createBlockare complementary.createBlockinserts a new block before a given block, andsplitBlockinserts the new block after the given block. Since "the given block" may actually be the first of multiple blocks,createBlockmakes much more sense here. Of course, where blocks are inserted doesn't affect actual code relationships between blocks. But it is much easier to read and debug IR when blocks are placed in more natural locations.