From aaf8cb7b89af99cf7ca7c6cc19911ef6b9826e82 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Thu, 30 Oct 2025 20:46:35 +0100 Subject: [PATCH 1/9] CPP modularized bitset module --- CMakeLists.txt | 8 ++++ cmake/stdlib.cmake | 3 ++ doc/specs/stdlib_math.md | 2 +- example/CMakeLists.txt | 14 +++++- example/math/CMakeLists.txt | 2 +- ...le_math_swap.f90 => example_math_swap.F90} | 4 +- example/sorting/CMakeLists.txt | 4 +- include/common.fypp | 47 ++++++++++++++++++- src/CMakeLists.txt | 23 +++++---- src/bitsets/CMakeLists.txt | 9 ++++ src/{ => bitsets}/stdlib_bitsets.fypp | 0 src/{ => bitsets}/stdlib_bitsets_64.fypp | 0 src/{ => bitsets}/stdlib_bitsets_large.fypp | 0 src/stdlib_math.fypp | 11 +++-- src/stdlib_sorting.fypp | 33 ++++++++----- src/stdlib_sorting_ord_sort.fypp | 18 ++++--- src/stdlib_sorting_sort.fypp | 18 ++++--- src/stdlib_sorting_sort_adjoint.fypp | 17 ++++--- test/CMakeLists.txt | 4 +- test/math/CMakeLists.txt | 9 +++- test/math/test_stdlib_math.fypp | 2 + test/sorting/CMakeLists.txt | 4 +- test/sorting/test_sorting.fypp | 36 +++++++++++++- 23 files changed, 210 insertions(+), 58 deletions(-) rename example/math/{example_math_swap.f90 => example_math_swap.F90} (94%) create mode 100644 src/bitsets/CMakeLists.txt rename src/{ => bitsets}/stdlib_bitsets.fypp (100%) rename src/{ => bitsets}/stdlib_bitsets_64.fypp (100%) rename src/{ => bitsets}/stdlib_bitsets_large.fypp (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index a0039d0b5..0567219d1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -49,6 +49,14 @@ if(NOT DEFINED CMAKE_MAXIMUM_RANK) set(CMAKE_MAXIMUM_RANK 4 CACHE STRING "Maximum array rank for generated procedures") endif() + +option(STDLIB_WITH_BITSET "Compile STDLIB BITSET" ON) + +if(STDLIB_WITH_BITSET) + message(STATUS "Enable stdlib bitset module") + add_compile_definitions(STDLIB_BITSET) +endif() + option(FIND_BLAS "Find external BLAS and LAPACK" ON) # --- find external BLAS and LAPACK diff --git a/cmake/stdlib.cmake b/cmake/stdlib.cmake index 0ec86e299..b7032fb52 100644 --- a/cmake/stdlib.cmake +++ b/cmake/stdlib.cmake @@ -101,6 +101,9 @@ function(configure_stdlib_target target_name regular_sources_var fypp_files_var $ $ ) + target_include_directories(${target_name} PRIVATE + ${PROJECT_SOURCE_DIR}/include + ) install(TARGETS ${target_name} EXPORT ${PROJECT_NAME}-targets diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 3d6524e04..80fa7556d 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -93,7 +93,7 @@ All arguments must have same `type` and same `kind`. #### Examples ```fortran -{!example/math/example_math_swap.f90!} +{!example/math/example_math_swap.F90!} ``` ### `gcd` function diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 16c83e332..cbcd07d10 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -6,10 +6,22 @@ macro(ADD_EXAMPLE name) WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) endmacro(ADD_EXAMPLE) +macro(ADD_EXAMPLEPP name) + add_executable(example_${name} example_${name}.F90) + target_link_libraries(example_${name} "${PROJECT_NAME}") + add_test(NAME ${name} + COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +endmacro(ADD_EXAMPLEPP) + + + add_subdirectory(ansi) add_subdirectory(array) add_subdirectory(ascii) -add_subdirectory(bitsets) +if (STDLIB_WITH_BITSET) + add_subdirectory(bitsets) +endif() add_subdirectory(constants) add_subdirectory(error) add_subdirectory(hashmaps) diff --git a/example/math/CMakeLists.txt b/example/math/CMakeLists.txt index 8b834f348..e333df4be 100644 --- a/example/math/CMakeLists.txt +++ b/example/math/CMakeLists.txt @@ -15,5 +15,5 @@ ADD_EXAMPLE(math_argpi) ADD_EXAMPLE(math_deg2rad) ADD_EXAMPLE(math_rad2deg) ADD_EXAMPLE(math_is_close) -ADD_EXAMPLE(math_swap) +ADD_EXAMPLEPP(math_swap) ADD_EXAMPLE(meshgrid) diff --git a/example/math/example_math_swap.f90 b/example/math/example_math_swap.F90 similarity index 94% rename from example/math/example_math_swap.f90 rename to example/math/example_math_swap.F90 index 7c2388b05..45d685c71 100644 --- a/example/math/example_math_swap.f90 +++ b/example/math/example_math_swap.F90 @@ -43,6 +43,7 @@ program example_math_swap call swap(x,y) end block +#ifdef STDLIB_BITSET block use stdlib_bitsets type(bitset_64) :: x, y @@ -50,5 +51,6 @@ program example_math_swap call y%from_string('1111') call swap(x,y) end block +#endif -end program example_math_swap \ No newline at end of file +end program example_math_swap diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 6d64ea2f1..8b9436e24 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -3,4 +3,6 @@ ADD_EXAMPLE(sort) ADD_EXAMPLE(sort_adjoint) ADD_EXAMPLE(sort_index) ADD_EXAMPLE(radix_sort) -ADD_EXAMPLE(sort_bitset) +if (STDLIB_WITH_BITSET) + ADD_EXAMPLE(sort_bitset) +endif() diff --git a/include/common.fypp b/include/common.fypp index de0a7b911..a2f7a3dd3 100644 --- a/include/common.fypp +++ b/include/common.fypp @@ -45,8 +45,11 @@ #:set REAL_TYPES = ["real({})".format(k) for k in REAL_KINDS] #:set REAL_SUFFIX = REAL_KINDS +#! Real CPPS to be considered during templating +#:set REAL_CPPS = ["" for k in REAL_KINDS] + #! Collected (kind, type) tuples for real types -#:set REAL_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_INIT)) +#:set REAL_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_INIT, REAL_CPPS)) #! Complex kinds to be considered during templating #:set CMPLX_KINDS = ["sp", "dp"] @@ -102,8 +105,14 @@ $:"s" if cmplx=="c" else "d" if cmplx=="z" else "x" if cmplx=="y" else "q" if cm #! Integer types to be considered during templating #:set INT_TYPES = ["integer({})".format(k) for k in INT_KINDS] +#! Integer abbreviations to be considered during templating +#:set INT_INIT = ["" for k in INT_KINDS] + +#! Integer CPPs to be considered during templating +#:set INT_CPPS = ["" for k in INT_KINDS] + #! Collected (kind, type) tuples for integer types -#:set INT_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES)) +#:set INT_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES, INT_INIT, INT_CPPS)) #! Logical kinds to be considered during templating #:set LOG_KINDS = ["lk"] @@ -123,6 +132,12 @@ $:"s" if cmplx=="c" else "d" if cmplx=="z" else "x" if cmplx=="y" else "q" if cm #! String types to be considered during templating #:set STRING_TYPES = ["type({})".format(k) for k in STRING_KINDS] +#! String abbreviations to be considered during templating +#:set STRING_INIT = ["" for k in STRING_KINDS] + +#! String CPPs to be considered during templating +#:set STRING_CPPS = ["" for k in STRING_KINDS] + #! Collected (kind, type) tuples for string derived types #:set STRING_KINDS_TYPES = list(zip(STRING_KINDS, STRING_TYPES)) @@ -132,6 +147,15 @@ $:"s" if cmplx=="c" else "d" if cmplx=="z" else "x" if cmplx=="y" else "q" if cm #! Bitset types to be considered during templating #:set BITSET_TYPES = ["type({})".format(k) for k in BITSET_KINDS] +#! Bitset abbreviations directive to be considered during templating +#:set BITSET_INIT = ["" for k in BITSET_KINDS] + +#! Bitset CPP directive to be considered during templating +#:set BITSET_CPPS = ["STDLIB_BITSET" for k in BITSET_KINDS] + +#! Collected (kind, type) tuples for bitset types +#:set BITSET_KINDS_TYPES = list(zip(BITSET_KINDS, BITSET_TYPES, BITSET_INIT, BITSET_CPPS)) + #! Sparse types to be considered during templating #:set SPARSE_KINDS = ["COO", "CSR", "CSC", "ELL"] @@ -463,4 +487,23 @@ ${indent}$do ${varname}$${n+1+dim_offset-i}$ = lbound(${matname}$, ${n+1+dim_off #:endcall #:enddef +#! + +#! +#! Encapsulate code into CPP pre-processing directives #ifdef and #endif +#! +#! Args: +#! code (str): Code to be encapsulated +#! cpp_var (str): CPP variable +#! +#:def generate_cpp(code, cpp_var) + #:if cpp_var != "" +#ifdef ${cpp_var}$ + #:endif + $:code + #:if cpp_var != "" +#endif + #:endif +#:enddef generate_cpp + #:endmute diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 826dc1eda..586517ea6 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,11 +1,11 @@ +if (STDLIB_WITH_BITSET) + add_subdirectory(bitsets) +endif() add_subdirectory(blas) add_subdirectory(lapack) set(fppFiles stdlib_ascii.fypp - stdlib_bitsets.fypp - stdlib_bitsets_64.fypp - stdlib_bitsets_large.fypp stdlib_codata_type.fypp stdlib_constants.fypp stdlib_error.fypp @@ -49,10 +49,6 @@ set(fppFiles stdlib_linalg_matrix_functions.fypp stdlib_optval.fypp stdlib_selection.fypp - stdlib_sorting.fypp - stdlib_sorting_ord_sort.fypp - stdlib_sorting_sort.fypp - stdlib_sorting_sort_adjoint.fypp stdlib_sparse_constants.fypp stdlib_sparse_conversion.fypp stdlib_sparse_kinds.fypp @@ -79,7 +75,6 @@ set(fppFiles stdlib_quadrature_trapz.fypp stdlib_quadrature_simps.fypp stdlib_random.fypp - stdlib_math.fypp stdlib_math_linspace.fypp stdlib_math_logspace.fypp stdlib_math_arange.fypp @@ -94,7 +89,13 @@ set(fppFiles stdlib_strings.fypp stdlib_version.fypp ) -set(cppFiles stdlib_linalg_constants.fypp) +set(cppFiles stdlib_linalg_constants.fypp + stdlib_math.fypp + stdlib_sorting.fypp + stdlib_sorting_ord_sort.fypp + stdlib_sorting_sort.fypp + stdlib_sorting_sort_adjoint.fypp + ) set(f90Files stdlib_ansi.f90 stdlib_ansi_operator.f90 @@ -121,4 +122,6 @@ set(f90Files configure_stdlib_target(${PROJECT_NAME} f90Files fppFiles cppFiles) -target_link_libraries(${PROJECT_NAME} PUBLIC blas lapack) +target_link_libraries(${PROJECT_NAME} PUBLIC + $<$:bitsets> + blas lapack) diff --git a/src/bitsets/CMakeLists.txt b/src/bitsets/CMakeLists.txt new file mode 100644 index 000000000..4f30729ff --- /dev/null +++ b/src/bitsets/CMakeLists.txt @@ -0,0 +1,9 @@ +set(bitsets_fppFiles + ../stdlib_kinds.fypp + ../stdlib_optval.fypp + stdlib_bitsets.fypp + stdlib_bitsets_64.fypp + stdlib_bitsets_large.fypp +) + +configure_stdlib_target(bitsets "" bitsets_fppFiles "") diff --git a/src/stdlib_bitsets.fypp b/src/bitsets/stdlib_bitsets.fypp similarity index 100% rename from src/stdlib_bitsets.fypp rename to src/bitsets/stdlib_bitsets.fypp diff --git a/src/stdlib_bitsets_64.fypp b/src/bitsets/stdlib_bitsets_64.fypp similarity index 100% rename from src/stdlib_bitsets_64.fypp rename to src/bitsets/stdlib_bitsets_64.fypp diff --git a/src/stdlib_bitsets_large.fypp b/src/bitsets/stdlib_bitsets_large.fypp similarity index 100% rename from src/stdlib_bitsets_large.fypp rename to src/bitsets/stdlib_bitsets_large.fypp diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 1b1abb363..540861151 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,11 +1,12 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -#:set BITSET_KINDS_TYPES = list(zip(BITSET_KINDS, BITSET_TYPES)) module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp use stdlib_optval, only: optval +#ifdef STDLIB_BITSET use stdlib_bitsets, only: bitset_64, bitset_large +#endif implicit none private @@ -48,8 +49,10 @@ module stdlib_math !> !> Version: experimental interface swap - #:for k1, t1 in INT_KINDS_TYPES + REAL_KINDS_TYPES + BITSET_KINDS_TYPES + #:for k1, t1, a1, cpp1 in INT_KINDS_TYPES + REAL_KINDS_TYPES + BITSET_KINDS_TYPES + #:block generate_cpp(cpp_var=cpp1) module procedure :: swap_${k1}$ + #:endblock #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES module procedure :: swap_c${k1}$ @@ -527,13 +530,15 @@ contains #:endfor - #:for k1, t1 in INT_KINDS_TYPES + REAL_KINDS_TYPES + BITSET_KINDS_TYPES + #:for k1, t1, a1, cpp1 in INT_KINDS_TYPES + REAL_KINDS_TYPES + BITSET_KINDS_TYPES + #:block generate_cpp(cpp_var=cpp1) elemental subroutine swap_${k1}$(lhs, rhs) ${t1}$, intent(inout) :: lhs, rhs ${t1}$ :: temp temp = lhs; lhs = rhs; rhs = temp end subroutine + #:endblock #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index c675e5f3f..968b9080d 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -1,10 +1,9 @@ #:include "common.fypp" - -#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS)) -#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) -#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) -#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"])) -#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) +#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) +#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS, STRING_CPPS)) +#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"], [""])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS, BITSET_CPPS)) #:set INT_INDEX_TYPES_ALT_NAME = list(zip(["int_index", "int_index_low"], ["integer(int_index)", "integer(int_index_low)"], ["default", "low"])) @@ -134,8 +133,10 @@ module stdlib_sorting use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(>=), operator(<), operator(<=) +#ifdef STDLIB_BITSET use stdlib_bitsets, only: bitset_64, bitset_large, & assignment(=), operator(>), operator(>=), operator(<), operator(<=) +#endif implicit none private @@ -493,7 +494,8 @@ module stdlib_sorting !! sorted data, having O(N) performance on uniformly non-increasing or !! non-decreasing data. -#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) module subroutine ${name1}$_ord_sort( array, work, reverse ) !! Version: experimental !! @@ -504,6 +506,7 @@ module stdlib_sorting logical, intent(in), optional :: reverse end subroutine ${name1}$_ord_sort +#:endblock #:endfor end interface ord_sort @@ -559,7 +562,8 @@ module stdlib_sorting !! on the `introsort` of David Musser. !! ([Specification](../page/specs/stdlib_sorting.html#sort-sorts-an-input-array)) -#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) pure module subroutine ${name1}$_sort( array, reverse ) !! Version: experimental !! @@ -572,6 +576,7 @@ module stdlib_sorting logical, intent(in), optional :: reverse end subroutine ${name1}$_sort +#:endblock #:endfor end interface sort @@ -591,7 +596,8 @@ module stdlib_sorting !! with a value of `.TRUE.` the indices correspond to a non-increasing sort. #:for ti, tii, namei in IR_INDEX_TYPES_ALT_NAME - #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + #:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME + #:block generate_cpp(cpp_var=cpp1) module subroutine ${name1}$_${namei}$_sort_adjoint( array, adjoint_array, work, iwork, & reverse ) !! Version: experimental @@ -608,6 +614,7 @@ module stdlib_sorting logical, intent(in), optional :: reverse end subroutine ${name1}$_${namei}$_sort_adjoint + #:endblock #:endfor #:endfor @@ -628,7 +635,8 @@ module stdlib_sorting !! with a value of `.TRUE.` the indices correspond to a non-increasing sort. #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME - #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + #:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME + #:block generate_cpp(cpp_var=cpp1) !> Version: experimental !> !> `${name1}$_sort_index_${namei}$( array, index[, work, iwork, reverse] )` sorts @@ -637,6 +645,7 @@ module stdlib_sorting !> and returns the sorted `ARRAY` and an array `INDEX` of indices in the !> order that would sort the input `ARRAY` in the desired direction. module procedure ${name1}$_sort_index_${namei}$ + #:endblock #:endfor #:endfor @@ -645,7 +654,8 @@ module stdlib_sorting contains #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME - #:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME + #:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME + #:block generate_cpp(cpp_var=cpp1) subroutine ${name1}$_sort_index_${namei}$( array, index, work, iwork, & reverse ) !! Version: experimental @@ -681,6 +691,7 @@ contains end subroutine ${name1}$_sort_index_${namei}$ + #:endblock #:endfor #:endfor diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index c77e1c797..7e7eaae73 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -1,9 +1,9 @@ #:include "common.fypp" -#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS)) -#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) -#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) -#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"])) -#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) +#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) +#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS, STRING_CPPS)) +#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"], [""])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS, BITSET_CPPS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines @@ -71,7 +71,8 @@ submodule(stdlib_sorting) stdlib_sorting_ord_sort contains -#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, t3, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) module subroutine ${name1}$_ord_sort( array, work, reverse ) ${t1}$, intent(inout) :: array(0:) ${t3}$, intent(out), optional :: work(0:) @@ -84,10 +85,12 @@ contains endif end subroutine ${name1}$_ord_sort +#:endblock #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, t3, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) subroutine ${name1}$_${sname}$_ord_sort( array, work ) ! A translation to Fortran 2008, of the `"Rust" sort` algorithm found in @@ -436,6 +439,7 @@ contains end subroutine ${name1}$_${sname}$_ord_sort +#:endblock #:endfor #:endfor diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index dcca28a0d..5729e7bf6 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -1,9 +1,9 @@ #:include "common.fypp" -#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS)) -#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) -#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS)) -#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"])) -#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) +#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) +#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS, STRING_CPPS)) +#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=len(array))"], ["char"], [""])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_KINDS, BITSET_CPPS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines @@ -75,7 +75,8 @@ submodule(stdlib_sorting) stdlib_sorting_sort contains -#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) pure module subroutine ${name1}$_sort( array, reverse ) ${t1}$, intent(inout) :: array(0:) logical, intent(in), optional :: reverse @@ -86,10 +87,12 @@ contains call ${name1}$_increase_sort(array) endif end subroutine ${name1}$_sort +#:endblock #:endfor #:for sname, signt, signoppt in SIGN_NAME_TYPE -#:for t1, t2, name1 in IRSCB_TYPES_ALT_NAME +#:for t1, t2, name1, cpp1 in IRSCB_TYPES_ALT_NAME +#:block generate_cpp(cpp_var=cpp1) pure subroutine ${name1}$_${sname}$_sort( array ) ! `${name1}$_${sname}$_sort( array )` sorts the input `ARRAY` of type `${t1}$` @@ -256,6 +259,7 @@ contains end subroutine ${name1}$_${sname}$_sort +#:endblock #:endfor #:endfor diff --git a/src/stdlib_sorting_sort_adjoint.fypp b/src/stdlib_sorting_sort_adjoint.fypp index a8b99b034..c3b4e32e7 100644 --- a/src/stdlib_sorting_sort_adjoint.fypp +++ b/src/stdlib_sorting_sort_adjoint.fypp @@ -1,9 +1,9 @@ #:include "common.fypp" -#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS)) -#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS)) -#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS)) -#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"])) -#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS)) +#:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) +#:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) +#:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_TYPES, STRING_KINDS, STRING_CPPS)) +#:set CHAR_TYPES_ALT_NAME = list(zip(["character(len=*)"], ["character(len=:)"], ["character(len=len(array))"], ["char"], [""])) +#:set BITSET_TYPES_ALT_NAME = list(zip(BITSET_TYPES, BITSET_TYPES, BITSET_TYPES, BITSET_KINDS, BITSET_CPPS)) #! For better code reuse in fypp, make lists that contain the input types, #! with each having output types and a separate name prefix for subroutines @@ -67,8 +67,10 @@ submodule(stdlib_sorting) stdlib_sorting_sort_adjoint contains -#:for ki, ti, tii, namei in IR_INDEX_TYPES_ALT_NAME - #:for t1, t2, t3, name1 in IRSCB_TYPES_ALT_NAME +#:for ki, ti, tii, namei, cppi in IR_INDEX_TYPES_ALT_NAME + #:for t1, t2, t3, name1, cpp1 in IRSCB_TYPES_ALT_NAME + #:block generate_cpp(cpp_var=cpp1) + module subroutine ${name1}$_${namei}$_sort_adjoint( array, adjoint_array, work, iwork, reverse ) ! A modification of `${name1}$_ord_sort` to return an array of indices that @@ -484,6 +486,7 @@ contains end subroutine ${name1}$_${namei}$_sort_adjoint + #:endblock #:endfor #:endfor diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 92e06c987..aecb237f6 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -29,7 +29,9 @@ endmacro(ADDTESTPP) add_subdirectory(array) add_subdirectory(ascii) -add_subdirectory(bitsets) +if (STDLIB_WITH_BITSET) + add_subdirectory(bitsets) +endif() add_subdirectory(constants) add_subdirectory(hash_functions) add_subdirectory(hash_functions_perf) diff --git a/test/math/CMakeLists.txt b/test/math/CMakeLists.txt index 315bb084a..49d5984ac 100644 --- a/test/math/CMakeLists.txt +++ b/test/math/CMakeLists.txt @@ -1,11 +1,16 @@ set( fppFiles - "test_stdlib_math.fypp" "test_meshgrid.fypp" ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) -ADDTEST(stdlib_math) +set( + cppFiles + "test_stdlib_math.fypp" +) +fypp_f90pp("${fyppFlags}" "${cppFiles}" outFiles) + +ADDTESTPP(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) ADDTEST(meshgrid) diff --git a/test/math/test_stdlib_math.fypp b/test/math/test_stdlib_math.fypp index 1365756b9..66fa5f5a2 100644 --- a/test/math/test_stdlib_math.fypp +++ b/test/math/test_stdlib_math.fypp @@ -370,6 +370,7 @@ contains if (allocated(error)) return end subroutine test_swap_stt +#ifdef STDLIB_BITSET subroutine test_swap_bitset_64(error) use stdlib_bitsets type(error_type), allocatable, intent(out) :: error @@ -415,6 +416,7 @@ contains call check(error, x == v ) if (allocated(error)) return end subroutine test_swap_bitset_large +#endif #:for k1 in CMPLX_KINDS subroutine test_arg_${k1}$(error) diff --git a/test/sorting/CMakeLists.txt b/test/sorting/CMakeLists.txt index 624b36b1e..de18bbd80 100644 --- a/test/sorting/CMakeLists.txt +++ b/test/sorting/CMakeLists.txt @@ -2,6 +2,6 @@ set( fppFiles "test_sorting.fypp" ) -fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) +fypp_f90pp("${fyppFlags}" "${fppFiles}" outFiles) -ADDTEST(sorting) +ADDTESTPP(sorting) diff --git a/test/sorting/test_sorting.fypp b/test/sorting/test_sorting.fypp index 025440147..4ba34d5f6 100644 --- a/test/sorting/test_sorting.fypp +++ b/test/sorting/test_sorting.fypp @@ -11,8 +11,10 @@ module test_sorting use stdlib_sorting, only: sort, sort_index, sort_adjoint, ord_sort, radix_sort, int_index, int_index_low use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(<), write(formatted) +#ifdef STDLIB_BITSET use stdlib_bitsets, only: bitset_64, bitset_large, & assignment(=), operator(>), operator(<) +#endif use testdrive, only: new_unittest, unittest_type, error_type, check implicit none @@ -22,7 +24,9 @@ module test_sorting integer(int32), parameter :: test_size = 2_int32**test_power integer(int32), parameter :: char_size = char_set_size**4 integer(int32), parameter :: string_size = char_set_size**3 +#ifdef STDLIB_BITSET integer(int32), parameter :: bitset_size = char_set_size**3 +#endif integer(int32), parameter :: block_size = test_size/6 integer, parameter :: repeat = 1 @@ -45,6 +49,7 @@ module test_sorting string_decrease(0:string_size-1), & string_increase(0:string_size-1), & string_rand(0:string_size-1) +#ifdef STDLIB_BITSET type(bitset_large) :: & bitsetl_decrease(0:bitset_size-1), & bitsetl_increase(0:bitset_size-1), & @@ -53,20 +58,25 @@ module test_sorting bitset64_decrease(0:bitset_size-1), & bitset64_increase(0:bitset_size-1), & bitset64_rand(0:bitset_size-1) +#endif integer(int32) :: dummy(0:test_size-1) real(sp) :: real_dummy(0:test_size-1) character(len=4) :: char_dummy(0:char_size-1) type(string_type) :: string_dummy(0:string_size-1) +#ifdef STDLIB_BITSET type(bitset_large) :: bitsetl_dummy(0:bitset_size-1) type(bitset_64) :: bitset64_dummy(0:bitset_size-1) +#endif integer(int_index) :: index_default(0:max(test_size, char_size, string_size)-1) integer(int_index_low) :: index_low(0:max(test_size, char_size, string_size)-1) integer(int32) :: work(0:test_size/2-1) character(len=4) :: char_work(0:char_size/2-1) type(string_type) :: string_work(0:string_size/2-1) +#ifdef STDLIB_BITSET type(bitset_large) :: bitsetl_work(0:bitset_size/2-1) type(bitset_64) :: bitset64_work(0:bitset_size/2-1) +#endif integer(int_index) :: iwork_default(0:max(test_size, char_size, & string_size)/2-1) integer(int_index_low) :: iwork_low(0:max(test_size, char_size, & @@ -77,8 +87,10 @@ module test_sorting integer :: lun character(len=4) :: char_temp type(string_type) :: string_temp +#ifdef STDLIB_BITSET type(bitset_large) :: bitsetl_temp type(bitset_64) :: bitset64_temp +#endif logical :: ltest, ldummy character(32) :: bin32 character(64) :: bin64 @@ -93,28 +105,36 @@ contains testsuite = [ & new_unittest('char_ord_sorts', test_char_ord_sorts), & new_unittest('string_ord_sorts', test_string_ord_sorts), & +#ifdef STDLIB_BITSET new_unittest('bitset_large_ord_sorts', test_bitsetl_ord_sorts), & new_unittest('bitset_64_ord_sorts', test_bitset64_ord_sorts), & +#endif new_unittest('int_radix_sorts', test_int_radix_sorts), & new_unittest('real_radix_sorts', test_real_radix_sorts), & new_unittest('int_sorts', test_int_sorts), & new_unittest('char_sorts', test_char_sorts), & new_unittest('string_sorts', test_string_sorts), & +#ifdef STDLIB_BITSET new_unittest('bitset_large_sorts', test_bitsetl_sorts), & new_unittest('bitset_64_sorts', test_bitset64_sorts), & +#endif #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME new_unittest('int_sort_indexes_${namei}$', test_int_sort_indexes_${namei}$), & new_unittest('char_sort_indexes_${namei}$', test_char_sort_indexes_${namei}$), & new_unittest('string_sort_indexes_${namei}$', test_string_sort_indexes_${namei}$), & +#ifdef STDLIB_BITSET new_unittest('bitset_large_sort_indexes_${namei}$', test_bitsetl_sort_indexes_${namei}$), & new_unittest('bitset_64_sort_indexes_${namei}$', test_bitset64_sort_indexes_${namei}$), & +#endif #:endfor #:for ki, ti, namei in INT_TYPES_ALT_NAME new_unittest('int_sort_adjointes_${namei}$', test_int_sort_adjointes_${namei}$), & new_unittest('char_sort_adjointes_${namei}$', test_char_sort_adjointes_${namei}$), & new_unittest('string_sort_adjointes_${namei}$', test_string_sort_adjointes_${namei}$), & +#ifdef STDLIB_BITSET new_unittest('bitset_large_sort_adjointes_${namei}$', test_bitsetl_sort_adjointes_${namei}$), & new_unittest('bitset_64_sort_adjointes_${namei}$', test_bitset64_sort_adjointes_${namei}$), & +#endif #:endfor #:for ki, ti, namei in REAL_TYPES_ALT_NAME new_unittest('real_sort_adjointes_${namei}$', test_real_sort_adjointes_${namei}$), & @@ -219,6 +239,7 @@ contains string_rand(index1) = string_temp end do +#ifdef STDLIB_BITSET do i = 0, bitset_size-1 write(bin32,'(b32.32)') i call bitsetl_increase(i)%from_string(bin32) @@ -252,6 +273,7 @@ contains bitset64_rand(i) = bitset64_rand(index1) bitset64_rand(index1) = bitset64_temp end do +#endif ! Create and intialize file to report the results of the sortings open( newunit=lun, file=filename, access='sequential', action='write', & @@ -533,6 +555,7 @@ contains end subroutine test_string_ord_sort +#ifdef STDLIB_BITSET subroutine test_bitsetl_ord_sorts(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -706,6 +729,7 @@ contains end if end subroutine test_bitset64_ord_sort +#endif subroutine test_int_radix_sorts(error) !> Error handling @@ -1088,6 +1112,7 @@ contains end subroutine test_string_sort +#ifdef STDLIB_BITSET subroutine test_bitsetl_sorts(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -1227,6 +1252,7 @@ contains bin_im1, bin_i end if end subroutine test_bitset64_sort +#endif #:for ki, ti, namei in INT_INDEX_TYPES_ALT_NAME subroutine test_int_sort_indexes_${namei}$(error) @@ -1440,6 +1466,7 @@ contains end subroutine test_string_sort_index_${namei}$ +#ifdef STDLIB_BITSET subroutine test_bitsetl_sort_indexes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -1553,6 +1580,7 @@ contains bitset_size, a_name, "Sort_Index", tdiff/rate end subroutine test_bitset64_sort_index_${namei}$ +#endif #:endfor #:for ki, ti, namei in INT_TYPES_ALT_NAME @@ -1778,6 +1806,7 @@ contains end subroutine test_string_sort_adjoint_${namei}$ +#ifdef STDLIB_BITSET subroutine test_bitsetl_sort_adjointes_${namei}$(error) !> Error handling type(error_type), allocatable, intent(out) :: error @@ -1897,6 +1926,7 @@ contains bitset_size, a_name, "Sort_adjoint", tdiff/rate end subroutine test_bitset64_sort_adjoint_${namei}$ +#endif #:endfor #:for ki, ti, namei in REAL_TYPES_ALT_NAME @@ -2077,6 +2107,7 @@ contains end subroutine verify_string_sort +#ifdef STDLIB_BITSET subroutine verify_bitsetl_sort( a, valid, i ) type(bitset_large), intent(in) :: a(0:) logical, intent(out) :: valid @@ -2108,7 +2139,8 @@ contains valid = .true. end subroutine verify_bitset64_sort - +#endif + subroutine verify_char_sort( a, valid, i ) character(len=4), intent(in) :: a(0:) logical, intent(out) :: valid @@ -2189,6 +2221,7 @@ contains end subroutine verify_string_reverse_sort +#ifdef STDLIB_BITSET subroutine verify_bitsetl_reverse_sort( a, valid, i ) type(bitset_large), intent(in) :: a(0:) logical, intent(out) :: valid @@ -2220,6 +2253,7 @@ contains valid = .true. end subroutine verify_bitset64_reverse_sort +#endif end module test_sorting From 123744da9720b43b960d7304743ce4bd2416bdd0 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Thu, 30 Oct 2025 20:49:26 +0100 Subject: [PATCH 2/9] Addition of modular ci --- .github/workflows/ci_modular.yml | 80 ++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 .github/workflows/ci_modular.yml diff --git a/.github/workflows/ci_modular.yml b/.github/workflows/ci_modular.yml new file mode 100644 index 000000000..91e623ed5 --- /dev/null +++ b/.github/workflows/ci_modular.yml @@ -0,0 +1,80 @@ +name: CI + +on: [push, pull_request] + +env: + CMAKE_BUILD_PARALLEL_LEVEL: "2" # 2 cores on each GHA VM, enable parallel builds + CTEST_OUTPUT_ON_FAILURE: "ON" # This way we don't need a flag to ctest + CTEST_PARALLEL_LEVEL: "2" + CTEST_TIME_TIMEOUT: "5" # some failures hang forever + HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker + HOMEBREW_NO_AUTO_UPDATE: "ON" + HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" + HOMEBREW_NO_GITHUB_API: "ON" + HOMEBREW_NO_INSTALL_CLEANUP: "ON" + +jobs: + Build: + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: [ubuntu-latest] + toolchain: + - {compiler: gcc, version: 14} + build: [cmake] + with_bitset: [On, Off] + env: + BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} + + steps: + - name: Checkout code + uses: actions/checkout@v4 + + - name: Set up Python 3.x + uses: actions/setup-python@v5 # Use pip to install latest CMake, & FORD/Jin2For, etc. + with: + python-version: 3.x + + - name: Install fypp + run: pip install --upgrade fypp ninja + + - name: Setup Fortran compiler + uses: fortran-lang/setup-fortran@v1.6.2 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.compiler }} + version: ${{ matrix.toolchain.version }} + + # Build and test with built-in BLAS and LAPACK + - name: Configure with CMake + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + cmake -Wdev -G Ninja + -DCMAKE_BUILD_TYPE=Release + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist + -DFIND_BLAS:STRING=FALSE + -DSTDLIB_WITH_BITSET:STRING=${{ matrix.with_bitset }} + -S . -B ${{ env.BUILD_DIR }} + + - name: Build and compile + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --build ${{ env.BUILD_DIR }} --parallel + + - name: catch build fail + if: ${{ failure() && contains(matrix.build, 'cmake') }} + run: cmake --build ${{ env.BUILD_DIR }} --verbose --parallel 1 + + - name: test + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + ctest + --test-dir ${{ env.BUILD_DIR }} + --parallel + --output-on-failure + --no-tests=error + + - name: Install project + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --install ${{ env.BUILD_DIR }} From 04c9acca8f484f49f48275e86900e6d99ed08f7b Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Thu, 30 Oct 2025 21:01:16 +0100 Subject: [PATCH 3/9] Cleaning of some files --- cmake/stdlib.cmake | 3 --- include/common.fypp | 2 -- src/stdlib_sorting.fypp | 1 + 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/cmake/stdlib.cmake b/cmake/stdlib.cmake index b7032fb52..0ec86e299 100644 --- a/cmake/stdlib.cmake +++ b/cmake/stdlib.cmake @@ -101,9 +101,6 @@ function(configure_stdlib_target target_name regular_sources_var fypp_files_var $ $ ) - target_include_directories(${target_name} PRIVATE - ${PROJECT_SOURCE_DIR}/include - ) install(TARGETS ${target_name} EXPORT ${PROJECT_NAME}-targets diff --git a/include/common.fypp b/include/common.fypp index a2f7a3dd3..29a596cb8 100644 --- a/include/common.fypp +++ b/include/common.fypp @@ -487,8 +487,6 @@ ${indent}$do ${varname}$${n+1+dim_offset-i}$ = lbound(${matname}$, ${n+1+dim_off #:endcall #:enddef -#! - #! #! Encapsulate code into CPP pre-processing directives #ifdef and #endif #! diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index 968b9080d..dade10bfe 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -1,4 +1,5 @@ #:include "common.fypp" + #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) #:set STRING_TYPES_ALT_NAME = list(zip(STRING_TYPES, STRING_TYPES, STRING_KINDS, STRING_CPPS)) From 75d904c5ccad5ae6f7325a9b7511a8693587bff3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Thu, 30 Oct 2025 21:10:59 +0100 Subject: [PATCH 4/9] Adapt fypp_deployment for new CPP files --- config/fypp_deployment.py | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/config/fypp_deployment.py b/config/fypp_deployment.py index aa44b1df0..eb805b83d 100644 --- a/config/fypp_deployment.py +++ b/config/fypp_deployment.py @@ -4,10 +4,18 @@ from joblib import Parallel, delayed C_PREPROCESSED = ( + "example_math_swap", "stdlib_linalg_constants" , "stdlib_linalg_blas" , "stdlib_linalg_lapack", - "test_blas_lapack" + "stdlib_math", + "stdlib_sorting", + "stdlib_sorting_ord_sort", + "stdlib_sorting_sort", + "stdlib_sorting_sort_adjoint", + "test_blas_lapack", + "test_stdlib_math", + "test_sorting" ) def pre_process_fypp(args): From 4f279e63c266b6450f48b79e3d5748d329cca93c Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 1 Nov 2025 23:07:21 +0100 Subject: [PATCH 5/9] Addition of macros.inc --- .github/workflows/ci_modular.yml | 2 +- CMakeLists.txt | 10 +++++----- example/CMakeLists.txt | 2 +- example/math/example_math_swap.F90 | 1 + example/sorting/CMakeLists.txt | 2 +- include/macros.inc | 7 +++++++ src/CMakeLists.txt | 4 ++-- src/stdlib_math.fypp | 1 + src/stdlib_sorting.fypp | 1 + src/stdlib_sorting_ord_sort.fypp | 1 + src/stdlib_sorting_sort.fypp | 1 + src/stdlib_sorting_sort_adjoint.fypp | 1 + test/CMakeLists.txt | 2 +- test/sorting/test_sorting.fypp | 1 + 14 files changed, 25 insertions(+), 11 deletions(-) create mode 100644 include/macros.inc diff --git a/.github/workflows/ci_modular.yml b/.github/workflows/ci_modular.yml index 91e623ed5..912734959 100644 --- a/.github/workflows/ci_modular.yml +++ b/.github/workflows/ci_modular.yml @@ -55,7 +55,7 @@ jobs: -DCMAKE_MAXIMUM_RANK:String=4 -DCMAKE_INSTALL_PREFIX=$PWD/_dist -DFIND_BLAS:STRING=FALSE - -DSTDLIB_WITH_BITSET:STRING=${{ matrix.with_bitset }} + -DSTDLIB_NO_BITSET:STRING=${{ matrix.with_bitset }} -S . -B ${{ env.BUILD_DIR }} - name: Build and compile diff --git a/CMakeLists.txt b/CMakeLists.txt index 0567219d1..da7cc24e8 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -49,12 +49,11 @@ if(NOT DEFINED CMAKE_MAXIMUM_RANK) set(CMAKE_MAXIMUM_RANK 4 CACHE STRING "Maximum array rank for generated procedures") endif() +option(STDLIB_NO_BITSET "Does not compile STDLIB BITSET" OFF) -option(STDLIB_WITH_BITSET "Compile STDLIB BITSET" ON) - -if(STDLIB_WITH_BITSET) - message(STATUS "Enable stdlib bitset module") - add_compile_definitions(STDLIB_BITSET) +if(STDLIB_NO_BITSET) + message(STATUS "Disable stdlib bitset module") + add_compile_definitions(STDLIB_NO_BITSET) endif() option(FIND_BLAS "Find external BLAS and LAPACK" ON) @@ -136,6 +135,7 @@ list( "-I${PROJECT_SOURCE_DIR}/include" ) +include_directories(${PROJECT_SOURCE_DIR}/include) add_subdirectory(src) if(BUILD_TESTING) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cbcd07d10..64114892a 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -19,7 +19,7 @@ endmacro(ADD_EXAMPLEPP) add_subdirectory(ansi) add_subdirectory(array) add_subdirectory(ascii) -if (STDLIB_WITH_BITSET) +if (NOT STDLIB_NO_BITSET) add_subdirectory(bitsets) endif() add_subdirectory(constants) diff --git a/example/math/example_math_swap.F90 b/example/math/example_math_swap.F90 index 45d685c71..f6957eccb 100644 --- a/example/math/example_math_swap.F90 +++ b/example/math/example_math_swap.F90 @@ -1,3 +1,4 @@ +#include 'macros.inc' program example_math_swap use stdlib_math, only: swap implicit none diff --git a/example/sorting/CMakeLists.txt b/example/sorting/CMakeLists.txt index 8b9436e24..426379cbe 100644 --- a/example/sorting/CMakeLists.txt +++ b/example/sorting/CMakeLists.txt @@ -3,6 +3,6 @@ ADD_EXAMPLE(sort) ADD_EXAMPLE(sort_adjoint) ADD_EXAMPLE(sort_index) ADD_EXAMPLE(radix_sort) -if (STDLIB_WITH_BITSET) +if (NOT STDLIB_NO_BITSET) ADD_EXAMPLE(sort_bitset) endif() diff --git a/include/macros.inc b/include/macros.inc new file mode 100644 index 000000000..5fa8182f3 --- /dev/null +++ b/include/macros.inc @@ -0,0 +1,7 @@ + +!Default: compile the bitset module +#define STDLIB_BITSET + +#ifdef STDLIB_NO_BITSET + #undef STDLIB_BITSET +#endif diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 586517ea6..8d181b115 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,4 +1,4 @@ -if (STDLIB_WITH_BITSET) +if (NOT STDLIB_NO_BITSET) add_subdirectory(bitsets) endif() add_subdirectory(blas) @@ -123,5 +123,5 @@ set(f90Files configure_stdlib_target(${PROJECT_NAME} f90Files fppFiles cppFiles) target_link_libraries(${PROJECT_NAME} PUBLIC - $<$:bitsets> + $<$>:bitsets> blas lapack) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 540861151..13874f318 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index dade10bfe..c2be4b46e 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 7e7eaae73..9d593c47a 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index 5729e7bf6..7fb818cfc 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/src/stdlib_sorting_sort_adjoint.fypp b/src/stdlib_sorting_sort_adjoint.fypp index c3b4e32e7..810bce0bb 100644 --- a/src/stdlib_sorting_sort_adjoint.fypp +++ b/src/stdlib_sorting_sort_adjoint.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index aecb237f6..f22c0c30f 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -29,7 +29,7 @@ endmacro(ADDTESTPP) add_subdirectory(array) add_subdirectory(ascii) -if (STDLIB_WITH_BITSET) +if (NOT STDLIB_NO_BITSET) add_subdirectory(bitsets) endif() add_subdirectory(constants) diff --git a/test/sorting/test_sorting.fypp b/test/sorting/test_sorting.fypp index 4ba34d5f6..ebfbb79f6 100644 --- a/test/sorting/test_sorting.fypp +++ b/test/sorting/test_sorting.fypp @@ -1,3 +1,4 @@ +#include 'macros.inc' #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) From e613be1ff52bf78847ffe0e45e13ebfd240d2855 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 1 Nov 2025 23:15:00 +0100 Subject: [PATCH 6/9] Replace " in include statements --- example/math/example_math_swap.F90 | 2 +- src/stdlib_math.fypp | 2 +- src/stdlib_sorting.fypp | 2 +- src/stdlib_sorting_ord_sort.fypp | 2 +- src/stdlib_sorting_sort.fypp | 2 +- src/stdlib_sorting_sort_adjoint.fypp | 2 +- test/sorting/test_sorting.fypp | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/example/math/example_math_swap.F90 b/example/math/example_math_swap.F90 index f6957eccb..0faba48d1 100644 --- a/example/math/example_math_swap.F90 +++ b/example/math/example_math_swap.F90 @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" program example_math_swap use stdlib_math, only: swap implicit none diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 13874f318..f63c3e0a2 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index c2be4b46e..0d331d6b5 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 9d593c47a..41e6a4043 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index 7fb818cfc..290f313d1 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/src/stdlib_sorting_sort_adjoint.fypp b/src/stdlib_sorting_sort_adjoint.fypp index 810bce0bb..3e0d7ac69 100644 --- a/src/stdlib_sorting_sort_adjoint.fypp +++ b/src/stdlib_sorting_sort_adjoint.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_TYPES, INT_KINDS, INT_CPPS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_TYPES, REAL_KINDS, REAL_CPPS)) diff --git a/test/sorting/test_sorting.fypp b/test/sorting/test_sorting.fypp index ebfbb79f6..a43e3b0d6 100644 --- a/test/sorting/test_sorting.fypp +++ b/test/sorting/test_sorting.fypp @@ -1,4 +1,4 @@ -#include 'macros.inc' +#include "macros.inc" #:include "common.fypp" #:set INT_TYPES_ALT_NAME = list(zip(INT_TYPES, INT_TYPES, INT_KINDS)) #:set REAL_TYPES_ALT_NAME = list(zip(REAL_TYPES, REAL_TYPES, REAL_KINDS)) From f7efea08cadae46a8fe5422b5082298f80ebe0f5 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 1 Nov 2025 23:21:02 +0100 Subject: [PATCH 7/9] fix macros.inc --- include/macros.inc | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/include/macros.inc b/include/macros.inc index 5fa8182f3..914333bbe 100644 --- a/include/macros.inc +++ b/include/macros.inc @@ -1,7 +1,6 @@ !Default: compile the bitset module -#define STDLIB_BITSET - #ifdef STDLIB_NO_BITSET - #undef STDLIB_BITSET +#else + #define STDLIB_BITSET #endif From f0075a4f12143b26b11f10494a4d1f3660120458 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 1 Nov 2025 23:23:40 +0100 Subject: [PATCH 8/9] fix macros.inc --- include/macros.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/macros.inc b/include/macros.inc index 914333bbe..ff5a3061c 100644 --- a/include/macros.inc +++ b/include/macros.inc @@ -2,5 +2,5 @@ !Default: compile the bitset module #ifdef STDLIB_NO_BITSET #else - #define STDLIB_BITSET + #define STDLIB_BITSET 1 #endif From 03490c1d2564fff427c0088ce894bb2c28f85b15 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 1 Nov 2025 23:26:55 +0100 Subject: [PATCH 9/9] fix macros.inc --- include/macros.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/macros.inc b/include/macros.inc index ff5a3061c..81bc57501 100644 --- a/include/macros.inc +++ b/include/macros.inc @@ -2,5 +2,5 @@ !Default: compile the bitset module #ifdef STDLIB_NO_BITSET #else - #define STDLIB_BITSET 1 +#define STDLIB_BITSET #endif