From 6e12e8fb557c333ccd19f66ead4c22462fdddb2e Mon Sep 17 00:00:00 2001 From: Eric Schweitz Date: Thu, 9 Apr 2020 08:59:33 -0700 Subject: [PATCH 001/118] This rolls up over a year's worth of work on the flang middle-end and merges it onto a working branch. --- flang/CMakeLists.txt | 185 +- flang/LAPACK-bugs.txt | 23 + flang/README.md | 192 +- flang/cmake/modules/AddFlang.cmake | 8 + flang/documentation/BurnsideToFIR.md | 823 ++++++ flang/include/flang/CMakeLists.txt | 4 +- flang/include/flang/Common/enum-set.h | 4 + flang/include/flang/Lower/Bridge.h | 165 ++ flang/include/flang/Lower/ConvertExpr.h | 73 + flang/include/flang/Lower/ConvertType.h | 122 + flang/include/flang/Lower/FIRBuilder.h | 378 +++ flang/include/flang/Lower/IO.h | 85 + flang/include/flang/Lower/Intrinsics.h | 74 + flang/include/flang/Lower/Mangler.h | 44 + flang/include/flang/Lower/PFTBuilder.h | 504 ++-- flang/include/flang/Lower/Runtime.h | 213 ++ flang/include/flang/Lower/Utils.h | 20 + .../Analysis/IteratedDominanceFrontier.h | 95 + .../flang/Optimizer/Support/KindMapping.h | 16 +- .../flang/Optimizer/Transforms/Passes.h | 47 + flang/include/flang/Semantics/symbol.h | 28 +- flang/include/flang/Semantics/tools.h | 2 + flang/include/flang/Version.h | 61 + flang/lib/CMakeLists.txt | 11 +- flang/lib/Decimal/binary-to-decimal.cpp | 40 +- flang/lib/Lower/Bridge.cpp | 1470 ++++++++++ flang/lib/Lower/CMakeLists.txt | 17 + flang/lib/Lower/ConvertExpr.cpp | 979 +++++++ flang/lib/Lower/ConvertType.cpp | 515 ++++ flang/lib/Lower/FIRBuilder.cpp | 576 ++++ flang/lib/Lower/IO.cpp | 1233 +++++++++ flang/lib/Lower/Intrinsics.cpp | 739 +++++ flang/lib/Lower/Mangler.cpp | 103 + flang/lib/Lower/PFTBuilder.cpp | 1093 +++++--- flang/lib/Lower/RTBuilder.h | 216 ++ flang/lib/Lower/Runtime.cpp | 108 + flang/lib/Optimizer/CMakeLists.txt | 21 +- flang/lib/Optimizer/CodeGen.cpp | 2404 +++++++++++++++++ .../Optimizer/IteratedDominanceFrontier.cpp | 107 + flang/lib/Optimizer/StdConverter.cpp | 231 ++ flang/lib/Optimizer/Support/KindMapping.cpp | 14 +- flang/lib/Optimizer/Transforms/CMakeLists.txt | 14 + flang/lib/Optimizer/Transforms/CSE.cpp | 325 +++ flang/lib/Optimizer/Transforms/MemToReg.cpp | 761 ++++++ .../lib/Optimizer/Transforms/RewriteLoop.cpp | 202 ++ flang/lib/Semantics/CMakeLists.txt | 1 + flang/lib/Semantics/tools.cpp | 10 + flang/not-test/fir/addrof.1.fir | 7 + flang/not-test/fir/aggregate.fir | 11 + flang/not-test/fir/alloc.fir | 21 + flang/not-test/fir/arrayset.fir | 16 + flang/not-test/fir/bugs/bug0001.fir | 41 + flang/not-test/fir/bugs/bug0002.fir | 12 + flang/not-test/fir/character.fir | 12 + flang/not-test/fir/commute.fir | 21 + flang/not-test/fir/compare.fir | 29 + flang/not-test/fir/complex.fir | 22 + flang/not-test/fir/complex.mlir | 6 + flang/not-test/fir/constant.fir | 19 + flang/not-test/fir/dynlayout.fir | 38 + flang/not-test/fir/embox.fir | 6 + flang/not-test/fir/fir-dt.fir | 5 + flang/not-test/lower/expr-test-generator.cc | 692 +++++ .../lower/test_expression_lowering.sh | 55 + flang/runtime/CMakeLists.txt | 8 +- flang/runtime/io-api.h | 5 +- flang/test/CMakeLists.txt | 7 +- flang/test/Examples/hello.f90 | 14 + flang/test/Examples/main.c | 14 + flang/test/Fir/char01.fir | 13 + flang/test/Fir/complex.fir | 82 + flang/test/Fir/coordinate01.fir | 19 + flang/test/Fir/cse.fir | 50 + flang/test/Fir/embox-write.fir | 18 + flang/test/Fir/fir-types.fir | 1 - flang/test/Fir/global.fir | 34 + flang/test/Fir/loop.fir | 22 + flang/test/Fir/loop10.fir | 24 + flang/test/Fir/print_complex.c | 5 + flang/test/Fir/real.fir | 51 + flang/test/Fir/recursive-type.fir | 11 + flang/test/Fir/select-type.fir | 22 + flang/test/Fir/select.fir | 63 + flang/test/Fir/widechar.fir | 22 + flang/test/Lower/arguments.f90 | 23 + flang/test/Lower/array-init-driver.c | 24 + flang/test/Lower/array-init.f90 | 48 + flang/test/Lower/call-site-mangling.f90 | 52 + flang/test/Lower/character-assignment.f90 | 106 + flang/test/Lower/control-flow.f90 | 25 + ...end-to-end-character-assignment-driver.cpp | 357 +++ .../Lower/end-to-end-character-assignment.f90 | 76 + flang/test/Lower/integer-operations.f90 | 111 + flang/test/Lower/io-stmt.f90 | 52 + flang/test/Lower/logical-operations.f90 | 67 + flang/test/Lower/pre-fir-tree01.f90 | 6 +- flang/test/Lower/pre-fir-tree02.f90 | 48 +- flang/test/Lower/pre-fir-tree03.f90 | 12 +- flang/test/Lower/pre-fir-tree04.f90 | 10 +- .../test/Lower/program-units-fir-mangling.f90 | 117 + flang/test/Lower/real-operations.f90 | 111 + flang/test/lit.cfg.py | 20 + flang/test/lit.site.cfg.py.in | 6 +- flang/tools/CMakeLists.txt | 13 +- flang/tools/bbc/CMakeLists.txt | 20 + flang/tools/bbc/bbc.cpp | 274 ++ flang/tools/f18/CMakeLists.txt | 3 + flang/tools/f18/f18.cpp | 1 - flang/tools/tco/CMakeLists.txt | 4 +- flang/tools/tco/tco.cpp | 19 +- flang/unittests/Decimal/CMakeLists.txt | 6 +- flang/unittests/Evaluate/CMakeLists.txt | 72 +- 112 files changed, 16560 insertions(+), 977 deletions(-) create mode 100644 flang/LAPACK-bugs.txt create mode 100644 flang/documentation/BurnsideToFIR.md create mode 100644 flang/include/flang/Lower/Bridge.h create mode 100644 flang/include/flang/Lower/ConvertExpr.h create mode 100644 flang/include/flang/Lower/ConvertType.h create mode 100644 flang/include/flang/Lower/FIRBuilder.h create mode 100644 flang/include/flang/Lower/IO.h create mode 100644 flang/include/flang/Lower/Intrinsics.h create mode 100644 flang/include/flang/Lower/Mangler.h create mode 100644 flang/include/flang/Lower/Runtime.h create mode 100644 flang/include/flang/Lower/Utils.h create mode 100644 flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h create mode 100644 flang/include/flang/Optimizer/Transforms/Passes.h create mode 100644 flang/include/flang/Version.h create mode 100644 flang/lib/Lower/Bridge.cpp create mode 100644 flang/lib/Lower/ConvertExpr.cpp create mode 100644 flang/lib/Lower/ConvertType.cpp create mode 100644 flang/lib/Lower/FIRBuilder.cpp create mode 100644 flang/lib/Lower/IO.cpp create mode 100644 flang/lib/Lower/Intrinsics.cpp create mode 100644 flang/lib/Lower/Mangler.cpp create mode 100644 flang/lib/Lower/RTBuilder.h create mode 100644 flang/lib/Lower/Runtime.cpp create mode 100644 flang/lib/Optimizer/CodeGen.cpp create mode 100644 flang/lib/Optimizer/IteratedDominanceFrontier.cpp create mode 100644 flang/lib/Optimizer/StdConverter.cpp create mode 100644 flang/lib/Optimizer/Transforms/CMakeLists.txt create mode 100644 flang/lib/Optimizer/Transforms/CSE.cpp create mode 100644 flang/lib/Optimizer/Transforms/MemToReg.cpp create mode 100644 flang/lib/Optimizer/Transforms/RewriteLoop.cpp create mode 100644 flang/not-test/fir/addrof.1.fir create mode 100644 flang/not-test/fir/aggregate.fir create mode 100644 flang/not-test/fir/alloc.fir create mode 100644 flang/not-test/fir/arrayset.fir create mode 100644 flang/not-test/fir/bugs/bug0001.fir create mode 100644 flang/not-test/fir/bugs/bug0002.fir create mode 100644 flang/not-test/fir/character.fir create mode 100644 flang/not-test/fir/commute.fir create mode 100644 flang/not-test/fir/compare.fir create mode 100644 flang/not-test/fir/complex.fir create mode 100644 flang/not-test/fir/complex.mlir create mode 100644 flang/not-test/fir/constant.fir create mode 100644 flang/not-test/fir/dynlayout.fir create mode 100644 flang/not-test/fir/embox.fir create mode 100644 flang/not-test/fir/fir-dt.fir create mode 100644 flang/not-test/lower/expr-test-generator.cc create mode 100755 flang/not-test/lower/test_expression_lowering.sh create mode 100644 flang/test/Examples/hello.f90 create mode 100644 flang/test/Examples/main.c create mode 100644 flang/test/Fir/char01.fir create mode 100644 flang/test/Fir/complex.fir create mode 100644 flang/test/Fir/coordinate01.fir create mode 100644 flang/test/Fir/cse.fir create mode 100644 flang/test/Fir/embox-write.fir create mode 100644 flang/test/Fir/global.fir create mode 100644 flang/test/Fir/loop.fir create mode 100644 flang/test/Fir/loop10.fir create mode 100644 flang/test/Fir/print_complex.c create mode 100644 flang/test/Fir/real.fir create mode 100644 flang/test/Fir/recursive-type.fir create mode 100644 flang/test/Fir/select-type.fir create mode 100644 flang/test/Fir/select.fir create mode 100644 flang/test/Fir/widechar.fir create mode 100644 flang/test/Lower/arguments.f90 create mode 100644 flang/test/Lower/array-init-driver.c create mode 100644 flang/test/Lower/array-init.f90 create mode 100644 flang/test/Lower/call-site-mangling.f90 create mode 100644 flang/test/Lower/character-assignment.f90 create mode 100644 flang/test/Lower/control-flow.f90 create mode 100644 flang/test/Lower/end-to-end-character-assignment-driver.cpp create mode 100644 flang/test/Lower/end-to-end-character-assignment.f90 create mode 100644 flang/test/Lower/integer-operations.f90 create mode 100644 flang/test/Lower/io-stmt.f90 create mode 100644 flang/test/Lower/logical-operations.f90 create mode 100644 flang/test/Lower/program-units-fir-mangling.f90 create mode 100644 flang/test/Lower/real-operations.f90 create mode 100644 flang/tools/bbc/CMakeLists.txt create mode 100644 flang/tools/bbc/bbc.cpp diff --git a/flang/CMakeLists.txt b/flang/CMakeLists.txt index 886213fd3c3eca..e18ed5c0d788ce 100644 --- a/flang/CMakeLists.txt +++ b/flang/CMakeLists.txt @@ -1,29 +1,27 @@ -cmake_minimum_required(VERSION 3.9.0) +cmake_minimum_required(VERSION 3.9.0) # RPATH settings on macOS do not affect INSTALL_NAME. -if (POLICY CMP0068) +if (POLICY CMP0068) cmake_policy(SET CMP0068 NEW) set(CMAKE_BUILD_WITH_INSTALL_NAME_DIR ON) endif() # Include file check macros honor CMAKE_REQUIRED_LIBRARIES. -if(POLICY CMP0075) +if(POLICY CMP0075) cmake_policy(SET CMP0075 NEW) endif() # option() honors normal variables. -if (POLICY CMP0077) +if (POLICY CMP0077) cmake_policy(SET CMP0077 NEW) endif() -option(LINK_WITH_FIR "Link driver with FIR and LLVM" ON) - -# Flang requires C++17. +# Flang requires C++17. set(CMAKE_CXX_STANDARD 17) set(CMAKE_CXX_STANDARD_REQUIRED TRUE) -set(CMAKE_CXX_EXTENSIONS OFF) set(FLANG_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR}) +set(FLANG_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR}) if (CMAKE_SOURCE_DIR STREQUAL CMAKE_BINARY_DIR AND NOT MSVC_IDE) message(FATAL_ERROR "In-source builds are not allowed. \ @@ -37,13 +35,13 @@ endif() list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake/modules") include(AddFlang) + # Check for a standalone build and configure as appropriate from # there. if (CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR) -message("Building Flang as a standalone project.") -project(Flang) + message("Building Flang as a standalone project.") + project(Flang) - set(FLANG_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR}) if (NOT MSVC_IDE) set(LLVM_ENABLE_ASSERTIONS ${ENABLE_ASSERTIONS} CACHE BOOL "Enable assertions") @@ -51,30 +49,28 @@ project(Flang) mark_as_advanced(LLVM_ENABLE_ASSERTIONS) endif() - # We need a pre-built/installed version of LLVM. + # We need a pre-built/installed version of LLVM and MLIR. find_package(LLVM REQUIRED HINTS "${LLVM_CMAKE_PATH}") list(APPEND CMAKE_MODULE_PATH ${LLVM_DIR}) + find_package(MLIR REQUIRED HINTS "${MLIR_CMAKE_PATH}") + list(APPEND CMAKE_MODULE_PATH ${MLIR_DIR}) + # If LLVM links to zlib we need the imported targets so we can too. if(LLVM_ENABLE_ZLIB) find_package(ZLIB REQUIRED) endif() + # They are used as destination of target generators. + set(LLVM_RUNTIME_OUTPUT_INTDIR ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_CFG_INTDIR}/bin) + set(LLVM_LIBRARY_OUTPUT_INTDIR ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_CFG_INTDIR}/lib${LLVM_LIBDIR_SUFFIX}) + include(CMakeParseArguments) include(AddLLVM) include(HandleLLVMOptions) include(VersionFromVCS) - - if(LINK_WITH_FIR) - include(TableGen) - find_package(MLIR REQUIRED CONFIG) - # Use SYSTEM for the same reasons as for LLVM includes - include_directories(SYSTEM ${MLIR_INCLUDE_DIRS}) - list(APPEND CMAKE_MODULE_PATH ${MLIR_DIR}) - include(AddMLIR) - find_program(MLIR_TABLEGEN_EXE "mlir-tblgen" ${LLVM_TOOLS_BINARY_DIR} - NO_DEFAULT_PATH) - endif() + include(TableGen) + include(AddMLIR) option(LLVM_ENABLE_WARNINGS "Enable compiler warnings." ON) option(LLVM_INSTALL_TOOLCHAIN_ONLY @@ -92,11 +88,13 @@ project(Flang) # should not be suppressed). include_directories(SYSTEM ${LLVM_INCLUDE_DIRS}) add_definitions(${LLVM_DEFINITIONS}) + include_directories(SYSTEM ${MLIR_INCLUDE_DIRS}) + add_definitions(${MLIR_DEFINITIONS}) # LLVM's cmake configuration files currently sneak in a c++11 flag. - # We look for it here and remove it from Flang's compile flags to - # avoid some mixed compilation flangs (e.g. -std=c++11 ... -std=c++17). - if (DEFINED LLVM_CXX_STD) + # We look for it here and remove it from Flang's compile flags to + # avoid some mixed compilation flangs (e.g. -std=c++11 ... -std=c++17). + if (DEFINED LLVM_CXX_STD) message("LLVM configuration set a C++ standard: ${LLVM_CXX_STD}") if (NOT LLVM_CXX_STD EQUAL "c++17") message("Flang: Overriding LLVM's 'cxx_std' setting...") @@ -109,12 +107,16 @@ project(Flang) link_directories("${LLVM_LIBRARY_DIR}") + set(LLVM_TOOLS_BINARY_DIR ${TOOLS_BINARY_DIR} CACHE PATH "Path to llvm/bin") + find_program(MLIR_TABLEGEN_EXE "mlir-tblgen" ${LLVM_TOOLS_BINARY_DIR} + NO_DEFAULT_PATH) + set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY + set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib${LLVM_LIBDIR_SUFFIX}) - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY + set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib${LLVM_LIBDIR_SUFFIX}) - + set(BACKEND_PACKAGE_STRING "LLVM ${LLVM_PACKAGE_VERSION}") set(LLVM_EXTERNAL_LIT "${LLVM_TOOLS_BINARY_DIR}/llvm-lit" CACHE STRING "Command used to spawn lit") @@ -127,37 +129,37 @@ project(Flang) endif() else() - option(FLANG_INCLUDE_TESTS - "Generate build targets for the Flang unit tests." - ${LLVM_INCLUDE_TESTS}) - set(FLANG_BINARY_DIR ${CMAKE_BINARY_DIR}/tools/flang) set(BACKEND_PACKAGE_STRING "${PACKAGE_STRING}") - if (LINK_WITH_FIR) - set(MLIR_MAIN_SRC_DIR ${LLVM_MAIN_SRC_DIR}/../mlir/include ) # --src-root - set(MLIR_INCLUDE_DIR ${LLVM_MAIN_SRC_DIR}/../mlir/include ) # --includedir - set(MLIR_TABLEGEN_OUTPUT_DIR ${CMAKE_BINARY_DIR}/tools/mlir/include) - set(MLIR_TABLEGEN_EXE $) - include_directories(SYSTEM ${MLIR_INCLUDE_DIR}) - include_directories(SYSTEM ${MLIR_TABLEGEN_OUTPUT_DIR}) - endif() + set(MLIR_BINARY_DIR ${LLVM_BINARY_DIR}/tools/mlir) + set(MLIR_SOURCE_DIR ${LLVM_SOURCE_DIR}/../mlir) endif() -if(LINK_WITH_FIR) - # tco tool and FIR lib output directories - set(LLVM_RUNTIME_OUTPUT_INTDIR ${CMAKE_BINARY_DIR}/bin) - set(LLVM_LIBRARY_OUTPUT_INTDIR ${CMAKE_BINARY_DIR}/lib) - # Always build tco tool - set(LLVM_BUILD_TOOLS ON) - message(STATUS "Linking driver with FIR and LLVM") - llvm_map_components_to_libnames(LLVM_COMMON_LIBS support) - message(STATUS "LLVM libraries: ${LLVM_COMMON_LIBS}") -endif() - -# Add Flang-centric modules to cmake path. include_directories(BEFORE ${FLANG_BINARY_DIR}/include ${FLANG_SOURCE_DIR}/include) +if(MLIR_SOURCE_DIR) + include_directories(BEFORE + ${FLANG_BINARY_DIR}/include + ${FLANG_SOURCE_DIR}/include + ${MLIR_BINARY_DIR}/include + ${MLIR_SOURCE_DIR}/include + ) + set(MLIR_MAIN_SRC_DIR ${MLIR_SOURCE_DIR}) + set(MLIR_INCLUDE_DIR ${MLIR_SOURCE_DIR}/include) +else() + include_directories(BEFORE + ${FLANG_BINARY_DIR}/include + ${FLANG_SOURCE_DIR}/include + ${MLIR_BINARY_DIR}/include + ) + set(MLIR_MAIN_SRC_DIR ${MLIR_BINARY_DIR}) + set(MLIR_INCLUDE_DIR ${MLIR_BINARY_DIR}/include) +endif() + +set(MLIR_TABLEGEN_EXE mlir-tblgen) + +# Add Flang-centric modules to cmake path. list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake/modules") if (NOT DEFAULT_SYSROOT) @@ -172,7 +174,7 @@ endif() set(FLANG_DEFAULT_LINKER "" CACHE STRING "Default linker to use (linker name or absolute path, empty for platform default)") -set(FLANG_DEFAULT_RTLIB "" CACHE STRING +set(FLANG_DEFAULT_RTLIB "" CACHE STRING "Default Fortran runtime library to use (\"libFortranRuntime\"), leave empty for platform default.") if (NOT(FLANG_DEFAULT_RTLIB STREQUAL "")) @@ -184,7 +186,7 @@ endif() set(PACKAGE_VERSION "${LLVM_PACKAGE_VERSION}") -# Override LLVM versioning for now... +# Override LLVM versioning for now... set(FLANG_VERSION_MAJOR "0") set(FLANG_VERSION_MINOR "1") set(FLANG_VERSION_PATCHLEVEL "0") @@ -234,59 +236,53 @@ endif() configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/include/flang/Version.inc.in ${CMAKE_CURRENT_BINARY_DIR}/include/flang/Version.inc) -# Configure Flang's version info header file. +# Configure Flang's version info header file. configure_file( ${FLANG_SOURCE_DIR}/include/flang/Config/config.h.cmake ${FLANG_BINARY_DIR}/include/flang/Config/config.h) -# Add global F18 flags. -set(CMAKE_CXX_FLAGS "-fno-rtti -fno-exceptions -pedantic -Wall -Wextra -Werror -Wcast-qual -Wimplicit-fallthrough -Wdelete-non-virtual-dtor ${CMAKE_CXX_FLAGS}") - -# Builtin check_cxx_compiler_flag doesn't seem to work correctly -macro(check_compiler_flag flag resultVar) - unset(${resultVar} CACHE) - check_cxx_compiler_flag("${flag}" ${resultVar}) -endmacro() - -check_compiler_flag("-Werror -Wno-deprecated-copy" CXX_SUPPORTS_NO_DEPRECATED_COPY_FLAG) -if (CXX_SUPPORTS_NO_DEPRECATED_COPY_FLAG) -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-deprecated-copy") -endif() -check_compiler_flag("-Wstring-conversion" CXX_SUPPORTS_NO_STRING_CONVERSION_FLAG) -if (CXX_SUPPORTS_NO_STRING_CONVERSION_FLAG) -set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-string-conversion") -endif() - # Add appropriate flags for GCC if (LLVM_COMPILER_IS_GCC_COMPATIBLE) - + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fno-rtti -fno-exceptions") if (NOT "${CMAKE_CXX_COMPILER_ID}" MATCHES "Clang") set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fno-strict-aliasing -fno-semantic-interposition") else() set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-unused-command-line-argument -Wstring-conversion \ -Wcovered-switch-default") - endif() # Clang. + + # The following works around warnings in the f18 sources. TODO: Should these move + # outside of GCC compatible block at some point? + + check_cxx_compiler_flag("-Werror -Wstring-conversion" CXX_SUPPORTS_NO_STRING_CONVERSION_FLAG) + if (CXX_SUPPORTS_NO_STRING_CONVERSION_FLAG) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-string-conversion") + endif() + endif() # Clang. check_cxx_compiler_flag("-Werror -Wnested-anon-types" CXX_SUPPORTS_NO_NESTED_ANON_TYPES_FLAG) if (CXX_SUPPORTS_NO_NESTED_ANON_TYPES_FLAG) set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-nested-anon-types") endif() - # Add to or adjust build type flags. - # - # TODO: This needs some extra thought. CMake's default for release builds + # Add to or adjust build type flags. + # + # TODO: This needs some extra thought. CMake's default for release builds # is -O3, which can cause build failures on certain platforms (and compilers) # with the current code base -- some templated functions are inlined and don't # become available at link time when using -O3 (with Clang under MacOS/darwin). - # If we reset CMake's default flags we also clobber any user provided settings; + # If we reset CMake's default flags we also clobber any user provided settings; # make it difficult to customize a build in this regard... The setup below - # has this side effect but enables successful builds across multiple platforms - # in release mode... - set(CMAKE_CXX_FLAGS_DEBUG "${CMAKE_CXX_FLAGS_DEBUG} -DDEBUGF18") - set(CMAKE_CXX_FLAGS_MINSIZEREL "${CMAKE_CXX_FLAGS_MINSIZEREL} -DCHECK=\"(void)\"") # do we need -O2 here? - set(CMAKE_CXX_FLAGS_RELEASE "-O2") + # has this side effect but enables successful builds across multiple platforms + # in release mode... + set(CMAKE_CXX_FLAGS_DEBUG "${CMAKE_CXX_FLAGS_DEBUG} -DDEBUGF18") + set(CMAKE_CXX_FLAGS_MINSIZEREL "${CMAKE_CXX_FLAGS_MINSIZEREL} -DCHECK=(void)") # do we need -O2 here? + set(CMAKE_CXX_FLAGS_RELEASE "-O2") + + if (GCC) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} --gcc-toolchain=${GCC}") + endif() - # Building shared libraries is bad for performance with GCC by default + # Building shared libraries is death on performance with GCC by default # due to the need to preserve the right to override external entry points if (BUILD_SHARED_LIBS AND NOT (CMAKE_CXX_COMPILER_ID MATCHES "Clang")) set(CMAKE_CXX_FLAGS_RELEASE "${CMAKE_CXX_FLAGS_RELEASE} -fno-semantic-interposition") @@ -330,11 +326,11 @@ if (FLANG_BUILD_TOOLS) endif() add_subdirectory(runtime) -if (FLANG_INCLUDE_TESTS) - enable_testing() - add_subdirectory(test) - add_subdirectory(unittests) -endif() +option(FLANG_INCLUDE_TESTS + "Generate build targets for the Flang unit tests." + ${LLVM_INCLUDE_TESTS}) +enable_testing() +add_subdirectory(test) option(FLANG_INCLUDE_DOCS "Generate build targets for the Flang docs." ${LLVM_INCLUDE_DOCS}) @@ -370,9 +366,10 @@ if (NOT LLVM_INSTALL_TOOLCHAIN_ONLY) FILES_MATCHING PATTERN "*.def" PATTERN "*.h" - PATTERN "*.inc" - PATTERN "*.td" + PATTERN "*.inc" PATTERN "config.h" EXCLUDE PATTERN ".git" EXCLUDE - PATTERN "CMakeFiles" EXCLUDE) + PATTERN "CMakeFiles" EXCLUDE + PATTERN "*") endif() + diff --git a/flang/LAPACK-bugs.txt b/flang/LAPACK-bugs.txt new file mode 100644 index 00000000000000..b1da627c1127b2 --- /dev/null +++ b/flang/LAPACK-bugs.txt @@ -0,0 +1,23 @@ +NEED ATTENTION +______________ + +[Eric] error: branch has N operands for successor #M, but target block has K +[Eric] UNREACHABLE executed at Lower/ConvertExpr.cpp:403! CHAR comparison + +[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1061! DATA +[Varun] UNREACHABLE executed at Lower/Bridge.cpp:1241! local w/ initializer (implied SAVE) + +UNREACHABLE executed at Lower/Bridge.cpp:1236! adjustable array? +UNREACHABLE executed at Lower/ConvertExpr.cpp:798! intrinsic subroutine + +FIXED +_____ + +UNREACHABLE executed at Lower/IO.cpp:764! FORMAT + +UNREACHABLE executed at Lower/ConvertExpr.cpp:848! temps on call? + +Block.cpp:200: mlir::Operation *mlir::Block::getTerminator(): Assertion `!empty() && !back().isKnownNonTerminator()' failed. + +error: 'std.return' op must be the last operation in the parent block + diff --git a/flang/README.md b/flang/README.md index 17f9939311bb19..0924a549da3e52 100644 --- a/flang/README.md +++ b/flang/README.md @@ -1,153 +1,125 @@ -# Flang -Flang is a ground-up implementation of a Fortran front end written in modern -C++. It started off as the f18 project (https://github.com/flang-compiler/f18) -with an aim to replace the previous flang project -(https://github.com/flang-compiler/flang) and address its various deficiencies. -F18 was subsequently accepted into the LLVM project and rechristened as Flang. +# FIR -## Getting Started +Working branch for FIR development. -Read more about flang in the [documentation directory](documentation). -Start with the [compiler overview](documentation/Overview.md). +## Monorepo now contains MLIR -To better understand Fortran as a language -and the specific grammar accepted by flang, -read [Fortran For C Programmers](documentation/FortranForCProgrammers.md) -and -flang's specifications of the [Fortran grammar](documentation/f2018-grammar.txt) -and -the [OpenMP grammar](documentation/OpenMP-4.5-grammar.txt). +### In-tree build -Treatment of language extensions is covered -in [this document](documentation/Extensions.md). +This is quite similar to the old way, but with a few subtle differences. -To understand the compilers handling of intrinsics, -see the [discussion of intrinsics](documentation/Intrinsics.md). +1. Get the stuff. -To understand how a flang program communicates with libraries at runtime, -see the discussion of [runtime descriptors](documentation/RuntimeDescriptor.md). +``` + git clone git@github.com:flang-compiler/f18-llvm-project.git + git clone git@github.com:schweitzpgi/f18.git +``` + +2. Get "on" the right branches. -If you're interested in contributing to the compiler, -read the [style guide](documentation/C++style.md) -and -also review [how flang uses modern C++ features](documentation/C++17.md). +``` + (cd f18-llvm-project ; git checkout mono) + (cd f18 ; git checkout mono) +``` + +3. Setup the LLVM space for in-tree builds. + +``` + (cd f18-llvm-project ; ln -s ../f18 flang) +``` -## Supported C++ compilers +4. Create a build space for cmake and make (or ninja) -Flang is written in C++17. +``` + mkdir build + cd build + cmake ../f18-llvm-project/llvm -DCMAKE_BUILD_TYPE=RelWithDebInfo -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_ENABLE_PROJECTS="flang;mlir" -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DLLVM_INSTALL_UTILS=On +``` -The code has been compiled and tested with -GCC versions from 7.2.0 to 9.3.0. +5. Build everything -The code has been compiled and tested with -clang version 7.0, 8.0, 9.0 and 10.0 -using either GNU's libstdc++ or LLVM's libc++. +One can, for example, do this with make as follows. -The code has been compiled on -AArch64, x86\_64 and ppc64le servers -with CentOS7, Ubuntu18.04, Rhel, MacOs, Mojave, XCode and -Apple Clang version 10.0.1. +``` +cd where/you/want/to/build/llvm +git clone --depth=1 -b f18 https://github.com/flang-compiler/f18-llvm-project.git +mkdir build +mkdir install +cd build +cmake ../f18-llvm-project/llvm -DCMAKE_BUILD_TYPE=Release \ + -DLLVM_ENABLE_PROJECTS=mlir -DCMAKE_CXX_STANDARD=17 \ + -DLLVM_INSTALL_UTILS=On \ + -DCMAKE_INSTALL_PREFIX=../install +make +make install +``` -The code does not compile with Windows and a compiler that does not have -support for C++17. +Or, of course, use their favorite build tool (such as ninja). -## Building Flang out of tree -These instructions are for building Flang separately from LLVM; if you are -building Flang alongside LLVM then follow the standard LLVM build instructions -and add flang to `LLVM_ENABLE_PROJECTS` instead, as detailed there. +### Out-of-tree build -### LLVM dependency +1. Get the stuff is the same as above. Get the code from the same repos. -The instructions to build LLVM can be found at -https://llvm.org/docs/GettingStarted.html. If you are building flang as part -of LLVM, follow those instructions and add flang to `LLVM_ENABLE_PROJECTS`. +2. Get on the right branches. Again, same as above. -We highly recommend using the same compiler to compile both llvm and flang. +3. SKIP step 3 above. We're not going to build `flang` yet. -The flang CMakeList.txt file uses -the variable `LLVM_DIR` to find the installed LLVM components -and -the variable `MLIR_DIR` to find the installed MLIR components. +4. Create a build space for cmake and make (or ninja) -To get the correct LLVM and MLIR libraries included in your flang build, -define LLVM_DIR and MLIR_DIR on the cmake command line. ``` -LLVM=/lib/cmake/llvm \ -MLIR=/lib/cmake/mlir \ -cmake -DLLVM_DIR=$LLVM -DMLIR_DIR=$MLIR ... + mkdir build + cd build + export CC= + export CXX= + cmake -GNinja ../f18-llvm-project/llvm -DCMAKE_BUILD_TYPE=Release -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_ENABLE_PROJECTS=mlir -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DLLVM_INSTALL_UTILS=On -DCMAKE_INSTALL_PREFIX= ``` -where `LLVM_BUILD_DIR` is -the top-level directory where LLVM was built. - -### Building flang with GCC -By default, -cmake will search for g++ on your PATH. -The g++ version must be one of the supported versions -in order to build flang. - -Or, cmake will use the variable CXX to find the C++ compiler. CXX should include -the full path to the compiler or a name that will be found on your PATH, e.g. -g++-8.3, assuming g++-8.3 is on your PATH. +5. Build and install ``` -export CXX=g++-8.3 + ninja + ninja install ``` -or + +6. Add the new installation to your PATH + ``` -CXX=/opt/gcc-8.3/bin/g++-8.3 cmake ... + PATH=/bin:$PATH ``` -### Building flang with clang +7. Create a build space for another round of cmake and make (or ninja) -To build flang with clang, -cmake needs to know how to find clang++ -and the GCC library and tools that were used to build clang++. - -CXX should include the full path to clang++ -or clang++ should be found on your PATH. ``` -export CXX=clang++ + mkdir build-flang + cd build-flang + cmake -GNinja ../f18 -DLLVM_DIR= -DCMAKE_BUILD_TYPE=RelWithDebInfo -DLLVM_TARGETS_TO_BUILD=X86 -DCMAKE_CXX_STANDARD=17 -DLLVM_BUILD_TOOLS=On -DCMAKE_INSTALL_PREFIX= ``` +Note: if you plan on running lit regression tests, you should either: +- Use `-DLLVM_DIR=` instead of `-DLLVM_DIR=` +- Or, keep `-DLLVM_DIR=` but add `-DLLVM_EXTERNAL_LIT=`. +A valid `llvm-lit` path is `/bin/llvm-lit`. +Note that LLVM must also have been built with `-DLLVM_INSTALL_UTILS=On` so that tools required by tests like `FileCheck` are available in ``. -### Installation Directory - -To specify a custom install location, -add -`-DCMAKE_INSTALL_PREFIX=` -to the cmake command -where `` -is the path where flang should be installed. +8. Build and install -### Build Types +``` + ninja + ninja check-flang + ninja install +``` -To create a debug build, -add -`-DCMAKE_BUILD_TYPE=Debug` -to the cmake command. -Debug builds execute slowly. +### Running regression tests -To create a release build, -add -`-DCMAKE_BUILD_TYPE=Release` -to the cmake command. -Release builds execute quickly. +Inside `build` for in-tree builds or inside `build-flang` for out-of-tree builds: -### Build Flang out of tree ``` -cd ~/flang/build -cmake -DLLVM_DIR=$LLVM -DMLIR_DIR=$MLIR ~/flang/src -make + ninja check-flang ``` -### How to Run the Regression Tests -To run all tests: -``` -cd ~/flang/build -cmake -DLLVM_DIR=$LLVM -DMLIR_DIR=$MLIR ~/flang/src -make test check-all -``` +Special CMake instructions given above are required while building out-of-tree so that lit regression tests can be run. + +### Problems To run individual regression tests llvm-lit needs to know the lit configuration for flang. The parameters in charge of this are: diff --git a/flang/cmake/modules/AddFlang.cmake b/flang/cmake/modules/AddFlang.cmake index 7fe8b7e9f4062b..e83b6b97ebad24 100644 --- a/flang/cmake/modules/AddFlang.cmake +++ b/flang/cmake/modules/AddFlang.cmake @@ -1,3 +1,11 @@ +#===-- cmake/modules/AddFlang.cmake ----------------------------------------===# +# +# 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 +# +#===------------------------------------------------------------------------===# + macro(set_flang_windows_version_resource_properties name) if (DEFINED windows_resource_file) set_windows_version_resource_properties(${name} ${windows_resource_file} diff --git a/flang/documentation/BurnsideToFIR.md b/flang/documentation/BurnsideToFIR.md new file mode 100644 index 00000000000000..de4d1ff44dd9b5 --- /dev/null +++ b/flang/documentation/BurnsideToFIR.md @@ -0,0 +1,823 @@ +## Burnside: The Bridge from the Fortran front-end to FIR + +This document sketches the translation of various Fortran snippets from +their syntactic level to how they ought to be represented in FIR. These +translations are representative and written in pseudo-code. + +This document shows examples of how Fortran fragments might be lowered into +FIR fragments. The style used throughout the document is to first show the +Fortran code fragment above a line and the FIR code fragment below the +line. + +### Program Units (PROGRAM, MODULE, and SUBMODULE) + +FIR has one flat global namespace. The global namespace can be populated +by Ops that represent code (functions), data (variables, constants), and +auxiliary structures (dispatch tables). + +Name collisions and scoping will be handled by a name mangling scheme. This +scheme ought to be a bijection from the tree of Fortran syntactic symbols +to and from the set of mangled names. + +A `PROGRAM` will necessarily have its executable definition wrapped in a +FIR `func` like a `SUBROUTINE`. Again, it is assumed the name mangling +scheme will provide a mapping to a distinct name. + +### Procedures (FUNCTION and SUBROUTINE) + +```fortran + FUNCTION foo (arg1, arg2) RESULT retval + + SUBROUTINE bar (arg1, arg2) +``` +---- +```mlir + func @foo(!fir.ref, !fir.ref) -> !TR + func @bar(!fir.ref, !fir.ref) +``` + +MLIR is strongly typed, so the types of the arguments and return value(s), +if any, must be explicitly specified. (Here, `arg1`, `arg2`, and `retval` +have the types `!T1`, `!T2`, and `!TR`, resp.) Also reflected is the +default calling convention: Fortran passes arguments by reference. + +#### Internal subprograms + +These will be lowered as any other `SUBROUTINE`. The difference will be +that they may take an extra `tuple` reference argument to refer to +variables in the host context. Host associated variables must be bundled +and passed explicitly on the FIR side. An example will be detailed below. + +#### Statement functions + +These are very simple internal subroutines, in a sense. They will be +lowered in the same way. + +### Non-executable statements + +#### Data + +Some non-executable statements may create constant (`PARAMETER`) or +variable data. This information should be lowered. + +##### Constants + +```fortran + INTEGER, PARAMETER :: x = 1 + CHARACTER (LEN = 10), PARAMETER :: DIGITS = "0123456789" +``` +---- +```mlir + %0 = constant 1 : i32 + + fir.global @_QG_digits constant : !fir.array<10:!fir.char<1>> { + constant '0' : !fir.char<1> + ... + constant '9' : !fir.char<1> + } +``` + +##### Local Variable + +```fortran + CHARACTER (LEN = 1) :: digit + INTEGER :: i +``` +---- +```mlir + %len = constant 1 : i32 + %digit = fir.alloca !fir.char<1>, %len : !fir.ref> + %i = fir.alloca i32 : !fir.ref +``` + +Note that in MLIR, the `%` sigil denotes an ssa-value, the `@` sigil +denotes a global symbol, and the `!` sigil denotes a type. + +##### Process lifetime variable + +```fortran + COMMON /X/ A(10),B(10) + + MODULE mymod + INTEGER a + + SUBROUTINE subr() + REAL, SAVE :: s + DATA s/12.0/ +``` +---- +```mlir + fir.global @common_x : tuple, !fir.array<10 : f32>> {} + + fir.global @mymod_a : i32 {} + + fir.global @subr_s : f32 { + constant 12.0 : f32 + } +``` + +The empty initializer region could mean these variables are placed in the +`.bss` section. + +#### Other non-executable statements + +These statements will define other properties of how the Fortran gets +lowered. For example, a variable in a `COMMON` block needs to reside in a +`fir.global`, or the structure of a derived type (user-defined record), +which would be reflected in a `!fir.type`. + +#### A note on TYPEs + +A FIR type is an synthesis of the Fortran concepts of type, attributes, and +type parameters. + +##### Intrinsic types + +For Fortran intrinsic types, there is a direct translation to a FIR type. + +```fortran + REAL(4) a + COMPLEX(8) b + CHARACTER(1,LEN=4) c + LOGICAL(1) d + INTEGER(4) e + + CHARACTER(1,LEN=*) f +``` +---- +```mlir + %a = ... : !fir.real<4> + %b = ... : !fir.complex<8> + %c = ... : !fir.array<4:!fir.char<1>> + %d = ... : !fir.logical<1> + %e = ... : !fir.int<4> + + %f_data = ... : !fir.ref>> + %f_len = ... : i32 + %f = fir.emboxchar %f_data, %f_len : !fir.boxchar<1> +``` + +The bridge will have a mapping of what the front-end kind value must map to +in the internal representation. For example, the f18 front-end maps kind +values for integers to the size in bytes of the integer representation. +Such mappings must be provided for all intrinsic type kind values. + +The Fortran `CHARACTER` variable, `f`, is a bit more complicated as there +is both a reference to a buffer (that contains the characters) and an +extra, assumed length, `LEN` type parameter to keep track of the length of +the buffer. The buffer is a sequence of `!fir.char<1>` values in memory. +The pair, `(buffer, len)`, may be boxed in a `!fir.boxchar<1>` type +object. + +##### Derived types + +Fortran also has derived types and these are supported with a more +elaborate record syntax. + +```fortran + TYPE :: person + CHARACTER(LEN=20) :: name + INTEGER :: age + END TYPE + + TYPE(person) :: george +``` +---- +```mlir + %george = ... : !fir.type>, age : i32}> +``` + +Fortran allows the compiler to reorder the fields in the derived type. +`SEQUENCE` can be used to disable reordering. (Name mangling can provide a +compile-time distinction, as needed.) + +Fortran allows a derived type to have type parameters. There are `KIND` +type parameters and `LEN` type parameters. A `KIND` type parameter is a +compile-time known constant. As such, it is possible for the compiler +implementation to create a distinct type for each set of `KIND` type +parameters (by name mangling, for instance). + +The `LEN` type parameters are runtime constant and not necessarily known at +compile-time. These values must be provided when constructing a value of +derived type in FIR, just as regular fields must be provided. (That does +not preclude an optimizer from eliminating unused `LEN` parameters.) + +Because of Fortran's `LEN` type parameters, an implementation is allowed to +defer the size and layout of an entity of derived type until runtime. + +Lowering may also exploit ad hoc product types created as needed. This can +be done using the standard dialect `tuple` type. + +##### Arrays + +An entity with type _T_ and a `DIMENSION` attribute is an array with +elements of type _T_ in Fortran. + +```fortran + INTEGER arr + DIMENSION arr(10,20) +``` +---- +```mlir + %arr = ... : !fir.array<10x20 : i32> +``` + +A FIR array is laid out in column-major order exactly like a Fortran array. + +##### Pointer and reference types + +The attribute `POINTER` can be used similarly to create a pointer entity. +The `ALLOCATABLE` attribute is another Fortran attribute that can be used +to indicate an entity's storage is to be allocated at runtime. As mentiond +previosuly, Fortran uses pass-by-reference calling semantics too. + +```fortran + INTEGER, POINTER :: ptr + REAL, ALLOCATABLE, DIMENSION(1000) :: al + + INTERFACE + SUBROUTINE fun(ptr, al) + INTEGER, POINTER :: p + REAL, ALLOCATABLE :: a + END SUBROUTINE + END INTERFACE +``` +---- +```mlir + %ptr = ... : !fir.ptr + %al = ... : !fir.heap> + + func @fun(!fir.ref>, !fir.ref>) +``` + +Note that references to pointers and heap allocatables are +allowed. However, a pointer/heap cannot point directly to a pointer/heap. + +```mlir + %err1 = ... : !fir.ptr> // Invalid type + %err2 = ... : !fir.heap> // Invalid type +``` + +Note that a value of function type is also considered a reference. + +```mlir + %fun = ... : (i32, f64) -> i1 // %fun is a reference to a func object +``` + +##### Boxed types + +Boxed types are reference types. A boxed entity is implicitly located in +memory. The only way to construct a boxed value is by providing a memory +reference type, discussed above. Any reference can be emboxed. + +There are additionally, two special-purpose box types. A `!fir.boxchar` +value is a `CHARACTER` variable (in memory) including both a pointer to the +buffer and the `LEN` type parameter. `boxchar` was discussed above. + +The second special case is the `!fir.boxproc` type. A Fortran internal +procedure can reference variables in its host's scope. Fortran also allows +pointers to procedures. A value of type `!fir.boxproc` then is a pair of +references, one for the procedure pointer and the other a pointer to a +tuple of host associated values. + +```fortran + SUBROUTINE host + REAL X + PROCEDURE(), POINTER :: procptr + ... + procptr => intern + ... + CALL procptr + CONTAINS + SUBROUTINE intern + X = ... +``` +---- +```mlir + func @host() { + %x = ... : !fir.ref + ... + %bag_val = fir.insert_value %b, %x, %0 : ... -> tuple, ...> + %bag = ... : !fir.ref, ...>> + fir.store %bag_val to %bag : !fir.ref, ...>> + %procptr = fir.emboxproc @intern, %bag : ... -> !fir.boxproc<() -> ()> + ... + fir.call %procptr() : () -> () +``` + +Here, the call to the boxed procedure implicitly passes the extra argument, the +reference to `%bag`, which contains the value of the variable `x`. + +##### Miscellaneous types + +Fortran uses triple notation to describe array sections, strided views of +multidimensional arrays. These sections can be captured using the +`fir.gendims` instruction which produces a value of type `!fir.dims`. + +```fortran + DIMENSION (10,10) a + ... a(2:6:2,1:7:4) ... +``` +---- +```mlir + // the following line is pseudocode + %1 = fir.gendims 2,6,2, 1,7,4 : !fir.dims<2> +``` + +Fortran also allows the implementation to reorder fields in a derived +type. Furthermore, the sizes of these fields and the layout may be left up +to the runtime. This could mean that the backend needs to generate runtime +calls to determine the offsets and sizes of fields. + +```fortran + TYPE ding(k) + ... + TYPE(T(k)) :: field_name +``` +---- +```mlir + %2 = fir.field("field_name") : !fir.field +``` + +When lowering a boxed value, the compiler may need to test what the exact +type of the value is at runtime. (For example, when generating code for +`SELECT TYPE`.) + +```fortran + CLASS(*) :: x + SELECT TYPE (x) + ... +``` +---- +```mlir + %1 = fir.box_tdesc %x : (!fir.box) -> !fir.tdesc +``` + +The `none` type is used when the entity has unlimited polymorphic type. See +below for a larger example of `SELECT TYPE`. + +### Executable statements + +The main purpose of lowering is to lower all the executable statements from +Fortran into FIR in a semantics preserving way. + +#### Substrings + +```fortran + ID(4:9) +``` +---- +```mlir + %id = ... : !fir.ref>> + %1 = fir.coordinate_of %id, %c3 : ... -> !fir.ref> + %2 = fir.emboxchar %1, %c5 : ... -> !fir.boxchar<1> +``` + +#### Structure components + +```fortran + scalar_parent%scalar_field +``` +---- +```mlir + %sf = fir.field("scalar_field") : !fir.field + %1 = fir.coordinate_of %scalar_parent, %sf : ... -> !fir.ref +``` + +#### Type parameters + +```fortran + TYPE ding(dim) + INTEGER, LEN :: dim + REAL :: values(dim) + END TYPE ding + + ding(x) :: a_ding + ... a_ding%dim ... +``` +---- +```mlir + %1 = fir.len_param_index("dim") : !fir.field + %2 = fir.coordinate_of %a_ding, %1 : ... -> !fir.ref + %3 = fir.load %2 : !fir.ref +``` + +#### Arrays + +```fortran + ... A ... ! whole array + ... B(4) ... ! array element + ... C(1:10) ... ! array section + ... D(1:10:2) ... ! array section with stride + INTEGER, DIMENSION :: V(4) + ... E(V) ... ! array section with vector subscript +``` +---- +```mlir + %1 = fir.load %a : !fir.ref> + + %2 = fir.extract_element %b, %c4 : (!fir.array, i32) -> f32 + + %3 = fir.coordinate_of %c, %c1 : (!fir.ref>, i32) -> !fir.ref + %4 = fir.convert %3 : (!fir.ref) -> !fir.ref> + %5 = fir.load %4 : (!fir.ref>) -> !fir.array<10:f32> + + %6 = fir.gendims %c1, %c10, %c2 : (i32, i32, i32) -> !fir.dims<1> + %7 = fir.embox %d, %6 : (!fir.ref>, !fir.dims<1>) -> !fir.embox> + + // create a temporary to hold E(V) + %v = ... : !fir.array<4:i32> + %8 = fir.alloca !fir.array<4:f32> : !fir.ref> + fir.loop %i = %c1 to %c4 unordered { + %9 = fir.extract_value %v, %i : (!fir.array<4:i32>, index) -> i32 + %10 = fir.extract_value %e, %9 : (!fir.array, i32) -> f32 + %11 = fir.coordinate_of %8, %i : (!fir.ref>, index) -> !fir.ref + fir.store %10 to %11 : !fir.ref + } +``` + +In the fourth case, lowering could also create a temporary and copy the +values from the section `D(1:10:2)` into it, but the preference should be +to defer copying data until it is necessary (as in the fifth non-affine +case, `E(V)`). + +#### Image selector + +```fortran + REAL :: A(10)[5,*] + + ... A(:)[1,4] ... ! selects image 16 (if available) +``` +---- +```mlir + %1 = fir.call @runtime_fetch_array(%a, %c_1, %c_4, ...) : (!fir.box>, i32, i32, ...) -> !fir.ref> +``` + +#### Dynamic association + +```fortran + ALLOCATE (x(n), b(-3:m, 0:9)) + + NULLIFY (p) + + DEALLOCATE (x, b) +``` +---- +```mlir + %x = fir.allocmem f32, %n : !fir.heap> + + %c4 = constant 4 : i32 + %1 = addi %m, %c4 : i32 + %2 = constant 10 : i32 + %b = fir.allocmem f32, %1, %2 : !fir.heap> + + %zero = constant 0 : i64 + %null = fir.convert %zero : (i64) -> !fir.ptr + fir.store %null to %p : !fir.ref> + + fir.freemem %x : !fir.heap> + fir.freemem %b : !fir.heap> +``` + +#### Basic operators + +Operators like `**`, `*`, `/`, etc. will be lowered into standard dialect +operations or runtime calls as needed. + +```fortran + a * b + c .LE. d +``` +---- +```mlir + %0 = mulf %a, %b : f32 + %1 = cmp "le" %c, %d : (f32, f32) -> i1 +``` + +#### Calls + +```fortran + CALL foo(v1) + ... func(v2, v3) ... + + pp => bar + CALL pp(v4) + + CALL object%method(arg) +``` +---- +```mlir + fir.call @foo(%v1) : (!fir.ref) -> () + %1 = fir.call @func(%v2, %v3) : (!fir.ref) -> i64 + + %pp = fir.address_of(@bar) : ((!fir.ref) -> ()) -> !fir.ref<(!fir.ref) -> ()> + fir.icall %pp(%v4) : (!fir.ref) -> () + + fir.dispatch "method"(%object, %arg) : (!fir.box>, !fir.ref) -> () +``` + +There are two modes of argument passing in Fortran: calls that are "Fortran +77" style and use an implicit interface, and calls that require an +interface. In FIR, this translates to passing a simple reference to an +entity's data versus passing a boxed reference value. The following calls +illustrate this distinction. + +```fortran + SUBROUTINE sub1(a) + INTEGER :: a(10,10) ! F77 style + ... + INTERFACE + SUBROUTINE sub2(a) + INTEGER :: a(:,:) ! assumed shape + ... + PROGRAM p + INTEGER :: a(10,10) + CALL sub1(a) + CALL sub2(a) +``` +---- +```mlir + func @sub1(!fir.ref>) -> () + func @sub1(!fir.box>) -> () + + func @_QP_p() { + %c1 = constant 1 : i32 + %c10 = constant 10 : i32 + %a1 = fir.alloca !fir.array<10x10:i32> : !fir.ref> + fir.call @sub1(%a1) : (!fir.ref>) -> () + %1 = fir.gendims %c1, %c10, %c1, %c1, %c10, %c1 : (i32,i32,i32,i32,i32,i32) -> !fir.dims<2> + %a2 = fir.embox %a1, %1 : (!fir.ref>, !fir.dims<2>) -> !fir.box> + fir.call @sub2(%a2) : (!fir.box>) -> () +``` + +When lowering into FIR, the bridge must explicitly perform any allocation, +copying, deallocation, and finalization on temporary entities as required +by the Fortran standard, preserving the copy-in copy-out calling +convention. + +#### Parentheses (10.1.8) + +```fortran + (a + b) + (a + c) ! cannot rewrite as (2 * a) + b + c +``` +---- +```mlir + %1 = addf %a, %b : f32 + %2 = fir.no_reassoc %1 : f32 // to prevent reassociation + %3 = addf %a, %c : f32 + %4 = fir.no_reassoc %3 : f32 + %5 = addf %2, %4 : f32 +``` + +One must also specify to LLVM that these operations will not be reassociated. + +#### Assignment + +```fortran + scalar = e1 ! intrinsic scalar assignment + array = e2 ! intrinsic array assignment + object = e3 ! defined assignment + pntr => e4 ! pointer assignment + pproc => func ! procedure pointer assignment +``` +---- +```mlir + %e1 = ... : f32 + fir.store %e1 to %scalar : !fir.ref + + %e2 = ... : !fir.array<10x10 : i32> + fir.store %e2 to %array : !fir.ref> + + %e3 = ... !fir.ref + %object = ... !fir.ref + fir.call @defd_assn(%object, %e3) : ... -> () + + %e4 = ... : !fir.ptr + %pntr = ... : !fir.ref> + fir.store %e4 to %pntr : !fir.ref> + + @func(i32, i32) -> i32 + %fn = fir.address_of(@func) : ((i32, i32) -> i32) -> !fir.ptr<(i32, i32) -> i32> + %pproc = ... : !fir.ref i32>> + fir.store %fn to %pproc : !fir.ref i32>> +``` + +#### Masked assignment + +```fortran + WHERE (arr < threshold) + arr = arr + increment + ELSEWHERE + arr = threshold + END WHILE +``` +---- +```mlir + %arr = ... : !fir.array + %threshold = ... : !fir.array + fir.loop %i = %c1 to %size { + %arr_i = fir.extract_value %arr, %i : ... -> !T + %threshold_i = fir.extract_value %threshold, %i : ... -> !T + %1 = cmp "lt" %arr_i, %threshold_i : ... -> i1 + fir.where %1 { + %2 = addf %arr_i, %increment : !T + %3 = fir.coordinate_of %arr, %i : ... -> !fir.ref + fir.store %2 to %3 : !fir.ref + } otherwise { + %4 = fir.coordinate_of %arr, %i : ... -> !fir.ref + fir.store %threshold_i to %4 + } + } +``` + +#### FORALL + +```fortran + FORALL (i = 1:100) + a(i) = b(i) / c(i) + END FORALL +``` +---- +```mlir + fir.loop %i = %c1 to %c100 unordered { + %1 = fir.extract_value %b, %i : (!fir.array, index) -> f32 + %2 = fir.extract_value %c, %i : (!fir.array, index) -> f32 + %3 = divf %1, %2 : f32 + %4 = fir.coordinate_of %a, %i : (!fir.ref>, index) -> !fir.ref + fir.store %3 to %4 : !fir.ref + } +``` + +#### ASSOCIATE construct + +```fortran + ASSOCIATE (z => EXP(-(x**2+y**2)) * COS(theta)) + CALL foo(z) + END ASSOCIATE +``` +---- +```mlir + %1 = ... : f32 + %2 = fir.call @exp(%1) : (f32) -> f32 + %3 = fir.load %theta : !fir.ref + %4 = fir.call @cos(%3) : (f32) -> f32 + %5 = mulf %2, %4 : f32 + fir.store %5 to %z : !fir.ref + fir.call @foo(%z) : (!fir.ref) -> () +``` + +#### DO construct + +```fortran + DIMENSION a(10,10,10), b(10,10,10) + + DO i = 1, m + DO j = 1, n + c(i,j) = dot_prod(a(i,j,:), b(:,i,j)) + END DO + END DO +``` +---- +```mlir + %c1 = constant 1 : index + %c10 = constant 10 : index + %c100 = constant 100 : index + %c1000 = constant 1000 : index + %1 = fir.gendims %c1, %c1000, %c100 : !fir.dims<1> + %2 = fir.gendims %c1, %c10, %c1 : !fir.dims<1> + + fir.loop %i = %c1 to %m { + fir.loop %i = %c1 to %n { + %13 = fir.coordinate_of %a, %i, %j : !fir.ref> + %14 = fir.embox %13, %1 : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %15 = fir.coordinate_of %b, %c1, %i, %j : !fir.ref + %16 = fir.convert %15 : (!fir.ref) -> !fir.ref> + %17 = fir.embox %16, %2 : (!fir.ref>, !fir.dims<1>) -> !fir.box> + %18 = fir.call @dot_prod(%14, %17) : (!fir.box>, !fir.box>) -> f32 + %19 = fir.coordinate_of %c, %i, %j : (!fir.box>, index, index) -> !fir.ref + fir.store %18 to %19 : !fir.ref + } + } +``` + +In this lowering, the array sections from the arrays `a` and `b` are _not_ +copied to a temporary memory buffer, but are instead captured in boxed +values (`%14` and `%17`). + +#### IF construct + +```fortran + IF (a > 0) THEN + ... + ELSE + ... + END IF +``` +---- +```mlir + %1 = ... : i1 + cond_br %1, ^bb1(%2:i32), ^bb2(%3:i32) +``` + +#### SELECT CASE construct + +```fortran + SELECT CASE (p) + CASE (1, 3:5) + ... + CASE (:-1) + ... + CASE (10:) + ... + CASE DEFAULT + ... + END SELECT CASE +``` +---- +```mlir + fir.select_case %p : i32 [#fir.point,%c1,^bb1, #fir.interval,%c3,%c5,^bb1, #fir.upper,%cn1,^bb2, #fir.lower,%c10,^bb3, unit,^bb4] +``` + +#### SELECT RANK construct + +```fortran + SELECT RANK (p) + RANK (2) + ... + RANK (*) + ... + RANK DEFAULT + ... + END SELECT RANK +``` +---- +```mlir + fir.select_rank %p : i32 [2,^bb1(%1:f32), -1,^bb2, unit,^bb3(%2:f32,%3:i32)] +``` + +#### SELECT TYPE construct + +```fortran + SELECT TYPE (p) + TYPE IS (type_a) + ... + CLASS IS (super_b) + ... + CLASS DEFAULT + ... + END SELECT TYPE +``` +---- +```mlir + fir.select_type %p : !fir.box [#fir.instance>,^bb_1(%1:i32,%2:i64), #fir.subsumed>,^bb_2(%3:f32,%4:f64,%5:i32), unit,^bb_3] +``` +---- +```mlir + %type_a_desc = fir.gentypedesc !fir.type : !fir.tdesc> + %super_b_desc = fir.gentypedesc !fir.type : !fir.tdesc> + %11 = fir.box_tdesc %p : (!fir.box) -> !fir.tdesc + %12 = cmp "eq" %11, %type_a_desc : (!fir.tdesc, !fir.tdesc>) -> i1 + cond_br %2, ^bb1(%1:i32,%2:i64), ^bb1b(%3:f32,%4:f64,%5:i32) + ^bb1(%a1,%a2 : i32,i64): + ... + ^bb1b(%b1,%b2,%b3 : f32,f64,i32): + %13 = fir.call @is_subtype_of(%11, %super_b_desc) : ... -> i1 + cond_br %13, ^bb2(%b1,%b2,%b3), ^bb3 + ^bb2(%b1,%b2,%b3 : f32,f64,i32): + ... + ^bb3: + ... +``` + +#### Jumping statements + +```fortran + STOP + ERROR STOP + FAIL IMAGE + CONTINUE loop + EXIT a_construct + GOTO label1 + GOTO (label2,label3,label4), i +``` +---- +```mlir + fir.call @stop() + fir.unreachable + + fir.call @error_stop() + fir.unreachable + + fir.call @fail_image() + fir.unreachable + + br ^bb_continue + + br ^bb_exit + + br ^bb_label1 + + fir.select %i : i32 [1,^bb_label2(%1:i32), 2,^bb_label3, 3,^bb_label4, unit,^fallthru] + ^fallthru: +``` + diff --git a/flang/include/flang/CMakeLists.txt b/flang/include/flang/CMakeLists.txt index db5d26a83b5684..8fa6447f19be7f 100644 --- a/flang/include/flang/CMakeLists.txt +++ b/flang/include/flang/CMakeLists.txt @@ -1,3 +1 @@ -if(LINK_WITH_FIR) - add_subdirectory(Optimizer) -endif() +add_subdirectory(Optimizer) diff --git a/flang/include/flang/Common/enum-set.h b/flang/include/flang/Common/enum-set.h index 5346cceaadfabb..9470b3196b3b5b 100644 --- a/flang/include/flang/Common/enum-set.h +++ b/flang/include/flang/Common/enum-set.h @@ -16,7 +16,9 @@ #include "constexpr-bitset.h" #include "idioms.h" +#ifndef FORTRAN_IN_RUNTIME #include "llvm/Support/raw_ostream.h" +#endif #include #include #include @@ -206,6 +208,7 @@ template class EnumSet { } } +#ifndef FORTRAN_IN_RUNTIME llvm::raw_ostream &Dump( llvm::raw_ostream &o, std::string EnumToString(enumerationType)) const { char sep{'{'}; @@ -215,6 +218,7 @@ template class EnumSet { }); return o << (sep == '{' ? "{}" : "}"); } +#endif private: bitsetType bitset_{}; diff --git a/flang/include/flang/Lower/Bridge.h b/flang/include/flang/Lower/Bridge.h new file mode 100644 index 00000000000000..8c4263616d866f --- /dev/null +++ b/flang/include/flang/Lower/Bridge.h @@ -0,0 +1,165 @@ +//===-- Lower/Bridge.h -- main interface to lowering ------------*- 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 +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// Implements lowering. Convert Fortran source to +/// [MLIR](https://github.com/tensorflow/mlir). +/// +/// [Coding style](https://llvm.org/docs/CodingStandards.html) +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_BRIDGE_H_ +#define FORTRAN_LOWER_BRIDGE_H_ + +#include "flang/Common/Fortran.h" +#include "mlir/IR/MLIRContext.h" +#include "mlir/IR/Module.h" +#include + +namespace Fortran { +namespace common { +class IntrinsicTypeDefaultKinds; +template +class Reference; +} // namespace common +namespace evaluate { +struct DataRef; +template +class Expr; +struct SomeType; +} // namespace evaluate +namespace parser { +class CharBlock; +class CookedSource; +struct Program; +} // namespace parser +namespace semantics { +class Symbol; +} // namespace semantics +} // namespace Fortran + +namespace llvm { +class Module; +class SourceMgr; +} // namespace llvm +namespace mlir { +class OpBuilder; +} +namespace fir { +struct NameUniquer; +} + +namespace Fortran::lower { + +using SomeExpr = evaluate::Expr; +using SymbolRef = common::Reference; +class FirOpBuilder; + +/// The abstract interface for converter implementations to lower Fortran +/// front-end fragments such as expressions, types, etc. to the FIR dialect of +/// MLIR. +class AbstractConverter { +public: + // + // Expressions + + /// Generate the address of the location holding the expression + virtual mlir::Value genExprAddr(const SomeExpr &, + mlir::Location *loc = nullptr) = 0; + mlir::Value genExprAddr(const SomeExpr *someExpr, mlir::Location loc) { + return genExprAddr(*someExpr, &loc); + } + + /// Generate the computations of the expression to produce a value + virtual mlir::Value genExprValue(const SomeExpr &, + mlir::Location *loc = nullptr) = 0; + mlir::Value genExprValue(const SomeExpr *someExpr, mlir::Location loc) { + return genExprValue(*someExpr, &loc); + } + + // + // Types + + /// Generate the type of a DataRef + virtual mlir::Type genType(const evaluate::DataRef &) = 0; + /// Generate the type of an Expr + virtual mlir::Type genType(const SomeExpr &) = 0; + /// Generate the type of a Symbol + virtual mlir::Type genType(SymbolRef) = 0; + /// Generate the type from a category + virtual mlir::Type genType(common::TypeCategory tc) = 0; + /// Generate the type from a category and kind + virtual mlir::Type genType(common::TypeCategory tc, int kind) = 0; + + // + // Locations + + /// Get the converter's current location + virtual mlir::Location getCurrentLocation() = 0; + /// Generate a dummy location + virtual mlir::Location genLocation() = 0; + /// Generate the location as converted from a CharBlock + virtual mlir::Location genLocation(const parser::CharBlock &) = 0; + + // + // FIR/MLIR + + /// Get the OpBuilder + virtual Fortran::lower::FirOpBuilder &getFirOpBuilder() = 0; + /// Get the ModuleOp + virtual mlir::ModuleOp &getModuleOp() = 0; + /// Unique a symbol + virtual std::string mangleName(const semantics::Symbol &) = 0; + /// Unique a compiler generated identifier + virtual std::string uniqueCGIdent(llvm::StringRef name) = 0; + + virtual ~AbstractConverter() = default; +}; + +/// The lowering bridge converts the front-end parse trees and semantics +/// checking residual to MLIR (FIR dialect) code. +class LoweringBridge { +public: + static LoweringBridge + create(const common::IntrinsicTypeDefaultKinds &defaultKinds, + const parser::CookedSource *cooked) { + return LoweringBridge{defaultKinds, cooked}; + } + + mlir::MLIRContext &getMLIRContext() { return *context.get(); } + mlir::ModuleOp &getModule() { return *module.get(); } + + void parseSourceFile(llvm::SourceMgr &); + + common::IntrinsicTypeDefaultKinds const &getDefaultKinds() { + return defaultKinds; + } + + bool validModule() { return getModule(); } + + const parser::CookedSource *getCookedSource() const { return cooked; } + + /// Cross the bridge from the Fortran parse-tree, etc. to FIR+OpenMP+MLIR + void lower(const parser::Program &program, fir::NameUniquer &uniquer); + +private: + explicit LoweringBridge(const common::IntrinsicTypeDefaultKinds &defaultKinds, + const parser::CookedSource *cooked); + LoweringBridge() = delete; + LoweringBridge(const LoweringBridge &) = delete; + + const common::IntrinsicTypeDefaultKinds &defaultKinds; + const parser::CookedSource *cooked; + std::unique_ptr context; + std::unique_ptr module; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_BRIDGE_H_ diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h new file mode 100644 index 00000000000000..3c7676a3956c26 --- /dev/null +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -0,0 +1,73 @@ +//===-- Lower/ConvertExpr.h -- lowering of expressions ----------*- 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 FORTRAN_LOWER_CONVERT_EXPR_H_ +#define FORTRAN_LOWER_CONVERT_EXPR_H_ + +#include "Intrinsics.h" + +/// [Coding style](https://llvm.org/docs/CodingStandards.html) + +namespace mlir { +class Location; +class OpBuilder; +class Type; +class Value; +} // namespace mlir + +namespace fir { +class AllocaExpr; +} // namespace fir + +namespace Fortran { +namespace common { +class IntrinsicTypeDefaultKinds; +} // namespace common + +namespace evaluate { +template +class Expr; +struct SomeType; +} // namespace evaluate + +namespace semantics { +class Symbol; +} // namespace semantics + +namespace lower { + +class AbstractConverter; +class FirOpBuilder; +class SymMap; + +/// Create an expression. +/// Lowers `expr` to the FIR dialect of MLIR. The expression is lowered to a +/// value result. +mlir::Value createSomeExpression(mlir::Location loc, + AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, + const IntrinsicLibrary &intrinsics); + +mlir::Value +createI1LogicalExpression(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, const IntrinsicLibrary &intrinsics); + +/// Create an address. +/// Lowers `expr` to the FIR dialect of MLIR. The expression must be an entity +/// and the address of the entity is returned. +mlir::Value createSomeAddress(mlir::Location loc, AbstractConverter &converter, + const evaluate::Expr &expr, + SymMap &symMap, + const IntrinsicLibrary &intrinsics); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_CONVERT_EXPR_H_ diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h new file mode 100644 index 00000000000000..deb0ebfacafe9f --- /dev/null +++ b/flang/include/flang/Lower/ConvertType.h @@ -0,0 +1,122 @@ +//===-- Lower/ConvertType.h -- lowering of types ----------------*- 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 FORTRAN_LOWER_CONVERT_TYPE_H_ +#define FORTRAN_LOWER_CONVERT_TYPE_H_ + +/// Conversion of front-end TYPE, KIND, ATTRIBUTE (TKA) information to FIR/MLIR. +/// This is meant to be the single point of truth (SPOT) for all type +/// conversions when lowering to FIR. This implements all lowering of parse +/// tree TKA to the FIR type system. If one is converting front-end types and +/// not using one of the routines provided here, it's being done wrong. +/// +/// [Coding style](https://llvm.org/docs/CodingStandards.html) + +#include "flang/Common/Fortran.h" +#include "mlir/IR/Types.h" + +namespace mlir { +class Location; +class MLIRContext; +class Type; +} // namespace mlir + +namespace Fortran { +namespace common { +class IntrinsicTypeDefaultKinds; +template +class Reference; +} // namespace common + +namespace evaluate { +struct DataRef; +template +class Designator; +template +class Expr; +template +struct SomeKind; +struct SomeType; +template +class Type; +} // namespace evaluate + +namespace parser { +class CharBlock; +class CookedSource; +} // namespace parser + +namespace semantics { +class Symbol; +} // namespace semantics + +namespace lower { + +using SomeExpr = evaluate::Expr; +using SymbolRef = common::Reference; + +constexpr common::TypeCategory IntegerCat{common::TypeCategory::Integer}; +constexpr common::TypeCategory RealCat{common::TypeCategory::Real}; +constexpr common::TypeCategory ComplexCat{common::TypeCategory::Complex}; +constexpr common::TypeCategory CharacterCat{common::TypeCategory::Character}; +constexpr common::TypeCategory LogicalCat{common::TypeCategory::Logical}; +constexpr common::TypeCategory DerivedCat{common::TypeCategory::Derived}; + +mlir::Type getFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + common::TypeCategory tc, int kind); +mlir::Type getFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + common::TypeCategory tc); + +mlir::Type +translateDataRefToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::DataRef &dataRef); + +template +inline mlir::Type translateDesignatorToFIRType( + mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::Designator> &) { + return getFIRType(ctxt, defaults, TC, KIND); +} + +template +inline mlir::Type translateDesignatorToFIRType( + mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::Designator> &) { + return getFIRType(ctxt, defaults, TC); +} + +mlir::Type +translateSomeExprToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const SomeExpr *expr); + +mlir::Type +translateSymbolToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const SymbolRef symbol); + +mlir::FunctionType translateSymbolToFIRFunctionType( + mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, + const SymbolRef symbol); + +mlir::Type convertReal(mlir::MLIRContext *ctxt, int KIND); + +// Given a ReferenceType of a base type, returns the ReferenceType to +// the SequenceType of this base type. +// The created SequenceType has one dimension of unknown extent. +// This is useful to do pointer arithmetic using fir::CoordinateOp that requires +// a memory reference to a sequence type. +mlir::Type getSequenceRefType(mlir::Type referenceType); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_CONVERT_TYPE_H_ diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h new file mode 100644 index 00000000000000..c18f5d65bfa0a3 --- /dev/null +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -0,0 +1,378 @@ +//===-- Lower/FirBuilder.h -- FIR operation builder -------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_FIRBUILDER_H +#define FORTRAN_LOWER_FIRBUILDER_H + +#include "flang/Common/reference.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "mlir/IR/Builders.h" +#include "mlir/IR/Function.h" +#include "mlir/IR/Module.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/Optional.h" + +namespace Fortran { +namespace semantics { +class Symbol; +using SymbolRef = common::Reference; +} // namespace semantics + +namespace lower { + +class AbstractConverter; + +/// Helper class to map front-end symbols to their MLIR representation. This +/// provides a way to lookup the fir.alloca location of a variable, for example. +class SymMap { +public: + /// Add `symbol` to the current map and bind to `value`. + void addSymbol(semantics::SymbolRef symbol, mlir::Value value); + + /// Find `symbol` and return its value if it appears in the current mappings. + mlir::Value lookupSymbol(semantics::SymbolRef symbol); + + void clear() { symbolMap.clear(); } + +private: + llvm::DenseMap symbolMap; +}; + +//===----------------------------------------------------------------------===// +// FirOpBuilder interface extensions +//===----------------------------------------------------------------------===// + +// TODO: Used CRTP to extend the FirOpBuilder interface, but this leads to some +// complex and downright ugly template code. + +/// Extension class to facilitate lowering of CHARACTER operation +template +class CharacterOpsBuilder { +public: + // access the implementation + T &impl() { return *static_cast(this); } + + /// Unless otherwise stated, all mlir::Value inputs of these pseudo-fir ops + /// must be of type: + /// - fir.boxchar (dynamic length character), + /// - fir.ref>> (character with compile time + /// constant length), + /// - fir.array> (compile time constant character) + + /// Copy the \p count first characters of \p src into \p dest. + /// \p count can have any integer type. + void createCopy(mlir::Value dest, mlir::Value src, mlir::Value count); + + /// Set characters of \p str at position [\p lower, \p upper) to blanks. + /// \p lower and \upper bounds are zero based. + /// If \p upper <= \p lower, no padding is done. + /// \p upper and \p lower can have any integer type. + void createPadding(mlir::Value str, mlir::Value lower, mlir::Value upper); + + /// Create str(lb:ub), lower bounds must always be specified, upper + /// bound is optional. + mlir::Value createSubstring(mlir::Value str, + llvm::ArrayRef bounds); + + /// Return blank character of given \p type !fir.char + mlir::Value createBlankConstant(fir::CharacterType type); + /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters. + /// It handles cases where \p lhs and \p rhs may overlap. + void createAssign(mlir::Value lhs, mlir::Value rhs); + + /// Embox \p addr and \p len and return fir.boxchar. + /// Take care of type conversions before emboxing. + /// \p len is converted to the integer type for character lengths if needed. + mlir::Value createEmboxChar(mlir::Value addr, mlir::Value len); + /// Unbox \p boxchar into (fir.ref>, getLengthType()). + std::pair createUnboxChar(mlir::Value boxChar); + + /// Allocate a temp of fir::CharacterType type and length len. + /// Returns related fir.ref>. + mlir::Value createCharacterTemp(mlir::Type type, mlir::Value len); + /// Allocate a temp of compile time constant length. + /// Returns related fir.ref>>. + mlir::Value createCharacterTemp(mlir::Type type, int len); + + /// Return buffer/length pair of character str, if str is a constant, + /// it is allocated into a temp, otherwise, its memory reference is + /// returned as the buffer. + /// The buffer type of str is of type: + /// - fir.ref>> if str has compile time + /// constant length. + /// - fir.ref> if str has dynamic length. + std::pair materializeCharacter(mlir::Value str); + + /// Return true if \p is a character literal (has type + /// fir.array>).; + bool isCharacterLiteral(mlir::Value str); + + /// Return true if \p val has one of the following type + /// - fir.boxchar + /// - fir.ref>> + /// - fir.array> + bool isCharacter(mlir::Value val); + + /// Extract the kind of character \p str. + int getCharacterKind(mlir::Value str); + + /// Return the integer type that must be used to manipulate + /// Character lengths. + mlir::Type getLengthType(); +}; + +/// Extension class to facilitate lowering of COMPLEX manipulations in FIR. +template +class ComplexOpsBuilder { +public: + // The values of part enum members are meaningful for + // InsertValueOp and ExtractValueOp so they are explicit. + enum class Part { Real = 0, Imag = 1 }; + + // access the implementation + T &impl() { return *static_cast(this); } + + /// Type helper. They do not create MLIR operations. + mlir::Type getComplexPartType(mlir::Value cplx); + mlir::Type getComplexPartType(mlir::Type complexType); + mlir::Type getComplexPartType(fir::KindTy complexKind); + + /// Complex operation creation helper. They create MLIR operations. + mlir::Value createComplex(fir::KindTy kind, mlir::Value real, + mlir::Value imag); + mlir::Value extractComplexPart(mlir::Value cplx, bool isImagPart) { + return isImagPart ? extract(cplx) : extract(cplx); + } + /// Returns (Real, Imag) pair of \p cplx + std::pair extractParts(mlir::Value cplx) { + return {extract(cplx), extract(cplx)}; + } + mlir::Value insertComplexPart(mlir::Value cplx, mlir::Value part, + bool isImagPart) { + return isImagPart ? insert(cplx, part) + : insert(cplx, part); + } + + mlir::Value createComplexCompare(mlir::Value cplx1, mlir::Value cplx2, + bool eq); + + static bool isComplex(mlir::Value val) { + auto ty = val.getType(); + return ty.isa() || ty.isa(); + } + +protected: + template + mlir::Value extract(mlir::Value cplx) { + return impl().template createHere( + getComplexPartType(cplx), cplx, createPartId()); + } + + template + mlir::Value insert(mlir::Value cplx, mlir::Value part) { + return impl().template createHere( + cplx.getType(), cplx, part, createPartId()); + } + + template + mlir::Value createPartId() { + return impl().createIntegerConstant(impl().getIntegerType(32), + static_cast(partId)); + } +}; + +//===----------------------------------------------------------------------===// +// FirOpBuilder +//===----------------------------------------------------------------------===// + +/// Extends the MLIR OpBuilder to provide methods for building common FIR +/// patterns. +class FirOpBuilder : public mlir::OpBuilder, + public CharacterOpsBuilder, + public ComplexOpsBuilder { +public: + using OpBuilder::OpBuilder; + + /// TODO: remove this as caching the location may have the location + /// unexpectedly overridden along the way. + /// Set the current location. Used by createHere template method, etc. + void setLocation(mlir::Location loc) { currentLoc = loc; } + + /// Get the current location (if any) or return unknown location. + mlir::Location getLoc() { + return currentLoc.hasValue() ? currentLoc.getValue() : getUnknownLoc(); + } + + template + auto createHere(AS... args) { + return create(getLoc(), std::forward(args)...); + } + + mlir::Region &getRegion() { return *getBlock()->getParent(); } + + /// Get the current Module + mlir::ModuleOp getModule() { + return getRegion().getParentOfType(); + } + + /// Get the current Function + mlir::FuncOp getFunction() { + return getRegion().getParentOfType(); + } + + /// Get the entry block of the current Function + mlir::Block *getEntryBlock() { return &getFunction().front(); } + + mlir::Type getRefType(mlir::Type eleTy); + + /// Create an integer constant of type \p type and value \p i. + mlir::Value createIntegerConstant(mlir::Type integerType, std::int64_t i); + + /// Create a temporary. A temp is allocated using `fir.alloca` and can be read + /// and written using `fir.load` and `fir.store`, resp. The temporary can be + /// given a name via a front-end `Symbol` or a `StringRef`. + mlir::Value createTemporary(mlir::Location loc, SymMap &symMap, + mlir::Type type, + llvm::ArrayRef shape = {}, + const Fortran::semantics::Symbol *symbol = {}, + llvm::StringRef name = {}); + + mlir::Value createTemporary(SymMap &symMap, mlir::Type type, + llvm::ArrayRef shape = {}, + const Fortran::semantics::Symbol *symbol = {}, + llvm::StringRef name = {}) { + return createTemporary(getLoc(), symMap, type, shape, symbol, name); + } + + /// Create an unnamed and untracked temporary on the stack. + mlir::Value createTemporary(mlir::Type type, + llvm::ArrayRef shape) { + SymMap fakeMap; + return createTemporary(getLoc(), fakeMap, type, shape); + } + + /// Create a global value. + fir::GlobalOp createGlobal(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + mlir::StringAttr linkage = {}, + mlir::Attribute value = {}, bool isConst = false); + + fir::GlobalOp createGlobal(mlir::Location loc, mlir::Type type, + llvm::StringRef name, bool isConst, + std::function bodyBuilder, + mlir::StringAttr linkage = {}); + + /// Create a global constant (read-only) value. + fir::GlobalOp createGlobalConstant(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + mlir::StringAttr linkage = {}, + mlir::Attribute value = {}) { + return createGlobal(loc, type, name, linkage, value, /*isConst=*/true); + } + + fir::GlobalOp + createGlobalConstant(mlir::Location loc, mlir::Type type, + llvm::StringRef name, + std::function bodyBuilder, + mlir::StringAttr linkage = {}) { + return createGlobal(loc, type, name, /*isConst=*/true, bodyBuilder, + linkage); + } + + /// Get a function by name. If the function exists in the current module, it + /// is returned. Otherwise, a null FuncOp is returned. + mlir::FuncOp getNamedFunction(llvm::StringRef name) { + return getNamedFunction(getModule(), name); + } + + static mlir::FuncOp getNamedFunction(mlir::ModuleOp module, + llvm::StringRef name); + + fir::GlobalOp getNamedGlobal(llvm::StringRef name) { + return getNamedGlobal(getModule(), name); + } + + static fir::GlobalOp getNamedGlobal(mlir::ModuleOp module, + llvm::StringRef name); + + /// Create a new FuncOp. If the function may have already been created, use + /// `addNamedFunction` instead. + mlir::FuncOp createFunction(mlir::Location loc, llvm::StringRef name, + mlir::FunctionType ty) { + return createFunction(loc, getModule(), name, ty); + } + + mlir::FuncOp createFunction(llvm::StringRef name, mlir::FunctionType ty) { + return createFunction(getLoc(), name, ty); + } + + static mlir::FuncOp createFunction(mlir::Location loc, mlir::ModuleOp module, + llvm::StringRef name, + mlir::FunctionType ty); + + /// Determine if the named function is already in the module. Return the + /// instance if found, otherwise add a new named function to the module. + mlir::FuncOp addNamedFunction(mlir::Location loc, llvm::StringRef name, + mlir::FunctionType ty) { + if (auto func = getNamedFunction(name)) + return func; + return createFunction(loc, name, ty); + } + + mlir::FuncOp addNamedFunction(llvm::StringRef name, mlir::FunctionType ty) { + if (auto func = getNamedFunction(name)) + return func; + return createFunction(name, ty); + } + + static mlir::FuncOp addNamedFunction(mlir::Location loc, + mlir::ModuleOp module, + llvm::StringRef name, + mlir::FunctionType ty) { + if (auto func = getNamedFunction(module, name)) + return func; + return createFunction(loc, module, name, ty); + } + + //===--------------------------------------------------------------------===// + // LoopOp helpers + //===--------------------------------------------------------------------===// + + using BodyGenerator = std::function; + + /// Build loop [\p lb, \p ub] with step \p step. + /// If \p step is an empty value, 1 is used for the step. + void createLoop(mlir::Value lb, mlir::Value ub, mlir::Value step, + const BodyGenerator &bodyGenerator); + + /// Build loop [\p lb, \p ub] with step 1. + void createLoop(mlir::Value lb, mlir::Value ub, + const BodyGenerator &bodyGenerator); + + /// Build loop [0, \p count) with step 1. + void createLoop(mlir::Value count, const BodyGenerator &bodyGenerator); + + /// Cast the input value to IndexType. + mlir::Value convertToIndexType(mlir::Value integer); + +private: + llvm::Optional currentLoc{}; +}; + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_FIRBUILDER_H diff --git a/flang/include/flang/Lower/IO.h b/flang/include/flang/Lower/IO.h new file mode 100644 index 00000000000000..a366bef9acb7ea --- /dev/null +++ b/flang/include/flang/Lower/IO.h @@ -0,0 +1,85 @@ +//===-- Lower/IO.h -- lower I/O statements ----------------------*- 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 +// +//===----------------------------------------------------------------------===// +/// +/// Experimental IO lowering to FIR + runtime. The Runtime design is under +/// design. +/// +/// FIXME This interface is also not final. Should it be based on parser::.. +/// nodes and lower expressions as needed or should it get every expression +/// already lowered as mlir::Value? (currently second options, not sure it will +/// provide enough information for complex IO statements). +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_IO_H_ +#define FORTRAN_LOWER_IO_H_ + +namespace mlir { +class Value; +} // namespace mlir + +namespace Fortran { +namespace parser { +struct BackspaceStmt; +struct CloseStmt; +struct EndfileStmt; +struct FlushStmt; +struct InquireStmt; +struct OpenStmt; +struct PrintStmt; +struct ReadStmt; +struct RewindStmt; +struct WaitStmt; +struct WriteStmt; +} // namespace parser + +namespace lower { + +class AbstractConverter; +class BridgeImpl; + +/// Generate IO call(s) for BACKSPACE; return the IOSTAT code +mlir::Value genBackspaceStatement(AbstractConverter &, + const parser::BackspaceStmt &); + +/// Generate IO call(s) for CLOSE; return the IOSTAT code +mlir::Value genCloseStatement(AbstractConverter &, const parser::CloseStmt &); + +/// Generate IO call(s) for ENDFILE; return the IOSTAT code +mlir::Value genEndfileStatement(AbstractConverter &, + const parser::EndfileStmt &); + +/// Generate IO call(s) for FLUSH; return the IOSTAT code +mlir::Value genFlushStatement(AbstractConverter &, const parser::FlushStmt &); + +/// Generate IO call(s) for INQUIRE; return the IOSTAT code +mlir::Value genInquireStatement(AbstractConverter &, + const parser::InquireStmt &); + +/// Generate IO call(s) for OPEN; return the IOSTAT code +mlir::Value genOpenStatement(AbstractConverter &, const parser::OpenStmt &); + +/// Generate IO call(s) for PRINT +void genPrintStatement(AbstractConverter &, const parser::PrintStmt &); + +/// Generate IO call(s) for READ; return the IOSTAT code +mlir::Value genReadStatement(AbstractConverter &, const parser::ReadStmt &); + +/// Generate IO call(s) for REWIND; return the IOSTAT code +mlir::Value genRewindStatement(AbstractConverter &, const parser::RewindStmt &); + +/// Generate IO call(s) for WAIT; return the IOSTAT code +mlir::Value genWaitStatement(AbstractConverter &, const parser::WaitStmt &); + +/// Generate IO call(s) for WRITE; return the IOSTAT code +mlir::Value genWriteStatement(AbstractConverter &, const parser::WriteStmt &); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_IO_H_ diff --git a/flang/include/flang/Lower/Intrinsics.h b/flang/include/flang/Lower/Intrinsics.h new file mode 100644 index 00000000000000..fe9687d59db75b --- /dev/null +++ b/flang/include/flang/Lower/Intrinsics.h @@ -0,0 +1,74 @@ +//===-- Lower/Intrinsics.h -- lowering of intrinsics ------------*- 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 +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_INTRINSICS_H_ +#define FORTRAN_LOWER_INTRINSICS_H_ + +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/ADT/StringRef.h" +#include + +namespace Fortran::lower { + +class FirOpBuilder; + +/// IntrinsicLibrary generates FIR+MLIR operations that implement Fortran +/// generic intrinsic function calls. It operates purely on FIR+MLIR types so +/// that it can be used at different lowering level if needed. +/// IntrinsicLibrary is not in charge of generating code for the argument +/// expressions/symbols. These must be generated before and the resulting +/// mlir::Values are inputs for the IntrinsicLibrary operation generation. +/// +/// The operations generated can be as simple as a single runtime library call +/// or they may fully implement the intrinsic without runtime help. This +/// depends on the IntrinsicLibrary::Implementation. +/// +/// IntrinsicLibrary should not be assumed cheap to build since they may need +/// to build a representation of the target runtime before they can be used. +/// Once built, they are stateless and cannot be modified. +/// + +class IntrinsicLibrary { +public: + /// Available runtime library versions. + enum class Version { PgmathFast, PgmathRelaxed, PgmathPrecise, LLVM }; + + /// Create an IntrinsicLibrary targeting the desired runtime library version. + IntrinsicLibrary(Version, mlir::MLIRContext &); + ~IntrinsicLibrary(); + /// Generate the FIR+MLIR operations for the generic intrinsic "name". + /// On failure, returns a nullptr, else the returned mlir::Value is + /// the returned Fortran intrinsic value. + mlir::Value genval(mlir::Location loc, Fortran::lower::FirOpBuilder &builder, + llvm::StringRef name, mlir::Type resultType, + llvm::ArrayRef args) const; + + // TODO: Expose interface to get specific intrinsic function address. + // TODO: Handle intrinsic subroutine. + // TODO: Intrinsics that do not require their arguments to be defined + // (e.g shape inquiries) might not fit in the current interface that + // requires mlir::Value to be provided. + // TODO: Error handling interface ? + // TODO: Implementation is incomplete. Many intrinsics to tbd. + +private: + /// Actual implementation is hidden. + class Implementation; + std::unique_ptr impl; +}; + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_INTRINSICS_H_ diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h new file mode 100644 index 00000000000000..b13b51355c8121 --- /dev/null +++ b/flang/include/flang/Lower/Mangler.h @@ -0,0 +1,44 @@ +//===-- Lower/Mangler.h -- name mangling ------------------------*- 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 FORTRAN_LOWER_MANGLER_H_ +#define FORTRAN_LOWER_MANGLER_H_ + +#include + +namespace fir { +struct NameUniquer; +} + +namespace llvm { +class StringRef; +} + +namespace Fortran { +namespace common { +template +class Reference; +} + +namespace semantics { +class Symbol; +} + +namespace lower { +namespace mangle { + +/// Convert a front-end Symbol to an internal name +std::string mangleName(fir::NameUniquer &uniquer, const semantics::Symbol &); + +std::string demangleName(llvm::StringRef name); + +} // namespace mangle +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_MANGLER_H_ diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h index 733027cc425d8b..1865b1ed4b9740 100644 --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -1,32 +1,28 @@ -//===-- include/flang/Lower/PFTBuilder.h ------------------------*- C++ -*-===// +//===-- Lower/PFTBuilder.h -- PFT builder -----------------------*- 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 // //===----------------------------------------------------------------------===// +// +// PFT (Pre-FIR Tree) interface. +// +//===----------------------------------------------------------------------===// -#ifndef FORTRAN_LOWER_PFT_BUILDER_H_ -#define FORTRAN_LOWER_PFT_BUILDER_H_ +#ifndef FORTRAN_LOWER_PFTBUILDER_H +#define FORTRAN_LOWER_PFTBUILDER_H +#include "flang/Common/reference.h" #include "flang/Common/template.h" #include "flang/Parser/parse-tree.h" +#include "llvm/ADT/DenseMap.h" +#include "llvm/ADT/SmallSet.h" +#include "llvm/Support/raw_ostream.h" #include -/// Build a light-weight tree over the parse-tree to help with lowering to FIR. -/// It is named Pre-FIR Tree (PFT) to underline it has no other usage than -/// helping lowering to FIR. -/// The PFT will capture pointers back into the parse tree, so the parse tree -/// data structure may not be changed between the construction of the -/// PFT and all of its uses. -/// -/// The PFT captures a structured view of the program. The program is a list of -/// units. Function like units will contain lists of evaluations. Evaluations -/// are either statements or constructs, where a construct contains a list of -/// evaluations. The resulting PFT structure can then be used to create FIR. - -namespace llvm { -class raw_ostream; +namespace mlir { +class Block; } namespace Fortran::lower { @@ -37,44 +33,18 @@ struct Program; struct ModuleLikeUnit; struct FunctionLikeUnit; -// TODO: A collection of Evaluations can obviously be any of the container -// types; leaving this as a std::list _for now_ because we reserve the right to -// insert PFT nodes in any order in O(1) time. -using EvaluationCollection = std::list; +// Using std::list for a list of Evaluations preserves the option to do +// O(1) time insertions anywhere. +using EvaluationList = std::list; -struct ParentType { +struct ParentVariant { template - ParentType(A &parent) : p{&parent} {} + ParentVariant(A &parentVariant) : p{&parentVariant} {} const std::variant p; }; -/// Flags to describe the impact of parse-trees nodes on the program -/// control flow. These annotations to parse-tree nodes are later used to -/// build the control flow graph when lowering to FIR. -enum class CFGAnnotation { - None, // Node does not impact control flow. - Goto, // Node acts like a goto on the control flow. - CondGoto, // Node acts like a conditional goto on the control flow. - IndGoto, // Node acts like an indirect goto on the control flow. - IoSwitch, // Node is an IO statement with ERR, END, or EOR specifier. - Switch, // Node acts like a switch on the control flow. - Iterative, // Node creates iterations in the control flow. - FirStructuredOp, // Node is a structured loop. - Return, // Node triggers a return from the current procedure. - Terminate // Node terminates the program. -}; - -/// Compiler-generated jump -/// -/// This is used to convert implicit control-flow edges to explicit form in the -/// decorated PFT -struct CGJump { - CGJump(Evaluation &to) : target{to} {} - Evaluation ⌖ -}; - /// Classify the parse-tree nodes from ExecutablePartConstruct using ActionStmts = std::tuple< @@ -95,15 +65,6 @@ using ActionStmts = std::tuple< using OtherStmts = std::tuple; -using Constructs = - std::tuple; - using ConstructStmts = std::tuple< parser::AssociateStmt, parser::EndAssociateStmt, parser::BlockStmt, parser::EndBlockStmt, parser::SelectCaseStmt, parser::CaseStmt, @@ -115,257 +76,323 @@ using ConstructStmts = std::tuple< parser::MaskedElsewhereStmt, parser::ElsewhereStmt, parser::EndWhereStmt, parser::ForallConstructStmt, parser::EndForallStmt>; +using Constructs = + std::tuple; + +template +static constexpr bool isActionStmt{common::HasMember}; + template -constexpr static bool isActionStmt{common::HasMember}; +static constexpr bool isOtherStmt{common::HasMember}; template -constexpr static bool isConstruct{common::HasMember}; +static constexpr bool isConstructStmt{common::HasMember}; template -constexpr static bool isConstructStmt{common::HasMember}; +static constexpr bool isConstruct{common::HasMember}; template -constexpr static bool isOtherStmt{common::HasMember}; +static constexpr bool isIntermediateConstructStmt{common::HasMember< + A, std::tuple>}; template -constexpr static bool isGenerated{std::is_same_v}; +static constexpr bool isNopConstructStmt{common::HasMember< + A, std::tuple>}; template -constexpr static bool isFunctionLike{common::HasMember< +static constexpr bool isFunctionLike{common::HasMember< A, std::tuple>}; -/// Function-like units can contains lists of evaluations. These can be -/// (simple) statements or constructs, where a construct contains its own -/// evaluations. -struct Evaluation { - using EvalTuple = common::CombineTuples; - - /// Hide non-nullable pointers to the parse-tree node. - template - using MakeRefType = const A *const; - using EvalVariant = - common::CombineVariants, - std::variant>; - template - constexpr auto visit(A visitor) const { - return std::visit(common::visitors{ - [&](const auto *p) { return visitor(*p); }, - [&](auto &r) { return visitor(r); }, - }, - u); +using LabelSet = llvm::SmallSet; +using SymbolRef = common::Reference; +using SymbolLabelMap = llvm::DenseMap; + +/// Provide a variant like container that can holds constant references. +/// It is used in the other classes to provide union of const references +/// to parse-tree nodes. +template +class ReferenceVariant { +public: + template + using ConstRef = common::Reference; + + ReferenceVariant() = delete; + template + ReferenceVariant(const B &b) : u{ConstRef{b}} {} + + template + constexpr const B &get() const { + return std::get>> (u).get(); } - template - constexpr const A *getIf() const { - if constexpr (!std::is_same_v) { - if (auto *ptr{std::get_if>(&u)}) { - return *ptr; - } - } else { - return std::get_if(&u); - } - return nullptr; + template + constexpr const B *getIf() const { + auto *ptr = std::get_if>(&u); + return ptr ? &ptr->get() : nullptr; } - template + template constexpr bool isA() const { - if constexpr (!std::is_same_v) { - return std::holds_alternative>(u); - } - return std::holds_alternative(u); + return std::holds_alternative>(u); } + template + constexpr auto visit(VISITOR &&visitor) const { + return std::visit( + common::visitors{[&visitor](auto ref) { return visitor(ref.get()); }}, + u); + } + +private: + std::variant...> u; +}; + +template +struct MakeReferenceVariantHelper {}; +template +struct MakeReferenceVariantHelper> { + using type = ReferenceVariant; +}; +template +struct MakeReferenceVariantHelper> { + using type = ReferenceVariant; +}; +template +using MakeReferenceVariant = typename MakeReferenceVariantHelper::type; + +using EvaluationTuple = + common::CombineTuples; +/// Hide non-nullable pointers to the parse-tree node. +/// Build type std::variant +/// from EvaluationTuple type (std::tuple). +using EvaluationVariant = MakeReferenceVariant; - Evaluation() = delete; - Evaluation(const Evaluation &) = delete; - Evaluation(Evaluation &&) = default; +/// Function-like units contain lists of evaluations. These can be simple +/// statements or constructs, where a construct contains its own evaluations. +struct Evaluation : EvaluationVariant { /// General ctor template - Evaluation(const A &a, const ParentType &p, const parser::CharBlock &pos, - const std::optional &lab) - : u{&a}, parent{p}, pos{pos}, lab{lab} {} - - /// Compiler-generated jump - Evaluation(const CGJump &jump, const ParentType &p) - : u{jump}, parent{p}, cfg{CFGAnnotation::Goto} {} + Evaluation(const A &a, const ParentVariant &parentVariant, + const parser::CharBlock &position, + const std::optional &label) + : EvaluationVariant{a}, + parentVariant{parentVariant}, position{position}, label{label} {} /// Construct ctor template - Evaluation(const A &a, const ParentType &parent) : u{&a}, parent{parent} { + Evaluation(const A &a, const ParentVariant &parentVariant) + : EvaluationVariant{a}, parentVariant{parentVariant} { static_assert(pft::isConstruct, "must be a construct"); } - constexpr bool isActionOrGenerated() const { + /// Evaluation classification predicates. + constexpr bool isActionStmt() const { return visit(common::visitors{ - [](auto &r) { - using T = std::decay_t; - return isActionStmt || isGenerated; - }, - }); + [](auto &r) { return pft::isActionStmt>; }}); } - - constexpr bool isStmt() const { + constexpr bool isOtherStmt() const { return visit(common::visitors{ - [](auto &r) { - using T = std::decay_t; - static constexpr bool isStmt{isActionStmt || isOtherStmt || - isConstructStmt}; - static_assert(!(isStmt && pft::isConstruct), - "statement classification is inconsistent"); - return isStmt; - }, - }); + [](auto &r) { return pft::isOtherStmt>; }}); } - constexpr bool isConstruct() const { return !isStmt(); } - - /// Set the type of originating control flow type for this evaluation. - void setCFG(CFGAnnotation a, Evaluation *cstr) { - cfg = a; - setBranches(cstr); + constexpr bool isConstructStmt() const { + return visit(common::visitors{[](auto &r) { + return pft::isConstructStmt>; + }}); } - - /// Is this evaluation a control-flow origin? (The PFT must be annotated) - bool isControlOrigin() const { return cfg != CFGAnnotation::None; } - - /// Is this evaluation a control-flow target? (The PFT must be annotated) - bool isControlTarget() const { return isTarget; } - - /// Set the containsBranches flag iff this evaluation (a construct) contains - /// control flow - void setBranches() { containsBranches = true; } - - EvaluationCollection *getConstructEvals() { - auto *evals{subs.get()}; - if (isStmt() && !evals) { - return nullptr; - } - if (isConstruct() && evals) { - return evals; - } - llvm_unreachable("evaluation subs is inconsistent"); - return nullptr; + constexpr bool isConstruct() const { + return visit(common::visitors{ + [](auto &r) { return pft::isConstruct>; }}); } - - /// Set that the construct `cstr` (if not a nullptr) has branches. - static void setBranches(Evaluation *cstr) { - if (cstr) - cstr->setBranches(); + constexpr bool isIntermediateConstructStmt() const { + return visit(common::visitors{[](auto &r) { + return pft::isIntermediateConstructStmt>; + }}); + } + constexpr bool isNopConstructStmt() const { + return visit(common::visitors{[](auto &r) { + return pft::isNopConstructStmt>; + }}); } - EvalVariant u; - ParentType parent; - parser::CharBlock pos; - std::optional lab; - std::unique_ptr subs; // construct sub-statements - CFGAnnotation cfg{CFGAnnotation::None}; - bool isTarget{false}; // this evaluation is a control target - bool containsBranches{false}; // construct contains branches + /// Return FunctionLikeUnit to which this evaluation + /// belongs. Nullptr if it does not belong to such unit. + FunctionLikeUnit *getOwningProcedure() const; + + bool lowerAsStructured() const; + bool lowerAsUnstructured() const; + + // FIR generation looks primarily at PFT statement (leaf) nodes. So members + // such as lexicalSuccessor and the various block fields are only applicable + // to statement nodes. One exception is that an internal construct node is + // a convenient place for a constructExit link that applies to exits from any + // statement within the construct. The controlSuccessor member is used for + // nonlexical successors, such as linking to a GOTO target. For multiway + // branches, controlSuccessor is set to one of the targets (might as well be + // the first target). Successor and exit links always target statements. + // + // An unstructured construct is one that contains some form of goto. This + // is indicated by the isUnstructured member flag, which may be set on a + // statement and propagated to enclosing constructs. This distinction allows + // a structured IF or DO statement to be materialized with custom structured + // FIR operations. An unstructured statement is materialized as mlir + // operation sequences that include explicit branches. + // + // There are two mlir::Block members. The block member is set for statements + // that begin a new block. If a statement may have more than one associated + // block, this member must be the block that would be the target of a branch + // to the statement. The prime example of a statement that may have multiple + // associated blocks is NonLabelDoStmt, which may have a loop preheader block + // for loop initialization code, and always has a header block that is the + // target of the loop back edge. If the NonLabelDoStmt is a concurrent loop, + // there may be an arbitrary number of nested preheader, header, and mask + // blocks. Any such additional blocks in the localBlocks member are local + // to a construct and cannot be the target of an unstructured branch. For + // NonLabelDoStmt, the block member designates the preheader block, which may + // be absent if loop initialization code may be appended to a predecessor + // block. The primary loop header block is localBlocks[0], with additional + // DO CONCURRENT blocks at localBlocks[1], etc. + // + // The printIndex member is only set for statements. It is used for dumps + // and does not affect FIR generation. It may also be helpful for debugging. + + ParentVariant parentVariant; + parser::CharBlock position{}; + std::optional label{}; + std::unique_ptr evaluationList; // nested evaluations + Evaluation *parentConstruct{nullptr}; // set for nodes below the top level + Evaluation *lexicalSuccessor{nullptr}; // set for ActionStmt, ConstructStmt + Evaluation *controlSuccessor{nullptr}; // set for some statements + Evaluation *constructExit{nullptr}; // set for constructs + bool isNewBlock{false}; // evaluation begins a new basic block + bool isUnstructured{false}; // evaluation has unstructured control flow + bool skip{false}; // evaluation has been processed in advance + class mlir::Block *block{nullptr}; // isNewBlock block + llvm::SmallVector localBlocks{}; // construct local blocks + int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps }; +using ProgramVariant = + ReferenceVariant; /// A program is a list of program units. -/// These units can be function like, module like, or block data -struct ProgramUnit { +/// These units can be function like, module like, or block data. +struct ProgramUnit : ProgramVariant { template - ProgramUnit(const A &ptr, const ParentType &parent) - : p{&ptr}, parent{parent} {} + ProgramUnit(const A &p, const ParentVariant &parentVariant) + : ProgramVariant{p}, parentVariant{parentVariant} {} ProgramUnit(ProgramUnit &&) = default; ProgramUnit(const ProgramUnit &) = delete; - const std::variant< - const parser::MainProgram *, const parser::FunctionSubprogram *, - const parser::SubroutineSubprogram *, const parser::Module *, - const parser::Submodule *, const parser::SeparateModuleSubprogram *, - const parser::BlockData *> - p; - ParentType parent; + ParentVariant parentVariant; }; -/// Function-like units have similar structure. They all can contain executable -/// statements as well as other function-like units (internal procedures and -/// function statements). +/// Function-like units may contain evaluations (executable statements) and +/// nested function-like units (internal procedures and function statements). struct FunctionLikeUnit : public ProgramUnit { // wrapper statements for function-like syntactic structures using FunctionStatement = - std::variant *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *>; - - FunctionLikeUnit(const parser::MainProgram &f, const ParentType &parent); + ReferenceVariant, + parser::Statement, + parser::Statement, + parser::Statement, + parser::Statement, + parser::Statement, + parser::Statement, + parser::Statement>; + + FunctionLikeUnit(const parser::MainProgram &f, + const ParentVariant &parentVariant); FunctionLikeUnit(const parser::FunctionSubprogram &f, - const ParentType &parent); + const ParentVariant &parentVariant); FunctionLikeUnit(const parser::SubroutineSubprogram &f, - const ParentType &parent); + const ParentVariant &parentVariant); FunctionLikeUnit(const parser::SeparateModuleSubprogram &f, - const ParentType &parent); + const ParentVariant &parentVariant); FunctionLikeUnit(FunctionLikeUnit &&) = default; FunctionLikeUnit(const FunctionLikeUnit &) = delete; - bool isMainProgram() { - return std::holds_alternative< - const parser::Statement *>(endStmt); + bool isMainProgram() const { + return endStmt.isA>(); } - const parser::FunctionStmt *getFunction() { - return getA(); + + /// Get the starting source location for this function like unit + parser::CharBlock getStartingSourceLoc() { + if (beginStmt) + return stmtSourceLoc(*beginStmt); + if (evaluationList.size()) + return evaluationList.front().position; + return stmtSourceLoc(endStmt); } - const parser::SubroutineStmt *getSubroutine() { - return getA(); + + /// Returns reference to the subprogram symbol of this FunctionLikeUnit. + /// Dies if the FunctionLikeUnit is not a subprogram. + const semantics::Symbol &getSubprogramSymbol() const { + assert(symbol && "not inside a procedure"); + return *symbol; } - const parser::MpSubprogramStmt *getMPSubp() { - return getA(); + + /// Helper to get location from FunctionLikeUnit begin/end statements. + static parser::CharBlock stmtSourceLoc(const FunctionStatement &stmt) { + return stmt.visit(common::visitors{[](const auto &x) { return x.source; }}); } /// Anonymous programs do not have a begin statement std::optional beginStmt; FunctionStatement endStmt; - EvaluationCollection evals; // statements - std::list funcs; // internal procedures - -private: - template - const A *getA() { - if (beginStmt) { - if (auto p = - std::get_if *>(&beginStmt.value())) - return &(*p)->statement; - } - return nullptr; - } + EvaluationList evaluationList; + llvm::DenseMap labelEvaluationMap; + SymbolLabelMap assignSymbolLabelMap; + std::list nestedFunctions; + /// Symbol associated to this FunctionLikeUnit. + /// Null if the FunctionLikeUnit is an anonymous program. + /// The symbol has MainProgramDetails for named programs, otherwise it has + /// SubprogramDetails. + const semantics::Symbol *symbol{nullptr}; + /// Terminal basic block (if any) + mlir::Block *finalBlock{}; }; -/// Module-like units have similar structure. They all can contain a list of -/// function-like units. +/// Module-like units contain a list of function-like units. struct ModuleLikeUnit : public ProgramUnit { // wrapper statements for module-like syntactic structures using ModuleStatement = - std::variant *, - const parser::Statement *, - const parser::Statement *, - const parser::Statement *>; - - ModuleLikeUnit(const parser::Module &m, const ParentType &parent); - ModuleLikeUnit(const parser::Submodule &m, const ParentType &parent); + ReferenceVariant, + parser::Statement, + parser::Statement, + parser::Statement>; + + ModuleLikeUnit(const parser::Module &m, const ParentVariant &parentVariant); + ModuleLikeUnit(const parser::Submodule &m, + const ParentVariant &parentVariant); ~ModuleLikeUnit() = default; ModuleLikeUnit(ModuleLikeUnit &&) = default; ModuleLikeUnit(const ModuleLikeUnit &) = delete; ModuleStatement beginStmt; ModuleStatement endStmt; - std::list funcs; + std::list nestedFunctions; }; struct BlockDataUnit : public ProgramUnit { - BlockDataUnit(const parser::BlockData &bd, const ParentType &parent); + BlockDataUnit(const parser::BlockData &bd, + const ParentVariant &parentVariant); BlockDataUnit(BlockDataUnit &&) = default; BlockDataUnit(const BlockDataUnit &) = delete; }; -/// A Program is the top-level PFT +/// A Program is the top-level root of the PFT. struct Program { using Units = std::variant; @@ -375,23 +402,28 @@ struct Program { std::list &getUnits() { return units; } + /// LLVM dump method on a Program. + void dump(); + private: std::list units; }; } // namespace pft -/// Create an PFT from the parse tree -std::unique_ptr createPFT(const parser::Program &root); - -/// Decorate the PFT with control flow annotations +/// Create a PFT (Pre-FIR Tree) from the parse tree. /// -/// The PFT must be decorated with control-flow annotations to prepare it for -/// use in generating a CFG-like structure. -void annotateControl(pft::Program &); +/// A PFT is a light weight tree over the parse tree that is used to create FIR. +/// The PFT captures pointers back into the parse tree, so the parse tree must +/// not be changed between the construction of the PFT and its last use. The +/// PFT captures a structured view of a program. A program is a list of units. +/// A function like unit contains a list of evaluations. An evaluation is +/// either a statement, or a construct with a nested list of evaluations. +std::unique_ptr createPFT(const parser::Program &root); -void dumpPFT(llvm::raw_ostream &o, pft::Program &); +/// Dumper for displaying a PFT. +void dumpPFT(llvm::raw_ostream &outputStream, pft::Program &pft); } // namespace Fortran::lower -#endif // FORTRAN_LOWER_PFT_BUILDER_H_ +#endif // FORTRAN_LOWER_PFTBUILDER_H diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h new file mode 100644 index 00000000000000..82b5e56e143d4f --- /dev/null +++ b/flang/include/flang/Lower/Runtime.h @@ -0,0 +1,213 @@ +//===-- Lower/Runtime.h -- Fortran runtime codegen interface ----*- 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 +// +//===----------------------------------------------------------------------===// +// +// Builder routines for constructing the FIR dialect of MLIR. As FIR is a +// dialect of MLIR, it makes extensive use of MLIR interfaces and MLIR's coding +// style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this +// module. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_RUNTIME_H_ +#define FORTRAN_LOWER_RUNTIME_H_ + +// use std::optional to effect constexpr evaluation +#include + +namespace llvm { +class StringRef; +} +namespace mlir { +class Type; +class FunctionType; +class MLIRContext; +class FuncOp; +} // namespace mlir + +namespace Fortran::lower { + +class FirOpBuilder; + +//===----------------------------------------------------------------------===// +// C++ does not provide variable size constexpr container yet. StaticVector is +// a class that can be used to hold constexpr data as if it was a vector (i.e, +// the number of element is not reflected in the container type). This is +// useful to use in classes that need to be constexpr and where leaking the +// size as a template type would make it harder to manipulate. It can hold +// whatever data that can appear as non-type templates (integers, enums, +// pointer to objects, function pointers...). +// +// Example usage: +// +// enum class Enum {A, B}; +// constexpr StaticVector vec{StaticVector::create()}; +// for (const Enum& code : vec) { /*...*/ } +// +//===----------------------------------------------------------------------===// + +/// This is the class where the constexpr data is "allocated". In fact +/// the data is stored "in" the type. Objects of this type are not meant to +/// be ever constructed. +template +struct StaticVectorStorage { + static constexpr T values[]{v...}; + static constexpr const T *start{&values[0]}; + static constexpr const T *end{start + sizeof...(v)}; +}; + +template +struct StaticVectorStorage { + static constexpr const T *start{nullptr}, *end{nullptr}; +}; + +/// StaticVector cannot be directly constructed, instead its +/// `create` static method has to be used to create StaticVector objects. +/// StaticVector are views over the StaticVectorStorage type that was built +/// while instantiating the create method. They do not duplicate the values from +/// these read-only storages. +template +struct StaticVector { + template + static constexpr StaticVector create() { + using storage = StaticVectorStorage; + return StaticVector{storage::start, storage::end}; + } + using const_iterator = const T *; + constexpr const_iterator begin() const { return startPtr; } + constexpr const_iterator end() const { return endPtr; } + const T *startPtr{nullptr}; + const T *endPtr{nullptr}; +}; + +/// Define a simple static runtime description that different runtime can +/// derived from (e.g io, maths ...). +/// This base class only define enough to generate the functuion declarations, +/// it is up to the actual runtime descriptions to define a way to organize +/// these descriptions in a meaningful way. +/// It is constexpr constructible so that static tables of such descriptions can +/// be safely stored as global variables without requiring global constructors. +class RuntimeStaticDescription { +public: + /// Define possible runtime function argument/return type used in signature + /// descriptions. They follow mlir standard types naming. MLIR types cannot + /// directly be used because they can only be dynamically built. + enum TypeCode { i32, i64, f32, f64, c32, c64, boolean, charPtr, IOCookie }; + using MaybeTypeCode = std::optional; // for results + using TypeCodeVector = StaticVector; // for arguments + static constexpr MaybeTypeCode voidTy{MaybeTypeCode{std::nullopt}}; + + constexpr RuntimeStaticDescription(const char *s, MaybeTypeCode r, + TypeCodeVector a) + : symbol{s}, resultTypeCode{r}, argumentTypeCodes{a} {} + const char *getSymbol() const { return symbol; } + /// Conversion between types of the static representation and MLIR types. + mlir::FunctionType getMLIRFunctionType(mlir::MLIRContext *) const; + mlir::FuncOp getFuncOp(Fortran::lower::FirOpBuilder &builder) const; + static mlir::Type getMLIRType(TypeCode, mlir::MLIRContext *); + +private: + const char *symbol{nullptr}; + MaybeTypeCode resultTypeCode; + TypeCodeVector argumentTypeCodes; +}; + +/// StaticMultimapView is a constexpr friendly multimap +/// implementation over sorted constexpr arrays. +/// As the View name suggests, it does not duplicate the +/// sorted array but only brings range and search concepts +/// over it. It provides compile time search and can also +/// provide dynamic search (currently linear, can be improved to +/// log(n) due to the sorted array property). + +// TODO: Find a better place for this if this is retained. +// This is currently here because this was designed to provide +// maps over runtime description without the burden of having to +// instantiate these maps dynamically and to keep them somewhere. +template +class StaticMultimapView { +public: + using Key = typename V::Key; + struct Range { + using const_iterator = const V *; + constexpr const_iterator begin() const { return startPtr; } + constexpr const_iterator end() const { return endPtr; } + constexpr bool empty() const { + return startPtr == nullptr || endPtr == nullptr || endPtr <= startPtr; + } + constexpr std::size_t size() const { + return empty() ? 0 : static_cast(endPtr - startPtr); + } + const V *startPtr{nullptr}; + const V *endPtr{nullptr}; + }; + using const_iterator = typename Range::const_iterator; + + template + constexpr StaticMultimapView(const V (&array)[N]) + : range{&array[0], &array[0] + N} {} + template + constexpr bool verify() { + // TODO: sorted + // non empty increasing pointer direction + return !range.empty(); + } + constexpr const_iterator begin() const { return range.begin(); } + constexpr const_iterator end() const { return range.end(); } + + // Assume array is sorted. + // TODO make it a log(n) search based on sorted property + // std::equal_range will be constexpr in C++20 only. + constexpr Range getRange(const Key &key) const { + bool matched{false}; + const V *start{nullptr}, *end{nullptr}; + for (const auto &desc : range) { + if (desc.key == key) { + if (!matched) { + start = &desc; + matched = true; + } + } else if (matched) { + end = &desc; + matched = false; + } + } + if (matched) { + end = range.end(); + } + return Range{start, end}; + } + + constexpr std::pair + equal_range(const Key &key) const { + Range range{getRange(key)}; + return {range.begin(), range.end()}; + } + + constexpr typename Range::const_iterator find(Key key) const { + const Range subRange{getRange(key)}; + return subRange.size() == 1 ? subRange.begin() : end(); + } + +private: + Range range{nullptr, nullptr}; +}; + +// Define Fortran related language (other than IO and maths) +// TODO: complete this list while working on the runtime. +enum class RuntimeEntryCode { + StopStatement, + StopStatementText, + FailImageStatement +}; + +mlir::FuncOp genRuntimeFunction(RuntimeEntryCode code, + Fortran::lower::FirOpBuilder &builder); + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_RUNTIME_H_ diff --git a/flang/include/flang/Lower/Utils.h b/flang/include/flang/Lower/Utils.h new file mode 100644 index 00000000000000..74c2037754d910 --- /dev/null +++ b/flang/include/flang/Lower/Utils.h @@ -0,0 +1,20 @@ +//===-- Lower/Utils.h -- utilities ------------------------------*- 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 FORTRAN_LOWER_UTILS_H +#define FORTRAN_LOWER_UTILS_H + +#include "flang/Parser/char-block.h" +#include "llvm/ADT/StringRef.h" + +/// Convert an F18 CharBlock to an LLVM StringRef +inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) { + return {cb.begin(), cb.size()}; +} + +#endif // FORTRAN_LOWER_UTILS_H diff --git a/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h b/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h new file mode 100644 index 00000000000000..5f686d59474569 --- /dev/null +++ b/flang/include/flang/Optimizer/Analysis/IteratedDominanceFrontier.h @@ -0,0 +1,95 @@ +//===- IteratedDominanceFrontier.h - Calculate IDF --------------*- 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 +// +//===----------------------------------------------------------------------===// +/// \file +/// Compute iterated dominance frontiers using a linear time algorithm. +/// +/// The algorithm used here is based on: +/// +/// Sreedhar and Gao. A linear time algorithm for placing phi-nodes. +/// In Proceedings of the 22nd ACM SIGPLAN-SIGACT Symposium on Principles of +/// Programming Languages +/// POPL '95. ACM, New York, NY, 62-73. +/// +/// It has been modified to not explicitly use the DJ graph data structure and +/// to directly compute pruned SSA using per-variable liveness information. +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_ANALYSIS_IDF_H +#define OPTIMIZER_ANALYSIS_IDF_H + +#include "mlir/Support/LLVM.h" + +namespace mlir { +class Block; +class DominanceInfo; +} // namespace mlir + +namespace fir { + +/// Determine the iterated dominance frontier, given a set of defining +/// blocks, and optionally, a set of live-in blocks. +/// +/// In turn, the results can be used to place phi nodes. +/// +/// This algorithm is a linear time computation of Iterated Dominance Frontiers, +/// pruned using the live-in set. +/// By default, liveness is not used to prune the IDF computation. +/// The template parameters should be either BasicBlock* or Inverse, depending on if you want the forward or reverse IDF. +template +class IDFCalculator { +public: + IDFCalculator(mlir::DominanceInfo &DT) : DT(DT), useLiveIn(false) {} + + /// Give the IDF calculator the set of blocks in which the value is + /// defined. This is equivalent to the set of starting blocks it should be + /// calculating the IDF for (though later gets pruned based on liveness). + /// + /// Note: This set *must* live for the entire lifetime of the IDF calculator. + void setDefiningBlocks(const llvm::SmallPtrSetImpl &Blocks) { + DefBlocks = &Blocks; + } + + /// Give the IDF calculator the set of blocks in which the value is + /// live on entry to the block. This is used to prune the IDF calculation to + /// not include blocks where any phi insertion would be dead. + /// + /// Note: This set *must* live for the entire lifetime of the IDF calculator. + void setLiveInBlocks(const llvm::SmallPtrSetImpl &Blocks) { + LiveInBlocks = &Blocks; + useLiveIn = true; + } + + /// Reset the live-in block set to be empty, and tell the IDF + /// calculator to not use liveness anymore. + void resetLiveInBlocks() { + LiveInBlocks = nullptr; + useLiveIn = false; + } + + /// Calculate iterated dominance frontiers + /// + /// This uses the linear-time phi algorithm based on DJ-graphs mentioned in + /// the file-level comment. It performs DF->IDF pruning using the live-in + /// set, to avoid computing the IDF for blocks where an inserted PHI node + /// would be dead. + void calculate(llvm::SmallVectorImpl &IDFBlocks); + +private: + mlir::DominanceInfo &DT; + bool useLiveIn; + const llvm::SmallPtrSetImpl *LiveInBlocks; + const llvm::SmallPtrSetImpl *DefBlocks; +}; + +typedef IDFCalculator ForwardIDFCalculator; + +} // namespace fir + +#endif // OPTIMIZER_ANALYSIS_IDF_H diff --git a/flang/include/flang/Optimizer/Support/KindMapping.h b/flang/include/flang/Optimizer/Support/KindMapping.h index 8c8ed1f24afddd..08ac14ca6d5f6e 100644 --- a/flang/include/flang/Optimizer/Support/KindMapping.h +++ b/flang/include/flang/Optimizer/Support/KindMapping.h @@ -1,4 +1,4 @@ -//===-- Optimizer/Support/KindMapping.h -------------------------*- C++ -*-===// +//===-- Optimizer/Support/KindMapping.h -- support kind mapping -*- C++ -*-===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. @@ -14,8 +14,6 @@ #include "llvm/IR/Type.h" namespace llvm { -template -class Optional; struct fltSemantics; } // namespace llvm @@ -57,24 +55,24 @@ class KindMapping { explicit KindMapping(mlir::MLIRContext *context, llvm::StringRef map); /// Get the size in bits of !fir.char - Bitsize getCharacterBitsize(KindTy kind); + Bitsize getCharacterBitsize(KindTy kind) const; /// Get the size in bits of !fir.int - Bitsize getIntegerBitsize(KindTy kind); + Bitsize getIntegerBitsize(KindTy kind) const; /// Get the size in bits of !fir.logical - Bitsize getLogicalBitsize(KindTy kind); + Bitsize getLogicalBitsize(KindTy kind) const; /// Get the LLVM Type::TypeID of !fir.real - LLVMTypeID getRealTypeID(KindTy kind); + LLVMTypeID getRealTypeID(KindTy kind) const; /// Get the LLVM Type::TypeID of !fir.complex - LLVMTypeID getComplexTypeID(KindTy kind); + LLVMTypeID getComplexTypeID(KindTy kind) const; mlir::MLIRContext *getContext() const { return context; } /// Get the float semantics of !fir.real - const llvm::fltSemantics &getFloatSemantics(KindTy kind); + const llvm::fltSemantics &getFloatSemantics(KindTy kind) const; private: MatchResult badMapString(const llvm::Twine &ptr); diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h new file mode 100644 index 00000000000000..0c59689b2b6203 --- /dev/null +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -0,0 +1,47 @@ +//===-- Optimizer/Transforms/Passes.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 +// +//===----------------------------------------------------------------------===// + +#ifndef OPTIMIZER_TRANSFORMS_PASSES_H +#define OPTIMIZER_TRANSFORMS_PASSES_H + +#include + +namespace mlir { +class FuncOp; +template +class OpPassBase; +class Pass; +} // namespace mlir + +namespace fir { + +class KindMapping; + +/// Convert fir.select_type to the standard dialect +std::unique_ptr createFIRToStdPass(const KindMapping &); + +/// Effects aware CSE pass +std::unique_ptr> createCSEPass(); + +/// Convert FIR loop constructs to the Affine dialect +std::unique_ptr createPromoteToAffinePass(); + +/// Convert `fir.loop` and `fir.where` to `loop.for` and `loop.if`. This +/// conversion enables the `createLowerToCFGPass` to transform these to CFG +/// form. +std::unique_ptr createLowerToLoopPass(); + +/// A pass to convert the FIR dialect from "Mem-SSA" form to "Reg-SSA" +/// form. This pass is a port of LLVM's mem2reg pass, but modified for the FIR +/// dialect as well as the restructuring of MLIR's representation to present PHI +/// nodes as block arguments. +std::unique_ptr> createMemToRegPass(); + +} // namespace fir + +#endif // OPTIMIZER_TRANSFORMS_PASSES_H diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 2a95f483a173ea..fb1fe03c531e6e 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -13,6 +13,7 @@ #include "flang/Common/Fortran.h" #include "flang/Common/enum-set.h" #include "flang/Common/reference.h" +#include "llvm/ADT/DenseMapInfo.h" #include #include #include @@ -752,6 +753,31 @@ inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) { return *x < *y; } using SymbolSet = std::set; - } // namespace Fortran::semantics + +// Define required info so that SymbolRef can be used inside llvm::DenseMap. +namespace llvm { +template <> struct DenseMapInfo { + static inline Fortran::semantics::SymbolRef getEmptyKey() { + auto ptr = DenseMapInfo::getEmptyKey(); + return *reinterpret_cast(&ptr); + } + + static inline Fortran::semantics::SymbolRef getTombstoneKey() { + auto ptr = + DenseMapInfo::getTombstoneKey(); + return *reinterpret_cast(&ptr); + } + + static unsigned getHashValue(const Fortran::semantics::SymbolRef &sym) { + return DenseMapInfo::getHashValue( + &sym.get()); + } + + static bool isEqual(const Fortran::semantics::SymbolRef &LHS, + const Fortran::semantics::SymbolRef &RHS) { + return LHS == RHS; + } +}; +} // namespace llvm #endif // FORTRAN_SEMANTICS_SYMBOL_H_ diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index e6a3a2eb53f1e1..0493ca4dd340c4 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -109,6 +109,8 @@ bool CanBeTypeBoundProc(const Symbol *); bool IsInitialized(const Symbol &); bool HasIntrinsicTypeName(const Symbol &); bool IsSeparateModuleProcedureInterface(const Symbol *); +// Given a subroutine symbol, tells if the subroutine has alternate returns +bool HasAlternateReturns(const Symbol &); // Return an ultimate component of type that matches predicate, or nullptr. const Symbol *FindUltimateComponent(const DerivedTypeSpec &type, diff --git a/flang/include/flang/Version.h b/flang/include/flang/Version.h new file mode 100644 index 00000000000000..e1d78eca58d06c --- /dev/null +++ b/flang/include/flang/Version.h @@ -0,0 +1,61 @@ +//===- Version.h - Flang Version Number -------------------------*- 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 +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// Defines version macros and version-related utility functions +/// for Flang. +/// +//===----------------------------------------------------------------------===// + +#ifndef LLVM_FLANG_VERSION_H +#define LLVM_FLANG_VERSION_H + +#include "flang/Version.inc" +#include "llvm/ADT/StringRef.h" + +namespace flang { + /// Retrieves the repository path (e.g., Subversion path) that + /// identifies the particular Flang branch, tag, or trunk from which this + /// Flang was built. + std::string getFlangRepositoryPath(); + + /// Retrieves the repository path from which LLVM was built. + /// + /// This supports LLVM residing in a separate repository from flang. + std::string getLLVMRepositoryPath(); + + /// Retrieves the repository revision number (or identifier) from which + /// this Flang was built. + std::string getFlangRevision(); + + /// Retrieves the repository revision number (or identifier) from which + /// LLVM was built. + /// + /// If Flang and LLVM are in the same repository, this returns the same + /// string as getFlangRevision. + std::string getLLVMRevision(); + + /// Retrieves the full repository version that is an amalgamation of + /// the information in getFlangRepositoryPath() and getFlangRevision(). + std::string getFlangFullRepositoryVersion(); + + /// Retrieves a string representing the complete flang version, + /// which includes the flang version number, the repository version, + /// and the vendor tag. + std::string getFlangFullVersion(); + + /// Like getFlangFullVersion(), but with a custom tool name. + std::string getFlangToolFullVersion(llvm::StringRef ToolName); + + /// Retrieves a string representing the complete flang version suitable + /// for use in the CPP __VERSION__ macro, which includes the flang version + /// number, the repository version, and the vendor tag. + std::string getFlangFullCPPVersion(); +} + +#endif // LLVM_FLANG_VERSION_H diff --git a/flang/lib/CMakeLists.txt b/flang/lib/CMakeLists.txt index ae321b872a7626..22ecde7b8844b2 100644 --- a/flang/lib/CMakeLists.txt +++ b/flang/lib/CMakeLists.txt @@ -1,10 +1,13 @@ +if ((CMAKE_CXX_COMPILER_ID MATCHES "Clang")) + if (APPLE) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-string-conversion -Wno-covered-switch-default") + endif() +endif() + add_subdirectory(Common) add_subdirectory(Evaluate) add_subdirectory(Decimal) add_subdirectory(Lower) add_subdirectory(Parser) +add_subdirectory(Optimizer) add_subdirectory(Semantics) - -if(LINK_WITH_FIR) - add_subdirectory(Optimizer) -endif() diff --git a/flang/lib/Decimal/binary-to-decimal.cpp b/flang/lib/Decimal/binary-to-decimal.cpp index 02e39c241ee1a1..38072d73935b15 100644 --- a/flang/lib/Decimal/binary-to-decimal.cpp +++ b/flang/lib/Decimal/binary-to-decimal.cpp @@ -304,7 +304,45 @@ void BigRadixFloatingPointNumber::Minimize( Normalize(); } -template +template +void BigRadixFloatingPointNumber::LoseLeastSignificantDigit() { + Digit LSD{digit_[0]}; + for (int j{0}; j < digits_ - 1; ++j) { + digit_[j] = digit_[j + 1]; + } + digit_[digits_ - 1] = 0; + bool incr{false}; + switch (rounding_) { + case RoundNearest: + case RoundDefault: + incr = LSD > radix / 2 || (LSD == radix / 2 && digit_[0] % 2 != 0); + break; + case RoundUp: + incr = LSD > 0 && !isNegative_; + break; + case RoundDown: + incr = LSD > 0 && isNegative_; + break; + case RoundToZero: + break; + case RoundCompatible: + incr = LSD >= radix / 2; + break; + } + for (int j{0}; (digit_[j] += incr) == radix; ++j) { + digit_[j] = 0; + } +} + +template void BigRadixFloatingPointNumber<8,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<11,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<24,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<53,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<64,16>::LoseLeastSignificantDigit(); +template void BigRadixFloatingPointNumber<113,16>::LoseLeastSignificantDigit(); + +template ConversionToDecimalResult ConvertToDecimal(char *buffer, std::size_t size, enum DecimalConversionFlags flags, int digits, enum FortranRounding rounding, BinaryFloatingPointNumber x) { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp new file mode 100644 index 00000000000000..65fc9c776ddfaf --- /dev/null +++ b/flang/lib/Lower/Bridge.cpp @@ -0,0 +1,1470 @@ +//===-- Bridge.cc -- bridge to lower to MLIR ------------------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/IO.h" +#include "flang/Lower/Intrinsics.h" +#include "flang/Lower/Mangler.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Runtime.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Optimizer/Support/InternalNames.h" +#include "flang/Parser/parse-tree.h" +#include "flang/Semantics/tools.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/Parser.h" +#include "mlir/Target/LLVMIR.h" +#include "llvm/Support/CommandLine.h" +#include "llvm/Support/ErrorHandling.h" +#include "llvm/Support/MD5.h" + +#undef TODO +#define TODO() \ + { \ + if (disableToDoAssertions) \ + mlir::emitError(toLocation(), __FILE__) \ + << ':' << __LINE__ << " not implemented"; \ + else \ + llvm_unreachable("not yet implemented"); \ + } + +static llvm::cl::opt + dumpBeforeFir("fdebug-dump-pre-fir", llvm::cl::init(false), + llvm::cl::desc("dump the IR tree prior to FIR")); + +static llvm::cl::opt + disableToDoAssertions("disable-burnside-todo", + llvm::cl::desc("disable burnside bridge asserts"), + llvm::cl::init(false), llvm::cl::Hidden); + +static llvm::cl::opt + nameLengthHashSize("length-to-hash-string-literal", + llvm::cl::desc("string literals that exceed this length" + " will use a hash value as their symbol " + "name"), + llvm::cl::init(32)); + +namespace { +/// Information for generating a structured or unstructured increment loop. +struct IncrementLoopInfo { + explicit IncrementLoopInfo( + Fortran::semantics::Symbol *sym, + const Fortran::parser::ScalarExpr &lowerExpr, + const Fortran::parser::ScalarExpr &upperExpr, + const std::optional &stepExpr, + mlir::Type type) + : loopVariableSym{sym}, lowerExpr{lowerExpr}, upperExpr{upperExpr}, + stepExpr{stepExpr}, loopVariableType{type} {} + + bool isStructured() const { return headerBlock == nullptr; } + + // Data members for both structured and unstructured loops. + Fortran::semantics::Symbol *loopVariableSym; + const Fortran::parser::ScalarExpr &lowerExpr; + const Fortran::parser::ScalarExpr &upperExpr; + const std::optional &stepExpr; + mlir::Type loopVariableType; + mlir::Value loopVariable{}; + mlir::Value stepValue{}; // possible uses in multiple blocks + + // Data members for structured loops. + fir::LoopOp doLoop{}; + mlir::OpBuilder::InsertPoint insertionPoint{}; + + // Data members for unstructured loops. + mlir::Value tripVariable{}; + mlir::Block *headerBlock{nullptr}; // loop entry and test block + mlir::Block *bodyBlock{nullptr}; // first loop body block + mlir::Block *successorBlock{nullptr}; // loop exit target block +}; +} // namespace + +//===----------------------------------------------------------------------===// +// FirConverter +//===----------------------------------------------------------------------===// + +namespace { +/// Walk over the pre-FIR tree (PFT) and lower it to the FIR dialect of MLIR. +/// +/// After building the PFT, the FirConverter processes that representation +/// and lowers it to the FIR executable representation. +class FirConverter : public Fortran::lower::AbstractConverter { +public: + explicit FirConverter(Fortran::lower::LoweringBridge &bridge, + fir::NameUniquer &uniquer) + : mlirContext{bridge.getMLIRContext()}, cooked{bridge.getCookedSource()}, + module{bridge.getModule()}, defaults{bridge.getDefaultKinds()}, + intrinsics{Fortran::lower::IntrinsicLibrary( + Fortran::lower::IntrinsicLibrary::Version::LLVM, + bridge.getMLIRContext())}, + uniquer{uniquer} {} + virtual ~FirConverter() = default; + + /// Convert the PFT to FIR + void run(Fortran::lower::pft::Program &pft) { + // do translation + for (auto &u : pft.getUnits()) { + std::visit( + Fortran::common::visitors{ + [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, + [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); }, + [&](Fortran::lower::pft::BlockDataUnit &) { TODO(); }, + }, + u); + } + } + + mlir::FunctionType genFunctionType(Fortran::lower::SymbolRef sym) { + return Fortran::lower::translateSymbolToFIRFunctionType(&mlirContext, + defaults, sym); + } + + //===--------------------------------------------------------------------===// + // AbstractConverter overrides + //===--------------------------------------------------------------------===// + + mlir::Value genExprAddr(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + return createFIRAddr(loc ? *loc : toLocation(), &expr); + } + mlir::Value genExprValue(const Fortran::lower::SomeExpr &expr, + mlir::Location *loc = nullptr) override final { + return createFIRExpr(loc ? *loc : toLocation(), &expr); + } + + mlir::Type genType(const Fortran::evaluate::DataRef &data) override final { + return Fortran::lower::translateDataRefToFIRType(&mlirContext, defaults, + data); + } + mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { + return Fortran::lower::translateSomeExprToFIRType(&mlirContext, defaults, + &expr); + } + mlir::Type genType(Fortran::lower::SymbolRef sym) override final { + return Fortran::lower::translateSymbolToFIRType(&mlirContext, defaults, + sym); + } + mlir::Type genType(Fortran::common::TypeCategory tc, + int kind) override final { + return Fortran::lower::getFIRType(&mlirContext, defaults, tc, kind); + } + mlir::Type genType(Fortran::common::TypeCategory tc) override final { + return Fortran::lower::getFIRType(&mlirContext, defaults, tc); + } + + mlir::Location getCurrentLocation() override final { return toLocation(); } + + /// Generate a dummy location. + mlir::Location genLocation() override final { + // Note: builder may not be instantiated yet + return mlir::UnknownLoc::get(&mlirContext); + } + + /// Generate a `Location` from the `CharBlock`. + mlir::Location + genLocation(const Fortran::parser::CharBlock &block) override final { + if (cooked) { + auto loc = cooked->GetSourcePositionRange(block); + if (loc.has_value()) { + // loc is a pair (begin, end); use the beginning position + auto &filePos = loc->first; + return mlir::FileLineColLoc::get(filePos.file.path(), filePos.line, + filePos.column, &mlirContext); + } + } + return genLocation(); + } + + Fortran::lower::FirOpBuilder &getFirOpBuilder() override final { + return *builder; + } + + mlir::ModuleOp &getModuleOp() override final { return module; } + + std::string + mangleName(const Fortran::semantics::Symbol &symbol) override final { + return Fortran::lower::mangle::mangleName(uniquer, symbol); + } + + std::string uniqueCGIdent(llvm::StringRef name) override final { + // For "long" identifiers use a hash value + if (name.size() > nameLengthHashSize) { + llvm::MD5 hash; + hash.update(name); + llvm::MD5::MD5Result result; + hash.final(result); + llvm::SmallString<32> str; + llvm::MD5::stringifyResult(result, str); + std::string hashName = "h."; + hashName.append(str.c_str()); + return uniquer.doGenerated(hashName); + } + // "Short" identifiers use a reversible hex string + return uniquer.doGenerated(llvm::toHex(name)); + } + +private: + FirConverter() = delete; + FirConverter(const FirConverter &) = delete; + FirConverter &operator=(const FirConverter &) = delete; + + //===--------------------------------------------------------------------===// + // Helper member functions + //===--------------------------------------------------------------------===// + + mlir::Value createFIRAddr(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createSomeAddress(loc, *this, *expr, localSymbols, intrinsics); + } + + mlir::Value createFIRExpr(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createSomeExpression(loc, *this, *expr, localSymbols, intrinsics); + } + mlir::Value createLogicalExprAsI1(mlir::Location loc, + const Fortran::semantics::SomeExpr *expr) { + return createI1LogicalExpression(loc, *this, *expr, localSymbols, + intrinsics); + } + mlir::Value createTemporary(mlir::Location loc, + const Fortran::semantics::Symbol &sym) { + return builder->createTemporary(loc, localSymbols, genType(sym), llvm::None, + &sym); + } + + mlir::FuncOp genFunctionFIR(llvm::StringRef callee, + mlir::FunctionType funcTy) { + if (auto func = builder->getNamedFunction(callee)) + return func; + return builder->createFunction(callee, funcTy); + } + + bool isNumericScalarCategory(Fortran::common::TypeCategory cat) { + return cat == Fortran::lower::IntegerCat || + cat == Fortran::lower::RealCat || + cat == Fortran::lower::ComplexCat || + cat == Fortran::lower::LogicalCat; + } + + bool isCharacterCategory(Fortran::common::TypeCategory cat) { + return cat == Fortran::lower::CharacterCat; + } + + void genFIRUnconditionalBranch(mlir::Block *targetBlock) { + assert(targetBlock && "missing unconditional target block"); + builder->create(toLocation(), targetBlock); + } + + void + genFIRUnconditionalBranch(Fortran::lower::pft::Evaluation *targetEvaluation) { + genFIRUnconditionalBranch(targetEvaluation->block); + } + + void genFIRConditionalBranch(mlir::Value &cond, mlir::Block *trueTarget, + mlir::Block *falseTarget) { + builder->create(toLocation(), cond, trueTarget, + llvm::None, falseTarget, llvm::None); + } + + void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr, + Fortran::lower::pft::Evaluation *trueTarget, + Fortran::lower::pft::Evaluation *falseTarget) { + assert(trueTarget && "missing conditional branch true block"); + assert(falseTarget && "missing conditional branch true block"); + mlir::Value cond = + createLogicalExprAsI1(toLocation(), Fortran::semantics::GetExpr(expr)); + genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block); + } + + // + // Termination of symbolically referenced execution units + // + + /// END of program + /// + /// Generate the cleanup block before the program exits + void genExitRoutine() { builder->create(toLocation()); } + void genFIRProgramExit() { genExitRoutine(); } + void genFIR(const Fortran::parser::EndProgramStmt &) { genFIRProgramExit(); } + + /// END of procedure-like constructs + /// + /// Generate the cleanup block before the procedure exits + void genExitFunction(mlir::Value val) { + builder->create(toLocation(), val); + } + void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { + const auto &details = + functionSymbol.get(); + auto resultRef = localSymbols.lookupSymbol(details.result()); + mlir::Value r = builder->create(toLocation(), resultRef); + genExitFunction(r); + } + + void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, + const Fortran::semantics::Symbol &symbol) { + if (Fortran::semantics::IsFunction(symbol)) { + // FUNCTION + genReturnSymbol(symbol); + return; + } + + // SUBROUTINE + if (Fortran::semantics::HasAlternateReturns(symbol)) { + // lower to a the constant expression (or zero); the return value will + // drive a SelectOp in the calling context to branch to the alternate + // return LABEL block + TODO(); + mlir::Value intExpr{}; + genExitFunction(intExpr); + return; + } + if (funit.finalBlock) + builder->setInsertionPoint(funit.finalBlock, funit.finalBlock->end()); + genExitRoutine(); + } + + // + // Statements that have control-flow semantics + // + + void switchInsertionPointToWhere(fir::WhereOp &where) { + builder->setInsertionPointToStart(&where.whereRegion().front()); + } + void switchInsertionPointToOtherwise(fir::WhereOp &where) { + builder->setInsertionPointToStart(&where.otherRegion().front()); + } + + template + mlir::OpBuilder::InsertPoint genWhereCondition(fir::WhereOp &where, + const A *stmt) { + auto cond = createLogicalExprAsI1( + toLocation(), + Fortran::semantics::GetExpr( + std::get(stmt->t))); + where = builder->create(toLocation(), cond, true); + auto insPt = builder->saveInsertionPoint(); + switchInsertionPointToWhere(where); + return insPt; + } + + mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x, + mlir::Type t) { + mlir::Value v = genExprValue(*Fortran::semantics::GetExpr(x)); + return builder->create(toLocation(), t, v); + } + + mlir::Value genFIRLoopIndex(const Fortran::parser::ScalarExpr &x) { + return genFIRLoopIndex(x, mlir::IndexType::get(&mlirContext)); + } + + mlir::FuncOp getFunc(llvm::StringRef name, mlir::FunctionType ty) { + if (auto func = builder->getNamedFunction(name)) { + assert(func.getType() == ty); + return func; + } + return builder->createFunction(name, ty); + } + + /// Lowering of CALL statement + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CallStmt &stmt) { + setCurrentPosition(stmt.v.source); + assert(stmt.typedCall && "Call was not analyzed"); + // The actual lowering is forwarded to expression lowering + // where the code is shared with function reference. + Fortran::semantics::SomeExpr expr{*stmt.typedCall}; + auto res = createFIRExpr(toLocation(), &expr); + if (res) + TODO(); // Alternate returns + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfStmt &stmt) { + if (eval.lowerAsUnstructured()) { + genFIRConditionalBranch( + std::get(stmt.t), + eval.lexicalSuccessor, eval.controlSuccessor); + return; + } + + // Generate fir.where. + fir::WhereOp where; + auto insPt = genWhereCondition(where, &stmt); + genFIR(*eval.lexicalSuccessor, /*unstructuredContext*/ false); + eval.lexicalSuccessor->skip = true; + builder->restoreInsertionPoint(insPt); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WaitStmt &stmt) { + genWaitStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ComputedGotoStmt &stmt) { + auto *exp = Fortran::semantics::GetExpr( + std::get(stmt.t)); + auto e1{genExprValue(*exp)}; + (void)e1; + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ArithmeticIfStmt &stmt) { + auto *exp = + Fortran::semantics::GetExpr(std::get(stmt.t)); + auto e1{genExprValue(*exp)}; + (void)e1; + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignedGotoStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssociateConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BlockConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ChangeTeamConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CriticalConstruct &) { + TODO(); + } + + /// Generate FIR for a DO construct. There are six variants: + /// - unstructured infinite and while loops + /// - structured and unstructured increment loops + /// - structured and unstructured concurrent loops + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DoConstruct &) { + bool unstructuredContext{eval.lowerAsUnstructured()}; + Fortran::lower::pft::Evaluation &doStmtEval = eval.evaluationList->front(); + auto *doStmt = doStmtEval.getIf(); + assert(doStmt && "missing DO statement"); + const auto &loopControl = + std::get>(doStmt->t); + llvm::SmallVector incrementLoopInfo; + const Fortran::parser::ScalarLogicalExpr *whileCondition = nullptr; + bool infiniteLoop = !loopControl.has_value(); + if (infiniteLoop) { + assert(unstructuredContext && "infinite loop must be unstructured"); + startBlock(doStmtEval.localBlocks[0]); // header block + } else if ((whileCondition = + std::get_if( + &loopControl->u))) { + assert(unstructuredContext && "while loop must be unstructured"); + startBlock(doStmtEval.localBlocks[0]); // header block + genFIRConditionalBranch(*whileCondition, doStmtEval.lexicalSuccessor, + doStmtEval.parentConstruct->constructExit); + } else if (const auto *bounds = + std::get_if( + &loopControl->u)) { + // "Normal" increment loop. + incrementLoopInfo.emplace_back(bounds->name.thing.symbol, bounds->lower, + bounds->upper, bounds->step, + genType(*bounds->name.thing.symbol)); + if (unstructuredContext) { + maybeStartBlock(doStmtEval.block); // preheader block + incrementLoopInfo[0].headerBlock = doStmtEval.localBlocks[0]; + incrementLoopInfo[0].bodyBlock = doStmtEval.lexicalSuccessor->block; + incrementLoopInfo[0].successorBlock = + doStmtEval.parentConstruct->constructExit->block; + } + } else { + const auto *concurrentInfo = + std::get_if( + &loopControl->u); + assert(concurrentInfo && "DO loop variant is invalid"); + TODO(); + // Add entries to incrementLoopInfo. (Define extra members for a mask.) + } + auto n = incrementLoopInfo.size(); + for (decltype(n) i = 0; i < n; ++i) { + genFIRIncrementLoopBegin(incrementLoopInfo[i]); + } + + // Generate loop body code. + for (auto &e : *eval.evaluationList) { + genFIR(e, unstructuredContext); + } + + // Generate end loop code. + if (infiniteLoop || whileCondition) { + genFIRUnconditionalBranch(doStmtEval.localBlocks[0]); + } else { + for (auto i = incrementLoopInfo.size(); i > 0;) + genFIRIncrementLoopEnd(incrementLoopInfo[--i]); + } + } + + /// Generate FIR to begin a structured or unstructured increment loop. + void genFIRIncrementLoopBegin(IncrementLoopInfo &info) { + auto location = toLocation(); + mlir::Type type = info.isStructured() + ? mlir::IndexType::get(builder->getContext()) + : info.loopVariableType; + auto lowerValue = genFIRLoopIndex(info.lowerExpr, type); + auto upperValue = genFIRLoopIndex(info.upperExpr, type); + info.stepValue = + info.stepExpr.has_value() + ? genFIRLoopIndex(*info.stepExpr, type) + : (info.isStructured() + ? builder->create(location, 1) + : builder->createIntegerConstant(info.loopVariableType, 1)); + assert(info.stepValue && "step value must be set"); + info.loopVariable = createTemporary(location, *info.loopVariableSym); + + // Structured loop - generate fir.loop. + if (info.isStructured()) { + info.insertionPoint = builder->saveInsertionPoint(); + info.doLoop = builder->create(location, lowerValue, + upperValue, info.stepValue); + builder->setInsertionPointToStart(info.doLoop.getBody()); + // Always store iteration ssa-value to the LCV to avoid missing any + // aliasing of the LCV. + auto lcv = builder->create( + location, info.loopVariableType, info.doLoop.getInductionVar()); + builder->create(location, lcv, info.loopVariable); + return; + } + + // Unstructured loop preheader code - initialize tripVariable, loopVariable. + auto distance = + builder->create(location, upperValue, lowerValue); + auto adjusted = + builder->create(location, distance, info.stepValue); + auto tripCount = + builder->create(location, adjusted, info.stepValue); + info.tripVariable = + builder->createTemporary(location, localSymbols, info.loopVariableType); + builder->create(location, tripCount, info.tripVariable); + builder->create(location, lowerValue, info.loopVariable); + + // Unstructured loop header code - generate loop condition. + startBlock(info.headerBlock); + mlir::Value tripVariable = + builder->create(location, info.tripVariable); + mlir::Value zero = builder->createIntegerConstant(info.loopVariableType, 0); + mlir::Value cond = builder->create( + location, mlir::CmpIPredicate::sgt, tripVariable, zero); + genFIRConditionalBranch(cond, info.bodyBlock, info.successorBlock); + } + + /// Generate FIR to end a structured or unstructured increment loop. + void genFIRIncrementLoopEnd(IncrementLoopInfo &info) { + mlir::Location location = toLocation(); + if (info.isStructured()) { + // End fir.loop. + builder->restoreInsertionPoint(info.insertionPoint); + return; + } + + // Unstructured loop - increment loopVariable. + mlir::Value loopVariable = + builder->create(location, info.loopVariable); + loopVariable = + builder->create(location, loopVariable, info.stepValue); + builder->create(location, loopVariable, info.loopVariable); + + // Unstructured loop - decrement tripVariable. + mlir::Value tripVariable = + builder->create(location, info.tripVariable); + mlir::Value one = builder->create( + location, builder->getIntegerAttr(info.loopVariableType, 1)); + tripVariable = builder->create(location, tripVariable, one); + builder->create(location, tripVariable, info.tripVariable); + genFIRUnconditionalBranch(info.headerBlock); + } + + /// Generate structured or unstructured FIR for an IF construct. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfConstruct &) { + if (eval.lowerAsStructured()) { + // Structured fir.where nest. + fir::WhereOp underWhere; + mlir::OpBuilder::InsertPoint insPt; + for (auto &e : *eval.evaluationList) { + if (auto *s = e.getIf()) { + // fir.where op + insPt = genWhereCondition(underWhere, s); + } else if (auto *s = e.getIf()) { + // otherwise block, then nested fir.where + switchInsertionPointToOtherwise(underWhere); + genWhereCondition(underWhere, s); + } else if (e.isA()) { + // otherwise block + switchInsertionPointToOtherwise(underWhere); + } else if (e.isA()) { + builder->restoreInsertionPoint(insPt); + } else { + genFIR(e, /*unstructuredContext*/ false); + } + } + return; + } + + // Unstructured branch sequence. + for (auto &e : *eval.evaluationList) { + const Fortran::parser::ScalarLogicalExpr *cond = nullptr; + if (auto *s = e.getIf()) { + maybeStartBlock(e.block); + cond = &std::get(s->t); + } else if (auto *s = e.getIf()) { + startBlock(e.block); + cond = &std::get(s->t); + } + if (cond) { + genFIRConditionalBranch( + *cond, + e.lexicalSuccessor == e.controlSuccessor + ? e.parentConstruct->constructExit // empty block --> exit + : e.lexicalSuccessor, // nonempty block + e.controlSuccessor); + } else { + genFIR(e); + } + } + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CaseConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectTypeConstruct &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereConstruct &) { + TODO(); + } + + /// Lower FORALL construct (See 10.2.4) + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallConstruct &forall) { + auto &stmt = std::get< + Fortran::parser::Statement>( + forall.t); + setCurrentPosition(stmt.source); + auto &fas = stmt.statement; + auto &ctrl = + std::get< + Fortran::common::Indirection>( + fas.t) + .value(); + (void)ctrl; + for (auto &s : + std::get>(forall.t)) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Statement< + Fortran::parser::ForallAssignmentStmt> &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + [&](const Fortran::parser::Statement + &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + [&](const Fortran::parser::WhereConstruct &b) { + genFIR(eval, b); + }, + [&](const Fortran::common::Indirection< + Fortran::parser::ForallConstruct> &b) { + genFIR(eval, b.value()); + }, + [&](const Fortran::parser::Statement + &b) { + setCurrentPosition(b.source); + genFIR(eval, b.statement); + }, + }, + s.u); + } + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallAssignmentStmt &s) { + std::visit([&](auto &b) { genFIR(eval, b); }, s.u); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CompilerDirective &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OpenMPConstruct &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OmpEndLoopDirective &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssociateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndAssociateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BlockStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndBlockStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectCaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndSelectStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ChangeTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndChangeTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CriticalStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndCriticalStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NonLabelDoStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndDoStmt &) {} // nop + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::IfThenStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElseIfStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElseStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndIfStmt &) {} // nop + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectRankCaseStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SelectTypeStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::TypeGuardStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WhereConstructStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::MaskedElsewhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ElsewhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndWhereStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ForallConstructStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndForallStmt &) { + TODO(); + } + + // + // Statements that do not have control-flow semantics + // + + // IO statements (see io.h) + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::BackspaceStmt &stmt) { + genBackspaceStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CloseStmt &stmt) { + genCloseStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EndfileStmt &stmt) { + genEndfileStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FlushStmt &stmt) { + genFlushStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::InquireStmt &stmt) { + genInquireStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::OpenStmt &stmt) { + genOpenStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PrintStmt &stmt) { + genPrintStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ReadStmt &stmt) { + genReadStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::RewindStmt &stmt) { + genRewindStatement(*this, stmt); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::WriteStmt &stmt) { + genWriteStatement(*this, stmt); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AllocateStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignmentStmt &stmt) { + assert(stmt.typedAssignment && stmt.typedAssignment->v && + "assignment analysis failed"); + const auto &assignment = *stmt.typedAssignment->v; + std::visit( // better formatting + Fortran::common::visitors{ + [&](const Fortran::evaluate::Assignment::Intrinsic &) { + const auto *sym = + Fortran::evaluate::UnwrapWholeSymbolDataRef(assignment.lhs); + if (sym && Fortran::semantics::IsAllocatable(*sym)) { + // Assignment of allocatable are more complex, the lhs + // may need to be deallocated/reallocated. + // See Fortran 2018 10.2.1.3 p3 + TODO(); + } else if (sym && Fortran::semantics::IsPointer(*sym)) { + // Target of the pointer must be assigned. + // See Fortran 2018 10.2.1.3 p2 + auto lhsType = assignment.lhs.GetType(); + assert(lhsType && "lhs cannot be typeless"); + if (isNumericScalarCategory(lhsType->category())) { + builder->create(toLocation(), + genExprValue(assignment.rhs), + genExprValue(assignment.lhs)); + } else if (isCharacterCategory(lhsType->category())) { + TODO(); + } else { + assert(lhsType->category() == Fortran::lower::DerivedCat); + TODO(); + } + } else if (assignment.lhs.Rank() > 0) { + // Array assignment + // See Fortran 2018 10.2.1.3 p5, p6, and p7 + TODO(); + } else { + // Scalar assignments + auto lhsType = assignment.lhs.GetType(); + assert(lhsType && "lhs cannot be typeless"); + if (isNumericScalarCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p8 and p9 + // Conversions are already inserted by semantic + // analysis. + builder->create(toLocation(), + genExprValue(assignment.rhs), + genExprAddr(assignment.lhs)); + } else if (isCharacterCategory(lhsType->category())) { + // Fortran 2018 10.2.1.3 p10 and p11 + // Generating value for lhs to get fir.boxchar. + auto lhs{genExprValue(assignment.lhs)}; + auto rhs{genExprValue(assignment.rhs)}; + builder->createAssign(lhs, rhs); + } else { + assert(lhsType->category() == Fortran::lower::DerivedCat); + // Fortran 2018 10.2.1.3 p12 and p13 + TODO(); + } + } + }, + [&](const Fortran::evaluate::ProcedureRef &) { + // Defined assignment: call ProcRef + TODO(); + }, + [&](const Fortran::evaluate::Assignment::BoundsSpec &) { + // Pointer assignment with possibly empty bounds-spec + TODO(); + }, + [&](const Fortran::evaluate::Assignment::BoundsRemapping &) { + // Pointer assignment with bounds-remapping + TODO(); + }, + }, + assignment.u); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ContinueStmt &) {} // nop + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DeallocateStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EventPostStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EventWaitStmt &) { + // call some runtime routine + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FormTeamStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::LockStmt &) { + // call some runtime routine + TODO(); + } + + /// Nullify pointer object list + /// + /// For each pointer object, reset the pointer to a disassociated status. + /// We do this by setting each pointer to null. + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NullifyStmt &stmt) { + for (auto &po : stmt.v) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::parser::Name &sym) { + auto ty = genType(*sym.symbol); + auto load = builder->create( + toLocation(), localSymbols.lookupSymbol(*sym.symbol)); + auto idxTy = mlir::IndexType::get(&mlirContext); + auto zero = builder->create( + toLocation(), idxTy, builder->getIntegerAttr(idxTy, 0)); + auto cast = + builder->create(toLocation(), ty, zero); + builder->create(toLocation(), cast, load); + }, + [&](const Fortran::parser::StructureComponent &) { TODO(); }, + }, + po.u); + } + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PointerAssignmentStmt &) { + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncAllStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncImagesStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncMemoryStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::SyncTeamStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::UnlockStmt &) { + // call some runtime routine + TODO(); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::AssignStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FormatStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::EntryStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::PauseStmt &) { + // call some runtime routine + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::DataStmt &) { + TODO(); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::NamelistStmt &) { + TODO(); + } + + // call FAIL IMAGE in runtime + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::FailImageStmt &stmt) { + auto callee = genRuntimeFunction( + Fortran::lower::RuntimeEntryCode::FailImageStatement, *builder); + llvm::SmallVector operands; // FAIL IMAGE has no args + builder->create(toLocation(), callee, operands); + } + + // call STOP, ERROR STOP in runtime + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::StopStmt &stmt) { + auto callee = genRuntimeFunction( + Fortran::lower::RuntimeEntryCode::StopStatement, *builder); + llvm::SmallVector operands; + builder->create(toLocation(), callee, operands); + } + + // gen expression, if any; share code with END of procedure + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ReturnStmt &stmt) { + const auto *funit = eval.getOwningProcedure(); + assert(funit && "not inside main program or a procedure"); + if (funit->isMainProgram()) { + genFIRProgramExit(); + } else { + if (stmt.v) { + // Alternate return + TODO(); + } + // an ordinary RETURN should be lowered as a GOTO to the last block of the + // SUBROUTINE + auto *subr = eval.getOwningProcedure(); + assert(subr && "RETURN not in a PROCEDURE"); + if (!subr->finalBlock) { + auto insPt = builder->saveInsertionPoint(); + subr->finalBlock = builder->createBlock(&builder->getRegion()); + builder->restoreInsertionPoint(insPt); + } + builder->create(toLocation(), subr->finalBlock); + } + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::CycleStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::ExitStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + void genFIR(Fortran::lower::pft::Evaluation &eval, + const Fortran::parser::GotoStmt &) { + genFIRUnconditionalBranch(eval.controlSuccessor); + } + + void genFIR(Fortran::lower::pft::Evaluation &eval, + bool unstructuredContext = true) { + if (eval.skip) + return; // rhs of {Forall,If,Where}Stmt has already been processed + + setCurrentPosition(eval.position); + if (unstructuredContext) { + // When transitioning from unstructured to structured code, + // the structured code might be a target that starts a new block. + maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() + ? eval.evaluationList->front().block + : eval.block); + } + eval.visit([&](const auto &stmt) { genFIR(eval, stmt); }); + if (unstructuredContext && eval.isActionStmt() && eval.controlSuccessor && + eval.controlSuccessor->block && blockIsUnterminated()) { + // Exit from an unstructured IF or SELECT construct block. + genFIRUnconditionalBranch(eval.controlSuccessor); + } + } + + mlir::FuncOp createNewFunction(mlir::Location loc, llvm::StringRef name, + const Fortran::semantics::Symbol *symbol) { + mlir::FunctionType ty = + symbol ? genFunctionType(*symbol) + : mlir::FunctionType::get(llvm::None, llvm::None, &mlirContext); + return Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty); + } + + /// Temporary helper to detect shapes that do not require evaluating + /// bound expressions at runtime or to get the shape from a descriptor. + static bool isConstantShape(const Fortran::semantics::ArraySpec &shape) { + auto isConstant{[](const auto &bound) { + const auto &expr = bound.GetExplicit(); + return expr.has_value() && Fortran::evaluate::IsConstantExpr(*expr); + }}; + for (const auto &susbcript : shape) { + const auto &lb = susbcript.lbound(); + const auto &ub = susbcript.ubound(); + if (isConstant(lb) && (isConstant(ub) || ub.isAssumed())) + break; + return false; + } + return true; + } + + /// Evaluate specification expressions of local symbol and add + /// the resulting mlir::value to localSymbols. + /// Before evaluating a specification expression, the symbols + /// appearing in the expression are gathered, and if they are also + /// local symbols, their specification are evaluated first. In case + /// a circular dependency occurs, this will crash. + void instantiateLocalVariable( + const Fortran::semantics::Symbol &symbol, + Fortran::lower::SymMap &dummyArgs, + llvm::DenseSet attempted) { + if (localSymbols.lookupSymbol(symbol)) + return; // already instantiated + + if (IsProcedure(symbol)) + return; + + if (symbol.has() || + symbol.has()) + TODO(); // Need to keep the localSymbols of other units ? + + if (attempted.find(symbol) != attempted.end()) + TODO(); // Complex dependencies in specification expressions. + + attempted.insert(symbol); + mlir::Value localValue; + auto *type = symbol.GetType(); + assert(type && "expected type for local symbol"); + + if (type->category() == Fortran::semantics::DeclTypeSpec::Character) { + const auto &lengthParam = type->characterTypeSpec().length(); + if (auto expr = lengthParam.GetExplicit()) { + for (const auto &requiredSymbol : + Fortran::evaluate::CollectSymbols(*expr)) { + instantiateLocalVariable(requiredSymbol, dummyArgs, attempted); + } + auto lenValue = + genExprValue(Fortran::evaluate::AsGenericExpr(std::move(*expr))); + if (auto actual = dummyArgs.lookupSymbol(symbol)) { + auto unboxed = builder->createUnboxChar(actual); + localValue = builder->createEmboxChar(unboxed.first, lenValue); + } else { + // TODO: propagate symbol name to FIR. + localValue = builder->createCharacterTemp(genType(symbol), lenValue); + } + } else if (lengthParam.isDeferred()) { + TODO(); + } else { + // Assumed + localValue = dummyArgs.lookupSymbol(symbol); + assert(localValue && + "expected dummy arguments when length not explicit"); + } + localSymbols.addSymbol(symbol, localValue); + } else if (!type->AsIntrinsic()) { + TODO(); // Derived type / polymorphic + } else { + if (auto actualValue = dummyArgs.lookupSymbol(symbol)) + localSymbols.addSymbol(symbol, actualValue); + else + createTemporary(toLocation(), symbol); + } + if (const auto *details = + symbol.detailsIf()) { + // For now, only allow compile time constant shapes that do no require + // to evaluate bounds expression here. Assumed size are also supported. + if (!isConstantShape(details->shape())) + TODO(); + // handle bounds specification expressions + if (!details->coshape().empty()) + TODO(); // handle cobounds specification expressions + if (details->init()) + TODO(); // init + } else { + assert(symbol.has()); + TODO(); // Procedure pointers + } + attempted.erase(symbol); + } + + /// Prepare to translate a new function + void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + assert(!builder && "expected nullptr"); + // get mangled name + std::string name = funit.isMainProgram() + ? uniquer.doProgramEntry().str() + : mangleName(funit.getSubprogramSymbol()); + + // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably + // should just stash the location in the funit regardless. + mlir::Location loc = toLocation(funit.getStartingSourceLoc()); + mlir::FuncOp func = + Fortran::lower::FirOpBuilder::getNamedFunction(module, name); + if (!func) + func = createNewFunction(loc, name, funit.symbol); + builder = new Fortran::lower::FirOpBuilder(func); + assert(builder && "FirOpBuilder did not instantiate"); + func.addEntryBlock(); + builder->setInsertionPointToStart(&func.front()); + + Fortran::lower::SymMap dummyAssociations; + // plumb function's arguments + if (funit.symbol && !funit.isMainProgram()) { + auto *entryBlock = &func.front(); + const auto &details = + funit.symbol->get(); + for (const auto &v : + llvm::zip(details.dummyArgs(), entryBlock->getArguments())) { + if (std::get<0>(v)) { + dummyAssociations.addSymbol(*std::get<0>(v), std::get<1>(v)); + } else { + TODO(); // handle alternate return + } + } + + // Go through the symbol scope and evaluate specification expressions + llvm::DenseSet attempted; + assert(funit.symbol->scope() && "subprogram symbol must have a scope"); + // TODO: This loop through scope symbols offers no stability guarantee + // regarding the order. This should not be a problem given how + // instantiateLocalVariable is implemented, but may harm reproducibility. + // A solution would be to sort the symbol based on their source location. + for (const auto &iter : *funit.symbol->scope()) { + instantiateLocalVariable(iter.second.get(), dummyAssociations, + attempted); + } + + // if (details.isFunction()) + // createTemporary(toLocation(), details.result()); + } + + // Create most function blocks in advance. + createEmptyBlocks(funit.evaluationList); + + // Reinstate entry block as the current insertion point. + builder->setInsertionPointToEnd(&func.front()); + } + + /// Create empty blocks for the current function. + void createEmptyBlocks( + std::list &evaluationList) { + for (auto &eval : evaluationList) { + if (eval.isNewBlock) + eval.block = builder->createBlock(&builder->getRegion()); + for (size_t i = 0, n = eval.localBlocks.size(); i < n; ++i) + eval.localBlocks[i] = builder->createBlock(&builder->getRegion()); + if (eval.isConstruct()) { + if (eval.lowerAsUnstructured()) { + createEmptyBlocks(*eval.evaluationList); + } else { + // A structured construct that is a target starts a new block. + Fortran::lower::pft::Evaluation &constructStmt = + eval.evaluationList->front(); + if (constructStmt.isNewBlock) + constructStmt.block = builder->createBlock(&builder->getRegion()); + } + } + } + } + + /// Return the predicate: "current block does not have a terminator branch". + bool blockIsUnterminated() { + auto *currentBlock = builder->getBlock(); + return currentBlock->empty() || currentBlock->back().isKnownNonTerminator(); + } + + /// Unconditionally switch code insertion to a new block. + void startBlock(mlir::Block *newBlock) { + assert(newBlock && "missing block"); + // If the current block does not have a terminator branch, + // append a fallthrough branch. + if (blockIsUnterminated()) + genFIRUnconditionalBranch(newBlock); + builder->setInsertionPointToStart(newBlock); + } + + /// Conditionally switch code insertion to a new block. + void maybeStartBlock(mlir::Block *newBlock) { + if (newBlock) + startBlock(newBlock); + } + + /// Emit return and cleanup after the function has been translated. + void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { + setCurrentPosition( + Fortran::lower::pft::FunctionLikeUnit::stmtSourceLoc(funit.endStmt)); + + if (funit.isMainProgram()) { + genFIRProgramExit(); + } else { + genFIRProcedureExit(funit, funit.getSubprogramSymbol()); + } + + delete builder; + builder = nullptr; + localSymbols.clear(); + } + + /// Lower a procedure-like construct + void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { + startNewFunction(funit); + // lower this procedure + for (auto &eval : funit.evaluationList) + genFIR(eval); + + endNewFunction(funit); + // recursively lower internal procedures + for (auto &f : funit.nestedFunctions) + lowerFunc(f); + } + + void lowerMod(Fortran::lower::pft::ModuleLikeUnit &mod) { + // FIXME: do we need to visit the module statements? + for (auto &f : mod.nestedFunctions) + lowerFunc(f); + } + + void setCurrentPosition(const Fortran::parser::CharBlock &position) { + if (position != Fortran::parser::CharBlock{}) + currentPosition = position; + } + + // + // Utility methods + // + + /// Convert a parser CharBlock to a Location + mlir::Location toLocation(const Fortran::parser::CharBlock &cb) { + return genLocation(cb); + } + + mlir::Location toLocation() { return toLocation(currentPosition); } + + // TODO: should these be moved to convert-expr? + template + mlir::Value genCompare(mlir::Value lhs, mlir::Value rhs) { + auto lty = lhs.getType(); + assert(lty == rhs.getType()); + if (lty.isSignlessIntOrIndex()) + return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); + if (fir::LogicalType::kindof(lty.getKind())) + return builder->create(lhs.getLoc(), ICMPOPC, lhs, rhs); + if (fir::CharacterType::kindof(lty.getKind())) { + // FIXME + // return builder->create(lhs->getLoc(), ); + } + mlir::emitError(toLocation(), "cannot generate operation on this type"); + return {}; + } + + mlir::Value genGE(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genLE(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genEQ(mlir::Value lhs, mlir::Value rhs) { + return genCompare(lhs, rhs); + } + mlir::Value genAND(mlir::Value lhs, mlir::Value rhs) { + return builder->create(lhs.getLoc(), lhs, rhs); + } + + mlir::MLIRContext &mlirContext; + const Fortran::parser::CookedSource *cooked; + mlir::ModuleOp &module; + const Fortran::common::IntrinsicTypeDefaultKinds &defaults; + Fortran::lower::IntrinsicLibrary intrinsics; + Fortran::lower::FirOpBuilder *builder = nullptr; + fir::NameUniquer &uniquer; + Fortran::lower::SymMap localSymbols; + Fortran::parser::CharBlock currentPosition; +}; + +} // namespace + +void Fortran::lower::LoweringBridge::lower(const Fortran::parser::Program &prg, + fir::NameUniquer &uniquer) { + auto pft = Fortran::lower::createPFT(prg); + if (dumpBeforeFir) + Fortran::lower::dumpPFT(llvm::errs(), *pft); + FirConverter converter{*this, uniquer}; + converter.run(*pft); +} + +void Fortran::lower::LoweringBridge::parseSourceFile(llvm::SourceMgr &srcMgr) { + auto owningRef = mlir::parseSourceFile(srcMgr, context.get()); + module.reset(new mlir::ModuleOp(owningRef.get().getOperation())); + owningRef.release(); +} + +Fortran::lower::LoweringBridge::LoweringBridge( + const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, + const Fortran::parser::CookedSource *cooked) + : defaultKinds{defaultKinds}, cooked{cooked} { + context = std::make_unique(); + module = std::make_unique( + mlir::ModuleOp::create(mlir::UnknownLoc::get(context.get()))); +} diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt index 6cbcfc3b630e8d..bca84d621f0747 100644 --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,6 +1,23 @@ +set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-error -Wno-unused-parameter") add_flang_library(FortranLower + Bridge.cpp + ConvertExpr.cpp + ConvertType.cpp + FIRBuilder.cpp + Intrinsics.cpp + IO.cpp + Mangler.cpp PFTBuilder.cpp + Runtime.cpp +) + +target_link_libraries(FortranLower + FIRSupport + MLIRAffine + MLIRLLVMIR + MLIRLoopToStandard + MLIRStandardOps LINK_COMPONENTS Support diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp new file mode 100644 index 00000000000000..193cd47c9caa32 --- /dev/null +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -0,0 +1,979 @@ +//===-- ConvertExpr.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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/ConvertExpr.h" +#include "flang/Common/default-kinds.h" +#include "flang/Common/unwrap.h" +#include "flang/Evaluate/fold.h" +#include "flang/Evaluate/real.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/FIRBuilder.h" +#include "flang/Lower/Runtime.h" +#include "flang/Optimizer/Dialect/FIRDialect.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/symbol.h" +#include "flang/Semantics/type.h" +#include "mlir/Dialect/Affine/IR/AffineOps.h" +#include "mlir/Dialect/LLVMIR/LLVMDialect.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "mlir/IR/Attributes.h" +#include "mlir/IR/Operation.h" +#include "mlir/IR/PatternMatch.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Pass/PassManager.h" +#include "mlir/Transforms/DialectConversion.h" +#include "mlir/Transforms/Passes.h" +#include "llvm/ADT/APFloat.h" +#include "llvm/ADT/ArrayRef.h" +#include "llvm/IR/Type.h" +#include "llvm/Support/ErrorHandling.h" +#include "llvm/Support/raw_ostream.h" + +namespace { + +#define TODO() llvm_unreachable("not yet implemented") + +/// Lowering of Fortran::evaluate::Expr expressions +class ExprLowering { + mlir::Location location; + Fortran::lower::AbstractConverter &converter; + Fortran::lower::FirOpBuilder &builder; + const Fortran::lower::SomeExpr &expr; + Fortran::lower::SymMap &symMap; + const Fortran::lower::IntrinsicLibrary &intrinsics; + bool genLogicalAsI1{false}; + + mlir::Location getLoc() { return location; } + + /// Convert parser's INTEGER relational operators to MLIR. TODO: using + /// unordered, but we may want to cons ordered in certain situation. + static mlir::CmpIPredicate + translateRelational(Fortran::common::RelationalOperator rop) { + switch (rop) { + case Fortran::common::RelationalOperator::LT: + return mlir::CmpIPredicate::slt; + case Fortran::common::RelationalOperator::LE: + return mlir::CmpIPredicate::sle; + case Fortran::common::RelationalOperator::EQ: + return mlir::CmpIPredicate::eq; + case Fortran::common::RelationalOperator::NE: + return mlir::CmpIPredicate::ne; + case Fortran::common::RelationalOperator::GT: + return mlir::CmpIPredicate::sgt; + case Fortran::common::RelationalOperator::GE: + return mlir::CmpIPredicate::sge; + } + llvm_unreachable("unhandled INTEGER relational operator"); + } + + /// Convert parser's REAL relational operators to MLIR. + /// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018 + /// requirements in the IEEE context (table 17.1 of F2018). This choice is + /// also applied in other contexts because it is easier and in line with + /// other Fortran compilers. + /// FIXME: The signaling/quiet aspect of the table 17.1 requirement is not + /// fully enforced. FIR and LLVM `fcmp` instructions do not give any guarantee + /// whether the comparison will signal or not in case of quiet NaN argument. + static mlir::CmpFPredicate + translateFloatRelational(Fortran::common::RelationalOperator rop) { + switch (rop) { + case Fortran::common::RelationalOperator::LT: + return mlir::CmpFPredicate::OLT; + case Fortran::common::RelationalOperator::LE: + return mlir::CmpFPredicate::OLE; + case Fortran::common::RelationalOperator::EQ: + return mlir::CmpFPredicate::OEQ; + case Fortran::common::RelationalOperator::NE: + return mlir::CmpFPredicate::UNE; + case Fortran::common::RelationalOperator::GT: + return mlir::CmpFPredicate::OGT; + case Fortran::common::RelationalOperator::GE: + return mlir::CmpFPredicate::OGE; + } + llvm_unreachable("unhandled REAL relational operator"); + } + + /// Generate an integral constant of `value` + template + mlir::Value genIntegerConstant(mlir::MLIRContext *context, + std::int64_t value) { + auto type = converter.genType(Fortran::lower::IntegerCat, KIND); + auto attr = builder.getIntegerAttr(type, value); + auto res = builder.create(getLoc(), type, attr); + return res.getResult(); + } + + /// Generate a logical/boolean constant of `value` + mlir::Value genLogicalConstantAsI1(mlir::MLIRContext *context, bool value) { + auto i1Type = mlir::IntegerType::get(1, builder.getContext()); + auto attr = builder.getIntegerAttr(i1Type, value ? 1 : 0); + return builder.create(getLoc(), i1Type, attr).getResult(); + } + + template + mlir::Value genRealConstant(mlir::MLIRContext *context, + const llvm::APFloat &value) { + auto fltTy = Fortran::lower::convertReal(context, KIND); + auto attr = builder.getFloatAttr(fltTy, value); + auto res = builder.create(getLoc(), fltTy, attr); + return res.getResult(); + } + + mlir::Type getSomeKindInteger() { + return mlir::IndexType::get(builder.getContext()); + } + + template + mlir::Value createBinaryOp(const A &ex, mlir::Value lhs, mlir::Value rhs) { + assert(lhs && rhs && "argument did not lower"); + auto x = builder.create(getLoc(), lhs, rhs); + return x.getResult(); + } + template + mlir::Value createBinaryOp(const A &ex, mlir::Value rhs) { + return createBinaryOp(ex, genval(ex.left()), rhs); + } + template + mlir::Value createBinaryOp(const A &ex) { + return createBinaryOp(ex, genval(ex.left()), genval(ex.right())); + } + + mlir::FuncOp getFunction(llvm::StringRef name, mlir::FunctionType funTy) { + if (auto func = builder.getNamedFunction(name)) { + assert(func.getType() == funTy && + "function already declared with a different type"); + return func; + } + return builder.createFunction(name, funTy); + } + + // FIXME binary operation :: ('a, 'a) -> 'a + template + mlir::FunctionType createFunctionType() { + if constexpr (TC == Fortran::lower::IntegerCat) { + auto output = converter.genType(Fortran::lower::IntegerCat, KIND); + llvm::SmallVector inputs; + inputs.push_back(output); + inputs.push_back(output); + return mlir::FunctionType::get(inputs, output, builder.getContext()); + } else if constexpr (TC == Fortran::lower::RealCat) { + auto output = Fortran::lower::convertReal(builder.getContext(), KIND); + llvm::SmallVector inputs; + inputs.push_back(output); + inputs.push_back(output); + return mlir::FunctionType::get(inputs, output, builder.getContext()); + } else { + llvm_unreachable("this category is not implemented"); + } + } + + template + mlir::Value createCompareOp(const A &ex, mlir::CmpIPredicate pred, + mlir::Value lhs, mlir::Value rhs) { + assert(lhs && rhs && "argument did not lower"); + auto x = builder.create(getLoc(), pred, lhs, rhs); + return x.getResult(); + } + template + mlir::Value createCompareOp(const A &ex, mlir::CmpIPredicate pred) { + return createCompareOp(ex, pred, genval(ex.left()), + genval(ex.right())); + } + template + mlir::Value createFltCmpOp(const A &ex, mlir::CmpFPredicate pred, + mlir::Value lhs, mlir::Value rhs) { + assert(lhs && rhs && "argument did not lower"); + auto x = builder.create(getLoc(), pred, lhs, rhs); + return x.getResult(); + } + template + mlir::Value createFltCmpOp(const A &ex, mlir::CmpFPredicate pred) { + return createFltCmpOp(ex, pred, genval(ex.left()), + genval(ex.right())); + } + + /// Returns a reference to a symbol or its box/boxChar descriptor if it has + /// one. + mlir::Value gen(Fortran::semantics::SymbolRef sym) { + // FIXME: not all symbols are local + auto addr = builder.createTemporary( + getLoc(), symMap, converter.genType(sym), llvm::None, &*sym); + assert(addr && "failed generating symbol address"); + return addr; + } + + mlir::Value gendef(Fortran::semantics::SymbolRef sym) { return gen(sym); } + + mlir::Value genval(Fortran::semantics::SymbolRef sym) { + auto var = gen(sym); + if (fir::isReferenceLike(var.getType())) + return builder.create(getLoc(), var); + return var; + } + + mlir::Value genval(const Fortran::evaluate::BOZLiteralConstant &) { TODO(); } + mlir::Value genval(const Fortran::evaluate::ProcedureRef &procRef) { + llvm::SmallVector resTy; + return genProcedureRef(procRef, resTy); + } + mlir::Value genval(const Fortran::evaluate::ProcedureDesignator &) { TODO(); } + mlir::Value genval(const Fortran::evaluate::NullPointer &) { TODO(); } + mlir::Value genval(const Fortran::evaluate::StructureConstructor &) { + TODO(); + } + mlir::Value genval(const Fortran::evaluate::ImpliedDoIndex &) { TODO(); } + mlir::Value genval(const Fortran::evaluate::DescriptorInquiry &desc) { + auto descRef = symMap.lookupSymbol(desc.base().GetLastSymbol()); + assert(descRef && "no mlir::Value associated to Symbol"); + auto descType = descRef.getType(); + mlir::Value res{}; + switch (desc.field()) { + case Fortran::evaluate::DescriptorInquiry::Field::Len: + if (descType.isa()) { + auto lenType{mlir::IntegerType::get(64, builder.getContext())}; + res = builder.create(getLoc(), lenType, descRef); + } else if (descType.isa()) { + TODO(); + } else { + llvm_unreachable("not a descriptor"); + } + break; + default: + TODO(); + } + return res; + } + + template + mlir::Value genval(const Fortran::evaluate::TypeParamInquiry &) { + TODO(); + } + + template + mlir::Value genval(const Fortran::evaluate::ComplexComponent &part) { + builder.setLocation(getLoc()); + return builder.extractComplexPart(genval(part.left()), + part.isImaginaryPart); + } + + template + mlir::Value genval( + const Fortran::evaluate::Negate> &op) { + auto input = genval(op.left()); + if constexpr (TC == Fortran::lower::IntegerCat) { + // Currently no Standard/FIR op for integer negation. + auto zero = genIntegerConstant(builder.getContext(), 0); + return builder.create(getLoc(), zero, input); + } else if constexpr (TC == Fortran::lower::RealCat) { + return builder.create(getLoc(), input); + } else { + static_assert(TC == Fortran::lower::ComplexCat, "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + mlir::Value + genval(const Fortran::evaluate::Add> &op) { + if constexpr (TC == Fortran::lower::IntegerCat) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::lower::RealCat) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::lower::ComplexCat, "Expected numeric type"); + return createBinaryOp(op); + } + } + template + mlir::Value + genval(const Fortran::evaluate::Subtract> + &op) { + if constexpr (TC == Fortran::lower::IntegerCat) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::lower::RealCat) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::lower::ComplexCat, "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + mlir::Value + genval(const Fortran::evaluate::Multiply> + &op) { + if constexpr (TC == Fortran::lower::IntegerCat) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::lower::RealCat) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::lower::ComplexCat, "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + mlir::Value genval( + const Fortran::evaluate::Divide> &op) { + if constexpr (TC == Fortran::lower::IntegerCat) { + return createBinaryOp(op); + } else if constexpr (TC == Fortran::lower::RealCat) { + return createBinaryOp(op); + } else { + static_assert(TC == Fortran::lower::ComplexCat, "Expected numeric type"); + return createBinaryOp(op); + } + } + + template + mlir::Value genval( + const Fortran::evaluate::Power> &op) { + llvm::SmallVector operands{genval(op.left()), + genval(op.right())}; + auto ty = converter.genType(TC, KIND); + return intrinsics.genval(getLoc(), builder, "pow", ty, operands); + } + + template + mlir::Value genval( + const Fortran::evaluate::RealToIntPower> + &op) { + // TODO: runtime as limited integer kind support. Look if the conversions + // are ok + llvm::SmallVector operands{genval(op.left()), + genval(op.right())}; + auto ty = converter.genType(TC, KIND); + return intrinsics.genval(getLoc(), builder, "pow", ty, operands); + } + + template + mlir::Value genval(const Fortran::evaluate::ComplexConstructor &op) { + builder.setLocation(getLoc()); + return builder.createComplex(KIND, genval(op.left()), genval(op.right())); + } + + template + mlir::Value genval(const Fortran::evaluate::Concat &op) { + TODO(); + } + + /// MIN and MAX operations + template + mlir::Value + genval(const Fortran::evaluate::Extremum> + &op) { + std::string name = + op.ordering == Fortran::evaluate::Ordering::Greater ? "max"s : "min"s; + auto type = converter.genType(TC, KIND); + llvm::SmallVector operands{genval(op.left()), + genval(op.right())}; + return intrinsics.genval(getLoc(), builder, name, type, operands); + } + + template + mlir::Value genval(const Fortran::evaluate::SetLength &) { + TODO(); + } + + template + mlir::Value + genval(const Fortran::evaluate::Relational> + &op) { + mlir::Value result{}; + if constexpr (TC == Fortran::lower::IntegerCat) { + result = createCompareOp(op, translateRelational(op.opr)); + } else if constexpr (TC == Fortran::lower::RealCat) { + result = + createFltCmpOp(op, translateFloatRelational(op.opr)); + } else if constexpr (TC == Fortran::lower::ComplexCat) { + bool eq{op.opr == Fortran::common::RelationalOperator::EQ}; + assert(eq || op.opr == Fortran::common::RelationalOperator::NE && + "relation undefined for complex"); + builder.setLocation(getLoc()); + result = builder.createComplexCompare(genval(op.left()), + genval(op.right()), eq); + } else { + static_assert(TC == Fortran::lower::CharacterCat); + TODO(); + } + return result; + } + + mlir::Value + genval(const Fortran::evaluate::Relational &op) { + return std::visit([&](const auto &x) { return genval(x); }, op.u); + } + + template + mlir::Value + genval(const Fortran::evaluate::Convert, + TC2> &convert) { + auto ty = converter.genType(TC1, KIND); + auto operand = genval(convert.left()); + if (TC1 == Fortran::lower::LogicalCat && genLogicalAsI1) { + // If an i1 result is needed, it does not make sens to convert between + // `fir.logical` types to later convert back to the result to i1. + return operand; + } + return builder.create(getLoc(), ty, operand); + } + + template + mlir::Value genval(const Fortran::evaluate::Parentheses &op) { + auto input = genval(op.left()); + return builder.create(getLoc(), input.getType(), input); + } + + template + mlir::Value genval(const Fortran::evaluate::Not &op) { + // Request operands to be generated as `i1` and restore after this scope. + auto restorer = Fortran::common::ScopedSet(genLogicalAsI1, true); + auto *context = builder.getContext(); + auto logical = genval(op.left()); + auto one = genLogicalConstantAsI1(context, true); + return builder.create(getLoc(), logical, one).getResult(); + } + + template + mlir::Value genval(const Fortran::evaluate::LogicalOperation &op) { + // Request operands to be generated as `i1` and restore after this scope. + auto restorer = Fortran::common::ScopedSet(genLogicalAsI1, true); + mlir::Value result; + switch (op.logicalOperator) { + case Fortran::evaluate::LogicalOperator::And: + result = createBinaryOp(op); + break; + case Fortran::evaluate::LogicalOperator::Or: + result = createBinaryOp(op); + break; + case Fortran::evaluate::LogicalOperator::Eqv: + result = createCompareOp(op, mlir::CmpIPredicate::eq); + break; + case Fortran::evaluate::LogicalOperator::Neqv: + result = createCompareOp(op, mlir::CmpIPredicate::ne); + break; + case Fortran::evaluate::LogicalOperator::Not: + // lib/evaluate expression for .NOT. is Fortran::evaluate::Not. + llvm_unreachable(".NOT. is not a binary operator"); + break; + } + if (!result) + llvm_unreachable("unhandled logical operation"); + return result; + } + + /// Construct a CHARACTER literal + template + mlir::Value genCharLit(const E &data, int64_t size) { + auto type = fir::SequenceType::get( + {size}, fir::CharacterType::get(builder.getContext(), KIND)); + // FIXME: for wider char types, use an array of i16 or i32 + // for now, just fake it that it's a i8 to get it past the C++ compiler + if constexpr (KIND == 1) { + std::string globalName = converter.uniqueCGIdent(data); + auto global = builder.getNamedGlobal(globalName); + if (!global) + global = builder.createGlobalConstant( + getLoc(), type, globalName, + [&](Fortran::lower::FirOpBuilder &builder) { + auto context = builder.getContext(); + auto strAttr = mlir::StringAttr::get(data.c_str(), context); + auto valTag = + mlir::Identifier::get(fir::StringLitOp::value(), context); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = + mlir::Identifier::get(fir::StringLitOp::size(), context); + mlir::NamedAttribute sizeAttr(sizeTag, + builder.getI64IntegerAttr(size)); + llvm::SmallVector attrs{dataAttr, + sizeAttr}; + auto str = builder.create( + getLoc(), llvm::ArrayRef{type}, llvm::None, + attrs); + builder.create(getLoc(), str); + }); + return builder.create(getLoc(), global.resultType(), + global.getSymbol()); + } + auto context = builder.getContext(); + auto valTag = mlir::Identifier::get(fir::StringLitOp::value(), context); + auto strAttr = mlir::StringAttr::get((const char *)data.c_str(), context); + mlir::NamedAttribute dataAttr(valTag, strAttr); + auto sizeTag = mlir::Identifier::get(fir::StringLitOp::size(), context); + mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(size)); + llvm::SmallVector attrs{dataAttr, sizeAttr}; + return builder.create( + getLoc(), llvm::ArrayRef{type}, llvm::None, attrs); + } + + template + mlir::Value + genval(const Fortran::evaluate::Constant> + &con) { + // TODO: + // - character type constant + // - array constant not handled + // - derived type constant + if constexpr (TC == Fortran::lower::IntegerCat) { + auto opt = con.GetScalarValue(); + if (opt.has_value()) + return genIntegerConstant(builder.getContext(), opt->ToInt64()); + llvm_unreachable("integer constant has no value"); + } else if constexpr (TC == Fortran::lower::LogicalCat) { + auto opt = con.GetScalarValue(); + if (opt.has_value()) + return genLogicalConstantAsI1(builder.getContext(), opt->IsTrue()); + llvm_unreachable("logical constant has no value"); + } else if constexpr (TC == Fortran::lower::RealCat) { + auto opt = con.GetScalarValue(); + if (opt.has_value()) { + std::string str = opt.value().DumpHexadecimal(); + if constexpr (KIND == 2) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEhalf(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 4) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEsingle(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 10) { + llvm::APFloat floatVal{llvm::APFloatBase::x87DoubleExtended(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else if constexpr (KIND == 16) { + llvm::APFloat floatVal{llvm::APFloatBase::IEEEquad(), str}; + return genRealConstant(builder.getContext(), floatVal); + } else { + // convert everything else to double + llvm::APFloat floatVal{llvm::APFloatBase::IEEEdouble(), str}; + return genRealConstant(builder.getContext(), floatVal); + } + } + llvm_unreachable("real constant has no value"); + } else if constexpr (TC == Fortran::lower::ComplexCat) { + auto opt = con.GetScalarValue(); + if (opt.has_value()) { + using TR = Fortran::evaluate::Type; + return genval(Fortran::evaluate::ComplexConstructor{ + Fortran::evaluate::Expr{ + Fortran::evaluate::Constant{opt->REAL()}}, + Fortran::evaluate::Expr{ + Fortran::evaluate::Constant{opt->AIMAG()}}}); + } + llvm_unreachable("array of complex unhandled"); + } else if constexpr (TC == Fortran::lower::CharacterCat) { + return genCharLit(con.GetScalarValue().value(), con.LEN()); + } else { + llvm_unreachable("unhandled constant"); + } + } + + template + mlir::Value genval( + const Fortran::evaluate::Constant> &con) { + if constexpr (TC == Fortran::lower::IntegerCat) { + auto opt = (*con).ToInt64(); + auto type = getSomeKindInteger(); + auto attr = builder.getIntegerAttr(type, opt); + auto res = builder.create(getLoc(), type, attr); + return res.getResult(); + } else { + llvm_unreachable("unhandled constant of unknown kind"); + } + } + + template + mlir::Value genval(const Fortran::evaluate::ArrayConstructor &) { + TODO(); + } + mlir::Value gen(const Fortran::evaluate::ComplexPart &) { TODO(); } + mlir::Value gendef(const Fortran::evaluate::ComplexPart &cp) { + return gen(cp); + } + mlir::Value genval(const Fortran::evaluate::ComplexPart &) { TODO(); } + + mlir::Value gen(const Fortran::evaluate::Substring &s) { + // Get base string + auto baseString = std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::DataRef &x) { return gen(x); }, + [&](const Fortran::evaluate::StaticDataObject::Pointer &) + -> mlir::Value { TODO(); }, + }, + s.parent()); + llvm::SmallVector bounds; + bounds.push_back(genval(s.lower())); + if (auto upperBound{s.upper()}) { + bounds.push_back(genval(*upperBound)); + } + return builder.createSubstring(baseString, bounds); + } + + mlir::Value gendef(const Fortran::evaluate::Substring &ss) { return gen(ss); } + mlir::Value genval(const Fortran::evaluate::Substring &ss) { return gen(ss); } + mlir::Value genval(const Fortran::evaluate::Triplet &trip) { TODO(); } + + mlir::Value genval(const Fortran::evaluate::Subscript &subs) { + return std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::IndirectSubscriptIntegerExpr &x) { + return genval(x.value()); + }, + [&](const Fortran::evaluate::Triplet &x) { return genval(x); }, + }, + subs.u); + } + + mlir::Value gen(const Fortran::evaluate::DataRef &dref) { + return std::visit([&](const auto &x) { return gen(x); }, dref.u); + } + mlir::Value gendef(const Fortran::evaluate::DataRef &dref) { + return gen(dref); + } + mlir::Value genval(const Fortran::evaluate::DataRef &dref) { + return std::visit([&](const auto &x) { return genval(x); }, dref.u); + } + + // Helper function to turn the left-recursive Component structure into a list. + // Returns the object used as the base coordinate for the component chain. + static Fortran::evaluate::DataRef const * + reverseComponents(const Fortran::evaluate::Component &cmpt, + std::list &list) { + list.push_front(&cmpt); + return std::visit(Fortran::common::visitors{ + [&](const Fortran::evaluate::Component &x) { + return reverseComponents(x, list); + }, + [&](auto &) { return &cmpt.base(); }, + }, + cmpt.base().u); + } + + // Return the coordinate of the component reference + mlir::Value gen(const Fortran::evaluate::Component &cmpt) { + std::list list; + auto *base = reverseComponents(cmpt, list); + llvm::SmallVector coorArgs; + auto obj = gen(*base); + auto *sym = &cmpt.GetFirstSymbol(); + auto ty = converter.genType(*sym); + for (auto *field : list) { + sym = &field->GetLastSymbol(); + auto name = sym->name().ToString(); + // FIXME: as we're walking the chain of field names, we need to update the + // subtype as we drill down + coorArgs.push_back(builder.create(getLoc(), name, ty)); + } + assert(sym && "no component(s)?"); + ty = fir::ReferenceType::get(ty); + return builder.create(getLoc(), ty, obj, coorArgs); + } + + mlir::Value gendef(const Fortran::evaluate::Component &cmpt) { + return gen(cmpt); + } + mlir::Value genval(const Fortran::evaluate::Component &cmpt) { + return builder.create(getLoc(), gen(cmpt)); + } + + // Determine the result type after removing `dims` dimensions from the array + // type `arrTy` + mlir::Type genSubType(mlir::Type arrTy, unsigned dims) { + auto unwrapTy = arrTy.cast().getEleTy(); + auto seqTy = unwrapTy.cast(); + auto shape = seqTy.getShape(); + assert(shape.size() > 0 && "removing columns for sequence sans shape"); + assert(dims <= shape.size() && "removing more columns than exist"); + fir::SequenceType::Shape newBnds; + // follow Fortran semantics and remove columns (from right) + auto e{shape.size() - dims}; + for (decltype(e) i{0}; i < e; ++i) + newBnds.push_back(shape[i]); + if (!newBnds.empty()) + return fir::SequenceType::get(newBnds, seqTy.getEleTy()); + return seqTy.getEleTy(); + } + + // Generate the code for a Bound value. + mlir::Value genval(const Fortran::semantics::Bound &bound) { + if (bound.isExplicit()) { + auto sub = bound.GetExplicit(); + if (sub.has_value()) + return genval(*sub); + return genIntegerConstant<8>(builder.getContext(), 1); + } + TODO(); + } + + mlir::Value genArrayRefComponent(const Fortran::evaluate::ArrayRef &aref) { + mlir::Value base = gen(aref.base().GetComponent()); + llvm::SmallVector args; + for (auto &subsc : aref.subscript()) + args.push_back(genval(subsc)); + auto ty = genSubType(base.getType(), args.size()); + ty = fir::ReferenceType::get(ty); + return builder.create(getLoc(), ty, base, args); + } + + // Return the coordinate of the array reference + mlir::Value gen(const Fortran::evaluate::ArrayRef &aref) { + if (aref.base().IsSymbol()) { + auto &symbol = aref.base().GetFirstSymbol(); + mlir::Value base = gen(symbol); + auto &shape = + symbol.get().shape(); + unsigned i = 0; + llvm::SmallVector args; + for (auto &subsc : aref.subscript()) { + auto val = genval(subsc); + auto adj = genval(shape[i++].lbound()); + auto ty = val.getType(); + args.push_back(builder.create(getLoc(), ty, val, adj)); + } + auto ty = genSubType(base.getType(), args.size()); + ty = fir::ReferenceType::get(ty); + return builder.create(getLoc(), ty, base, args); + } + return genArrayRefComponent(aref); + } + + mlir::Value gendef(const Fortran::evaluate::ArrayRef &aref) { + return gen(aref); + } + + mlir::Value genval(const Fortran::evaluate::ArrayRef &aref) { + return builder.create(getLoc(), gen(aref)); + } + + // Return a coordinate of the coarray reference. This is necessary as a + // Component may have a CoarrayRef as its base coordinate. + mlir::Value gen(const Fortran::evaluate::CoarrayRef &coref) { + // FIXME: need to visit the cosubscripts... + // return gen(coref.base()); + TODO(); + } + mlir::Value gendef(const Fortran::evaluate::CoarrayRef &coref) { + return gen(coref); + } + mlir::Value genval(const Fortran::evaluate::CoarrayRef &coref) { + return builder.create(getLoc(), gen(coref)); + } + + template + mlir::Value gen(const Fortran::evaluate::Designator &des) { + return std::visit([&](const auto &x) { return gen(x); }, des.u); + } + template + mlir::Value gendef(const Fortran::evaluate::Designator &des) { + return gen(des); + } + template + mlir::Value genval(const Fortran::evaluate::Designator &des) { + return std::visit([&](const auto &x) { return genval(x); }, des.u); + } + + // call a function + template + mlir::Value gen(const Fortran::evaluate::FunctionRef &funRef) { + TODO(); + } + template + mlir::Value gendef(const Fortran::evaluate::FunctionRef &funRef) { + return gen(funRef); + } + template + mlir::Value genval(const Fortran::evaluate::FunctionRef &funRef) { + TODO(); // Derived type functions (user + intrinsics) + } + + mlir::Value + genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef, + const Fortran::evaluate::SpecificIntrinsic &intrinsic, + mlir::ArrayRef resultType) { + if (resultType.size() == 1) + TODO(); // Intrinsic subroutine + + llvm::SmallVector operands; + // Lower arguments + // For now, logical arguments for intrinsic are lowered to `fir.logical` + // so that TRANSFER can work. For some arguments, it could lead to useless + // conversions (e.g scalar MASK of MERGE will be converted to `i1`), but + // the generated code is at least correct. To improve this, the intrinsic + // lowering facility should control argument lowering. + auto restorer = Fortran::common::ScopedSet(genLogicalAsI1, false); + for (const auto &arg : procRef.arguments()) { + if (auto *expr = Fortran::evaluate::UnwrapExpr< + Fortran::evaluate::Expr>(arg)) { + operands.push_back(genval(*expr)); + } else { + operands.push_back(nullptr); // optional + } + } + // Let the intrinsic library lower the intrinsic procedure call + llvm::StringRef name{intrinsic.name}; + return intrinsics.genval(getLoc(), builder, name, resultType[0], operands); + } + + mlir::Value genProcedureRef(const Fortran::evaluate::ProcedureRef procRef, + mlir::ArrayRef resultType) { + if (const auto *intrinsic{procRef.proc().GetSpecificIntrinsic()}) { + return genIntrinsicRef(procRef, *intrinsic, resultType[0]); + } + // Implicit interface implementation only + // TODO: Explicit interface, we need to use Characterize here, + // evaluate::IntrinsicProcTable is required to use it. + llvm::SmallVector argTypes; + llvm::SmallVector operands; + // Logical arguments of user functions must be lowered to `fir.logical` + // and not `i1`. + auto restorer = Fortran::common::ScopedSet(genLogicalAsI1, false); + for (const auto &arg : procRef.arguments()) { + if (!arg.has_value()) + TODO(); // optional arguments + const auto *expr = arg->UnwrapExpr(); + if (!expr) + TODO(); // assumed type arguments + if (const auto *sym = + Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr)) { + mlir::Value argRef = symMap.lookupSymbol(*sym); + assert(argRef && "could not get symbol reference"); + argTypes.push_back(argRef.getType()); + operands.push_back(argRef); + } else { + // create a temp to store the expression value + auto val = genval(*expr); + auto addr = builder.createTemporary(getLoc(), symMap, val.getType()); + builder.create(getLoc(), val, addr); + argTypes.push_back(addr.getType()); + operands.push_back(addr); + } + } + mlir::FunctionType funTy = + mlir::FunctionType::get(argTypes, resultType, builder.getContext()); + auto funName = applyNameMangling(procRef.proc()); + getFunction(funName, funTy); + auto call = builder.create( + getLoc(), resultType, builder.getSymbolRefAttr(funName), operands); + + if (resultType.size() == 0) + return {}; // subroutine call + // For now, Fortran returned values are implemented with a single MLIR + // function return value. + assert(call.getNumResults() == 1 && + "Expected exactly one result in FUNCTION call"); + return call.getResult(0); + } + + template + mlir::Value + genval(const Fortran::evaluate::FunctionRef> + &funRef) { + llvm::SmallVector resTy; + resTy.push_back(converter.genType(TC, KIND)); + return genProcedureRef(funRef, resTy); + } + + template + mlir::Value gen(const Fortran::evaluate::Expr &exp) { + // must be a designator or function-reference (R902) + return std::visit([&](const auto &e) { return gendef(e); }, exp.u); + } + template + mlir::Value gendef(const Fortran::evaluate::Expr &exp) { + return gen(exp); + } + template + mlir::Value genval(const Fortran::evaluate::Expr &exp) { + return std::visit([&](const auto &e) { return genval(e); }, exp.u); + } + + template + mlir::Value + genval(const Fortran::evaluate::Expr< + Fortran::evaluate::Type> &exp) { + auto result = std::visit([&](const auto &e) { return genval(e); }, exp.u); + // Handle the `i1` to `fir.logical` conversions as needed. + if (result) { + mlir::Type type = result.getType(); + if (type.isa()) { + if (genLogicalAsI1) + result = builder.create(getLoc(), builder.getI1Type(), + result); + } else if (type.isa()) { + if (!genLogicalAsI1) { + auto firLogicalType = + converter.genType(Fortran::lower::LogicalCat, KIND); + result = + builder.create(getLoc(), firLogicalType, result); + } + } else if (auto seqType{type.dyn_cast_or_null()}) { + // TODO: Conversions at array level should probably be avoided. + // This depends on how array expressions will be lowered. + llvm_unreachable("logical array loads not yet implemented"); + } else { + llvm_unreachable("unexpected logical type in expression"); + } + } + return result; + } + + template + mlir::Value gendef(const A &) { + llvm_unreachable("expression error"); + } + + std::string + applyNameMangling(const Fortran::evaluate::ProcedureDesignator &proc) { + if (const auto *symbol = proc.GetSymbol()) + return converter.mangleName(*symbol); + // Do not mangle intrinsic for now + assert(proc.GetSpecificIntrinsic() && + "expected intrinsic procedure in designator"); + return proc.GetName(); + } + +public: + explicit ExprLowering(mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &vop, + Fortran::lower::SymMap &map, + const Fortran::lower::IntrinsicLibrary &intr, + bool logicalAsI1 = false) + : location{loc}, converter{converter}, + builder{converter.getFirOpBuilder()}, expr{vop}, symMap{map}, + intrinsics{intr}, genLogicalAsI1{logicalAsI1} {} + + /// Lower the expression `expr` into MLIR standard dialect + mlir::Value gen() { return gen(expr); } + mlir::Value genval() { return genval(expr); } +}; + +} // namespace + +mlir::Value Fortran::lower::createSomeExpression( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap, + const Fortran::lower::IntrinsicLibrary &intrinsics) { + return ExprLowering{loc, converter, expr, symMap, intrinsics, false}.genval(); +} + +mlir::Value Fortran::lower::createI1LogicalExpression( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap, + const Fortran::lower::IntrinsicLibrary &intrinsics) { + return ExprLowering{loc, converter, expr, symMap, intrinsics, true}.genval(); +} + +mlir::Value Fortran::lower::createSomeAddress( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::evaluate::Expr &expr, + Fortran::lower::SymMap &symMap, + const Fortran::lower::IntrinsicLibrary &intrinsics) { + return ExprLowering{loc, converter, expr, symMap, intrinsics}.gen(); +} diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp new file mode 100644 index 00000000000000..dcf2b605e66611 --- /dev/null +++ b/flang/lib/Lower/ConvertType.cpp @@ -0,0 +1,515 @@ +//===-- ConvertType.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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/ConvertType.h" +#include "../../runtime/io-api.h" +#include "flang/Lower/Bridge.h" +#include "flang/Lower/Utils.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/tools.h" +#include "flang/Semantics/type.h" +#include "mlir/IR/Builders.h" +#include "mlir/IR/Location.h" +#include "mlir/IR/MLIRContext.h" +#include "mlir/IR/StandardTypes.h" + +namespace { + +template +bool isConstant(const Fortran::evaluate::Expr &e) { + return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e}); +} + +template +int64_t toConstant(const Fortran::evaluate::Expr &e) { + auto opt = Fortran::evaluate::ToInt64(e); + assert(opt.has_value() && "expression didn't resolve to a constant"); + return opt.value(); +} + +#undef TODO +#define TODO() \ + assert(false && "not yet implemented"); \ + return {} + +// one argument template, must be specialized +template +mlir::Type genFIRType(mlir::MLIRContext *, int) { + return {}; +} + +// two argument template +template +mlir::Type genFIRType(mlir::MLIRContext *context) { + if constexpr (TC == Fortran::lower::IntegerCat) { + auto bits{Fortran::evaluate::Type::Scalar::bits}; + return mlir::IntegerType::get(bits, context); + } else if constexpr (TC == Fortran::lower::LogicalCat || + TC == Fortran::lower::CharacterCat || + TC == Fortran::lower::ComplexCat) { + return genFIRType(context, KIND); + } else { + return {}; + } +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF16(context); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getBF16(context); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF32(context); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF64(context); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return fir::RealType::get(context, 10); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context) { + return fir::RealType::get(context, 16); +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context, + int kind) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType(Fortran::lower::RealCat, + kind)) { + switch (kind) { + case 2: + return genFIRType(context); + case 3: + return genFIRType(context); + case 4: + return genFIRType(context); + case 8: + return genFIRType(context); + case 10: + return genFIRType(context); + case 16: + return genFIRType(context); + } + assert(false && "type translation not implemented"); + } + return {}; +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context, + int kind) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType(Fortran::lower::IntegerCat, + kind)) { + switch (kind) { + case 1: + return genFIRType(context); + case 2: + return genFIRType(context); + case 4: + return genFIRType(context); + case 8: + return genFIRType(context); + case 16: + return genFIRType(context); + } + assert(false && "type translation not implemented"); + } + return {}; +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType(Fortran::lower::LogicalCat, + KIND)) + return fir::LogicalType::get(context, KIND); + return {}; +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::lower::CharacterCat, KIND)) + return fir::CharacterType::get(context, KIND); + return {}; +} + +template <> +mlir::Type genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType(Fortran::lower::ComplexCat, + KIND)) + return fir::CplxType::get(context, KIND); + return {}; +} + +/// Recover the type of an Fortran::evaluate::Expr and convert it to an +/// mlir::Type. The type returned can be a MLIR standard or FIR type. +class TypeBuilder { + mlir::MLIRContext *context; + const Fortran::common::IntrinsicTypeDefaultKinds &defaults; + + template + int defaultKind() { + return defaultKind(TC); + } + int defaultKind(Fortran::common::TypeCategory TC) { + return defaults.GetDefaultKind(TC); + } + + mlir::InFlightDiagnostic emitError(const llvm::Twine &message) { + return mlir::emitError(mlir::UnknownLoc::get(context), message); + } + + mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) { + return mlir::emitWarning(mlir::UnknownLoc::get(context), message); + } + +public: + explicit TypeBuilder( + mlir::MLIRContext *context, + const Fortran::common::IntrinsicTypeDefaultKinds &defaults) + : context{context}, defaults{defaults} {} + + // non-template, arguments are runtime values + mlir::Type genFIRTy(Fortran::common::TypeCategory tc, int kind) { + switch (tc) { + case Fortran::lower::RealCat: + return genFIRType(context, kind); + case Fortran::lower::IntegerCat: + return genFIRType(context, kind); + case Fortran::lower::ComplexCat: + return genFIRType(context, kind); + case Fortran::lower::LogicalCat: + return genFIRType(context, kind); + case Fortran::lower::CharacterCat: + return genFIRType(context, kind); + default: + break; + } + assert(false && "unhandled type category"); + return {}; + } + + // non-template, category is runtime values, kind is defaulted + mlir::Type genFIRTy(Fortran::common::TypeCategory tc) { + return genFIRTy(tc, defaultKind(tc)); + } + + mlir::Type gen(const Fortran::evaluate::ImpliedDoIndex &) { + return genFIRType( + context, defaultKind()); + } + + template