Skip to content

Commit cc38a4a

Browse files
clementvaljeanPeriermleairschweitzpgi
committed
[flang] Lower character related intrinsics
This patch adds lowering for some character related intrinsics: - `scan` - `verify` This patch is part of the upstreaming effort from fir-dev branch. Reviewed By: PeteSteinfeld Differential Revision: https://reviews.llvm.org/D121842 Co-authored-by: Jean Perier <jperier@nvidia.com> Co-authored-by: mleair <leairmark@gmail.com> Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
1 parent ea0f8ec commit cc38a4a

File tree

3 files changed

+348
-0
lines changed

3 files changed

+348
-0
lines changed

‎flang/lib/Lower/IntrinsicCall.cpp

Lines changed: 170 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -486,6 +486,7 @@ struct IntrinsicLibrary {
486486
void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
487487
void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
488488
void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
489+
fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
489490
mlir::Value genSetExponent(mlir::Type resultType,
490491
llvm::ArrayRef<mlir::Value> args);
491492
fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -495,6 +496,7 @@ struct IntrinsicLibrary {
495496
llvm::ArrayRef<fir::ExtendedValue>);
496497
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
497498
fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
499+
fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
498500

499501
/// Define the different FIR generators that can be mapped to intrinsic to
500502
/// generate the related code.
@@ -727,6 +729,13 @@ static constexpr IntrinsicHandler handlers[]{
727729
&I::genRandomSeed,
728730
{{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
729731
/*isElemental=*/false},
732+
{"scan",
733+
&I::genScan,
734+
{{{"string", asAddr},
735+
{"set", asAddr},
736+
{"back", asValue, handleDynamicOptional},
737+
{"kind", asValue}}},
738+
/*isElemental=*/true},
730739
{"set_exponent", &I::genSetExponent},
731740
{"size",
732741
&I::genSize,
@@ -756,6 +765,13 @@ static constexpr IntrinsicHandler handlers[]{
756765
&I::genUnpack,
757766
{{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
758767
/*isElemental=*/false},
768+
{"verify",
769+
&I::genVerify,
770+
{{{"string", asAddr},
771+
{"set", asAddr},
772+
{"back", asValue, handleDynamicOptional},
773+
{"kind", asValue}}},
774+
/*isElemental=*/true},
759775
};
760776

761777
static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
@@ -2485,6 +2501,83 @@ void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
24852501
Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
24862502
}
24872503

2504+
// SCAN
2505+
fir::ExtendedValue
2506+
IntrinsicLibrary::genScan(mlir::Type resultType,
2507+
llvm::ArrayRef<fir::ExtendedValue> args) {
2508+
2509+
assert(args.size() == 4);
2510+
2511+
if (isAbsent(args[3])) {
2512+
// Kind not specified, so call scan/verify runtime routine that is
2513+
// specialized on the kind of characters in string.
2514+
2515+
// Handle required string base arg
2516+
mlir::Value stringBase = fir::getBase(args[0]);
2517+
2518+
// Handle required set string base arg
2519+
mlir::Value setBase = fir::getBase(args[1]);
2520+
2521+
// Handle kind argument; it is the kind of character in this case
2522+
fir::KindTy kind =
2523+
fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
2524+
stringBase.getType());
2525+
2526+
// Get string length argument
2527+
mlir::Value stringLen = fir::getLen(args[0]);
2528+
2529+
// Get set string length argument
2530+
mlir::Value setLen = fir::getLen(args[1]);
2531+
2532+
// Handle optional back argument
2533+
mlir::Value back =
2534+
isAbsent(args[2])
2535+
? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
2536+
: fir::getBase(args[2]);
2537+
2538+
return builder.createConvert(loc, resultType,
2539+
fir::runtime::genScan(builder, loc, kind,
2540+
stringBase, stringLen,
2541+
setBase, setLen, back));
2542+
}
2543+
// else use the runtime descriptor version of scan/verify
2544+
2545+
// Handle optional argument, back
2546+
auto makeRefThenEmbox = [&](mlir::Value b) {
2547+
fir::LogicalType logTy = fir::LogicalType::get(
2548+
builder.getContext(), builder.getKindMap().defaultLogicalKind());
2549+
mlir::Value temp = builder.createTemporary(loc, logTy);
2550+
mlir::Value castb = builder.createConvert(loc, logTy, b);
2551+
builder.create<fir::StoreOp>(loc, castb, temp);
2552+
return builder.createBox(loc, temp);
2553+
};
2554+
mlir::Value back = fir::isUnboxedValue(args[2])
2555+
? makeRefThenEmbox(*args[2].getUnboxed())
2556+
: builder.create<fir::AbsentOp>(
2557+
loc, fir::BoxType::get(builder.getI1Type()));
2558+
2559+
// Handle required string argument
2560+
mlir::Value string = builder.createBox(loc, args[0]);
2561+
2562+
// Handle required set argument
2563+
mlir::Value set = builder.createBox(loc, args[1]);
2564+
2565+
// Handle kind argument
2566+
mlir::Value kind = fir::getBase(args[3]);
2567+
2568+
// Create result descriptor
2569+
fir::MutableBoxValue resultMutableBox =
2570+
fir::factory::createTempMutableBox(builder, loc, resultType);
2571+
mlir::Value resultIrBox =
2572+
fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2573+
2574+
fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
2575+
kind);
2576+
2577+
// Handle cleanup of allocatable result descriptor and return
2578+
return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
2579+
}
2580+
24882581
// SET_EXPONENT
24892582
mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
24902583
llvm::ArrayRef<mlir::Value> args) {
@@ -2710,6 +2803,83 @@ IntrinsicLibrary::genUnpack(mlir::Type resultType,
27102803
"unexpected result for UNPACK");
27112804
}
27122805

2806+
// VERIFY
2807+
fir::ExtendedValue
2808+
IntrinsicLibrary::genVerify(mlir::Type resultType,
2809+
llvm::ArrayRef<fir::ExtendedValue> args) {
2810+
2811+
assert(args.size() == 4);
2812+
2813+
if (isAbsent(args[3])) {
2814+
// Kind not specified, so call scan/verify runtime routine that is
2815+
// specialized on the kind of characters in string.
2816+
2817+
// Handle required string base arg
2818+
mlir::Value stringBase = fir::getBase(args[0]);
2819+
2820+
// Handle required set string base arg
2821+
mlir::Value setBase = fir::getBase(args[1]);
2822+
2823+
// Handle kind argument; it is the kind of character in this case
2824+
fir::KindTy kind =
2825+
fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
2826+
stringBase.getType());
2827+
2828+
// Get string length argument
2829+
mlir::Value stringLen = fir::getLen(args[0]);
2830+
2831+
// Get set string length argument
2832+
mlir::Value setLen = fir::getLen(args[1]);
2833+
2834+
// Handle optional back argument
2835+
mlir::Value back =
2836+
isAbsent(args[2])
2837+
? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
2838+
: fir::getBase(args[2]);
2839+
2840+
return builder.createConvert(
2841+
loc, resultType,
2842+
fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
2843+
setBase, setLen, back));
2844+
}
2845+
// else use the runtime descriptor version of scan/verify
2846+
2847+
// Handle optional argument, back
2848+
auto makeRefThenEmbox = [&](mlir::Value b) {
2849+
fir::LogicalType logTy = fir::LogicalType::get(
2850+
builder.getContext(), builder.getKindMap().defaultLogicalKind());
2851+
mlir::Value temp = builder.createTemporary(loc, logTy);
2852+
mlir::Value castb = builder.createConvert(loc, logTy, b);
2853+
builder.create<fir::StoreOp>(loc, castb, temp);
2854+
return builder.createBox(loc, temp);
2855+
};
2856+
mlir::Value back = fir::isUnboxedValue(args[2])
2857+
? makeRefThenEmbox(*args[2].getUnboxed())
2858+
: builder.create<fir::AbsentOp>(
2859+
loc, fir::BoxType::get(builder.getI1Type()));
2860+
2861+
// Handle required string argument
2862+
mlir::Value string = builder.createBox(loc, args[0]);
2863+
2864+
// Handle required set argument
2865+
mlir::Value set = builder.createBox(loc, args[1]);
2866+
2867+
// Handle kind argument
2868+
mlir::Value kind = fir::getBase(args[3]);
2869+
2870+
// Create result descriptor
2871+
fir::MutableBoxValue resultMutableBox =
2872+
fir::factory::createTempMutableBox(builder, loc, resultType);
2873+
mlir::Value resultIrBox =
2874+
fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
2875+
2876+
fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
2877+
back, kind);
2878+
2879+
// Handle cleanup of allocatable result descriptor and return
2880+
return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
2881+
}
2882+
27132883
//===----------------------------------------------------------------------===//
27142884
// Argument lowering rules interface
27152885
//===----------------------------------------------------------------------===//

