Merge pull request lfortran#4663 from HarshitaKalani/findloc_01

Implement `findloc` intrinsic

integration_tests/CMakeLists.txt

@@ -876,6 +876,7 @@ RUN(NAME intrinsics_297 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # poppar
 RUN(NAME intrinsics_298 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc fortran) # dot_product
 RUN(NAME intrinsics_299 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # command_argument_count
 RUN(NAME intrinsics_300 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # kind
+RUN(NAME intrinsics_301 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # findloc
 RUN(NAME intrinsics_304 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc) # sign
 RUN(NAME intrinsics_305 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc fortran) # realpart
 RUN(NAME intrinsics_306 LABELS gfortran llvm llvm_wasm llvm_wasm_emcc fortran) # imagpart

integration_tests/intrinsics_301.f90

@@ -0,0 +1,74 @@
+program intrinsics_301
+    implicit none
+
+    integer(4), parameter :: i1(1) = findloc([1, 2, 3], 2)
+    integer(4), parameter :: i2(1) = findloc([1.0, 2.0, 3.0], 2.0)
+    integer(4), parameter :: i3(1) = findloc(["aa", "db", "ca"], "aa")
+    integer(4), parameter :: i4(1) = findloc([1,2,3], 3, mask = [.true., .true., .true.])
+    integer(8), parameter :: i5(1) = findloc([1,2,3], 1, mask=[.true., .false., .true.], kind = 8)
+    integer(4), parameter :: i6(1) = findloc([1,2,3], 2, mask=[.true., .false., .true.], dim=1)
+    integer(4), parameter :: i7(1) = findloc(["aa", "db", "ca"], "aa", mask=[.true., .false., .true.])
+    integer(4), parameter :: i8(1) = findloc(["aa", "db", "ca"], "db", mask=[.true., .false., .true.], dim = 1)
+    integer(4), parameter :: i9(1) = findloc([1, 3, 2, 3], 3, mask = [.true., .true., .false., .true.], back = .true.)
+    integer(4), parameter :: i10(1) = findloc([3, 2, 1, 3], 3, back = .true.)
+    integer(4), parameter :: i11(1) = findloc([3.0, 2.0, 1.0, 3.0], 2.0, back = .true., dim=1)
+    integer(4), parameter :: i12(1) = findloc(["aa", "db", "ca"], "aa", mask = [.false., .false., .false.], kind = 4)
+
+    integer :: x1(5) = [1, 3, 2, 4, 2], y1 = 2
+    real :: x2(5) = [1.0, 3.0, 2.0, 4.0, 2.0], y2 = 2.0
+    character(len=2) :: x3(3) = ["aa", "db", "ca"], y3 = "aa"
+    logical :: mask1(5) = [.true., .true., .false., .true., .true.]
+    logical :: mask2(3) = [.true., .false., .true.]
+    logical :: back1 = .false.
+    logical :: back2 = .true.
+
+    print *, findloc(x1, y1)
+    if (any(findloc(x1, y1) /= 3)) error stop
+    print *, findloc(x2, y2)
+    if (any(findloc(x2, y2) /= 3)) error stop
+    print *, findloc(x3, y3)
+    if (any(findloc(x3, y3) /= 1)) error stop
+    print *, findloc(x1, y1, mask = mask1)
+    if (any(findloc(x1, y1, mask = mask1) /= 5)) error stop
+    print *, findloc(x2, y2, mask = mask1)
+    if (any(findloc(x2, y2, mask = mask1) /= 5)) error stop
+    print *, findloc(x3, y3, mask = mask2)
+    if (any(findloc(x3, y3, mask = mask2) /= 1)) error stop
+    print *, findloc(x1, y1, mask = mask1, back = back1)
+    if (any(findloc(x1, y1, mask = mask1, back = back1) /= 5)) error stop
+    print *, findloc(x1, y1, mask = mask1, back = back2)
+    if (any(findloc(x1, y1, mask = mask1, back = back2) /= 5)) error stop
+    print *, findloc(x2, y2, mask = mask1, back = back2)
+    if (any(findloc(x2, y2, mask = mask1, back = back2) /= 5)) error stop
+    print *, findloc(x1, y1, mask = mask1, back = back2, kind = 8)
+    if (any(findloc(x1, y1, mask = mask1, back = back2, kind = 8) /= 5)) error stop
+
+    print *, i1
+    if (i1(1) /= 2) error stop
+    print *, i2
+    if (i2(1) /= 2) error stop
+    print *, i3
+    if (i3(1) /= 1) error stop
+    print *, i4
+    if (i4(1) /= 3) error stop
+    print *, i5
+    if (i5(1) /= 1) error stop
+    print *, i6
+    if (i6(1) /= 0) error stop
+    print *, i7
+    if (i7(1) /= 1) error stop
+    print *, i8
+    if (i8(1) /= 0) error stop
+    print *, i9
+    if (i9(1) /= 4) error stop
+    print *, i10
+    if (i10(1) /= 4) error stop
+    print *, i11
+    if (i11(1) /= 2) error stop
+    print *, i12
+    if (i12(1) /= 0) error stop
+
+    print *, kind(findloc(["aa", "db", "ca"], "aa", 1, mask = [.false., .false., .false.], kind = 8))
+    if (kind(findloc(["aa", "db", "ca"], "db", 1, mask = [.false., .false., .false.], kind = 8)) /= 8) error stop
+
+end program intrinsics_301

src/lfortran/semantics/ast_common_visitor.h

@@ -788,8 +788,8 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
         {"maxval", {IntrinsicSignature({"array", "dim", "mask"}, 1, 3)}},
         {"maxloc", {IntrinsicSignature({"array", "dim", "mask", "kind", "back"}, 1, 5)}},
         {"minval", {IntrinsicSignature({"array", "dim", "mask"}, 1, 3)}},
-        {"minloc", {IntrinsicSignature({"array", "dim", "mask", "kind", "back"}, 1, 5),
-                    IntrinsicSignature({"array", "mask", "kind", "back"}, 1, 4)}},
+        {"minloc", {IntrinsicSignature({"array", "dim", "mask", "kind", "back"}, 1, 5)}},
+        {"findloc", {IntrinsicSignature({"array", "value", "dim", "mask", "kind", "back"}, 2, 6)}},
         // max0 can accept any arbitrary number of arguments 2<=x<=100
         {"max0", {IntrinsicSignature({"a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "a10", "a11", "a12", "a13", "a14", "a15", "a16", "a17", "a18", "a19", "a20", "a21", "a22", "a23", "a24", "a25", "a26", "a27", "a28", "a29", "a30", "a31", "a32", "a33", "a34", "a35", "a36", "a37", "a38", "a39", "a40", "a41", "a42", "a43", "a44", "a45", "a46", "a47", "a48", "a49", "a50", "a51", "a52", "a53", "a54", "a55", "a56", "a57", "a58", "a59", "a60", "a61", "a62", "a63", "a64", "a65", "a66", "a67", "a68", "a69", "a70", "a71", "a72", "a73", "a74", "a75", "a76", "a77", "a78", "a79", "a80", "a81", "a82", "a83", "a84", "a85", "a86", "a87", "a88", "a89", "a90", "a91", "a92", "a93", "a94", "a95", "a96", "a97", "a98", "a99", "a100"}, 2, 100)}},
         // min0 can accept any arbitrary number of arguments 2<=x<=100