‎flang/test/Lower/Intrinsics/scan.f90

Lines changed: 91 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,91 @@
1+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
3+
! CHECK-LABEL: func @_QPscan_test(
4+
! CHECK-SAME: %[[s:[^:]+]]: !fir.boxchar<1>{{.*}}, %[[ss:[^:]+]]: !fir.boxchar<1>{{.*}}) -> i32
5+
integer function scan_test(s1, s2)
6+
character(*) :: s1, s2
7+
! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box<!fir.heap<i32>>
8+
! CHECK-DAG: %[[c:.*]]:2 = fir.unboxchar %[[s]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
9+
! CHECK-DAG: %[[cBox:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
10+
! CHECK-DAG: %[[cBoxNone:.*]] = fir.convert %[[cBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
11+
! CHECK-DAG: %[[c2:.*]]:2 = fir.unboxchar %[[ss]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
12+
! CHECK-DAG: %[[cBox2:.*]] = fir.embox %[[c2]]#0 typeparams %[[c2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
13+
! CHECK-DAG: %[[cBoxNone2:.*]] = fir.convert %[[cBox2]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
14+
! CHECK-DAG: %[[backOptBox:.*]] = fir.absent !fir.box<i1>
15+
! CHECK-DAG: %[[backBox:.*]] = fir.convert %[[backOptBox]] : (!fir.box<i1>) -> !fir.box<none>
16+
! CHECK-DAG: %[[kindConstant:.*]] = arith.constant 4 : i32
17+
! CHECK-DAG: %[[resBox:.*]] = fir.convert %[[tmpBox:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> !fir.ref<!fir.box<none>>
18+
! CHECK: fir.call @{{.*}}Scan(%[[resBox]], %[[cBoxNone]], %[[cBoxNone2]], %[[backBox]], %[[kindConstant]], {{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
19+
scan_test = scan(s1, s2, kind=4)
20+
! CHECK-DAG: %[[tmpAddr:.*]] = fir.box_addr
21+
! CHECK: fir.freemem %[[tmpAddr]]
22+
end function scan_test
23+
24+
! CHECK-LABEL: func @_QPscan_test2(
25+
! CHECK-SAME: %[[s:[^:]+]]: !fir.boxchar<1>{{.*}},
26+
! CHECK-SAME: %[[ss:[^:]+]]: !fir.boxchar<1>{{.*}}) -> i32
27+
integer function scan_test2(s1, s2)
28+
character(*) :: s1, s2
29+
! CHECK: %[[st:[^:]*]]:2 = fir.unboxchar %[[s]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
30+
! CHECK: %[[sst:[^:]*]]:2 = fir.unboxchar %[[ss]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
31+
! CHECK: %[[a1:.*]] = fir.convert %[[st]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
32+
! CHECK: %[[a2:.*]] = fir.convert %[[st]]#1 : (index) -> i64
33+
! CHECK: %[[a3:.*]] = fir.convert %[[sst]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
34+
! CHECK: %[[a4:.*]] = fir.convert %[[sst]]#1 : (index) -> i64
35+
! CHECK: = fir.call @_FortranAScan1(%[[a1]], %[[a2]], %[[a3]], %[[a4]], %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
36+
scan_test2 = scan(s1, s2, .true.)
37+
end function scan_test2
38+
39+
! CHECK-LABEL: func @_QPtest_optional(
40+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>
41+
! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1>
42+
! CHECK-SAME: %[[VAL_2:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>>
43+
subroutine test_optional(string, set, back)
44+
character (*) :: string(:), set
45+
logical, optional :: back(:)
46+
print *, scan(string, set, back)
47+
! CHECK: %[[VAL_11:.*]] = fir.is_present %[[VAL_2]] : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> i1
48+
! CHECK: %[[VAL_12:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.logical<4>>>
49+
! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index
50+
! CHECK: %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
51+
! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_12]](%[[VAL_14]]) : (!fir.ref<!fir.array<?x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.logical<4>>>
52+
! CHECK: %[[VAL_16:.*]] = arith.select %[[VAL_11]], %[[VAL_2]], %[[VAL_15]] : !fir.box<!fir.array<?x!fir.logical<4>>>
53+
! CHECK: %[[VAL_17:.*]] = fir.array_load %[[VAL_16]] {fir.optional} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> !fir.array<?x!fir.logical<4>>
54+
! CHECK: fir.do_loop %[[VAL_25:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?xi32>) {
55+
! CHECK: %[[VAL_31:.*]] = fir.if %[[VAL_11]] -> (!fir.logical<4>) {
56+
! CHECK: %[[VAL_32:.*]] = fir.array_fetch %[[VAL_17]], %[[VAL_25]] : (!fir.array<?x!fir.logical<4>>, index) -> !fir.logical<4>
57+
! CHECK: fir.result %[[VAL_32]] : !fir.logical<4>
58+
! CHECK: } else {
59+
! CHECK: %[[VAL_33:.*]] = arith.constant false
60+
! CHECK: %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i1) -> !fir.logical<4>
61+
! CHECK: fir.result %[[VAL_34]] : !fir.logical<4>
62+
! CHECK: }
63+
! CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_31]] : (!fir.logical<4>) -> i1
64+
! CHECK: fir.call @_FortranAScan1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_39]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
65+
! CHECK: }
66+
! CHECK: fir.array_merge_store
67+
end subroutine
68+
69+
! CHECK-LABEL: func @_QPtest_optional_scalar(
70+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>
71+
! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1>
72+
! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref<!fir.logical<4>>
73+
subroutine test_optional_scalar(string, set, back)
74+
character (*) :: string(:), set
75+
logical, optional :: back
76+
print *, scan(string, set, back)
77+
! CHECK: %[[VAL_11:.*]] = fir.is_present %[[VAL_2]] : (!fir.ref<!fir.logical<4>>) -> i1
78+
! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_11]] -> (!fir.logical<4>) {
79+
! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.logical<4>>
80+
! CHECK: fir.result %[[VAL_13]] : !fir.logical<4>
81+
! CHECK: } else {
82+
! CHECK: %[[VAL_14:.*]] = arith.constant false
83+
! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i1) -> !fir.logical<4>
84+
! CHECK: fir.result %[[VAL_15]] : !fir.logical<4>
85+
! CHECK: }
86+
! CHECK: fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?xi32>) {
87+
! CHECK: %[[VAL_39:.*]] = fir.convert %[[VAL_12]] : (!fir.logical<4>) -> i1
88+
! CHECK: fir.call @_FortranAScan1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_39]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
89+
! CHECK: }
90+
! CHECK: fir.array_merge_store
91+
end subroutine

0 commit comments

Comments
 (0)